diff --git a/fcs/Directory.Build.props b/fcs/Directory.Build.props index 2841a5fb34f..0912aba5fd8 100644 --- a/fcs/Directory.Build.props +++ b/fcs/Directory.Build.props @@ -31,7 +31,7 @@ $(FSharpSourcesRoot)\..\packages\FSharp.Compiler.Tools.4.1.27\tools fsi.exe - 4.6.2 + 4.7.1 net461 diff --git a/fcs/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj b/fcs/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj index a131b776660..1e95fbbdebe 100644 --- a/fcs/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj +++ b/fcs/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj @@ -715,6 +715,7 @@ Service/fsi.fs + diff --git a/fcs/FSharp.Compiler.Service/service_slim.fs b/fcs/FSharp.Compiler.Service/service_slim.fs new file mode 100644 index 00000000000..be6316a6eb9 --- /dev/null +++ b/fcs/FSharp.Compiler.Service/service_slim.fs @@ -0,0 +1,243 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +namespace FSharp.Compiler.SourceCodeServices + +open System +open System.Collections.Concurrent +open System.IO + +open FSharp.Compiler +open FSharp.Compiler.AbstractIL +open FSharp.Compiler.AbstractIL.IL +open FSharp.Compiler.AbstractIL.ILBinaryReader +open FSharp.Compiler.AbstractIL.Internal.Library +open FSharp.Compiler.AbstractIL.Internal.Utils +open FSharp.Compiler.CompileOps +open FSharp.Compiler.CompileOptions +open FSharp.Compiler.CompilerGlobalState +open FSharp.Compiler.Driver +open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.Lib +open FSharp.Compiler.NameResolution +open FSharp.Compiler.Range +open FSharp.Compiler.SyntaxTree +open FSharp.Compiler.TcGlobals +open FSharp.Compiler.Text +open FSharp.Compiler.TypeChecker +open FSharp.Compiler.TypedTree +open FSharp.Compiler.TypedTreeOps + +open Internal.Utilities +open Internal.Utilities.Collections + +//------------------------------------------------------------------------- +// InteractiveChecker +//------------------------------------------------------------------------- + +type internal TcResult = TcEnv * TopAttribs * TypedImplFile option * ModuleOrNamespaceType +type internal TcErrors = FSharpErrorInfo[] + +type InteractiveChecker internal (tcConfig, tcGlobals, tcImports, tcInitialState, ctok, reactorOps, parseCache, checkCache) = + let userOpName = "Unknown" + let suggestNamesForErrors = true + + static member Create(projectOptions: FSharpProjectOptions) = + let tcConfig = + let tcConfigB = TcConfigBuilder.Initial + tcConfigB.implicitIncludeDir <- Path.GetDirectoryName(projectOptions.ProjectFileName) + tcConfigB.legacyReferenceResolver <- SimulatedMSBuildReferenceResolver.getResolver() + let sourceFiles = projectOptions.SourceFiles |> Array.toList + let argv = projectOptions.OtherOptions |> Array.toList + let _sourceFiles = ApplyCommandLineArgs(tcConfigB, sourceFiles, argv) + TcConfig.Create(tcConfigB, validate=false) + + let tcConfigP = TcConfigProvider.Constant(tcConfig) + + let ctok = CompilationThreadToken() + let tcGlobals, tcImports = + TcImports.BuildTcImports (ctok, tcConfigP) + |> Cancellable.runWithoutCancellation + + let niceNameGen = NiceNameGenerator() + let assemblyName = projectOptions.ProjectFileName |> System.IO.Path.GetFileNameWithoutExtension + let tcInitialEnv = GetInitialTcEnv (assemblyName, rangeStartup, tcConfig, tcImports, tcGlobals) + let tcInitialState = GetInitialTcState (rangeStartup, assemblyName, tcConfig, tcGlobals, tcImports, niceNameGen, tcInitialEnv) + + let reactorOps = + { new IReactorOperations with + member __.EnqueueAndAwaitOpAsync (userOpName, opName, opArg, op) = + async.Return (Cancellable.runWithoutCancellation (op ctok)) + member __.EnqueueOp (userOpName, opName, opArg, op) = (op ctok) } + + // parse cache, keyed on file name and source hash + let parseCache = ConcurrentDictionary(HashIdentity.Structural) + // type check cache, keyed on file name + let checkCache = ConcurrentDictionary(HashIdentity.Structural) + + InteractiveChecker (tcConfig, tcGlobals, tcImports, tcInitialState, ctok, reactorOps, parseCache, checkCache) + + member private x.MakeProjectResults (projectFileName: string, parseResults: FSharpParseFileResults[], tcState: TcState, errors: FSharpErrorInfo[], + symbolUses: TcSymbolUses list, topAttrsOpt: TopAttribs option, tcImplFilesOpt: TypedImplFile list option) = + let assemblyRef = mkSimpleAssemblyRef "stdin" + let assemblyDataOpt = None + let access = tcState.TcEnvFromImpls.AccessRights + let dependencyFiles = parseResults |> Seq.map (fun x -> x.DependencyFiles) |> Array.concat + let details = (tcGlobals, tcImports, tcState.Ccu, tcState.CcuSig, symbolUses, topAttrsOpt, assemblyDataOpt, assemblyRef, access, tcImplFilesOpt, dependencyFiles) + let keepAssemblyContents = true + FSharpCheckProjectResults (projectFileName, Some tcConfig, keepAssemblyContents, errors, Some details) + + member private x.ClearStaleCache (fileName: string, parsingOptions: FSharpParsingOptions) = + let fileIndex = parsingOptions.SourceFiles |> Array.findIndex ((=) fileName) + let filesAbove = parsingOptions.SourceFiles |> Array.take fileIndex + // backup all cached typecheck entries above file + let cachedAbove = filesAbove |> Array.choose (fun key -> + match checkCache.TryGetValue(key) with + | true, value -> Some (key, value) + | false, _ -> None) + // remove all parse cache entries with the same file name + let staleParseKeys = parseCache.Keys |> Seq.filter (fun (n,_) -> n = fileName) |> Seq.toArray + staleParseKeys |> Array.iter (fun key -> parseCache.TryRemove(key) |> ignore) + checkCache.Clear(); // clear all typecheck cache + // restore all cached typecheck entries above file + cachedAbove |> Array.iter (fun (key, value) -> checkCache.TryAdd(key, value) |> ignore) + + member private x.ParseFile (fileName: string, sourceHash: int, source: Lazy, parsingOptions: FSharpParsingOptions) = + let parseCacheKey = fileName, sourceHash + parseCache.GetOrAdd(parseCacheKey, fun _ -> + x.ClearStaleCache(fileName, parsingOptions) + let sourceText = SourceText.ofString source.Value + let parseErrors, parseTreeOpt, anyErrors = ParseAndCheckFile.parseFile (sourceText, fileName, parsingOptions, userOpName, suggestNamesForErrors) + let dependencyFiles = [||] // interactions have no dependencies + FSharpParseFileResults (parseErrors, parseTreeOpt, anyErrors, dependencyFiles) ) + + member private x.TypeCheckOneInput (parseResults: FSharpParseFileResults, tcSink: TcResultsSink, tcState: TcState, moduleNamesDict: ModuleNamesDict) = + let input = parseResults.ParseTree.Value + let capturingErrorLogger = CompilationErrorLogger("TypeCheckFile", tcConfig.errorSeverityOptions) + let errorLogger = GetErrorLoggerFilteringByScopedPragmas(false, GetScopedPragmasForInput(input), capturingErrorLogger) + use _errorScope = new CompilationGlobalsScope (errorLogger, BuildPhase.TypeCheck) + + let checkForErrors () = parseResults.ParseHadErrors || errorLogger.ErrorCount > 0 + let prefixPathOpt = None + + let input, moduleNamesDict = input |> DeduplicateParsedInputModuleName moduleNamesDict + let tcResult, tcState = + TypeCheckOneInputEventually (checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcSink, tcState, input) + |> Eventually.force ctok + + let fileName = parseResults.FileName + let tcErrors = ErrorHelpers.CreateErrorInfos (tcConfig.errorSeverityOptions, false, fileName, (capturingErrorLogger.GetErrors()), suggestNamesForErrors) + (tcResult, tcErrors), (tcState, moduleNamesDict) + + member private x.CheckFile (projectFileName: string, parseResults: FSharpParseFileResults, tcState: TcState, moduleNamesDict: ModuleNamesDict) = + match parseResults.ParseTree with + | Some _input -> + let sink = TcResultsSinkImpl(tcGlobals) + let tcSink = TcResultsSink.WithSink sink + let (tcResult, tcErrors), (tcState, moduleNamesDict) = + x.TypeCheckOneInput (parseResults, tcSink, tcState, moduleNamesDict) + let fileName = parseResults.FileName + checkCache.[fileName] <- ((tcResult, tcErrors), (tcState, moduleNamesDict)) + + let loadClosure = None + let textSnapshotInfo = None + let keepAssemblyContents = true + + let tcEnvAtEnd, _topAttrs, implFile, ccuSigForFile = tcResult + let errors = Array.append parseResults.Errors tcErrors + + let scope = TypeCheckInfo (tcConfig, tcGlobals, ccuSigForFile, tcState.Ccu, tcImports, tcEnvAtEnd.AccessRights, + projectFileName, fileName, sink.GetResolutions(), sink.GetSymbolUses(), tcEnvAtEnd.NameEnv, + loadClosure, reactorOps, textSnapshotInfo, implFile, sink.GetOpenDeclarations()) + FSharpCheckFileResults (fileName, errors, Some scope, parseResults.DependencyFiles, None, reactorOps, keepAssemblyContents) + |> Some + | None -> + None + + member private x.TypeCheckClosedInputSet (parseResults: FSharpParseFileResults[], tcState) = + let cachedTypeCheck (tcState, moduleNamesDict) (parseRes: FSharpParseFileResults) = + let checkCacheKey = parseRes.FileName + let typeCheckOneInput _fileName = + x.TypeCheckOneInput (parseRes, TcResultsSink.NoSink, tcState, moduleNamesDict) + checkCache.GetOrAdd(checkCacheKey, typeCheckOneInput) + let results, (tcState, moduleNamesDict) = + ((tcState, Map.empty), parseResults) ||> Array.mapFold cachedTypeCheck + let tcResults, tcErrors = Array.unzip results + let (tcEnvAtEndOfLastFile, topAttrs, implFiles, _ccuSigsForFiles), tcState = + TypeCheckMultipleInputsFinish(tcResults |> Array.toList, tcState) + let tcState, declaredImpls = TypeCheckClosedInputSetFinish (implFiles, tcState) + tcState, topAttrs, declaredImpls, tcEnvAtEndOfLastFile, moduleNamesDict, tcErrors + + /// Errors grouped by file, sorted by line, column + member private x.ErrorsByFile (fileNames: string[], errorList: FSharpErrorInfo[] list) = + let errorMap = errorList |> Array.concat |> Array.groupBy (fun x -> x.FileName) |> Map.ofArray + let errors = fileNames |> Array.choose errorMap.TryFind + errors |> Array.iter (Array.sortInPlaceBy (fun x -> x.StartLineAlternate, x.StartColumn)) + errors |> Array.concat + + /// Clears parse and typecheck caches. + member x.ClearCache () = + parseCache.Clear() + checkCache.Clear() + + /// Parses and checks the whole project, good for compilers (Fable etc.) + /// Does not retain name resolutions and symbol uses which are quite memory hungry (so no intellisense etc.). + /// Already parsed files will be cached so subsequent compilations will be faster. + member x.ParseAndCheckProject (projectFileName: string, fileNames: string[], sourceReader: string->int*Lazy) = + // parse files + let parsingOptions = FSharpParsingOptions.FromTcConfig(tcConfig, fileNames, false) + let parseResults = fileNames |> Array.map (fun fileName -> + let sourceHash, source = sourceReader fileName + x.ParseFile(fileName, sourceHash, source, parsingOptions)) + + // type check files + let tcState, topAttrs, tcImplFiles, _tcEnvAtEnd, _moduleNamesDict, tcErrors = + x.TypeCheckClosedInputSet (parseResults, tcInitialState) + + // make project results + let parseErrors = parseResults |> Array.collect (fun p -> p.Errors) + let typedErrors = tcErrors |> Array.concat + let errors = x.ErrorsByFile (fileNames, [ parseErrors; typedErrors ]) + let symbolUses = [] //TODO: + let projectResults = x.MakeProjectResults (projectFileName, parseResults, tcState, errors, symbolUses, Some topAttrs, Some tcImplFiles) + + projectResults + + /// Parses and checks file in project, will compile and cache all the files up to this one + /// (if not already done before), or fetch them from cache. Returns partial project results, + /// up to and including the file requested. Returns parse and typecheck results containing + /// name resolutions and symbol uses for the file requested only, so intellisense etc. works. + member x.ParseAndCheckFileInProject (fileName: string, projectFileName: string, fileNames: string[], sources: string[]) = + // get files before file + let fileIndex = fileNames |> Array.findIndex ((=) fileName) + let fileNamesBeforeFile = fileNames |> Array.take fileIndex + let sourcesBeforeFile = sources |> Array.take fileIndex + + // parse files before file + let parsingOptions = FSharpParsingOptions.FromTcConfig(tcConfig, fileNames, false) + let parseFile (fileName, source) = x.ParseFile (fileName, hash source, lazy source, parsingOptions) + let parseResults = Array.zip fileNamesBeforeFile sourcesBeforeFile |> Array.map parseFile + + // type check files before file + let tcState, topAttrs, tcImplFiles, _tcEnvAtEnd, moduleNamesDict, tcErrors = + x.TypeCheckClosedInputSet (parseResults, tcInitialState) + + // parse and type check file + let parseFileResults = parseFile (fileName, sources.[fileIndex]) + let checkFileResults = x.CheckFile (projectFileName, parseFileResults, tcState, moduleNamesDict) + let (tcResult, _tcErrors), (tcState, _moduleNamesDict) = checkCache.[fileName] + let _tcEnvAtEndFile, topAttrsFile, implFile, _ccuSigForFile = tcResult + + // collect errors + let parseErrorsBefore = parseResults |> Array.collect (fun p -> p.Errors) + let typedErrorsBefore = tcErrors |> Array.concat + let newErrors = match checkFileResults with | Some res -> res.Errors | None -> [||] + let errors = x.ErrorsByFile (fileNames, [ parseErrorsBefore; typedErrorsBefore; newErrors ]) + + // make partial project results + let parseResults = Array.append parseResults [| parseFileResults |] + let tcImplFiles = List.append tcImplFiles (Option.toList implFile) + let topAttrs = CombineTopAttrs topAttrsFile topAttrs + let symbolUses = [] //TODO: + let projectResults = x.MakeProjectResults (projectFileName, parseResults, tcState, errors, symbolUses, Some topAttrs, Some tcImplFiles) + + parseFileResults, checkFileResults, projectResults diff --git a/fcs/fcs-test/Program.fs b/fcs/fcs-test/Program.fs new file mode 100644 index 00000000000..e59e47a0dd6 --- /dev/null +++ b/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" + +[] +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 diff --git a/fcs/fcs-test/Properties/launchSettings.json b/fcs/fcs-test/Properties/launchSettings.json new file mode 100644 index 00000000000..06e83994e87 --- /dev/null +++ b/fcs/fcs-test/Properties/launchSettings.json @@ -0,0 +1,8 @@ +{ + "profiles": { + "fcs-test": { + "commandName": "Project", + "workingDirectory": "$(SolutionDir)" + } + } +} \ No newline at end of file diff --git a/fcs/fcs-test/ast_print.fs b/fcs/fcs-test/ast_print.fs new file mode 100644 index 00000000000..bf936a8d48d --- /dev/null +++ b/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 | _ -> "" + 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 "" + } diff --git a/fcs/fcs-test/fcs-test.fsproj b/fcs/fcs-test/fcs-test.fsproj new file mode 100644 index 00000000000..f1896078692 --- /dev/null +++ b/fcs/fcs-test/fcs-test.fsproj @@ -0,0 +1,24 @@ + + + + Exe + netcoreapp3.1 + true + + + + + + + + + + + + + + + + + + diff --git a/fcs/fcs-test/fcs-test.sln b/fcs/fcs-test/fcs-test.sln new file mode 100644 index 00000000000..3287d08d17d --- /dev/null +++ b/fcs/fcs-test/fcs-test.sln @@ -0,0 +1,31 @@ + +Microsoft Visual Studio Solution File, Format Version 12.00 +# Visual Studio 15 +VisualStudioVersion = 15.0.28307.329 +MinimumVisualStudioVersion = 10.0.40219.1 +Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "fcs-test", "fcs-test.fsproj", "{9AC7F48B-3B30-4FC6-BB6D-16018DF0BA7D}" +EndProject +Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "FSharp.Compiler.Service", "..\FSharp.Compiler.Service\FSharp.Compiler.Service.fsproj", "{9C758A40-9461-4E41-9C93-219684F0A489}" +EndProject +Global + GlobalSection(SolutionConfigurationPlatforms) = preSolution + Debug|Any CPU = Debug|Any CPU + Release|Any CPU = Release|Any CPU + EndGlobalSection + GlobalSection(ProjectConfigurationPlatforms) = postSolution + {9AC7F48B-3B30-4FC6-BB6D-16018DF0BA7D}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {9AC7F48B-3B30-4FC6-BB6D-16018DF0BA7D}.Debug|Any CPU.Build.0 = Debug|Any CPU + {9AC7F48B-3B30-4FC6-BB6D-16018DF0BA7D}.Release|Any CPU.ActiveCfg = Release|Any CPU + {9AC7F48B-3B30-4FC6-BB6D-16018DF0BA7D}.Release|Any CPU.Build.0 = Release|Any CPU + {9C758A40-9461-4E41-9C93-219684F0A489}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {9C758A40-9461-4E41-9C93-219684F0A489}.Debug|Any CPU.Build.0 = Debug|Any CPU + {9C758A40-9461-4E41-9C93-219684F0A489}.Release|Any CPU.ActiveCfg = Release|Any CPU + {9C758A40-9461-4E41-9C93-219684F0A489}.Release|Any CPU.Build.0 = Release|Any CPU + EndGlobalSection + GlobalSection(SolutionProperties) = preSolution + HideSolutionNode = FALSE + EndGlobalSection + GlobalSection(ExtensibilityGlobals) = postSolution + SolutionGuid = {F6FF1C8B-1B15-4F82-990E-A2D53B4BEE4A} + EndGlobalSection +EndGlobal diff --git a/fcs/fcs-test/test_script.fsx b/fcs/fcs-test/test_script.fsx new file mode 100644 index 00000000000..1bbe729ab75 --- /dev/null +++ b/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. diff --git a/src/buildtools/buildtools.targets b/src/buildtools/buildtools.targets index 185fd4d0599..128eafe3a2b 100644 --- a/src/buildtools/buildtools.targets +++ b/src/buildtools/buildtools.targets @@ -20,7 +20,7 @@ BeforeTargets="CoreCompile"> - $(ArtifactsDir)\Bootstrap\fslex\fslex.dll + $(ArtifactsDir)\bin\fslex\Proto\netcoreapp3.0\fslex.dll @@ -43,7 +43,7 @@ BeforeTargets="CoreCompile"> - $(ArtifactsDir)\Bootstrap\fsyacc\fsyacc.dll + $(ArtifactsDir)\bin\fslex\Proto\netcoreapp3.0\fsyacc.dll diff --git a/src/fsharp/service/FSharpCheckerResults.fsi b/src/fsharp/service/FSharpCheckerResults.fsi index 12be0190a35..27731cbc000 100644 --- a/src/fsharp/service/FSharpCheckerResults.fsi +++ b/src/fsharp/service/FSharpCheckerResults.fsi @@ -72,9 +72,47 @@ type public FSharpParsingOptions = static member internal FromTcConfigBuilder: tcConfigB: TcConfigBuilder * sourceFiles: string[] * isInteractive: bool -> FSharpParsingOptions +[] +type internal TypeCheckInfo = + internal new : + tcConfig: TcConfig * + tcGlobals: TcGlobals * + ccuSigForFile: ModuleOrNamespaceType * + thisCcu: CcuThunk * + tcImports: TcImports * + tcAccessRights: AccessorDomain * + projectFileName: string * + mainInputFileName: string * + sResolutions: TcResolutions * + sSymbolUses: TcSymbolUses * + sFallback: NameResolutionEnv * + loadClosure : LoadClosure option * + reactorOps : IReactorOperations * + textSnapshotInfo: obj option * + implFileOpt: TypedImplFile option * + openDeclarations: OpenDeclaration[] + -> TypeCheckInfo + member ScopeResolutions: TcResolutions + member ScopeSymbolUses: TcSymbolUses + member TcGlobals: TcGlobals + member TcImports: TcImports + member CcuSigForFile: ModuleOrNamespaceType + member ThisCcu: CcuThunk + member ImplementationFile: TypedImplFile option + /// A handle to the results of CheckFileInProject. [] type public FSharpCheckFileResults = + internal new : + filename: string * + errors: FSharpErrorInfo[] * + scopeOptX: TypeCheckInfo option * + dependencyFiles: string[] * + builderX: IncrementalBuilder option * + reactorOpsX: IReactorOperations * + keepAssemblyContents: bool + -> FSharpCheckFileResults + /// The errors returned by parsing a source file. member Errors : FSharpErrorInfo[] diff --git a/src/fsharp/symbols/Exprs.fs b/src/fsharp/symbols/Exprs.fs index 17290528587..c66ae6ebe33 100644 --- a/src/fsharp/symbols/Exprs.fs +++ b/src/fsharp/symbols/Exprs.fs @@ -5,6 +5,7 @@ namespace FSharp.Compiler.SourceCodeServices open FSharp.Compiler open FSharp.Compiler.AbstractIL.Internal.Library open FSharp.Compiler.AbstractIL.IL +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.Lib open FSharp.Compiler.Infos open FSharp.Compiler.QuotationTranslator @@ -35,13 +36,26 @@ module ExprTranslationImpl = isinstVals: ValMap substVals: ValMap + + /// Indicates that we disable generation of witnesses + suppressWitnesses: bool + + /// All witnesses in scope and their mapping to lambda variables. + // + // Note: this uses an immutable HashMap/Dictionary with an IEqualityComparer that captures TcGlobals, see + // the point where the empty initial object is created. + witnessesInScope: TraitWitnessInfoHashMap + } - static member Empty = + static member Empty g = { vs=ValMap<_>.Empty - tyvs = Map.empty ; + tyvs = Map.empty isinstVals = ValMap<_>.Empty - substVals = ValMap<_>.Empty } + substVals = ValMap<_>.Empty + suppressWitnesses = false + witnessesInScope = EmptyTraitWitnessInfoHashMap g + } member env.BindTypar (v: Typar, gp) = { env with tyvs = env.tyvs.Add(v.Stamp, gp ) } @@ -81,7 +95,7 @@ type E = | IfThenElse of FSharpExpr * FSharpExpr * FSharpExpr | DecisionTree of FSharpExpr * (FSharpMemberOrFunctionOrValue list * FSharpExpr) list | DecisionTreeSuccess of int * FSharpExpr list - | Call of FSharpExpr option * FSharpMemberOrFunctionOrValue * FSharpType list * FSharpType list * FSharpExpr list + | Call of FSharpExpr option * FSharpMemberOrFunctionOrValue * FSharpType list * FSharpType list * FSharpExpr list * FSharpExpr list | NewObject of FSharpMemberOrFunctionOrValue * FSharpType list * FSharpExpr list | LetRec of ( FSharpMemberOrFunctionOrValue * FSharpExpr) list * FSharpExpr | Let of (FSharpMemberOrFunctionOrValue * FSharpExpr) * FSharpExpr @@ -117,6 +131,7 @@ type E = | ILFieldGet of FSharpExpr option * FSharpType * string | ILFieldSet of FSharpExpr option * FSharpType * string * FSharpExpr | ILAsm of string * FSharpType list * FSharpExpr list + | WitnessArg of int /// Used to represent the information at an object expression member and [] FSharpObjectExprOverride(sgn: FSharpAbstractSignature, gps: FSharpGenericParameter list, args: FSharpMemberOrFunctionOrValue list list, body: FSharpExpr) = @@ -150,7 +165,7 @@ and [] FSharpExpr (cenv, f: (unit -> FSharpExpr) option, e: E, m: range, | E.NewUnionCase (_unionType, _unionCase, es) -> es | E.NewTuple (_tupleType, es) -> es | E.TupleGet (_tupleType, _itemIndex, tupleExpr) -> [tupleExpr] - | E.Call (objOpt, _b, _c, _d, es) -> (match objOpt with None -> es | Some x -> x :: es) + | E.Call (objOpt, _b, _c, _d, ws, es) -> (match objOpt with None -> ws @ es | Some x -> x :: ws @ es) | E.NewObject (_a, _b, c) -> c | E.FSharpFieldGet (objOpt, _b, _c) -> (match objOpt with None -> [] | Some x -> [x]) | E.FSharpFieldSet (objOpt, _b, _c, d) -> (match objOpt with None -> [d] | Some x -> [x;d]) @@ -187,7 +202,7 @@ and [] FSharpExpr (cenv, f: (unit -> FSharpExpr) option, e: E, m: range, | E.UnionCaseSet (obj, _unionType, _unionCase, _unionField, valueExpr) -> [ yield obj; yield valueExpr ] | E.TraitCall (_sourceTypes, _traitName, _memberFlags, _paramTypes, _retTypes, args) -> args | E.Unused -> [] // unexpected - + | E.WitnessArg _n -> [] /// The implementation of the conversion operation module FSharpExprConvert = @@ -409,19 +424,19 @@ module FSharpExprConvert = let (numEnclTypeArgs, _, isNewObj, _valUseFlags, _isSelfInit, takesInstanceArg, _isPropGet, _isPropSet) = GetMemberCallInfo cenv.g (vref, vFlags) - let isMember, curriedArgInfos = + let isMember, tps, curriedArgInfos = match vref.MemberInfo with | Some _ when not vref.IsExtensionMember -> // This is an application of a member method // We only count one argument block for these. - let _tps, curriedArgInfos, _, _ = GetTypeOfMemberInFSharpForm cenv.g vref - true, curriedArgInfos + let tps, curriedArgInfos, _, _ = GetTypeOfMemberInFSharpForm cenv.g vref + true, tps, curriedArgInfos | _ -> // This is an application of a module value or extension member let arities = arityOfVal vref.Deref - let _tps, curriedArgInfos, _, _ = GetTopValTypeInFSharpForm cenv.g arities vref.Type m - false, curriedArgInfos + let tps, curriedArgInfos, _, _ = GetTopValTypeInFSharpForm cenv.g arities vref.Type m + false, tps, curriedArgInfos // Compute the object arguments as they appear in a compiled call // Strip off the object argument, if any. The curriedArgInfos are already adjusted to compiled member form @@ -467,12 +482,30 @@ module FSharpExprConvert = if isMember then let callArgs = (objArgs :: untupledCurriedArgs) |> List.concat let enclTyArgs, methTyArgs = List.splitAfter numEnclTypeArgs tyargs + let witnessArgsR = GetWitnessArgs cenv env m tps tyargs // tailcall - ConvObjectModelCallLinear cenv env (isNewObj, FSharpMemberOrFunctionOrValue(cenv, vref), enclTyArgs, methTyArgs, callArgs) contf2 + ConvObjectModelCallLinear cenv env (isNewObj, FSharpMemberOrFunctionOrValue(cenv, vref), enclTyArgs, methTyArgs, witnessArgsR, callArgs) contf2 else let v = FSharpMemberOrFunctionOrValue(cenv, vref) + let witnessArgsR = GetWitnessArgs cenv env m vref.Typars tyargs // tailcall - ConvObjectModelCallLinear cenv env (false, v, [], tyargs, List.concat untupledCurriedArgs) contf2 + ConvObjectModelCallLinear cenv env (false, v, [], tyargs, witnessArgsR, List.concat untupledCurriedArgs) contf2 + + and GetWitnessArgs cenv (env: ExprTranslationEnv) m tps tyargs : FSharpExpr list = + let g = cenv.g + if cenv.g.langVersion.SupportsFeature(Features.LanguageFeature.WitnessPassing) && not env.suppressWitnesses then + let witnessExprs = + ConstraintSolver.CodegenWitnessesForTyparInst cenv.tcValF g cenv.amap m tps tyargs + |> CommitOperationResult + let env = { env with suppressWitnesses = true } + witnessExprs |> List.map (fun arg -> + match arg with + | Choice1Of2 traitInfo -> + ConvWitnessInfo cenv env m traitInfo + | Choice2Of2 arg -> + ConvExpr cenv env arg) + else + [] and ConvExprPrim (cenv: SymbolEnv) (env: ExprTranslationEnv) expr = // Eliminate integer 'for' loops @@ -554,7 +587,7 @@ module FSharpExprConvert = let vslR = List.map (List.map (ConvVal cenv)) tmvs let sgn = FSharpAbstractSignature(cenv, slotsig) let tpsR = [ for tp in tps -> FSharpGenericParameter(cenv, tp) ] - let env = ExprTranslationEnv.Empty.BindTypars (Seq.zip tps tpsR |> Seq.toList) + let env = env.BindTypars (Seq.zip tps tpsR |> Seq.toList) let env = env.BindCurriedVals tmvs let bodyR = ConvExpr cenv env body FSharpObjectExprOverride(sgn, tpsR, vslR, bodyR) ] @@ -841,9 +874,29 @@ module FSharpExprConvert = ConvExprPrim cenv env replExpr | _ -> wfail (sprintf "unhandled construct in AST", m) + | Expr.WitnessArg (traitInfo, _m) -> + ConvWitnessInfoPrim cenv env traitInfo | _ -> wfail (sprintf "unhandled construct in AST", expr.Range) + and ConvWitnessInfoPrim _cenv env traitInfo : E = + let witnessInfo = traitInfo.TraitKey + let env = { env with suppressWitnesses = true } + // First check if this is a witness in ReflectedDefinition code + if env.witnessesInScope.ContainsKey witnessInfo then + let witnessArgIdx = env.witnessesInScope.[witnessInfo] + E.WitnessArg(witnessArgIdx) + // Otherwise it is a witness in a quotation literal + else + //failwith "witness not found" + E.WitnessArg(-1) + + and ConvWitnessInfo cenv env m traitInfo : FSharpExpr = + let g = cenv.g + let witnessInfo = traitInfo.TraitKey + let witnessTy = GenWitnessTy g witnessInfo + let traitInfoR = ConvWitnessInfoPrim cenv env traitInfo + Mk cenv m witnessTy traitInfoR and ConvLetBind cenv env (bind : Binding) = match bind.Expr with @@ -895,7 +948,7 @@ module FSharpExprConvert = let enclosingType = generalizedTyconRef tcref let makeCall minfo = - ConvObjectModelCallLinear cenv env (isNewObj, minfo, enclTypeArgs, methTypeArgs, callArgs) id + ConvObjectModelCallLinear cenv env (isNewObj, minfo, enclTypeArgs, methTypeArgs, [], callArgs) id let makeFSCall isMember (vr: ValRef) = let memOrVal = @@ -1079,7 +1132,7 @@ module FSharpExprConvert = with e -> failwithf "An IL call to '%s' could not be resolved: %s" (ilMethRef.ToString()) e.Message - and ConvObjectModelCallLinear cenv env (isNewObj, v: FSharpMemberOrFunctionOrValue, enclTyArgs, methTyArgs, callArgs) contF = + and ConvObjectModelCallLinear cenv env (isNewObj, v: FSharpMemberOrFunctionOrValue, enclTyArgs, methTyArgs, witnessArgsR: FSharpExpr list, callArgs) contF = let enclTyArgsR = ConvTypes cenv enclTyArgs let methTyArgsR = ConvTypes cenv methTyArgs let obj, callArgs = @@ -1095,7 +1148,7 @@ module FSharpExprConvert = if isNewObj then E.NewObject(v, enclTyArgsR, callArgsR) else - E.Call(objR, v, enclTyArgsR, methTyArgsR, callArgsR)) + E.Call(objR, v, enclTyArgsR, methTyArgsR, witnessArgsR, callArgsR)) and ConvExprs cenv env args = List.map (ConvExpr cenv env) args @@ -1255,7 +1308,7 @@ and FSharpImplementationFileContents(cenv, mimpl) = let v = FSharpMemberOrFunctionOrValue(cenv, mkLocalValRef v) let gps = v.GenericParameters let vslR = List.map (List.map (FSharpExprConvert.ConvVal cenv)) vsl - let env = ExprTranslationEnv.Empty.BindTypars (Seq.zip tps gps |> Seq.toList) + let env = ExprTranslationEnv.Empty(cenv.g).BindTypars (Seq.zip tps gps |> Seq.toList) let env = env.BindCurriedVals vsl let e = FSharpExprConvert.ConvExprOnDemand cenv env body FSharpImplementationFileDeclaration.MemberOrFunctionOrValue(v, vslR, e) @@ -1277,7 +1330,7 @@ and FSharpImplementationFileContents(cenv, mimpl) = | TMDefLet(bind, _m) -> [ yield getBind bind ] | TMDefDo(expr, _m) -> - [ let expr = FSharpExprConvert.ConvExprOnDemand cenv ExprTranslationEnv.Empty expr + [ let expr = FSharpExprConvert.ConvExprOnDemand cenv (ExprTranslationEnv.Empty(cenv.g)) expr yield FSharpImplementationFileDeclaration.InitAction expr ] | TMDefs mdefs -> [ for mdef in mdefs do yield! getDecls mdef ] @@ -1303,7 +1356,8 @@ module BasicPatterns = let (|NewUnionCase|_|) (e: FSharpExpr) = match e.E with E.NewUnionCase (e, tys, es) -> Some (e, tys, es) | _ -> None let (|NewTuple|_|) (e: FSharpExpr) = match e.E with E.NewTuple (ty, es) -> Some (ty, es) | _ -> None let (|TupleGet|_|) (e: FSharpExpr) = match e.E with E.TupleGet (ty, n, es) -> Some (ty, n, es) | _ -> None - let (|Call|_|) (e: FSharpExpr) = match e.E with E.Call (a, b, c, d, e) -> Some (a, b, c, d, e) | _ -> None + let (|Call|_|) (e: FSharpExpr) = match e.E with E.Call (a, b, c, d, _e, f) -> Some (a, b, c, d, f) | _ -> None + let (|CallWithWitnesses|_|) (e: FSharpExpr) = match e.E with E.Call (a, b, c, d, e, f) -> Some (a, b, c, d, e, f) | _ -> None let (|NewObject|_|) (e: FSharpExpr) = match e.E with E.NewObject (a, b, c) -> Some (a, b, c) | _ -> None let (|FSharpFieldGet|_|) (e: FSharpExpr) = match e.E with E.FSharpFieldGet (a, b, c) -> Some (a, b, c) | _ -> None let (|AnonRecordGet|_|) (e: FSharpExpr) = match e.E with E.AnonRecordGet (a, b, c) -> Some (a, b, c) | _ -> None @@ -1335,4 +1389,5 @@ module BasicPatterns = let (|DecisionTreeSuccess|_|) (e: FSharpExpr) = match e.E with E.DecisionTreeSuccess (a, b) -> Some (a, b) | _ -> None let (|UnionCaseSet|_|) (e: FSharpExpr) = match e.E with E.UnionCaseSet (a, b, c, d, e) -> Some (a, b, c, d, e) | _ -> None let (|TraitCall|_|) (e: FSharpExpr) = match e.E with E.TraitCall (a, b, c, d, e, f) -> Some (a, b, c, d, e, f) | _ -> None + let (|WitnessArg|_|) (e: FSharpExpr) = match e.E with E.WitnessArg n -> Some n | _ -> None diff --git a/src/fsharp/symbols/Exprs.fsi b/src/fsharp/symbols/Exprs.fsi index 2d2a78370ee..966decf35ac 100644 --- a/src/fsharp/symbols/Exprs.fsi +++ b/src/fsharp/symbols/Exprs.fsi @@ -1,6 +1,6 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. -namespace FSharp.Compiler.SourceCodeServices +namespace rec FSharp.Compiler.SourceCodeServices open FSharp.Compiler.CompileOps open FSharp.Compiler.Range @@ -17,7 +17,7 @@ type public FSharpAssemblyContents = member ImplementationFiles: FSharpImplementationFileContents list /// Represents the definitional contents of a single file or fragment in an assembly, as seen by the F# language -and [] public FSharpImplementationFileContents = +type public FSharpImplementationFileContents = internal new : cenv: SymbolEnv * mimpl: TypedImplFile -> FSharpImplementationFileContents /// The qualified name acts to fully-qualify module specifications and implementations @@ -52,7 +52,8 @@ and public FSharpImplementationFileDeclaration = /// /// Pattern matching is reduced to decision trees and conditional tests. Some other /// constructs may be represented in reduced form. -and [] public FSharpExpr = +[] +type public FSharpExpr = /// The range of the expression member Range : range @@ -108,6 +109,9 @@ module public BasicPatterns = /// arguments are collapsed to a single collection of arguments, as done in the compiled version of these. val (|Call|_|) : FSharpExpr -> (FSharpExpr option * FSharpMemberOrFunctionOrValue * FSharpType list * FSharpType list * FSharpExpr list) option + /// Like Call but also indicates witness arguments + val (|CallWithWitnesses|_|) : FSharpExpr -> (FSharpExpr option * FSharpMemberOrFunctionOrValue * FSharpType list * FSharpType list * FSharpExpr list * FSharpExpr list) option + /// Matches expressions which are calls to object constructors val (|NewObject|_|) : FSharpExpr -> (FSharpMemberOrFunctionOrValue * FSharpType list * FSharpExpr list) option @@ -218,3 +222,5 @@ module public BasicPatterns = /// Matches expressions for an unresolved call to a trait val (|TraitCall|_|) : FSharpExpr -> (FSharpType list * string * MemberFlags * FSharpType list * FSharpType list * FSharpExpr list) option + /// Indicates a witness argument index from the witness arguments supplied to the enclosing method + val (|WitnessArg|_|) : FSharpExpr -> int option diff --git a/src/fsharp/symbols/Symbols.fs b/src/fsharp/symbols/Symbols.fs index f387a9bc7e1..4eda3f1e3b6 100644 --- a/src/fsharp/symbols/Symbols.fs +++ b/src/fsharp/symbols/Symbols.fs @@ -1,6 +1,6 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. -namespace FSharp.Compiler.SourceCodeServices +namespace rec FSharp.Compiler.SourceCodeServices open System.Collections.Generic @@ -56,6 +56,8 @@ type FSharpAccessibility(a:Accessibility, ?isProtected) = type SymbolEnv(g: TcGlobals, thisCcu: CcuThunk, thisCcuTy: ModuleOrNamespaceType option, tcImports: TcImports, amapV: Import.ImportMap, infoReaderV: InfoReader) = + let tcVal = TypeChecker.LightweightTcValForUsingInBuildMethodCall g + new(g: TcGlobals, thisCcu: CcuThunk, thisCcuTy: ModuleOrNamespaceType option, tcImports: TcImports) = let amap = tcImports.GetImportMap() let infoReader = InfoReader(g, amap) @@ -67,6 +69,7 @@ type SymbolEnv(g: TcGlobals, thisCcu: CcuThunk, thisCcuTy: ModuleOrNamespaceType member __.thisCcuTy = thisCcuTy member __.infoReader = infoReaderV member __.tcImports = tcImports + member __.tcValF = tcVal [] module Impl = @@ -328,7 +331,7 @@ type FSharpSymbol(cenv: SymbolEnv, item: (unit -> Item), access: (FSharpSymbol - | :? FSharpMemberFunctionOrValue as x -> Some x.Accessibility | _ -> None -and FSharpEntity(cenv: SymbolEnv, entity:EntityRef) = +type FSharpEntity(cenv: SymbolEnv, entity:EntityRef) = inherit FSharpSymbol(cenv, (fun () -> checkEntityIsResolved entity @@ -758,7 +761,7 @@ and FSharpEntity(cenv: SymbolEnv, entity:EntityRef) = override x.ToString() = x.CompiledName -and FSharpUnionCase(cenv, v: UnionCaseRef) = +type FSharpUnionCase(cenv, v: UnionCaseRef) = inherit FSharpSymbol (cenv, (fun () -> checkEntityIsResolved v.TyconRef @@ -834,7 +837,7 @@ and FSharpUnionCase(cenv, v: UnionCaseRef) = override x.ToString() = x.CompiledName -and FSharpFieldData = +type FSharpFieldData = | AnonField of AnonRecdTypeInfo * TTypes * int * range | ILField of ILFieldInfo | RecdOrClass of RecdFieldRef @@ -853,7 +856,7 @@ and FSharpFieldData = | ILField f -> Some f.DeclaringTyconRef | _ -> None -and FSharpAnonRecordTypeDetails(cenv: SymbolEnv, anonInfo: AnonRecdTypeInfo) = +type FSharpAnonRecordTypeDetails(cenv: SymbolEnv, anonInfo: AnonRecdTypeInfo) = member __.Assembly = FSharpAssembly (cenv, anonInfo.Assembly) /// Names of any enclosing types of the compiled form of the anonymous type (if the anonymous type was defined as a nested type) @@ -865,7 +868,7 @@ and FSharpAnonRecordTypeDetails(cenv: SymbolEnv, anonInfo: AnonRecdTypeInfo) = /// The sorted labels of the anonymous type member __.SortedFieldNames = anonInfo.SortedNames -and FSharpField(cenv: SymbolEnv, d: FSharpFieldData) = +type FSharpField(cenv: SymbolEnv, d: FSharpFieldData) = inherit FSharpSymbol (cenv, (fun () -> match d with @@ -1082,14 +1085,14 @@ and FSharpField(cenv: SymbolEnv, d: FSharpFieldData) = override x.ToString() = "field " + x.Name -and [] FSharpRecordField = FSharpField +type [] FSharpRecordField = FSharpField -and [] FSharpAccessibilityRights(thisCcu: CcuThunk, ad:AccessorDomain) = +type [] FSharpAccessibilityRights(thisCcu: CcuThunk, ad:AccessorDomain) = member internal __.ThisCcu = thisCcu member internal __.Contents = ad -and FSharpActivePatternCase(cenv, apinfo: PrettyNaming.ActivePatternInfo, ty, n, valOpt: ValRef option, item) = +type FSharpActivePatternCase(cenv, apinfo: PrettyNaming.ActivePatternInfo, ty, n, valOpt: ValRef option, item) = inherit FSharpSymbol (cenv, (fun () -> item), @@ -1116,7 +1119,7 @@ and FSharpActivePatternCase(cenv, apinfo: PrettyNaming.ActivePatternInfo, ty, n, | Some (_, docsig) -> docsig | _ -> "" -and FSharpActivePatternGroup(cenv, apinfo:PrettyNaming.ActivePatternInfo, ty, valOpt) = +type FSharpActivePatternGroup(cenv, apinfo:PrettyNaming.ActivePatternInfo, ty, valOpt) = member __.Name = valOpt |> Option.map (fun vref -> vref.LogicalName) @@ -1133,7 +1136,7 @@ and FSharpActivePatternGroup(cenv, apinfo:PrettyNaming.ActivePatternInfo, ty, va | ParentNone -> None | Parent p -> Some (FSharpEntity(cenv, p))) -and FSharpGenericParameter(cenv, v:Typar) = +type FSharpGenericParameter(cenv, v:Typar) = inherit FSharpSymbol (cenv, (fun () -> Item.TypeVar(v.Name, v)), @@ -1169,7 +1172,7 @@ and FSharpGenericParameter(cenv, v:Typar) = override x.ToString() = "generic parameter " + x.Name -and FSharpDelegateSignature(cenv, info: SlotSig) = +type FSharpDelegateSignature(cenv, info: SlotSig) = member __.DelegateArguments = info.FormalParams.Head @@ -1182,7 +1185,7 @@ and FSharpDelegateSignature(cenv, info: SlotSig) = | Some ty -> FSharpType(cenv, ty) override x.ToString() = "" -and FSharpAbstractParameter(cenv, info: SlotParam) = +type FSharpAbstractParameter(cenv, info: SlotParam) = member __.Name = let (TSlotParam(name, _, _, _, _, _)) = info @@ -1207,7 +1210,7 @@ and FSharpAbstractParameter(cenv, info: SlotParam) = attribs |> List.map (fun a -> FSharpAttribute(cenv, AttribInfo.FSAttribInfo(cenv.g, a))) |> makeReadOnlyCollection -and FSharpAbstractSignature(cenv, info: SlotSig) = +type FSharpAbstractSignature(cenv, info: SlotSig) = member __.AbstractArguments = info.FormalParams @@ -1233,7 +1236,7 @@ and FSharpAbstractSignature(cenv, info: SlotSig) = member __.DeclaringType = FSharpType(cenv, info.ImplementedType) -and FSharpGenericParameterMemberConstraint(cenv, info: TraitConstraintInfo) = +type FSharpGenericParameterMemberConstraint(cenv, info: TraitConstraintInfo) = let (TTrait(tys, nm, flags, atys, rty, _)) = info member __.MemberSources = tys |> List.map (fun ty -> FSharpType(cenv, ty)) |> makeReadOnlyCollection @@ -1251,17 +1254,17 @@ and FSharpGenericParameterMemberConstraint(cenv, info: TraitConstraintInfo) = override x.ToString() = "" -and FSharpGenericParameterDelegateConstraint(cenv, tupledArgTy: TType, rty: TType) = +type FSharpGenericParameterDelegateConstraint(cenv, tupledArgTy: TType, rty: TType) = member __.DelegateTupledArgumentType = FSharpType(cenv, tupledArgTy) member __.DelegateReturnType = FSharpType(cenv, rty) override x.ToString() = "" -and FSharpGenericParameterDefaultsToConstraint(cenv, pri:int, ty:TType) = +type FSharpGenericParameterDefaultsToConstraint(cenv, pri:int, ty:TType) = member __.DefaultsToPriority = pri member __.DefaultsToTarget = FSharpType(cenv, ty) override x.ToString() = "" -and FSharpGenericParameterConstraint(cenv, cx: TyparConstraint) = +type FSharpGenericParameterConstraint(cenv, cx: TyparConstraint) = member __.IsCoercesToConstraint = match cx with @@ -1358,25 +1361,25 @@ and FSharpGenericParameterConstraint(cenv, cx: TyparConstraint) = override x.ToString() = "" -and FSharpInlineAnnotation = +type FSharpInlineAnnotation = | PseudoValue | AlwaysInline | OptionalInline | NeverInline | AggressiveInline -and FSharpMemberOrValData = +type FSharpMemberOrValData = | E of EventInfo | P of PropInfo | M of MethInfo | C of MethInfo | V of ValRef -and FSharpMemberOrVal = FSharpMemberOrFunctionOrValue +type FSharpMemberOrVal = FSharpMemberOrFunctionOrValue -and FSharpMemberFunctionOrValue = FSharpMemberOrFunctionOrValue +type FSharpMemberFunctionOrValue = FSharpMemberOrFunctionOrValue -and FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) = +type FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) = inherit FSharpSymbol(cenv, (fun () -> item), @@ -2056,8 +2059,29 @@ and FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) = | V v -> v.TauType NicePrint.prettyLayoutOfTypeNoCx (denv.Contents cenv.g) ty - -and FSharpType(cenv, ty:TType) = + member x.GetWitnessPassingInfo() = + let witnessInfos = + match d with + | M (FSMeth(_, _, vref, _)) -> + let _tps, witnessInfos, _curriedArgInfos, _retTy, _ = GetTypeOfMemberInMemberForm cenv.g vref + witnessInfos + | V vref -> + let arities = arityOfVal vref.Deref + let numEnclosingTypars = CountEnclosingTyparsOfActualParentOfVal vref.Deref + let _tps, witnessInfos, _curriedArgInfos, _retTy, _ = GetTopValTypeInCompiledForm cenv.g arities numEnclosingTypars vref.Type vref.DefinitionRange + witnessInfos + | E _ | P _ | M _ | C _ -> [] + match witnessInfos with + | [] -> None + | _ when not (cenv.g.langVersion.SupportsFeature(Features.LanguageFeature.WitnessPassing)) -> None + | _ -> + let g = cenv.g + let witnessTys = GenWitnessTys g witnessInfos + let tys = witnessTys |> List.map (fun ty -> FSharpType(cenv, ty)) |> makeReadOnlyCollection + let witnessMethName = PrettyNaming.ExtraWitnessMethodName x.CompiledName + Some (witnessMethName, tys) + +type FSharpType(cenv, ty:TType) = let isUnresolved() = ErrorLogger.protectAssemblyExploration true <| fun () -> @@ -2272,7 +2296,7 @@ and FSharpType(cenv, ty:TType) = let ps = (xs, prettyTys) ||> List.map2 (List.map2 (fun p pty -> p.AdjustType pty)) |> List.map makeReadOnlyCollection |> makeReadOnlyCollection ps, returnParameter.AdjustType prettyRetTy -and FSharpAttribute(cenv: SymbolEnv, attrib: AttribInfo) = +type FSharpAttribute(cenv: SymbolEnv, attrib: AttribInfo) = let rec resolveArgObj (arg: obj) = match arg with @@ -2307,7 +2331,7 @@ and FSharpAttribute(cenv: SymbolEnv, attrib: AttribInfo) = override __.ToString() = if entityIsUnresolved attrib.TyconRef then "attribute ???" else "attribute " + attrib.TyconRef.CompiledName + "(...)" #if !NO_EXTENSIONTYPING -and FSharpStaticParameter(cenv, sp: Tainted< ExtensionTyping.ProvidedParameterInfo >, m) = +type FSharpStaticParameter(cenv, sp: Tainted< ExtensionTyping.ProvidedParameterInfo >, m) = inherit FSharpSymbol(cenv, (fun () -> protect <| fun () -> @@ -2347,7 +2371,7 @@ and FSharpStaticParameter(cenv, sp: Tainted< ExtensionTyping.ProvidedParameterIn "static parameter " + x.Name #endif -and FSharpParameter(cenv, paramTy: TType, topArgInfo: ArgReprInfo, ownerOpt, ownerRangeOpt, isParamArrayArg, isInArg, isOutArg, isOptionalArg) = +type FSharpParameter(cenv, paramTy: TType, topArgInfo: ArgReprInfo, ownerOpt, ownerRangeOpt, isParamArrayArg, isInArg, isOutArg, isOptionalArg) = inherit FSharpSymbol(cenv, (fun () -> let m = defaultArg ownerRangeOpt range0 @@ -2410,7 +2434,7 @@ and FSharpParameter(cenv, paramTy: TType, topArgInfo: ArgReprInfo, ownerOpt, own override x.ToString() = "parameter " + (match x.Name with None -> " s) -and FSharpAssemblySignature (cenv, topAttribs: TypeChecker.TopAttribs option, optViewedCcu: CcuThunk option, mtyp: ModuleOrNamespaceType) = +type FSharpAssemblySignature (cenv, topAttribs: TypeChecker.TopAttribs option, optViewedCcu: CcuThunk option, mtyp: ModuleOrNamespaceType) = // Assembly signature for a referenced/linked assembly new (cenv: SymbolEnv, ccu: CcuThunk) = @@ -2469,7 +2493,7 @@ and FSharpAssemblySignature (cenv, topAttribs: TypeChecker.TopAttribs option, op override x.ToString() = "" -and FSharpAssembly internal (cenv, ccu: CcuThunk) = +type FSharpAssembly internal (cenv, ccu: CcuThunk) = new (g, tcImports, ccu: CcuThunk) = FSharpAssembly(SymbolEnv(g, ccu, None, tcImports), ccu) diff --git a/src/fsharp/symbols/Symbols.fsi b/src/fsharp/symbols/Symbols.fsi index 4f8313c7919..f182e1a7dbc 100644 --- a/src/fsharp/symbols/Symbols.fsi +++ b/src/fsharp/symbols/Symbols.fsi @@ -1,6 +1,6 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. -namespace FSharp.Compiler.SourceCodeServices +namespace rec FSharp.Compiler.SourceCodeServices open System.Collections.Generic @@ -22,6 +22,7 @@ type internal SymbolEnv = new: TcGlobals * thisCcu: CcuThunk * thisCcuTyp: ModuleOrNamespaceType option * tcImports: TcImports * amap: ImportMap * infoReader: InfoReader -> SymbolEnv member amap: ImportMap member g: TcGlobals + member tcValF: ConstraintSolver.TcValF /// Indicates the accessibility of a symbol, as seen by the F# language type public FSharpAccessibility = @@ -48,7 +49,8 @@ type public FSharpAccessibility = /// /// Acquired via GetDisplayEnvAtLocationAlternate and similar methods. May be passed /// to the Format method on FSharpType and other methods. -type [] public FSharpDisplayContext = +[] +type public FSharpDisplayContext = internal new : denv: (TcGlobals -> DisplayEnv) -> FSharpDisplayContext static member Empty: FSharpDisplayContext @@ -59,7 +61,8 @@ type [] public FSharpDisplayContext = /// The subtype of the symbol may reveal further information and can be one of FSharpEntity, FSharpUnionCase /// FSharpField, FSharpGenericParameter, FSharpStaticParameter, FSharpMemberOrFunctionOrValue, FSharpParameter, /// or FSharpActivePatternCase. -type [] public FSharpSymbol = +[] +type public FSharpSymbol = static member internal Create: g: TcGlobals * thisCcu: CcuThunk * thisCcuTyp: ModuleOrNamespaceType * tcImports: TcImports * item: NameResolution.Item -> FSharpSymbol static member internal Create: cenv: SymbolEnv * item: NameResolution.Item -> FSharpSymbol @@ -104,7 +107,8 @@ type [] public FSharpSymbol = static member GetAccessibility : FSharpSymbol -> FSharpAccessibility option /// Represents an assembly as seen by the F# language -and [] public FSharpAssembly = +[] +type public FSharpAssembly = internal new : tcGlobals: TcGlobals * tcImports: TcImports * ccu: CcuThunk -> FSharpAssembly @@ -128,7 +132,8 @@ and [] public FSharpAssembly = #endif /// Represents an inferred signature of part of an assembly as seen by the F# language -and [] public FSharpAssemblySignature = +[] +type public FSharpAssemblySignature = internal new : tcGlobals: TcGlobals * thisCcu: CcuThunk * thisCcuTyp: ModuleOrNamespaceType * tcImports: TcImports * topAttribs: TypeChecker.TopAttribs option * contents: ModuleOrNamespaceType -> FSharpAssemblySignature @@ -144,7 +149,8 @@ and [] public FSharpAssemblySignature = /// A subtype of FSharpSymbol that represents a type definition or module as seen by the F# language -and [] public FSharpEntity = +[] +type public FSharpEntity = inherit FSharpSymbol internal new : SymbolEnv * EntityRef -> FSharpEntity @@ -323,7 +329,8 @@ and [] public FSharpEntity = member ActivePatternCases : FSharpActivePatternCase list /// Represents a delegate signature in an F# symbol -and [] public FSharpDelegateSignature = +[] +type public FSharpDelegateSignature = /// Get the argument types of the delegate signature member DelegateArguments : IList @@ -331,7 +338,8 @@ and [] public FSharpDelegateSignature = member DelegateReturnType : FSharpType /// Represents a parameter in an abstract method of a class or interface -and [] public FSharpAbstractParameter = +[] +type public FSharpAbstractParameter = /// The optional name of the parameter member Name : string option @@ -352,7 +360,8 @@ and [] public FSharpAbstractParameter = member Attributes : IList /// Represents the signature of an abstract slot of a class or interface -and [] public FSharpAbstractSignature = +[] +type public FSharpAbstractSignature = internal new : SymbolEnv * SlotSig -> FSharpAbstractSignature /// Get the arguments of the abstract slot @@ -374,7 +383,8 @@ and [] public FSharpAbstractSignature = member DeclaringType : FSharpType /// A subtype of FSharpSymbol that represents a union case as seen by the F# language -and [] public FSharpUnionCase = +[] +type public FSharpUnionCase = inherit FSharpSymbol internal new : SymbolEnv * UnionCaseRef -> FSharpUnionCase @@ -412,7 +422,8 @@ and [] public FSharpUnionCase = member IsUnresolved : bool /// A subtype of FSharpSymbol that represents a record or union case field as seen by the F# language -and [] public FSharpAnonRecordTypeDetails = +[] +type public FSharpAnonRecordTypeDetails = /// The assembly where the compiled form of the anonymous type is defined member Assembly : FSharpAssembly @@ -427,7 +438,8 @@ and [] public FSharpAnonRecordTypeDetails = member SortedFieldNames : string[] /// A subtype of FSharpSymbol that represents a record or union case field as seen by the F# language -and [] public FSharpField = +[] +type public FSharpField = inherit FSharpSymbol internal new : SymbolEnv * RecdFieldRef -> FSharpField @@ -501,12 +513,14 @@ and [] public FSharpField = member IsUnresolved : bool /// Represents the rights of a compilation to access symbols -and [] public FSharpAccessibilityRights = +[] +type public FSharpAccessibilityRights = internal new : CcuThunk * AccessorDomain -> FSharpAccessibilityRights member internal Contents : AccessorDomain /// A subtype of FSharpSymbol that represents a generic parameter for an FSharpSymbol -and [] public FSharpGenericParameter = +[] +type public FSharpGenericParameter = inherit FSharpSymbol internal new : SymbolEnv * Typar -> FSharpGenericParameter @@ -538,7 +552,8 @@ and [] public FSharpGenericParameter = #if !NO_EXTENSIONTYPING /// A subtype of FSharpSymbol that represents a static parameter to an F# type provider -and [] public FSharpStaticParameter = +[] +type public FSharpStaticParameter = inherit FSharpSymbol @@ -676,7 +691,8 @@ and [] public FSharpInlineAnnotation = | AggressiveInline /// A subtype of F# symbol that represents an F# method, property, event, function or value, including extension members. -and [] public FSharpMemberOrFunctionOrValue = +[] +type public FSharpMemberOrFunctionOrValue = inherit FSharpSymbol internal new : SymbolEnv * ValRef -> FSharpMemberOrFunctionOrValue @@ -864,9 +880,13 @@ and [] public FSharpMemberOrFunctionOrValue = /// Format the type using the rules of the given display context member FormatLayout : context: FSharpDisplayContext -> Layout + /// Check if this method has an entrpoint that accepts witness arguments and if so return + /// the name of that entrypoint and the types of the witness arguments + member GetWitnessPassingInfo: unit -> (string * IList) option /// A subtype of FSharpSymbol that represents a parameter -and [] public FSharpParameter = +[] +type public FSharpParameter = inherit FSharpSymbol @@ -896,7 +916,8 @@ and [] public FSharpParameter = /// A subtype of FSharpSymbol that represents a single case within an active pattern -and [] public FSharpActivePatternCase = +[] +type public FSharpActivePatternCase = inherit FSharpSymbol @@ -919,7 +940,8 @@ and [] public FSharpActivePatternCase = member XmlDocSig: string /// Represents all cases within an active pattern -and [] public FSharpActivePatternGroup = +[] +type public FSharpActivePatternGroup = /// The whole group name member Name: string option @@ -936,7 +958,8 @@ and [] public FSharpActivePatternGroup = /// Try to get the entity in which the active pattern is declared member DeclaringEntity : FSharpEntity option -and [] public FSharpType = +[] +type public FSharpType = /// Internal use only. Create a ground type. internal new : g:TcGlobals * thisCcu: CcuThunk * thisCcuTyp: ModuleOrNamespaceType * tcImports: TcImports * ty:TType -> FSharpType @@ -1030,7 +1053,8 @@ and [] public FSharpType = /// Represents a custom attribute attached to F# source code or a compiler .NET component -and [] public FSharpAttribute = +[] +type public FSharpAttribute = /// The type of the attribute member AttributeType : FSharpEntity