Skip to content

Commit e072e77

Browse files
ncavencave
committed
Added service_slim
1 parent 0dac9c0 commit e072e77

File tree

11 files changed

+567
-4
lines changed

11 files changed

+567
-4
lines changed

‎fcs/build.sh

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,4 @@
1+
#!/usr/bin/env bash
2+
3+
dotnet build -c Release src/buildtools/buildtools.proj
4+
dotnet build -c Release src/fsharp/FSharp.Compiler.Service

‎fcs/fcs-test/Program.fs

Lines changed: 127 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,127 @@
1+
open System.IO
2+
open System.Collections.Generic
3+
open FSharp.Compiler
4+
open FSharp.Compiler.SourceCodeServices
5+
6+
let getProjectOptions (folder: string) (projectFile: string) =
7+
let runProcess (workingDir: string) (exePath: string) (args: string) =
8+
let psi = System.Diagnostics.ProcessStartInfo()
9+
psi.FileName <- exePath
10+
psi.WorkingDirectory <- workingDir
11+
psi.RedirectStandardOutput <- false
12+
psi.RedirectStandardError <- false
13+
psi.Arguments <- args
14+
psi.CreateNoWindow <- true
15+
psi.UseShellExecute <- false
16+
17+
use p = new System.Diagnostics.Process()
18+
p.StartInfo <- psi
19+
p.Start() |> ignore
20+
p.WaitForExit()
21+
22+
let exitCode = p.ExitCode
23+
exitCode, ()
24+
25+
let runCmd exePath args = runProcess folder exePath (args |> String.concat " ")
26+
let msbuildExec = Dotnet.ProjInfo.Inspect.dotnetMsbuild runCmd
27+
let result = Dotnet.ProjInfo.Inspect.getProjectInfo ignore msbuildExec Dotnet.ProjInfo.Inspect.getFscArgs projectFile
28+
match result with
29+
| Ok (Dotnet.ProjInfo.Inspect.GetResult.FscArgs x) -> x
30+
| _ -> []
31+
32+
let mkStandardProjectReferences () =
33+
let projFile = "fcs-test.fsproj"
34+
let projDir = __SOURCE_DIRECTORY__
35+
getProjectOptions projDir projFile
36+
|> List.filter (fun s -> s.StartsWith("-r:"))
37+
|> List.map (fun s -> s.Replace("-r:", ""))
38+
39+
let mkProjectCommandLineArgsForScript (dllName, fileNames) =
40+
[| yield "--simpleresolution"
41+
yield "--noframework"
42+
yield "--debug:full"
43+
yield "--define:DEBUG"
44+
yield "--optimize-"
45+
yield "--out:" + dllName
46+
yield "--doc:test.xml"
47+
yield "--warn:3"
48+
yield "--fullpaths"
49+
yield "--flaterrors"
50+
yield "--target:library"
51+
for x in fileNames do
52+
yield x
53+
let references = mkStandardProjectReferences ()
54+
for r in references do
55+
yield "-r:" + r
56+
|]
57+
58+
let getProjectOptionsFromCommandLineArgs(projName, argv) =
59+
{ ProjectFileName = projName
60+
ProjectId = None
61+
SourceFiles = [| |]
62+
OtherOptions = argv
63+
ReferencedProjects = [| |]
64+
IsIncompleteTypeCheckEnvironment = false
65+
UseScriptResolutionRules = false
66+
LoadTime = System.DateTime.MaxValue
67+
UnresolvedReferences = None
68+
OriginalLoadReferences = []
69+
ExtraProjectInfo = None
70+
Stamp = None }
71+
72+
let printAst title (projectResults: FSharpCheckProjectResults) =
73+
let implFiles = projectResults.AssemblyContents.ImplementationFiles
74+
let decls = implFiles
75+
|> Seq.collect (fun file -> AstPrint.printFSharpDecls "" file.Declarations)
76+
|> String.concat "\n"
77+
printfn "%s Typed AST:" title
78+
decls |> printfn "%s"
79+
80+
[<EntryPoint>]
81+
let main argv =
82+
let projName = "Project.fsproj"
83+
let fileName = "test_script.fsx"
84+
let fileNames = [| fileName |]
85+
let source = File.ReadAllText (fileName, System.Text.Encoding.UTF8)
86+
let sources = [| source |]
87+
88+
let dllName = Path.ChangeExtension(fileName, ".dll")
89+
let args = mkProjectCommandLineArgsForScript (dllName, fileNames)
90+
// for arg in args do printfn "%s" arg
91+
92+
let projectOptions = getProjectOptionsFromCommandLineArgs (projName, args)
93+
let checker = InteractiveChecker.Create(projectOptions)
94+
95+
// // parse and typecheck a project
96+
// let projectResults = checker.ParseAndCheckProject(projName, fileNames, sources)
97+
// projectResults.Errors |> Array.iter (fun e -> printfn "%A: %A" (e.Severity) e)
98+
// printAst "ParseAndCheckProject" projectResults
99+
100+
// or just parse and typecheck a file in project
101+
let parseResults, tcResultsOpt, projectResults =
102+
checker.ParseAndCheckFileInProject(fileName, projName, fileNames, sources)
103+
projectResults.Errors |> Array.iter (fun e -> printfn "%A: %A" (e.Severity) e)
104+
105+
match tcResultsOpt with
106+
| Some typeCheckResults ->
107+
printAst "ParseAndCheckFileInProject" projectResults
108+
109+
let inputLines = source.Split('\n')
110+
async {
111+
// Get tool tip at the specified location
112+
let! tip = typeCheckResults.GetToolTipText(4, 7, inputLines.[3], ["foo"], FSharpTokenTag.IDENT)
113+
(sprintf "%A" tip).Replace("\n","") |> printfn "\n---> ToolTip Text = %A" // should be "FSharpToolTipText [...]"
114+
115+
// Get declarations (autocomplete) for msg
116+
let partialName = { QualifyingIdents = []; PartialIdent = "msg"; EndColumn = 17; LastDotPos = None }
117+
let! decls = typeCheckResults.GetDeclarationListInfo(Some parseResults, 6, inputLines.[5], partialName, (fun _ -> []), fun _ -> false)
118+
[ for item in decls.Items -> item.Name ] |> printfn "\n---> msg AutoComplete = %A" // should be string methods
119+
120+
// Get declarations (autocomplete) for canvas
121+
let partialName = { QualifyingIdents = []; PartialIdent = "canvas"; EndColumn = 10; LastDotPos = None }
122+
let! decls = typeCheckResults.GetDeclarationListInfo(Some parseResults, 8, inputLines.[7], partialName, (fun _ -> []), fun _ -> false)
123+
[ for item in decls.Items -> item.Name ] |> printfn "\n---> canvas AutoComplete = %A"
124+
} |> Async.StartImmediate
125+
126+
| _ -> ()
127+
0

