Added service_slim

fcs/fcs-test/Program.fs

@@ -0,0 +1,127 @@
+open System.IO
+open System.Collections.Generic
+open FSharp.Compiler
+open FSharp.Compiler.SourceCodeServices
+
+let getProjectOptions (folder: string) (projectFile: string) =
+    let runProcess (workingDir: string) (exePath: string) (args: string) =
+        let psi = System.Diagnostics.ProcessStartInfo()
+        psi.FileName <- exePath
+        psi.WorkingDirectory <- workingDir
+        psi.RedirectStandardOutput <- false
+        psi.RedirectStandardError <- false
+        psi.Arguments <- args
+        psi.CreateNoWindow <- true
+        psi.UseShellExecute <- false
+
+        use p = new System.Diagnostics.Process()
+        p.StartInfo <- psi
+        p.Start() |> ignore
+        p.WaitForExit()
+
+        let exitCode = p.ExitCode
+        exitCode, ()
+
+    let runCmd exePath args = runProcess folder exePath (args |> String.concat " ")
+    let msbuildExec = Dotnet.ProjInfo.Inspect.dotnetMsbuild runCmd
+    let result = Dotnet.ProjInfo.Inspect.getProjectInfo ignore msbuildExec Dotnet.ProjInfo.Inspect.getFscArgs projectFile
+    match result with
+    | Ok (Dotnet.ProjInfo.Inspect.GetResult.FscArgs x) -> x
+    | _ -> []
+
+let mkStandardProjectReferences () = 
+    let projFile = "fcs-test.fsproj"
+    let projDir = __SOURCE_DIRECTORY__
+    getProjectOptions projDir projFile
+    |> List.filter (fun s -> s.StartsWith("-r:"))
+    |> List.map (fun s -> s.Replace("-r:", ""))
+
+let mkProjectCommandLineArgsForScript (dllName, fileNames) = 
+    [|  yield "--simpleresolution" 
+        yield "--noframework" 
+        yield "--debug:full" 
+        yield "--define:DEBUG" 
+        yield "--optimize-" 
+        yield "--out:" + dllName
+        yield "--doc:test.xml" 
+        yield "--warn:3" 
+        yield "--fullpaths" 
+        yield "--flaterrors" 
+        yield "--target:library" 
+        for x in fileNames do 
+            yield x
+        let references = mkStandardProjectReferences ()
+        for r in references do
+            yield "-r:" + r
+     |]
+
+let getProjectOptionsFromCommandLineArgs(projName, argv) = 
+      { ProjectFileName = projName
+        ProjectId = None
+        SourceFiles = [| |]
+        OtherOptions = argv
+        ReferencedProjects = [| |]  
+        IsIncompleteTypeCheckEnvironment = false
+        UseScriptResolutionRules = false
+        LoadTime = System.DateTime.MaxValue
+        UnresolvedReferences = None
+        OriginalLoadReferences = []
+        ExtraProjectInfo = None
+        Stamp = None }
+
+let printAst title (projectResults: FSharpCheckProjectResults) =
+    let implFiles = projectResults.AssemblyContents.ImplementationFiles
+    let decls = implFiles
+                |> Seq.collect (fun file -> AstPrint.printFSharpDecls "" file.Declarations)
+                |> String.concat "\n"
+    printfn "%s Typed AST:" title
+    decls |> printfn "%s"
+
+[<EntryPoint>]
+let main argv = 
+    let projName = "Project.fsproj"
+    let fileName = "test_script.fsx"
+    let fileNames = [| fileName |]
+    let source = File.ReadAllText (fileName, System.Text.Encoding.UTF8)
+    let sources =  [| source |]
+
+    let dllName = Path.ChangeExtension(fileName, ".dll")
+    let args = mkProjectCommandLineArgsForScript (dllName, fileNames)
+    // for arg in args do printfn "%s" arg
+
+    let projectOptions = getProjectOptionsFromCommandLineArgs (projName, args)
+    let checker = InteractiveChecker.Create(projectOptions)
+
+    // // parse and typecheck a project
+    // let projectResults = checker.ParseAndCheckProject(projName, fileNames, sources)
+    // projectResults.Errors |> Array.iter (fun e -> printfn "%A: %A" (e.Severity) e)
+    // printAst "ParseAndCheckProject" projectResults
+
+    // or just parse and typecheck a file in project
+    let parseResults, tcResultsOpt, projectResults =
+        checker.ParseAndCheckFileInProject(fileName, projName, fileNames, sources)
+    projectResults.Errors |> Array.iter (fun e -> printfn "%A: %A" (e.Severity) e)
+
+    match tcResultsOpt with
+    | Some typeCheckResults ->
+        printAst "ParseAndCheckFileInProject" projectResults
+
+        let inputLines = source.Split('\n')
+        async {
+            // Get tool tip at the specified location
+            let! tip = typeCheckResults.GetToolTipText(4, 7, inputLines.[3], ["foo"], FSharpTokenTag.IDENT)
+            (sprintf "%A" tip).Replace("\n","") |> printfn "\n---> ToolTip Text = %A" // should be "FSharpToolTipText [...]"
+
+            // Get declarations (autocomplete) for msg
+            let partialName = { QualifyingIdents = []; PartialIdent = "msg"; EndColumn = 17; LastDotPos = None }
+            let! decls = typeCheckResults.GetDeclarationListInfo(Some parseResults, 6, inputLines.[5], partialName, (fun _ -> []), fun _ -> false)
+            [ for item in decls.Items -> item.Name ] |> printfn "\n---> msg AutoComplete = %A" // should be string methods
+
+            // Get declarations (autocomplete) for canvas
+            let partialName = { QualifyingIdents = []; PartialIdent = "canvas"; EndColumn = 10; LastDotPos = None }
+            let! decls = typeCheckResults.GetDeclarationListInfo(Some parseResults, 8, inputLines.[7], partialName, (fun _ -> []), fun _ -> false)
+            [ for item in decls.Items -> item.Name ] |> printfn "\n---> canvas AutoComplete = %A"
+        } |> Async.StartImmediate
+
+    | _ -> ()
+    0

