diff --git a/.vscode/launch.json b/.vscode/launch.json index b93e358bbc1..e424c366f12 100644 --- a/.vscode/launch.json +++ b/.vscode/launch.json @@ -92,6 +92,16 @@ "enableStepFiltering": false, "requireExactSource": false, "allowFastEvaluate": true + }, + { + "name": "FCS Test", + "type": "coreclr", + "request": "launch", + "program": "${workspaceFolder}/artifacts/bin/fcs-test/Debug/net8.0/fcs-test.dll", + "args": [], + "cwd": "${workspaceFolder}/fcs/fcs-test", + "console": "internalConsole", + "stopAtEntry": false } ] -} +} \ No newline at end of file diff --git a/buildtools/buildtools.targets b/buildtools/buildtools.targets index 86346fc2a15..ed0259f01c7 100644 --- a/buildtools/buildtools.targets +++ b/buildtools/buildtools.targets @@ -20,7 +20,7 @@ BeforeTargets="CoreCompile"> - $(ArtifactsDir)\Bootstrap\fslex\fslex.dll + $(ArtifactsDir)\bin\fslex\Release\net9.0\linux-x64\fslex.dll @@ -44,7 +44,7 @@ BeforeTargets="CoreCompile"> - $(ArtifactsDir)\Bootstrap\fsyacc\fsyacc.dll + $(ArtifactsDir)\bin\fsyacc\Release\net9.0\linux-x64\fsyacc.dll diff --git a/fcs/build.sh b/fcs/build.sh new file mode 100644 index 00000000000..99848aa8ffa --- /dev/null +++ b/fcs/build.sh @@ -0,0 +1,7 @@ +#!/usr/bin/env bash + +dotnet build -c Release buildtools/fslex +dotnet build -c Release buildtools/fsyacc +dotnet build -c Release src/Compiler +dotnet run -c Release --project fcs/fcs-test +echo "Binaries can be found here: /artifacts/bin/FSharp.Compiler.Service/Release/netstandard2.0/" \ No newline at end of file diff --git a/fcs/fcs-test/NuGet.config b/fcs/fcs-test/NuGet.config new file mode 100644 index 00000000000..273c7d2db75 --- /dev/null +++ b/fcs/fcs-test/NuGet.config @@ -0,0 +1,10 @@ + + + + + + + + + + diff --git a/fcs/fcs-test/Program.fs b/fcs/fcs-test/Program.fs new file mode 100644 index 00000000000..fdefd83d449 --- /dev/null +++ b/fcs/fcs-test/Program.fs @@ -0,0 +1,178 @@ +open System.IO +open System.Text.RegularExpressions +open FSharp.Compiler +open FSharp.Compiler.CodeAnalysis +open FSharp.Compiler.SourceCodeServices +open FSharp.Compiler.EditorServices +open Buildalyzer + +let getProjectOptionsFromProjectFile (isMain: bool) (projFile: string) = + + let tryGetResult (isMain: bool) (manager: AnalyzerManager) (maybeCsprojFile: string) = + + let analyzer = manager.GetProject(maybeCsprojFile) + let env = analyzer.EnvironmentFactory.GetBuildEnvironment(Environment.EnvironmentOptions(DesignTime=true,Restore=false)) + // If System.the project targets multiple frameworks, multiple results will be returned + // For now we just take the first one with non-empty command + let results = analyzer.Build(env) + results + |> Seq.tryFind (fun r -> System.String.IsNullOrEmpty(r.Command) |> not) + + let manager = + let log = new StringWriter() + let options = AnalyzerManagerOptions(LogWriter = log) + let m = AnalyzerManager(options) + m + + // Because Buildalyzer works better with .csproj, we first "dress up" the project as if it were a C# one + // and try to adapt the results. If it doesn't work, we try again to analyze the .fsproj directly + let csprojResult = + let csprojFile = projFile.Replace(".fsproj", ".csproj") + if File.Exists(csprojFile) then + None + else + try + File.Copy(projFile, csprojFile) + tryGetResult isMain manager csprojFile + |> Option.map (fun (r: IAnalyzerResult) -> + // Careful, options for .csproj start with / but so do root paths in unix + let reg = Regex(@"^\/[^\/]+?(:?:|$)") + let comArgs = + r.CompilerArguments + |> Array.map (fun line -> + if reg.IsMatch(line) then + if line.StartsWith("/reference") then "-r" + line.Substring(10) + else "--" + line.Substring(1) + else line) + let comArgs = + match r.Properties.TryGetValue("OtherFlags") with + | false, _ -> comArgs + | true, otherFlags -> + let otherFlags = otherFlags.Split(' ', System.StringSplitOptions.RemoveEmptyEntries) + Array.append otherFlags comArgs + comArgs, r) + finally + File.Delete(csprojFile) + + let compilerArgs, result = + csprojResult + |> Option.orElseWith (fun () -> + tryGetResult isMain manager projFile + |> Option.map (fun r -> + // result.CompilerArguments doesn't seem to work well in Linux + let comArgs = Regex.Split(r.Command, @"\r?\n") + comArgs, r)) + |> function + | Some result -> result + // TODO: Get Buildalyzer errors from the log + | None -> failwith $"Cannot parse {projFile}" + + let projDir = Path.GetDirectoryName(projFile) + let projOpts = + compilerArgs + |> Array.skipWhile (fun line -> not(line.StartsWith("-"))) + |> Array.map (fun f -> + if f.EndsWith(".fs") || f.EndsWith(".fsi") then + if Path.IsPathRooted f then f else Path.Combine(projDir, f) + else f) + projOpts, + Seq.toArray result.ProjectReferences, + result.Properties, + result.TargetFramework + +let mkStandardProjectReferences () = + let fileName = "fcs-test.fsproj" + let projDir = __SOURCE_DIRECTORY__ + let projFile = Path.Combine(projDir, fileName) + let (args, _, _, _) = getProjectOptionsFromProjectFile true projFile + args + |> Array.filter (fun s -> s.StartsWith("-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 + |] + +let getProjectOptionsFromCommandLineArgs(projName, argv): FSharpProjectOptions = + { ProjectFileName = projName + ProjectId = None + SourceFiles = [| |] + OtherOptions = argv + ReferencedProjects = [| |] + IsIncompleteTypeCheckEnvironment = false + UseScriptResolutionRules = false + LoadTime = System.DateTime.MaxValue + UnresolvedReferences = None + OriginalLoadReferences = [] + 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 = __SOURCE_DIRECTORY__ + "/test_script.fsx" + let fileNames = [| fileName |] + let source = File.ReadAllText (fileName, System.Text.Encoding.UTF8) + + 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) + let sourceReader _fileName = (hash source, lazy source) + + // parse and typecheck a project + let projectResults = + checker.ParseAndCheckProject(projName, fileNames, sourceReader) + |> Async.RunSynchronously + projectResults.Diagnostics |> Array.iter (fun e -> printfn "%A: %A" (e.Severity) e) + printAst "ParseAndCheckProject" projectResults + + // or just parse and typecheck a file in project + let (parseResults, typeCheckResults, projectResults) = + checker.ParseAndCheckFileInProject(projName, fileNames, sourceReader, fileName) + |> Async.RunSynchronously + projectResults.Diagnostics |> Array.iter (fun e -> printfn "%A: %A" (e.Severity) e) + + printAst "ParseAndCheckFileInProject" projectResults + + let inputLines = source.Split('\n') + + // Get tool tip at the specified location + let tip = typeCheckResults.GetToolTip(4, 7, inputLines.[3], ["foo"], Tokenization.FSharpTokenTag.IDENT) + (sprintf "%A" tip).Replace("\n","") |> printfn "\n---> ToolTip Text = %A" // should print "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 _ -> [])) + [ for item in decls.Items -> item.NameInList ] |> printfn "\n---> msg AutoComplete = %A" // should print 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 _ -> [])) + [ for item in decls.Items -> item.NameInList ] |> printfn "\n---> canvas AutoComplete = %A" + + printfn "Done." + 0 diff --git a/fcs/fcs-test/ast_print.fs b/fcs/fcs-test/ast_print.fs new file mode 100644 index 00000000000..747860e55b3 --- /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. + +module AstPrint + +open FSharp.Compiler.Symbols + +//------------------------------------------------------------------------- +// 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..d401fb31e84 --- /dev/null +++ b/fcs/fcs-test/fcs-test.fsproj @@ -0,0 +1,27 @@ + + + + Exe + net9.0 + true + + + + + + + + + + + + + + + + + + + + + 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/fcs/service_slim.fs b/fcs/service_slim.fs new file mode 100644 index 00000000000..d80132171a8 --- /dev/null +++ b/fcs/service_slim.fs @@ -0,0 +1,467 @@ +// 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 System.Threading + +open Internal.Utilities.Collections +open Internal.Utilities.Library +open Internal.Utilities.Library.Extras + +open FSharp.Compiler +open FSharp.Compiler.AbstractIL +open FSharp.Compiler.AbstractIL.IL +open FSharp.Compiler.AbstractIL.ILBinaryReader +open FSharp.Compiler.CodeAnalysis +open FSharp.Compiler.CheckBasics +open FSharp.Compiler.CheckDeclarations +open FSharp.Compiler.CompilerConfig +open FSharp.Compiler.CompilerDiagnostics +open FSharp.Compiler.CompilerGlobalState +open FSharp.Compiler.CompilerImports +open FSharp.Compiler.CompilerOptions +open FSharp.Compiler.DependencyManager +open FSharp.Compiler.Diagnostics +open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.Driver +open FSharp.Compiler.NameResolution +open FSharp.Compiler.ParseAndCheckInputs +open FSharp.Compiler.ScriptClosure +open FSharp.Compiler.Symbols +open FSharp.Compiler.Syntax +open FSharp.Compiler.TcGlobals +open FSharp.Compiler.Text +open FSharp.Compiler.Text.Range +open FSharp.Compiler.Tokenization +open FSharp.Compiler.TypedTree +open FSharp.Compiler.TypedTreeBasics +open FSharp.Compiler.TypedTreeOps +open FSharp.Compiler.BuildGraph +open FSharp.Compiler.GraphChecking + +//------------------------------------------------------------------------- +// InteractiveChecker +//------------------------------------------------------------------------- + +type internal TcResult = TcEnv * TopAttribs * CheckedImplFile option * ModuleOrNamespaceType +type internal TcErrors = FSharpDiagnostic[] + +type internal CompilerState = { + tcConfig: TcConfig + tcGlobals: TcGlobals + tcImports: TcImports + tcInitialState: TcState + projectOptions: FSharpProjectOptions + parseCache: ConcurrentDictionary + checkCache: ConcurrentDictionary +} + +type internal CacheMsg<'T> = + | Get of AsyncReplyChannel<'T> + | Reset + +type internal Cache<'T>(init: (unit -> unit) -> Async<'T>) = + let agent = + MailboxProcessor>.Start(fun agent -> + let rec loop cached = async { + match! agent.Receive() with + | Get channel -> + match cached with + | Some cached -> + channel.Reply(cached) + return! Some cached |> loop + | None -> + let reset() = agent.Post Reset + let! cached = init reset + channel.Reply cached + return! Some cached |> loop + | Reset -> + return! loop None + } + + loop None) + member _.Get() = agent.PostAndAsyncReply(Get) + member _.Reset() = agent.Post Reset + +[] +module internal ParseAndCheck = + + let userOpName = "Unknown" + let suggestNamesForErrors = true + let captureIdentifiersWhenParsing = false + + let measureTime (f: unit -> 'a) = + let sw = Diagnostics.Stopwatch.StartNew() + let res = f() + sw.Stop() + res, sw.ElapsedMilliseconds + + let measureTimeAsync (f: unit -> Async<'a>) = async { + let sw = Diagnostics.Stopwatch.StartNew() + let! res = f() + sw.Stop() + return res, sw.ElapsedMilliseconds + } + + // Cache to store current compiler state. + // In the case of type provider invalidation, + // compiler state needs to be reset to recognize TP changes. + let initializeCompilerState projectOptions reset = async { + let tcConfig = + let tcConfigB = + TcConfigBuilder.CreateNew( + SimulatedMSBuildReferenceResolver.getResolver(), + defaultFSharpBinariesDir = FSharpCheckerResultsSettings.defaultFSharpBinariesDir, + reduceMemoryUsage = ReduceMemoryFlag.Yes, + implicitIncludeDir = !! Path.GetDirectoryName(projectOptions.ProjectFileName), + isInteractive = false, + isInvalidationSupported = true, + defaultCopyFSharpCore = CopyFSharpCoreFlag.No, + tryGetMetadataSnapshot = (fun _ -> None), + sdkDirOverride = None, + rangeForErrors = range0 + ) + 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 dependencyProvider = new DependencyProvider() + let! tcGlobals, tcImports = + TcImports.BuildTcImports (tcConfigP, dependencyProvider) + + // Handle type provider invalidation by resetting compiler state + tcImports.GetCcusExcludingBase() + |> Seq.iter (fun ccu -> + ccu.Deref.InvalidateEvent.Add(fun _ -> reset()) + ) + + let assemblyName = !! Path.GetFileNameWithoutExtension(projectOptions.ProjectFileName) + let tcInitial, openDecls0 = GetInitialTcEnv (assemblyName, rangeStartup, tcConfig, tcImports, tcGlobals) + let tcInitialState = GetInitialTcState (rangeStartup, assemblyName, tcConfig, tcGlobals, tcImports, tcInitial, openDecls0) + + // 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) + + return { + tcConfig = tcConfig + tcGlobals = tcGlobals + tcImports = tcImports + tcInitialState = tcInitialState + projectOptions = projectOptions + parseCache = parseCache + checkCache = checkCache + } + } + + let MakeProjectResults (projectFileName: string, parseResults: FSharpParseFileResults[], tcState: TcState, errors: FSharpDiagnostic[], + topAttrsOpt: TopAttribs option, tcImplFilesOpt: CheckedImplFile list option, compilerState) = + let assemblyRef = mkSimpleAssemblyRef "stdin" + let access = tcState.TcEnvFromImpls.AccessRights + let symbolUses = Choice2Of2 (async { return seq { } }) + let dependencyFiles = parseResults |> Seq.map (fun x -> x.DependencyFiles) |> Array.concat + let getAssemblyData () = None + let details = (compilerState.tcGlobals, compilerState.tcImports, tcState.Ccu, tcState.CcuSig, symbolUses, topAttrsOpt, + getAssemblyData, assemblyRef, access, tcImplFilesOpt, dependencyFiles, compilerState.projectOptions) + let keepAssemblyContents = true + FSharpCheckProjectResults (projectFileName, Some compilerState.tcConfig, keepAssemblyContents, errors, Some details) + + let ClearStaleCache (fileName: string, parsingOptions: FSharpParsingOptions, compilerState) = + 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 compilerState.checkCache.TryGetValue(key) with + | true, value -> Some (key, value) + | false, _ -> None) + // remove all parse cache entries with the same file name + let staleParseKeys = compilerState.parseCache.Keys |> Seq.filter (fun (n,_) -> n = fileName) |> Seq.toArray + staleParseKeys |> Array.iter (fun key -> compilerState.parseCache.TryRemove(key) |> ignore) + compilerState.checkCache.Clear(); // clear all typecheck cache + // restore all cached typecheck entries above file + cachedAbove |> Array.iter (fun (key, value) -> compilerState.checkCache.TryAdd(key, value) |> ignore) + + let ParseFile (fileName: string, sourceHash: int, source: Lazy, parsingOptions: FSharpParsingOptions, compilerState, ct) = + let parseCacheKey = fileName, sourceHash + compilerState.parseCache.GetOrAdd(parseCacheKey, fun _ -> + ClearStaleCache(fileName, parsingOptions, compilerState) + let sourceText = SourceText.ofString source.Value + let flatErrors = compilerState.tcConfig.flatErrors + let parseErrors, parseTreeOpt, anyErrors = + ParseAndCheckFile.parseFile (sourceText, fileName, parsingOptions, userOpName, suggestNamesForErrors, flatErrors, captureIdentifiersWhenParsing, ct) + let dependencyFiles = [||] // interactions have no dependencies + FSharpParseFileResults (parseErrors, parseTreeOpt, anyErrors, dependencyFiles) ) + + let TypeCheckOneInputEntry (parseResults: FSharpParseFileResults, tcSink: TcResultsSink, tcState: TcState, moduleNamesDict: ModuleNamesDict, compilerState) = + let input = parseResults.ParseTree + let diagnosticsOptions = compilerState.tcConfig.diagnosticsOptions + let capturingLogger = CompilationDiagnosticLogger("TypeCheckFile", diagnosticsOptions) + let diagnosticsLogger = GetDiagnosticsLoggerFilteringByScopedPragmas(false, input.ScopedPragmas, diagnosticsOptions, capturingLogger) + use _scope = new CompilationGlobalsScope (diagnosticsLogger, BuildPhase.TypeCheck) + + let checkForErrors () = parseResults.ParseHadErrors || diagnosticsLogger.ErrorCount > 0 + let prefixPathOpt = None + + let input, moduleNamesDict = input |> DeduplicateParsedInputModuleName moduleNamesDict + let tcResult, tcState = + CheckOneInput (checkForErrors, compilerState.tcConfig, compilerState.tcImports, compilerState.tcGlobals, prefixPathOpt, tcSink, tcState, input) + |> Cancellable.runWithoutCancellation + + let fileName = parseResults.FileName + let flatErrors = compilerState.tcConfig.flatErrors + let parseDiagnostics = capturingLogger.GetDiagnostics() + let tcErrors = DiagnosticHelpers.CreateDiagnostics (diagnosticsOptions, false, fileName, parseDiagnostics, suggestNamesForErrors, flatErrors, None) + (tcResult, tcErrors), (tcState, moduleNamesDict) + + let CheckFile (projectFileName: string, parseResults: FSharpParseFileResults, tcState: TcState, moduleNamesDict: ModuleNamesDict, compilerState) = + let sink = TcResultsSinkImpl(compilerState.tcGlobals) + let tcSink = TcResultsSink.WithSink sink + let (tcResult, tcErrors), (tcState, moduleNamesDict) = + TypeCheckOneInputEntry (parseResults, tcSink, tcState, moduleNamesDict, compilerState) + let fileName = parseResults.FileName + compilerState.checkCache.[fileName] <- ((tcResult, tcErrors), (tcState, moduleNamesDict)) + + let loadClosure = None + let keepAssemblyContents = true + + let tcEnvAtEnd, _topAttrs, implFile, ccuSigForFile = tcResult + let errors = Array.append parseResults.Diagnostics tcErrors + + let scope = TypeCheckInfo (compilerState.tcConfig, compilerState.tcGlobals, ccuSigForFile, tcState.Ccu, compilerState.tcImports, tcEnvAtEnd.AccessRights, + projectFileName, fileName, compilerState.projectOptions, sink.GetResolutions(), sink.GetSymbolUses(), tcEnvAtEnd.NameEnv, + loadClosure, implFile, sink.GetOpenDeclarations()) + FSharpCheckFileResults (fileName, errors, Some scope, parseResults.DependencyFiles, None, keepAssemblyContents) + + let TypeCheckClosedInputSet (parseResults: FSharpParseFileResults[], tcState, compilerState, subscriber) = + let cachedTypeCheck (tcState, moduleNamesDict) (parseRes: FSharpParseFileResults) = + let checkCacheKey = parseRes.FileName + + let typeCheckOneInput _fileName = + TypeCheckOneInputEntry (parseRes, TcResultsSink.NoSink, tcState, moduleNamesDict, compilerState) + + let (result, errors), (tcState, moduleNamesDict) = compilerState.checkCache.GetOrAdd(checkCacheKey, typeCheckOneInput) + + let _, _, implFile, _ = result + match subscriber, implFile with + | Some subscriber, Some implFile -> + let cenv = SymbolEnv(compilerState.tcGlobals, tcState.Ccu, Some tcState.CcuSig, compilerState.tcImports) + FSharpImplementationFileContents(cenv, implFile) |> subscriber + | _ -> () + + (result, errors), (tcState, moduleNamesDict) + + let results, (tcState, moduleNamesDict) = + ((tcState, Map.empty), parseResults) ||> Array.mapFold cachedTypeCheck + + let tcResults, tcErrors = Array.unzip results + let (tcEnvAtEndOfLastFile, topAttrs, implFiles, _ccuSigsForFiles), tcState = + CheckMultipleInputsFinish(tcResults |> Array.toList, tcState) + + let tcState, declaredImpls, ccuContents = CheckClosedInputSetFinish (implFiles, tcState) + tcState.Ccu.Deref.Contents <- ccuContents + tcState, topAttrs, declaredImpls, tcEnvAtEndOfLastFile, moduleNamesDict, tcErrors + + /// Errors grouped by file, sorted by line, column + let ErrorsByFile (fileNames: string[], errorList: FSharpDiagnostic[] 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.StartLine, x.StartColumn)) + errors |> Array.concat + +type InteractiveChecker internal (compilerStateCache) = + + static member Create(projectOptions: FSharpProjectOptions) = + Cache(initializeCompilerState projectOptions) |> InteractiveChecker + + /// Clears parse and typecheck caches. + member _.ClearCache () = async { + let! compilerState = compilerStateCache.Get() + compilerState.parseCache.Clear() + compilerState.checkCache.Clear() + } + + member _.GetImportedAssemblies() = async { + let! compilerState = compilerStateCache.Get() + let tcImports = compilerState.tcImports + let tcGlobals = compilerState.tcGlobals + return + tcImports.GetImportedAssemblies() + |> List.map (fun x -> FSharpAssembly(tcGlobals, tcImports, x.FSharpViewOfMetadata)) + } + + /// Compile project to file. If project has already been type checked, + /// check results will be taken from the cache. + member _.Compile(fileNames: string[], sourceReader: string -> int * Lazy, outFile: string) = async { + let! ct = Async.CancellationToken + let! compilerState = compilerStateCache.Get() + let parsingOptions = FSharpParsingOptions.FromTcConfig(compilerState.tcConfig, fileNames, false) + let parseResults = fileNames |> Array.map (fun fileName -> + let sourceHash, source = sourceReader fileName + ParseFile(fileName, sourceHash, source, parsingOptions, compilerState, ct)) + + let (tcState, topAttrs, tcImplFiles, _tcEnvAtEnd, _moduleNamesDict, _tcErrors) = + TypeCheckClosedInputSet (parseResults, compilerState.tcInitialState, compilerState, None) + + let ctok = CompilationThreadToken() + let flatErrors = compilerState.tcConfig.flatErrors + let errors, diagnosticsLogger, _loggerProvider = CompileHelpers.mkCompilationDiagnosticsHandlers(flatErrors) + let exnOpt = + CompileHelpers.tryCompile diagnosticsLogger (fun exiter -> + CompileFromTypedAst (ctok, compilerState.tcGlobals, compilerState.tcImports, tcState.Ccu, + tcImplFiles, topAttrs, compilerState.tcConfig, outFile, diagnosticsLogger, exiter)) + + return errors.ToArray(), exnOpt + } + + /// 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 _.ParseAndCheckProject (projectFileName: string, fileNames: string[], sourceReader: string -> int * Lazy, + ?lastFile: string, ?subscriber: FSharpImplementationFileContents -> unit) = async { + let! ct = Async.CancellationToken + let! compilerState = compilerStateCache.Get() + // parse files + let parsingOptions = FSharpParsingOptions.FromTcConfig(compilerState.tcConfig, fileNames, false) + let parseResults = + let fileNames = + match lastFile with + | None -> fileNames + | Some fileName -> + let fileIndex = fileNames |> Array.findIndex ((=) fileName) + fileNames |> Array.take (fileIndex + 1) + + let parseFile fileName = + let sourceHash, source = sourceReader fileName + ParseFile(fileName, sourceHash, source, parsingOptions, compilerState, ct) + + // Don't parallelize if we have cached files, as it would create issues with invalidation + if compilerState.parseCache.Count = 0 then + fileNames |> Array.Parallel.map parseFile + else + fileNames |> Array.map parseFile + + // type check files + let (tcState, topAttrs, tcImplFiles, _tcEnvAtEnd, _moduleNamesDict, tcErrors) = + TypeCheckClosedInputSet (parseResults, compilerState.tcInitialState, compilerState, subscriber) + + // make project results + let parseErrors = parseResults |> Array.collect (fun p -> p.Diagnostics) + let typedErrors = tcErrors |> Array.concat + let errors = ErrorsByFile (fileNames, [ parseErrors; typedErrors ]) + let projectResults = MakeProjectResults (projectFileName, parseResults, tcState, errors, Some topAttrs, Some tcImplFiles, compilerState) + + return 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 _.ParseAndCheckFileInProject (projectFileName: string, fileNames: string[], sourceReader: string -> int * Lazy, fileName: string) = async { + let! ct = Async.CancellationToken + let! compilerState = compilerStateCache.Get() + + // get files before file + let fileIndex = fileNames |> Array.findIndex ((=) fileName) + let fileNamesBeforeFile = fileNames |> Array.take fileIndex + + // parse files before file + let parsingOptions = FSharpParsingOptions.FromTcConfig(compilerState.tcConfig, fileNames, false) + let parseFile fileName = + let sourceHash, source = sourceReader fileName + ParseFile (fileName, sourceHash, source, parsingOptions, compilerState, ct) + let parseResults = fileNamesBeforeFile |> Array.map parseFile + + // type check files before file + let tcState, topAttrs, tcImplFiles, _tcEnvAtEnd, moduleNamesDict, tcErrors = + TypeCheckClosedInputSet (parseResults, compilerState.tcInitialState, compilerState, None) + + // parse and type check file + let parseFileResults = parseFile fileName + let checkFileResults = CheckFile (projectFileName, parseFileResults, tcState, moduleNamesDict, compilerState) + let (tcResult, _tcErrors), (tcState, _moduleNamesDict) = compilerState.checkCache.[fileName] + let _tcEnvAtEndFile, topAttrsFile, implFile, _ccuSigForFile = tcResult + + // collect errors + let parseErrorsBefore = parseResults |> Array.collect (fun p -> p.Diagnostics) + let typedErrorsBefore = tcErrors |> Array.concat + let newErrors = checkFileResults.Diagnostics + let errors = 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 projectResults = MakeProjectResults (projectFileName, parseResults, tcState, errors, Some topAttrs, Some tcImplFiles, compilerState) + + return (parseFileResults, checkFileResults, projectResults) + } + + /// Find the transitive dependent files of the current file based on the untyped syntax tree. + member _.GetDependentFiles(currentFileName: string, fileNames: string[], sourceReader: string -> int * Lazy) = async { + // parse files + let! ct = Async.CancellationToken + let! compilerState = compilerStateCache.Get() + // parse files + let parsingOptions = FSharpParsingOptions.FromTcConfig(compilerState.tcConfig, fileNames, false) + let parseFile fileName = + let sourceHash, source = sourceReader fileName + ParseFile (fileName, sourceHash, source, parsingOptions, compilerState, ct) + + // TODO: not sure if parse cache issues still applies + let parseResults = fileNames |> Array.Parallel.map parseFile + let sourceFiles: FileInProject array = + parseResults + |> Array.mapi (fun idx (parseResults: FSharpParseFileResults) -> + let input = parseResults.ParseTree + { + Idx = idx + FileName = input.FileName + ParsedInput = input + }) + + let currentFileIdx = Array.IndexOf(fileNames, currentFileName) + + let filePairs = FilePairMap(sourceFiles) + let graph, _trie = DependencyResolution.mkGraph filePairs sourceFiles + let findTransitiveDependentFiles (startNode : FileIndex) : FileIndex array = + let rec dfs (node : FileIndex) (visited : Set) (acc : FileIndex array) : FileIndex array = + if (Set.contains node visited) then + acc + else + let newVisited = Set.add node visited + + let consumers = + // Last node in the project cannot have + if node = graph.Count - 1 then + acc + else + // Look if the next nodes depend on the current node + [| (node + 1) .. (graph.Count - 1) |] + |> Array.fold + (fun innerAcc nextIdx -> + if not (Array.contains node graph.[nextIdx]) then + innerAcc + else + dfs nextIdx newVisited innerAcc) + acc + + [| yield node; yield! consumers |] + + dfs startNode Set.empty Array.empty + |> Array.sort + + let dependentFiles = + findTransitiveDependentFiles currentFileIdx + |> Array.sort + |> Array.map (fun idx -> Array.item idx fileNames) + + return dependentFiles + } diff --git a/src/Compiler/Checking/Expressions/CheckComputationExpressions.fs b/src/Compiler/Checking/Expressions/CheckComputationExpressions.fs index 22b603d211a..1f70a0fcfdd 100644 --- a/src/Compiler/Checking/Expressions/CheckComputationExpressions.fs +++ b/src/Compiler/Checking/Expressions/CheckComputationExpressions.fs @@ -460,7 +460,7 @@ let tryGetArgAttribsForCustomOperator ceenv (nm: Ident) = _joinConditionWord, methInfo) -> match methInfo.GetParamAttribs(ceenv.cenv.amap, ceenv.mWhole) with - | [ curriedArgInfo ] -> Some curriedArgInfo // one for the actual argument group + | [ curriedArgInfo ] -> Some (List.map fst curriedArgInfo) // one for the actual argument group | _ -> None) |> Some | _ -> None diff --git a/src/Compiler/Checking/Expressions/CheckExpressions.fs b/src/Compiler/Checking/Expressions/CheckExpressions.fs index b52b4b2ad2c..b7fb6dc7fd5 100644 --- a/src/Compiler/Checking/Expressions/CheckExpressions.fs +++ b/src/Compiler/Checking/Expressions/CheckExpressions.fs @@ -4188,7 +4188,7 @@ and TcPseudoMemberSpec cenv newOk env synTypes tpenv synMemberSig m = let logicalCompiledName = ComputeLogicalName id memberFlags for argInfos in curriedArgInfos do for argInfo in argInfos do - let info = CrackParamAttribsInfo g argInfo + let info, _ = CrackParamAttribsInfo g argInfo let (ParamAttribs(isParamArrayArg, isInArg, isOutArg, optArgInfo, callerInfo, reflArgInfo)) = info if isParamArrayArg || isInArg || isOutArg || optArgInfo.IsOptional || callerInfo <> CallerInfo.NoCallerInfo || reflArgInfo <> ReflectedArgInfo.None then if g.langVersion.SupportsFeature(LanguageFeature.InterfacesWithAbstractStaticMembers) then @@ -9779,6 +9779,7 @@ and GenerateMatchingSimpleArgumentTypes (cenv: cenv) (calledMeth: MethInfo) mIte let g = cenv.g let curriedMethodArgAttribs = calledMeth.GetParamAttribs(cenv.amap, mItem) curriedMethodArgAttribs + |> List.map (List.map fst) |> List.map (List.filter isSimpleFormalArg >> NewInferenceTypes g) and UnifyMatchingSimpleArgumentTypes (cenv: cenv) (env: TcEnv) exprTy (calledMeth: MethInfo) mMethExpr mItem = @@ -9832,7 +9833,7 @@ and TcMethodApplication_SplitSynArguments let singleMethodCurriedArgs = match candidates with | [calledMeth] when List.forall isNil namedCurriedCallerArgs -> - let curriedCalledArgs = calledMeth.GetParamAttribs(cenv.amap, mItem) + let curriedCalledArgs = calledMeth.GetParamAttribs(cenv.amap, mItem) |> List.map (List.map fst) match curriedCalledArgs with | [arg :: _] when isSimpleFormalArg arg -> Some(curriedCalledArgs) | _ -> None @@ -10077,7 +10078,7 @@ and TcAdhocChecksOnLibraryMethods (cenv: cenv) (env: TcEnv) isInstance (finalCal if HasHeadType g g.tcref_System_Collections_Generic_Dictionary finalCalledMethInfo.ApparentEnclosingType && finalCalledMethInfo.IsConstructor && not (finalCalledMethInfo.GetParamDatas(cenv.amap, mItem, finalCalledMeth.CalledTyArgs) - |> List.existsSquared (fun (ParamData(_, _, _, _, _, _, _, ty)) -> + |> List.existsSquared (fun (ParamData(_, _, _, _, _, _, _, ty), _) -> HasHeadType g g.tcref_System_Collections_Generic_IEqualityComparer ty)) then match argsOfAppTy g finalCalledMethInfo.ApparentEnclosingType with diff --git a/src/Compiler/Checking/MethodCalls.fs b/src/Compiler/Checking/MethodCalls.fs index 3343f7dbac3..c96637a0d18 100644 --- a/src/Compiler/Checking/MethodCalls.fs +++ b/src/Compiler/Checking/MethodCalls.fs @@ -471,7 +471,7 @@ type CalledMethArgSet<'T> = let MakeCalledArgs amap m (minfo: MethInfo) minst = // Mark up the arguments with their position, so we can sort them back into order later let paramDatas = minfo.GetParamDatas(amap, m, minst) - paramDatas |> List.mapiSquared (fun i j (ParamData(isParamArrayArg, isInArg, isOutArg, optArgInfo, callerInfoFlags, nmOpt, reflArgInfo, calledArgTy)) -> + paramDatas |> List.mapiSquared (fun i j (ParamData(isParamArrayArg, isInArg, isOutArg, optArgInfo, callerInfoFlags, nmOpt, reflArgInfo, calledArgTy), _) -> { Position=(i,j) IsParamArray=isParamArrayArg OptArgInfo=optArgInfo diff --git a/src/Compiler/Checking/NicePrint.fs b/src/Compiler/Checking/NicePrint.fs index a01802b1d7c..85bf6fd9f9d 100644 --- a/src/Compiler/Checking/NicePrint.fs +++ b/src/Compiler/Checking/NicePrint.fs @@ -1642,7 +1642,7 @@ module InfoMemberPrinting = let layout = layoutXmlDocOfMethInfo denv infoReader minfo layout let paramsL = - let paramDatas = minfo.GetParamDatas(amap, m, minst) + let paramDatas = minfo.GetParamDatas(amap, m, minst) |> List.map (List.map fst) if List.forall isNil paramDatas then WordL.structUnit else @@ -1694,6 +1694,7 @@ module InfoMemberPrinting = |> PrintTypes.layoutCsharpCodeAnalysisIlAttributes denv (mi.RawMetadata.Return.CustomAttrs) (squareAngleReturn >> (@@)) let paramLayouts = minfo.GetParamDatas (amap, m, minst) + |> List.map (List.map fst) |> List.head |> List.zip (mi.ParamMetadata) |> List.map(fun (ilParams,paramData) -> @@ -1704,6 +1705,7 @@ module InfoMemberPrinting = | _ -> layout, minfo.GetParamDatas (amap, m, minst) + |> List.map (List.map fst) |> List.concat |> List.map (layoutParamData denv) diff --git a/src/Compiler/Checking/PostInferenceChecks.fs b/src/Compiler/Checking/PostInferenceChecks.fs index 645f43fe3cb..99a8e893560 100644 --- a/src/Compiler/Checking/PostInferenceChecks.fs +++ b/src/Compiler/Checking/PostInferenceChecks.fs @@ -2393,13 +2393,13 @@ let CheckEntityDefn cenv env (tycon: Entity) = if numCurriedArgSets > 1 && (minfo.GetParamDatas(cenv.amap, m, minfo.FormalMethodInst) - |> List.existsSquared (fun (ParamData(isParamArrayArg, _isInArg, isOutArg, optArgInfo, callerInfo, _, reflArgInfo, ty)) -> + |> List.existsSquared (fun (ParamData(isParamArrayArg, _isInArg, isOutArg, optArgInfo, callerInfo, _, reflArgInfo, ty), _) -> isParamArrayArg || isOutArg || reflArgInfo.AutoQuote || optArgInfo.IsOptional || callerInfo <> NoCallerInfo || isByrefLikeTy g m ty)) then errorR(Error(FSComp.SR.chkCurriedMethodsCantHaveOutParams(), m)) if numCurriedArgSets = 1 then minfo.GetParamDatas(cenv.amap, m, minfo.FormalMethodInst) - |> List.iterSquared (fun (ParamData(_, isInArg, _, optArgInfo, callerInfo, _, _, ty)) -> + |> List.iterSquared (fun (ParamData(_, isInArg, _, optArgInfo, callerInfo, _, _, ty), _) -> ignore isInArg match (optArgInfo, callerInfo) with | _, NoCallerInfo -> () diff --git a/src/Compiler/Checking/QuotationTranslator.fs b/src/Compiler/Checking/QuotationTranslator.fs index d5daa377540..c51383419cd 100644 --- a/src/Compiler/Checking/QuotationTranslator.fs +++ b/src/Compiler/Checking/QuotationTranslator.fs @@ -248,8 +248,10 @@ and GetWitnessArgs cenv (env : QuotationTranslationEnv) m tps tyargs = let g = cenv.g if g.generateWitnesses && not env.suppressWitnesses then let witnessExprs = + try ConstraintSolver.CodegenWitnessesForTyparInst cenv.tcVal g cenv.amap m tps tyargs |> CommitOperationResult + with _ -> [] let env = { env with suppressWitnesses = true } witnessExprs |> List.map (fun arg -> match arg with diff --git a/src/Compiler/Checking/infos.fs b/src/Compiler/Checking/infos.fs index 18add6588d0..666963ac6f6 100644 --- a/src/Compiler/Checking/infos.fs +++ b/src/Compiler/Checking/infos.fs @@ -337,7 +337,7 @@ let CrackParamAttribsInfo g (ty: TType, argInfo: ArgReprInfo) = | ValueSome optTy when typeEquiv g g.int32_ty optTy -> CallerFilePath | _ -> CallerLineNumber - ParamAttribs(isParamArrayArg, isInArg, isOutArg, optArgInfo, callerInfo, reflArgInfo) + ParamAttribs(isParamArrayArg, isInArg, isOutArg, optArgInfo, callerInfo, reflArgInfo), argInfo.Attribs #if !NO_TYPEPROVIDERS @@ -1293,7 +1293,7 @@ type MethInfo = if p.Type.TypeRef.FullName = "System.Int32" then CallerFilePath else CallerLineNumber - ParamAttribs(isParamArrayArg, isInArg, isOutArg, optArgInfo, callerInfo, reflArgInfo) ] ] + ParamAttribs(isParamArrayArg, isInArg, isOutArg, optArgInfo, callerInfo, reflArgInfo), [] ] ] | FSMeth(g, _, vref, _) -> GetArgInfosOfMember x.IsCSharpStyleExtensionMember g vref @@ -1315,7 +1315,7 @@ type MethInfo = | None -> ReflectedArgInfo.None let isOutArg = p.PUntaint((fun p -> p.IsOut && not p.IsIn), m) let isInArg = p.PUntaint((fun p -> p.IsIn && not p.IsOut), m) - ParamAttribs(isParamArrayArg, isInArg, isOutArg, optArgInfo, NoCallerInfo, reflArgInfo)] ] + ParamAttribs(isParamArrayArg, isInArg, isOutArg, optArgInfo, NoCallerInfo, reflArgInfo), [] ] ] #endif /// Get the signature of an abstract method slot. @@ -1426,13 +1426,13 @@ type MethInfo = #endif let paramAttribs = x.GetParamAttribs(amap, m) - (paramAttribs, paramNamesAndTypes) ||> List.map2 (List.map2 (fun info (ParamNameAndType(nmOpt, pty)) -> - let (ParamAttribs(isParamArrayArg, isInArg, isOutArg, optArgInfo, callerInfo, reflArgInfo)) = info - ParamData(isParamArrayArg, isInArg, isOutArg, optArgInfo, callerInfo, nmOpt, reflArgInfo, pty))) + (paramAttribs, paramNamesAndTypes) ||> List.map2 (List.map2 (fun (info, attribs) (ParamNameAndType(nmOpt, pty)) -> + let (ParamAttribs(isParamArrayArg, isInArg, isOutArg, optArgInfo, callerInfo, reflArgInfo)) = info + ParamData(isParamArrayArg, isInArg, isOutArg, optArgInfo, callerInfo, nmOpt, reflArgInfo, pty), attribs)) /// Get the ParamData objects for the parameters of a MethInfo member x.HasParamArrayArg(amap, m, minst) = - x.GetParamDatas(amap, m, minst) |> List.existsSquared (fun (ParamData(isParamArrayArg, _, _, _, _, _, _, _)) -> isParamArrayArg) + x.GetParamDatas(amap, m, minst) |> List.existsSquared (fun (ParamData(isParamArrayArg, _, _, _, _, _, _, _), _) -> isParamArrayArg) /// Select all the type parameters of the declaring type of a method. /// diff --git a/src/Compiler/Checking/infos.fsi b/src/Compiler/Checking/infos.fsi index 9ab99a8346b..0a5389ca88e 100644 --- a/src/Compiler/Checking/infos.fsi +++ b/src/Compiler/Checking/infos.fsi @@ -146,7 +146,7 @@ type ParamAttribs = callerInfo: CallerInfo * reflArgInfo: ReflectedArgInfo -val CrackParamAttribsInfo: TcGlobals -> ty: TType * argInfo: ArgReprInfo -> ParamAttribs +val CrackParamAttribsInfo: TcGlobals -> ty: TType * argInfo: ArgReprInfo -> ParamAttribs * Attribs /// Describes an F# use of an IL type, including the type instantiation associated with the type at a particular usage point. [] @@ -524,10 +524,10 @@ type MethInfo = member GetCustomAttrs: unit -> ILAttributes /// Get the parameter attributes of a method info, which get combined with the parameter names and types - member GetParamAttribs: amap: ImportMap * m: range -> ParamAttribs list list + member GetParamAttribs: amap: ImportMap * m: range -> (ParamAttribs * Attribs) list list /// Get the ParamData objects for the parameters of a MethInfo - member GetParamDatas: amap: ImportMap * m: range * minst: TType list -> ParamData list list + member GetParamDatas: amap: ImportMap * m: range * minst: TType list -> (ParamData * Attribs) list list /// Get the parameter names of a MethInfo member GetParamNames: unit -> string option list list diff --git a/src/Compiler/Driver/fsc.fs b/src/Compiler/Driver/fsc.fs index 1d17950a9ac..bf6fa877173 100644 --- a/src/Compiler/Driver/fsc.fs +++ b/src/Compiler/Driver/fsc.fs @@ -1263,3 +1263,47 @@ let CompileFromCommandLineArguments |> main4 (tcImportsCapture, dynamicAssemblyCreator) |> main5 |> main6 dynamicAssemblyCreator + +let CompileFromTypedAst + ( + ctok, + tcGlobals, + tcImports: TcImports, + generatedCcu: CcuThunk, + typedImplFiles, + topAttrs, + tcConfig: TcConfig, + outfile: string, + diagnosticsLogger, + exiter: Exiter + ) = + + let tcImportsCapture = None + let dynamicAssemblyCreator = None + let assemblyName = !! Path.GetFileNameWithoutExtension(outfile) + // Doubling here tcImports as frameworkTcImports, seems to work... + let frameworkTcImports = tcImports + let pdbfile = None + let ilSourceDocs = [] + + Args ( + ctok, + tcGlobals, + tcImports, + frameworkTcImports, + generatedCcu, + typedImplFiles, + topAttrs, + tcConfig, + outfile, + pdbfile, + assemblyName, + diagnosticsLogger, + exiter, + ilSourceDocs + ) + |> main2 + |> main3 + |> main4 (tcImportsCapture, dynamicAssemblyCreator) + |> main5 + |> main6 dynamicAssemblyCreator diff --git a/src/Compiler/Driver/fsc.fsi b/src/Compiler/Driver/fsc.fsi index 8731b5fae0c..ab4af0b6e8b 100644 --- a/src/Compiler/Driver/fsc.fsi +++ b/src/Compiler/Driver/fsc.fsi @@ -58,3 +58,16 @@ val CompileFromCommandLineArguments: /// Read the parallelReferenceResolution flag from environment variables val internal getParallelReferenceResolutionFromEnvironment: unit -> ParallelReferenceResolution option + +val CompileFromTypedAst: + ctok: CompilationThreadToken * + tcGlobals: TcGlobals * + tcImports: TcImports * + generatedCcu: TypedTree.CcuThunk * + typedImplFiles: TypedTree.CheckedImplFile list * + topAttrs: CheckDeclarations.TopAttribs * + tcConfig: TcConfig * + outfile: string * + diagnosticsLogger: DiagnosticsLogger * + exiter: Exiter + -> unit diff --git a/src/Compiler/FSharp.Compiler.Service.fsproj b/src/Compiler/FSharp.Compiler.Service.fsproj index 419746af6c0..e3b92cef3ce 100644 --- a/src/Compiler/FSharp.Compiler.Service.fsproj +++ b/src/Compiler/FSharp.Compiler.Service.fsproj @@ -14,6 +14,7 @@ $(OtherFlags) --warnaserror-:1182 FSharp.Compiler.Service true + $(DefineConstants);FABLE_CLI $(DefineConstants);COMPILER true diff --git a/src/Compiler/Optimize/Optimizer.fs b/src/Compiler/Optimize/Optimizer.fs index 51d889f5691..8d22f3af4f4 100644 --- a/src/Compiler/Optimize/Optimizer.fs +++ b/src/Compiler/Optimize/Optimizer.fs @@ -499,10 +499,18 @@ let rec IsPartialExprVal x = | ValValue (_, a) | SizeValue (_, a) -> IsPartialExprVal a +#if FABLE_CLI +// Many Fable packages inline functions that access internal values to resolve generics, this is not an issue +// in "normal" Fable compilations but it raises errors when generating an assembly por precompilation. Disable +// for Fable as it's not an actual error (and if is, we assume it's already been raised during type chedking). +let CheckInlineValueIsComplete (_v: Val) _res = + () +#else let CheckInlineValueIsComplete (v: Val) res = if v.ShouldInline && IsPartialExprVal res then errorR(Error(FSComp.SR.optValueMarkedInlineButIncomplete(v.DisplayName), v.Range)) //System.Diagnostics.Debug.Assert(false, sprintf "Break for incomplete inline value %s" v.DisplayName) +#endif let check (vref: ValRef) (res: ValInfo) = CheckInlineValueIsComplete vref.Deref res.ValExprInfo diff --git a/src/Compiler/Service/FSharpCheckerResults.fs b/src/Compiler/Service/FSharpCheckerResults.fs index 1c7878c6df8..8289ad1aaaa 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fs +++ b/src/Compiler/Service/FSharpCheckerResults.fs @@ -654,7 +654,7 @@ type internal TypeCheckInfo match meth.GetParamDatas(amap, m, meth.FormalMethodInst) with | x :: _ -> x - |> List.choose (fun (ParamData(_isParamArray, _isInArg, _isOutArg, _optArgInfo, _callerInfo, name, _, ty)) -> + |> List.choose (fun (ParamData(_isParamArray, _isInArg, _isOutArg, _optArgInfo, _callerInfo, name, _, ty), _) -> match name with | Some id -> Some(Item.OtherName(Some id, ty, None, Some(ArgumentContainer.Method meth), id.idRange)) | None -> None) diff --git a/src/Compiler/Service/FSharpCheckerResults.fsi b/src/Compiler/Service/FSharpCheckerResults.fsi index 6b0a7f49135..7fcc69e1341 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fsi +++ b/src/Compiler/Service/FSharpCheckerResults.fsi @@ -245,9 +245,45 @@ type public FSharpParsingOptions = static member internal FromTcConfigBuilder: tcConfigB: TcConfigBuilder * sourceFiles: string[] * isInteractive: bool -> FSharpParsingOptions +[] +type internal TypeCheckInfo = + internal new : + _sTcConfig: TcConfig * + g: TcGlobals * + ccuSigForFile: ModuleOrNamespaceType * + thisCcu: CcuThunk * + tcImports: TcImports * + tcAccessRights: AccessorDomain * + projectFileName: string * + mainInputFileName: string * + projectOptions: FSharpProjectOptions * + sResolutions: TcResolutions * + sSymbolUses: TcSymbolUses * + sFallback: NameResolutionEnv * + loadClosure: LoadClosure option * + implFileOpt: CheckedImplFile option * + openDeclarations: OpenDeclaration[] + -> TypeCheckInfo + member ScopeResolutions: TcResolutions + member ScopeSymbolUses: TcSymbolUses + member TcGlobals: TcGlobals + member TcImports: TcImports + member CcuSigForFile: ModuleOrNamespaceType + member ThisCcu: CcuThunk + member ImplementationFile: CheckedImplFile option + /// A handle to the results of CheckFileInProject. [] type public FSharpCheckFileResults = + internal new : + fileName: string * + errors: FSharpDiagnostic[] * + scopeOptX: TypeCheckInfo option * + dependencyFiles: string[] * + builderX: IncrementalBuilder option * + keepAssemblyContents: bool + -> FSharpCheckFileResults + /// The errors returned by parsing a source file. member Diagnostics: FSharpDiagnostic[] diff --git a/src/Compiler/Service/ServiceDeclarationLists.fs b/src/Compiler/Service/ServiceDeclarationLists.fs index e0bce073607..acae7acdeae 100644 --- a/src/Compiler/Service/ServiceDeclarationLists.fs +++ b/src/Compiler/Service/ServiceDeclarationLists.fs @@ -799,7 +799,7 @@ module internal DescriptionListsImpl = | Item.CtorGroup(_, minfo :: _) | Item.MethodGroup(_, minfo :: _, _) -> - let paramDatas = minfo.GetParamDatas(amap, m, minfo.FormalMethodInst) |> List.head + let paramDatas = minfo.GetParamDatas(amap, m, minfo.FormalMethodInst) |> List.head |> List.map fst let retTy = minfo.GetFSharpReturnType(amap, m, minfo.FormalMethodInst) let _prettyTyparInst, prettyParams, prettyRetTyL, _prettyConstraintsL = PrettyParamsOfParamDatas g denv item.TyparInstantiation paramDatas retTy // FUTURE: prettyTyparInst is the pretty version of the known instantiations of type parameters in the output. It could be returned diff --git a/src/Compiler/Service/service.fsi b/src/Compiler/Service/service.fsi index 3e4fde2229c..244ab7483f6 100644 --- a/src/Compiler/Service/service.fsi +++ b/src/Compiler/Service/service.fsi @@ -18,6 +18,12 @@ open FSharp.Compiler.Symbols open FSharp.Compiler.Syntax open FSharp.Compiler.Text open FSharp.Compiler.Tokenization +open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.Driver + +module internal CompileHelpers = + val mkCompilationDiagnosticsHandlers: bool -> ResizeArray * DiagnosticsLogger * IDiagnosticsLoggerProvider + val tryCompile: DiagnosticsLogger -> (StopProcessingExiter -> unit) -> exn option /// Used to parse and check F# source code. [] diff --git a/src/Compiler/Symbols/Exprs.fs b/src/Compiler/Symbols/Exprs.fs index 91480597cc2..45586677de5 100644 --- a/src/Compiler/Symbols/Exprs.fs +++ b/src/Compiler/Symbols/Exprs.fs @@ -515,6 +515,7 @@ module FSharpExprConvert = // let inline HashChar (x:char) = (# "or" (# "shl" x 16 : int #) x : int #) // in FSharp.Core. | ErrorResult _ when vref.LogicalName = "op_LeftShift" && List.isSingleton tyargs -> [] + | ErrorResult (warns, err) -> ReportWarnings (err::warns); [] // temporary, ignores the error | res -> CommitOperationResult res let env = { env with suppressWitnesses = true } witnessExprs |> List.map (fun arg -> diff --git a/src/Compiler/Symbols/Symbols.fs b/src/Compiler/Symbols/Symbols.fs index 95427b7914f..da35b4e61cb 100644 --- a/src/Compiler/Symbols/Symbols.fs +++ b/src/Compiler/Symbols/Symbols.fs @@ -2120,10 +2120,8 @@ type FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) = | M m | C m -> [ for argTys in m.GetParamDatas(cenv.amap, range0, m.FormalMethodInst) do yield - [ for ParamData(isParamArrayArg, isInArg, isOutArg, optArgInfo, _callerInfo, nmOpt, _reflArgInfo, pty) in argTys do - // INCOMPLETENESS: Attribs is empty here, so we can't look at attributes for - // either .NET or F# parameters - let argInfo: ArgReprInfo = { Name=nmOpt; Attribs=[]; OtherRange=None } + [ for ParamData(isParamArrayArg, isInArg, isOutArg, optArgInfo, _callerInfo, nmOpt, _reflArgInfo, pty), attribs in argTys do + let argInfo: ArgReprInfo = { Name=nmOpt; Attribs=attribs; OtherRange=None } let m = match nmOpt with | Some v -> v.idRange