‎fcs/fcs-test/Properties/launchSettings.json

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,8 @@
1+
{
2+
"profiles": {
3+
"fcs-test": {
4+
"commandName": "Project",
5+
"workingDirectory": "$(SolutionDir)"
6+
}
7+
}
8+
}

‎fcs/fcs-test/ast_print.fs

Lines changed: 101 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,101 @@
1+
// 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.
2+
3+
namespace FSharp.Compiler.SourceCodeServices
4+
5+
//-------------------------------------------------------------------------
6+
// AstPrint
7+
//-------------------------------------------------------------------------
8+
9+
module AstPrint =
10+
11+
let attribsOfSymbol (s:FSharpSymbol) =
12+
[ match s with
13+
| :? FSharpField as v ->
14+
yield "field"
15+
if v.IsCompilerGenerated then yield "compgen"
16+
if v.IsDefaultValue then yield "default"
17+
if v.IsMutable then yield "mutable"
18+
if v.IsVolatile then yield "volatile"
19+
if v.IsStatic then yield "static"
20+
if v.IsLiteral then yield sprintf "%A" v.LiteralValue.Value
21+
22+
| :? FSharpEntity as v ->
23+
v.TryFullName |> ignore // check there is no failure here
24+
match v.BaseType with
25+
| Some t when t.HasTypeDefinition && t.TypeDefinition.TryFullName.IsSome ->
26+
yield sprintf "inherits %s" t.TypeDefinition.FullName
27+
| _ -> ()
28+
if v.IsNamespace then yield "namespace"
29+
if v.IsFSharpModule then yield "module"
30+
if v.IsByRef then yield "byref"
31+
if v.IsClass then yield "class"
32+
if v.IsDelegate then yield "delegate"
33+
if v.IsEnum then yield "enum"
34+
if v.IsFSharpAbbreviation then yield "abbrev"
35+
if v.IsFSharpExceptionDeclaration then yield "exception"
36+
if v.IsFSharpRecord then yield "record"
37+
if v.IsFSharpUnion then yield "union"
38+
if v.IsInterface then yield "interface"
39+
if v.IsMeasure then yield "measure"
40+
#if !NO_EXTENSIONTYPING
41+
if v.IsProvided then yield "provided"
42+
if v.IsStaticInstantiation then yield "static_inst"
43+
if v.IsProvidedAndErased then yield "erased"
44+
if v.IsProvidedAndGenerated then yield "generated"
45+
#endif
46+
if v.IsUnresolved then yield "unresolved"
47+
if v.IsValueType then yield "valuetype"
48+
49+
| :? FSharpMemberOrFunctionOrValue as v ->
50+
yield "owner: " + match v.DeclaringEntity with | Some e -> e.CompiledName | _ -> "<unknown>"
51+
if v.IsActivePattern then yield "active_pattern"
52+
if v.IsDispatchSlot then yield "dispatch_slot"
53+
if v.IsModuleValueOrMember && not v.IsMember then yield "val"
54+
if v.IsMember then yield "member"
55+
if v.IsProperty then yield "property"
56+
if v.IsExtensionMember then yield "extension_member"
57+
if v.IsPropertyGetterMethod then yield "property_getter"
58+
if v.IsPropertySetterMethod then yield "property_setter"
59+
if v.IsEvent then yield "event"
60+
if v.EventForFSharpProperty.IsSome then yield "property_event"
61+
if v.IsEventAddMethod then yield "event_add"
62+
if v.IsEventRemoveMethod then yield "event_remove"
63+
if v.IsTypeFunction then yield "type_func"
64+
if v.IsCompilerGenerated then yield "compiler_gen"
65+
if v.IsImplicitConstructor then yield "implicit_ctor"
66+
if v.IsMutable then yield "mutable"
67+
if v.IsOverrideOrExplicitInterfaceImplementation then yield "override_impl"
68+
if not v.IsInstanceMember then yield "static"
69+
if v.IsInstanceMember && not v.IsInstanceMemberInCompiledCode && not v.IsExtensionMember then yield "funky"
70+
if v.IsExplicitInterfaceImplementation then yield "interface_impl"
71+
yield sprintf "%A" v.InlineAnnotation
72+
// if v.IsConstructorThisValue then yield "ctorthis"
73+
// if v.IsMemberThisValue then yield "this"
74+
// if v.LiteralValue.IsSome then yield "literal"
75+
| _ -> () ]
76+
77+
let rec printFSharpDecls prefix decls = seq {
78+
let mutable i = 0
79+
for decl in decls do
80+
i <- i + 1
81+
match decl with
82+
| FSharpImplementationFileDeclaration.Entity (e, sub) ->
83+
yield sprintf "%s%i) ENTITY: %s %A" prefix i e.CompiledName (attribsOfSymbol e)
84+
if not (Seq.isEmpty e.Attributes) then
85+
yield sprintf "%sattributes: %A" prefix (Seq.toList e.Attributes)
86+
if not (Seq.isEmpty e.DeclaredInterfaces) then
87+
yield sprintf "%sinterfaces: %A" prefix (Seq.toList e.DeclaredInterfaces)
88+
yield ""
89+
yield! printFSharpDecls (prefix + "\t") sub
90+
| FSharpImplementationFileDeclaration.MemberOrFunctionOrValue (meth, args, body) ->
91+
yield sprintf "%s%i) METHOD: %s %A" prefix i meth.CompiledName (attribsOfSymbol meth)
92+
yield sprintf "%stype: %A" prefix meth.FullType
93+
yield sprintf "%sargs: %A" prefix args
94+
// if not meth.IsCompilerGenerated then
95+
yield sprintf "%sbody: %A" prefix body
96+
yield ""
97+
| FSharpImplementationFileDeclaration.InitAction (expr) ->
98+
yield sprintf "%s%i) ACTION" prefix i
99+
yield sprintf "%s%A" prefix expr
100+
yield ""
101+
}