fcs/fcs-test/Properties/launchSettings.json

@@ -0,0 +1,8 @@
+{
+  "profiles": {
+    "fcs-test": {
+      "commandName": "Project",
+      "workingDirectory": "$(SolutionDir)"
+    }
+  }
+}

fcs/fcs-test/ast_print.fs

@@ -0,0 +1,101 @@
+// Copyright (c) Microsoft Corporation.  All Rights Reserved.  Licensed under the Apache License, Version 2.0.  See License.txt in the project root for license information.
+
+namespace FSharp.Compiler.SourceCodeServices
+
+//-------------------------------------------------------------------------
+// AstPrint
+//-------------------------------------------------------------------------
+
+module AstPrint =
+
+    let attribsOfSymbol (s:FSharpSymbol) =
+        [ match s with
+            | :? FSharpField as v ->
+                yield "field"
+                if v.IsCompilerGenerated then yield "compgen"
+                if v.IsDefaultValue then yield "default"
+                if v.IsMutable then yield "mutable"
+                if v.IsVolatile then yield "volatile"
+                if v.IsStatic then yield "static"
+                if v.IsLiteral then yield sprintf "%A" v.LiteralValue.Value
+
+            | :? FSharpEntity as v ->
+                v.TryFullName |> ignore // check there is no failure here
+                match v.BaseType with
+                | Some t when t.HasTypeDefinition && t.TypeDefinition.TryFullName.IsSome ->
+                    yield sprintf "inherits %s" t.TypeDefinition.FullName
+                | _ -> ()
+                if v.IsNamespace then yield "namespace"
+                if v.IsFSharpModule then yield "module"
+                if v.IsByRef then yield "byref"
+                if v.IsClass then yield "class"
+                if v.IsDelegate then yield "delegate"
+                if v.IsEnum then yield "enum"
+                if v.IsFSharpAbbreviation then yield "abbrev"
+                if v.IsFSharpExceptionDeclaration then yield "exception"
+                if v.IsFSharpRecord then yield "record"
+                if v.IsFSharpUnion then yield "union"
+                if v.IsInterface then yield "interface"
+                if v.IsMeasure then yield "measure"
+#if !NO_EXTENSIONTYPING
+                if v.IsProvided then yield "provided"
+                if v.IsStaticInstantiation then yield "static_inst"
+                if v.IsProvidedAndErased then yield "erased"
+                if v.IsProvidedAndGenerated then yield "generated"
+#endif
+                if v.IsUnresolved then yield "unresolved"
+                if v.IsValueType then yield "valuetype"
+
+            | :? FSharpMemberOrFunctionOrValue as v ->
+                yield "owner: " + match v.DeclaringEntity with | Some e -> e.CompiledName | _ -> "<unknown>"
+                if v.IsActivePattern then yield "active_pattern"
+                if v.IsDispatchSlot then yield "dispatch_slot"
+                if v.IsModuleValueOrMember && not v.IsMember then yield "val"
+                if v.IsMember then yield "member"
+                if v.IsProperty then yield "property"
+                if v.IsExtensionMember then yield "extension_member"
+                if v.IsPropertyGetterMethod then yield "property_getter"
+                if v.IsPropertySetterMethod then yield "property_setter"
+                if v.IsEvent then yield "event"
+                if v.EventForFSharpProperty.IsSome then yield "property_event"
+                if v.IsEventAddMethod then yield "event_add"
+                if v.IsEventRemoveMethod then yield "event_remove"
+                if v.IsTypeFunction then yield "type_func"
+                if v.IsCompilerGenerated then yield "compiler_gen"
+                if v.IsImplicitConstructor then yield "implicit_ctor"
+                if v.IsMutable then yield "mutable"
+                if v.IsOverrideOrExplicitInterfaceImplementation then yield "override_impl"
+                if not v.IsInstanceMember then yield "static"
+                if v.IsInstanceMember && not v.IsInstanceMemberInCompiledCode && not v.IsExtensionMember then yield "funky"
+                if v.IsExplicitInterfaceImplementation then yield "interface_impl"
+                yield sprintf "%A" v.InlineAnnotation
+                // if v.IsConstructorThisValue then yield "ctorthis"
+                // if v.IsMemberThisValue then yield "this"
+                // if v.LiteralValue.IsSome then yield "literal"
+            | _ -> () ]
+
+    let rec printFSharpDecls prefix decls = seq {
+        let mutable i = 0
+        for decl in decls do
+            i <- i + 1
+            match decl with
+            | FSharpImplementationFileDeclaration.Entity (e, sub) ->
+                yield sprintf "%s%i) ENTITY: %s %A" prefix i e.CompiledName (attribsOfSymbol e)
+                if not (Seq.isEmpty e.Attributes) then
+                    yield sprintf "%sattributes: %A" prefix (Seq.toList e.Attributes)
+                if not (Seq.isEmpty e.DeclaredInterfaces) then
+                    yield sprintf "%sinterfaces: %A" prefix (Seq.toList e.DeclaredInterfaces)
+                yield ""
+                yield! printFSharpDecls (prefix + "\t") sub
+            | FSharpImplementationFileDeclaration.MemberOrFunctionOrValue (meth, args, body) ->
+                yield sprintf "%s%i) METHOD: %s %A" prefix i meth.CompiledName (attribsOfSymbol meth)
+                yield sprintf "%stype: %A" prefix meth.FullType
+                yield sprintf "%sargs: %A" prefix args
+                // if not meth.IsCompilerGenerated then
+                yield sprintf "%sbody: %A" prefix body
+                yield ""
+            | FSharpImplementationFileDeclaration.InitAction (expr) ->
+                yield sprintf "%s%i) ACTION" prefix i
+                yield sprintf "%s%A" prefix expr
+                yield ""
+    }

