Skip to content

Commit

Permalink
Added service_slim
Browse files Browse the repository at this point in the history
  • Loading branch information
ncave committed Oct 4, 2020
1 parent 0dac9c0 commit a71a32f
Show file tree
Hide file tree
Showing 10 changed files with 563 additions and 4 deletions.
127 changes: 127 additions & 0 deletions fcs/fcs-test/Program.fs
Original file line number Diff line number Diff line change
@@ -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
8 changes: 8 additions & 0 deletions fcs/fcs-test/Properties/launchSettings.json
Original file line number Diff line number Diff line change
@@ -0,0 +1,8 @@
{
"profiles": {
"fcs-test": {
"commandName": "Project",
"workingDirectory": "$(SolutionDir)"
}
}
}
101 changes: 101 additions & 0 deletions fcs/fcs-test/ast_print.fs
Original file line number Diff line number Diff line change
@@ -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 ""
}
26 changes: 26 additions & 0 deletions fcs/fcs-test/fcs-test.fsproj
Original file line number Diff line number Diff line change
@@ -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>
8 changes: 8 additions & 0 deletions fcs/fcs-test/test_script.fsx
Original file line number Diff line number Diff line change
@@ -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.
4 changes: 2 additions & 2 deletions global.json
Original file line number Diff line number Diff line change
@@ -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": [
Expand Down
4 changes: 2 additions & 2 deletions src/buildtools/buildtools.targets
Original file line number Diff line number Diff line change
Expand Up @@ -20,7 +20,7 @@
BeforeTargets="CoreCompile">

<PropertyGroup>
<FsLexPath Condition="'$(FsLexPath)' == ''">$(ArtifactsDir)\Bootstrap\fslex\fslex.dll</FsLexPath>
<FsLexPath Condition="'$(FsLexPath)' == ''">$(ArtifactsDir)\bin\fslex\Release\netcoreapp3.1\fslex.dll</FsLexPath>
</PropertyGroup>

<!-- Create the output directory -->
Expand All @@ -44,7 +44,7 @@
BeforeTargets="CoreCompile">

<PropertyGroup>
<FsYaccPath Condition="'$(FsYaccPath)' == ''">$(ArtifactsDir)\Bootstrap\fsyacc\fsyacc.dll</FsYaccPath>
<FsYaccPath Condition="'$(FsYaccPath)' == ''">$(ArtifactsDir)\bin\fsyacc\Release\netcoreapp3.1\fsyacc.dll</FsYaccPath>
</PropertyGroup>

<!-- Create the output directory -->
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -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'">
Expand Down
Loading

0 comments on commit a71a32f

Please sign in to comment.