‎fcs/fcs-test/fcs-test.fsproj

Lines changed: 26 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,26 @@
1+
<Project Sdk="Microsoft.NET.Sdk">
2+
3+
<PropertyGroup>
4+
<OutputType>Exe</OutputType>
5+
<TargetFramework>netcoreapp3.1</TargetFramework>
6+
<DisableImplicitFSharpCoreReference>true</DisableImplicitFSharpCoreReference>
7+
</PropertyGroup>
8+
9+
<ItemGroup>
10+
<Compile Include="ast_print.fs"/>
11+
<Compile Include="Program.fs" />
12+
</ItemGroup>
13+
14+
<ItemGroup>
15+
<!-- <ProjectReference Include="../../src/fsharp/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj" /> -->
16+
<Reference Include="../../artifacts/bin/FSharp.Compiler.Service/Debug/netstandard2.0/FSharp.Core.dll" />
17+
<Reference Include="../../artifacts/bin/FSharp.Compiler.Service/Debug/netstandard2.0/FSharp.Compiler.Service.dll" />
18+
</ItemGroup>
19+
20+
<ItemGroup>
21+
<PackageReference Include="Dotnet.ProjInfo" Version="0.44.0" />
22+
<!-- <PackageReference Include="FSharp.Core" Version="4.7.2" /> -->
23+
<PackageReference Include="Fable.Core" Version="3.1.6" />
24+
<PackageReference Include="Fable.Import.Browser" Version="*" />
25+
</ItemGroup>
26+
</Project>