fcs/fcs-test/fcs-test.fsproj

@@ -0,0 +1,26 @@
+<Project Sdk="Microsoft.NET.Sdk">
+
+  <PropertyGroup>
+    <OutputType>Exe</OutputType>
+    <TargetFramework>netcoreapp3.1</TargetFramework>
+    <DisableImplicitFSharpCoreReference>true</DisableImplicitFSharpCoreReference>
+  </PropertyGroup>
+
+  <ItemGroup>
+    <Compile Include="ast_print.fs"/>
+    <Compile Include="Program.fs" />
+  </ItemGroup>
+
+  <ItemGroup>
+    <!-- <ProjectReference Include="../../src/fsharp/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj" /> -->
+    <Reference Include="../../artifacts/bin/FSharp.Compiler.Service/Debug/netstandard2.0/FSharp.Core.dll" />
+    <Reference Include="../../artifacts/bin/FSharp.Compiler.Service/Debug/netstandard2.0/FSharp.Compiler.Service.dll" />
+  </ItemGroup>
+
+  <ItemGroup>
+    <PackageReference Include="Dotnet.ProjInfo" Version="0.44.0" />
+    <!-- <PackageReference Include="FSharp.Core" Version="4.7.2" /> -->
+    <PackageReference Include="Fable.Core" Version="3.1.6" />
+    <PackageReference Include="Fable.Import.Browser" Version="*" />
+  </ItemGroup>
+</Project>

fcs/fcs-test/test_script.fsx

@@ -0,0 +1,8 @@
+open System
+open Fable.Import
+
+let foo() =
+    let msg = String.Concat("Hello"," ","world")
+    let len = msg.Length
+    let canvas = Browser.document.createElement_canvas ()
+    canvas.width <- 1000.

global.json

@@ -1,9 +1,9 @@
 {
   "sdk": {
-    "version": "3.1.302"
+    "version": "3.1.402"
   },
   "tools": {
-    "dotnet": "3.1.302",
+    "dotnet": "3.1.402",
     "vs": {
       "version": "16.4",
       "components": [

src/fsharp/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj

@@ -750,6 +750,7 @@
     <Compile Include="..\fsi\fsi.fs">
       <Link>InteractiveSession/fsi.fs</Link>
     </Compile>
+    <Compile Include="service_slim.fs" />
   </ItemGroup>
 
   <ItemGroup Condition="'$(FSHARPCORE_USE_PACKAGE)' != 'true'">