diff --git a/.vscode/launch.json b/.vscode/launch.json index a0118990e74..db55bfe7034 100644 --- a/.vscode/launch.json +++ b/.vscode/launch.json @@ -87,6 +87,16 @@ "justMyCode": true, "enableStepFiltering": false, "requireExactSource": false + }, + { + "name": "FCS Export", + "type": "coreclr", + "request": "launch", + "program": "${workspaceFolder}/artifacts/bin/fcs-export/Debug/net7.0/fcs-export.dll", + "args": [], + "cwd": "${workspaceFolder}/fcs/fcs-export", + "console": "internalConsole", + "stopAtEntry": false } ] } diff --git a/buildtools/buildtools.targets b/buildtools/buildtools.targets index 86346fc2a15..3b2fa489c66 100644 --- a/buildtools/buildtools.targets +++ b/buildtools/buildtools.targets @@ -20,7 +20,7 @@ BeforeTargets="CoreCompile"> - $(ArtifactsDir)\Bootstrap\fslex\fslex.dll + $(ArtifactsDir)\bin\fslex\Release\net7.0\fslex.dll @@ -44,7 +44,7 @@ BeforeTargets="CoreCompile"> - $(ArtifactsDir)\Bootstrap\fsyacc\fsyacc.dll + $(ArtifactsDir)\bin\fsyacc\Release\net7.0\fsyacc.dll diff --git a/fcs/build.sh b/fcs/build.sh new file mode 100644 index 00000000000..abe0adc099f --- /dev/null +++ b/fcs/build.sh @@ -0,0 +1,5 @@ +#!/usr/bin/env bash + +dotnet build -c Release buildtools +dotnet build -c Release src/Compiler +dotnet run -c Release --project fcs/fcs-export diff --git a/fcs/fcs-export/NuGet.config b/fcs/fcs-export/NuGet.config new file mode 100644 index 00000000000..273c7d2db75 --- /dev/null +++ b/fcs/fcs-export/NuGet.config @@ -0,0 +1,10 @@ + + + + + + + + + + diff --git a/fcs/fcs-export/Program.fs b/fcs/fcs-export/Program.fs new file mode 100644 index 00000000000..58ce2b4f879 --- /dev/null +++ b/fcs/fcs-export/Program.fs @@ -0,0 +1,137 @@ +open System.IO +open System.Text.RegularExpressions +open FSharp.Compiler.CodeAnalysis +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 file = "fcs-export.fsproj" + let projDir = __SOURCE_DIRECTORY__ + let projFile = Path.Combine(projDir, file) + 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 "--targetprofile:netcore" + 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 checker = FSharpChecker.Create() + +let parseAndCheckScript (file, input) = + let dllName = Path.ChangeExtension(file, ".dll") + let projName = Path.ChangeExtension(file, ".fsproj") + let args = mkProjectCommandLineArgsForScript (dllName, [file]) + printfn "file: %s" file + args |> Array.iter (printfn "args: %s") + let projectOptions = checker.GetProjectOptionsFromCommandLineArgs (projName, args) + let parseRes, typedRes = checker.ParseAndCheckFileInProject(file, 0, input, projectOptions) |> Async.RunSynchronously + + if parseRes.Diagnostics.Length > 0 then + printfn "---> Parse Input = %A" input + printfn "---> Parse Error = %A" parseRes.Diagnostics + + match typedRes with + | FSharpCheckFileAnswer.Succeeded(res) -> parseRes, res + | res -> failwithf "Parsing did not finish... (%A)" res + +[] +let main argv = + ignore argv + printfn "Exporting metadata..." + let file = "/temp/test.fsx" + let input = "let a = 42" + let sourceText = FSharp.Compiler.Text.SourceText.ofString input + // parse script just to export metadata + let parseRes, typedRes = parseAndCheckScript(file, sourceText) + printfn "Exporting is done. Binaries can be found in ./temp/metadata/" + 0 diff --git a/fcs/fcs-export/fcs-export.fsproj b/fcs/fcs-export/fcs-export.fsproj new file mode 100644 index 00000000000..150e70dcdab --- /dev/null +++ b/fcs/fcs-export/fcs-export.fsproj @@ -0,0 +1,31 @@ + + + + Exe + net7.0 + true + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/src/Compiler/AbstractIL/ilwrite.fs b/src/Compiler/AbstractIL/ilwrite.fs index 4582821e486..d629ad3285c 100644 --- a/src/Compiler/AbstractIL/ilwrite.fs +++ b/src/Compiler/AbstractIL/ilwrite.fs @@ -1098,9 +1098,11 @@ let FindMethodDefIdx cenv mdkey = else sofar) None) with | Some x -> x | None -> raise MethodDefNotFound +#if !EXPORT_METADATA let (TdKey (tenc, tname)) = typeNameOfIdx mdkey.TypeIdx dprintn ("The local method '"+(String.concat "." (tenc@[tname]))+"'::'"+mdkey.Name+"' was referenced but not declared") dprintn ("generic arity: "+string mdkey.GenericArity) +#endif cenv.methodDefIdxsByKey.dict |> Seq.iter (fun (KeyValue(mdkey2, _)) -> if mdkey2.TypeIdx = mdkey.TypeIdx && mdkey.Name = mdkey2.Name then let (TdKey (tenc2, tname2)) = typeNameOfIdx mdkey2.TypeIdx @@ -2609,6 +2611,9 @@ let GenMethodDefAsRow cenv env midx (mdef: ILMethodDef) = if cenv.entrypoint <> None then failwith "duplicate entrypoint" else cenv.entrypoint <- Some (true, midx) let codeAddr = +#if EXPORT_METADATA + 0x0000 +#else (match mdef.Body with | MethodBody.IL ilmbodyLazy -> let ilmbody = @@ -2659,6 +2664,7 @@ let GenMethodDefAsRow cenv env midx (mdef: ILMethodDef) = | MethodBody.Native -> failwith "cannot write body of native method - Abstract IL cannot roundtrip mixed native/managed binaries" | _ -> 0x0000) +#endif UnsharedRow [| ULong codeAddr @@ -3814,6 +3820,7 @@ let writeBinaryAux (stream: Stream, options: options, modul, normalizeAssemblyRe match options.signer, modul.Manifest with | Some _, _ -> options.signer | _, None -> options.signer +#if !EXPORT_METADATA | None, Some {PublicKey=Some pubkey} -> (dprintn "Note: The output assembly will be delay-signed using the original public" dprintn "Note: key. In order to load it you will need to either sign it with" @@ -3823,6 +3830,7 @@ let writeBinaryAux (stream: Stream, options: options, modul, normalizeAssemblyRe dprintn "Note: private key when converting the assembly, assuming you have access to" dprintn "Note: it." Some (ILStrongNameSigner.OpenPublicKey pubkey)) +#endif | _ -> options.signer let modul = @@ -3834,11 +3842,13 @@ let writeBinaryAux (stream: Stream, options: options, modul, normalizeAssemblyRe with exn -> failwith ("A call to StrongNameGetPublicKey failed (" + exn.Message + ")") None +#if !EXPORT_METADATA match modul.Manifest with | None -> () | Some m -> if m.PublicKey <> None && m.PublicKey <> pubkey then dprintn "Warning: The output assembly is being signed or delay-signed with a strong name that is different to the original." +#endif { modul with Manifest = match modul.Manifest with None -> None | Some m -> Some {m with PublicKey = pubkey} } let pdbData, pdbInfoOpt, debugDirectoryChunk, debugDataChunk, debugChecksumPdbChunk, debugEmbeddedPdbChunk, debugDeterministicPdbChunk, textV2P, mappings = diff --git a/src/Compiler/Driver/CompilerImports.fs b/src/Compiler/Driver/CompilerImports.fs index d182a8d8ebf..7a65a15c08c 100644 --- a/src/Compiler/Driver/CompilerImports.fs +++ b/src/Compiler/Driver/CompilerImports.fs @@ -2507,6 +2507,46 @@ and [] TcImports global_g <- Some tcGlobals #endif frameworkTcImports.SetTcGlobals tcGlobals + +#if EXPORT_METADATA + let metadataPath = __SOURCE_DIRECTORY__ + "/../../../temp/metadata/" + let writeMetadata (dllInfo: ImportedBinary) = + let outfile = Path.GetFullPath(metadataPath + Path.GetFileName(dllInfo.FileName)) + let ilModule = dllInfo.RawMetadata.TryGetILModuleDef().Value + try + let args: AbstractIL.ILBinaryWriter.options = { + ilg = tcGlobals.ilg + outfile = outfile + pdbfile = None //pdbfile + emitTailcalls = tcConfig.emitTailcalls + deterministic = tcConfig.deterministic + portablePDB = tcConfig.portablePDB + embeddedPDB = tcConfig.embeddedPDB + embedAllSource = tcConfig.embedAllSource + embedSourceList = tcConfig.embedSourceList + allGivenSources = [] //ilSourceDocs + sourceLink = tcConfig.sourceLink + checksumAlgorithm = tcConfig.checksumAlgorithm + signer = None //GetStrongNameSigner signingInfo + dumpDebugInfo = tcConfig.dumpDebugInfo + referenceAssemblyOnly = false + referenceAssemblyAttribOpt = None + pathMap = tcConfig.pathMap + } + AbstractIL.ILBinaryWriter.WriteILBinaryFile (args, ilModule, id) + with Failure msg -> + printfn "Export error: %s" msg + + _assemblies + |> List.iter (function + | ResolvedImportedAssembly (asm, m) -> + let ilShortAssemName = getNameOfScopeRef asm.ILScopeRef + let dllInfo = frameworkTcImports.FindDllInfo(ctok, m, ilShortAssemName) + writeMetadata dllInfo + | UnresolvedImportedAssembly (_assemblyName, _m) -> () + ) +#endif + return tcGlobals, frameworkTcImports } diff --git a/src/Compiler/FSharp.Compiler.Service.fsproj b/src/Compiler/FSharp.Compiler.Service.fsproj index 6025101e553..1c7844b36a0 100644 --- a/src/Compiler/FSharp.Compiler.Service.fsproj +++ b/src/Compiler/FSharp.Compiler.Service.fsproj @@ -12,6 +12,7 @@ $(NoWarn);NU5125 FSharp.Compiler.Service true + $(DefineConstants);EXPORT_METADATA $(DefineConstants);COMPILER $(DefineConstants);FSHARPCORE_USE_PACKAGE $(OtherFlags) --extraoptimizationloops:1