‎fcs/fcs-test/test_script.fsx

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,8 @@
1+
open System
2+
open Fable.Import
3+
4+
let foo() =
5+
let msg = String.Concat("Hello"," ","world")
6+
let len = msg.Length
7+
let canvas = Browser.document.createElement_canvas ()
8+
canvas.width <- 1000.

‎global.json

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,9 +1,9 @@
11
{
22
"sdk": {
3-
"version": "3.1.302"
3+
"version": "3.1.402"
44
},
55
"tools": {
6-
"dotnet": "3.1.302",
6+
"dotnet": "3.1.402",
77
"vs": {
88
"version": "16.4",
99
"components": [

‎src/buildtools/buildtools.targets

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -20,7 +20,7 @@
2020
BeforeTargets="CoreCompile">
2121

2222
<PropertyGroup>
23-
<FsLexPath Condition="'$(FsLexPath)' == ''">$(ArtifactsDir)\Bootstrap\fslex\fslex.dll</FsLexPath>
23+
<FsLexPath Condition="'$(FsLexPath)' == ''">$(ArtifactsDir)\bin\fslex\Release\netcoreapp3.1\fslex.dll</FsLexPath>
2424
</PropertyGroup>
2525

2626
<!-- Create the output directory -->
@@ -44,7 +44,7 @@
4444
BeforeTargets="CoreCompile">
4545

4646
<PropertyGroup>
47-
<FsYaccPath Condition="'$(FsYaccPath)' == ''">$(ArtifactsDir)\Bootstrap\fsyacc\fsyacc.dll</FsYaccPath>
47+
<FsYaccPath Condition="'$(FsYaccPath)' == ''">$(ArtifactsDir)\bin\fsyacc\Release\netcoreapp3.1\fsyacc.dll</FsYaccPath>
4848
</PropertyGroup>
4949

5050
<!-- Create the output directory -->

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

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -750,6 +750,7 @@
750750
<Compile Include="..\fsi\fsi.fs">
751751
<Link>InteractiveSession/fsi.fs</Link>
752752
</Compile>
753+
<Compile Include="service_slim.fs" />
753754
</ItemGroup>
754755

755756
<ItemGroup Condition="'$(FSHARPCORE_USE_PACKAGE)' != 'true'">

0 commit comments

Comments
 (0)