forked from dotnet/fsharp
-
Notifications
You must be signed in to change notification settings - Fork 0
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
- Loading branch information
Showing
10 changed files
with
563 additions
and
4 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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 |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,8 @@ | ||
{ | ||
"profiles": { | ||
"fcs-test": { | ||
"commandName": "Project", | ||
"workingDirectory": "$(SolutionDir)" | ||
} | ||
} | ||
} |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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 "" | ||
} |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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> |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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. |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Oops, something went wrong.