From 984e8541acc68e2a2865896c702266f70f8a6f69 Mon Sep 17 00:00:00 2001
From: ncave <777696+ncave@users.noreply.github.com>
Date: Thu, 25 Aug 2022 22:02:58 -0700
Subject: [PATCH] Export metadata
---
.vscode/launch.json | 10 +++
buildtools/AssemblyCheck/AssemblyCheck.fsproj | 2 +-
buildtools/buildtools.targets | 4 +-
buildtools/fslex/fslex.fsproj | 2 +-
buildtools/fsyacc/fsyacc.fsproj | 2 +-
fcs/build.sh | 5 ++
fcs/fcs-export/NuGet.config | 10 +++
fcs/fcs-export/Program.fs | 88 +++++++++++++++++++
fcs/fcs-export/fcs-export.fsproj | 31 +++++++
global.json | 4 +-
src/Compiler/AbstractIL/ilwrite.fs | 10 +++
src/Compiler/Driver/CompilerImports.fs | 36 ++++++++
src/Compiler/FSharp.Compiler.Service.fsproj | 1 +
13 files changed, 198 insertions(+), 7 deletions(-)
create mode 100644 fcs/build.sh
create mode 100644 fcs/fcs-export/NuGet.config
create mode 100644 fcs/fcs-export/Program.fs
create mode 100644 fcs/fcs-export/fcs-export.fsproj
diff --git a/.vscode/launch.json b/.vscode/launch.json
index 35d96c984db2..0e0dc9130f43 100644
--- a/.vscode/launch.json
+++ b/.vscode/launch.json
@@ -75,6 +75,16 @@
},
"justMyCode": true,
"enableStepFiltering": false,
+ },
+ {
+ "name": "FCS Export",
+ "type": "coreclr",
+ "request": "launch",
+ "program": "${workspaceFolder}/artifacts/bin/fcs-export/Debug/net6.0/fcs-export.dll",
+ "args": [],
+ "cwd": "${workspaceFolder}/fcs/fcs-export",
+ "console": "internalConsole",
+ "stopAtEntry": false
}
]
}
\ No newline at end of file
diff --git a/buildtools/AssemblyCheck/AssemblyCheck.fsproj b/buildtools/AssemblyCheck/AssemblyCheck.fsproj
index d82763ddc2eb..d396c055fecb 100644
--- a/buildtools/AssemblyCheck/AssemblyCheck.fsproj
+++ b/buildtools/AssemblyCheck/AssemblyCheck.fsproj
@@ -2,7 +2,7 @@
Exe
- net7.0
+ net6.0
true
false
diff --git a/buildtools/buildtools.targets b/buildtools/buildtools.targets
index 86346fc2a156..8332b53a2370 100644
--- a/buildtools/buildtools.targets
+++ b/buildtools/buildtools.targets
@@ -20,7 +20,7 @@
BeforeTargets="CoreCompile">
- $(ArtifactsDir)\Bootstrap\fslex\fslex.dll
+ $(ArtifactsDir)\bin\fslex\Release\net6.0\fslex.dll
@@ -44,7 +44,7 @@
BeforeTargets="CoreCompile">
- $(ArtifactsDir)\Bootstrap\fsyacc\fsyacc.dll
+ $(ArtifactsDir)\bin\fsyacc\Release\net6.0\fsyacc.dll
diff --git a/buildtools/fslex/fslex.fsproj b/buildtools/fslex/fslex.fsproj
index 8577bf4e3afc..fe737d003316 100644
--- a/buildtools/fslex/fslex.fsproj
+++ b/buildtools/fslex/fslex.fsproj
@@ -2,7 +2,7 @@
Exe
- net7.0
+ net6.0
INTERNALIZED_FSLEXYACC_RUNTIME;$(DefineConstants)
true
false
diff --git a/buildtools/fsyacc/fsyacc.fsproj b/buildtools/fsyacc/fsyacc.fsproj
index e3a4b88a3a07..839c919617d4 100644
--- a/buildtools/fsyacc/fsyacc.fsproj
+++ b/buildtools/fsyacc/fsyacc.fsproj
@@ -2,7 +2,7 @@
Exe
- net7.0
+ net6.0
INTERNALIZED_FSLEXYACC_RUNTIME;$(DefineConstants)
true
false
diff --git a/fcs/build.sh b/fcs/build.sh
new file mode 100644
index 000000000000..abe0adc099ff
--- /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 000000000000..273c7d2db75d
--- /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 000000000000..b3dddeb90320
--- /dev/null
+++ b/fcs/fcs-export/Program.fs
@@ -0,0 +1,88 @@
+open System.IO
+open System.Collections.Generic
+open FSharp.Compiler.CodeAnalysis
+
+let readRefs (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
+ |> List.filter (fun s -> s.StartsWith("-r:"))
+ |> List.map (fun s -> s.Replace("-r:", ""))
+ | _ -> []
+
+let mkStandardProjectReferences () =
+ let file = "fcs-export.fsproj"
+ let projDir = __SOURCE_DIRECTORY__
+ readRefs projDir file
+
+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:" + 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 000000000000..67a874f14fea
--- /dev/null
+++ b/fcs/fcs-export/fcs-export.fsproj
@@ -0,0 +1,31 @@
+
+
+
+ Exe
+ net6.0
+ true
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/global.json b/global.json
index 3790ed6b19c4..3ecb60962c05 100644
--- a/global.json
+++ b/global.json
@@ -1,11 +1,11 @@
{
"sdk": {
- "version": "7.0.100-preview.6.22352.1",
+ "version": "6.0.400",
"allowPrerelease": true,
"rollForward": "latestMajor"
},
"tools": {
- "dotnet": "7.0.100-preview.6.22352.1",
+ "dotnet": "6.0.400",
"vs": {
"version": "17.0",
"components": [
diff --git a/src/Compiler/AbstractIL/ilwrite.fs b/src/Compiler/AbstractIL/ilwrite.fs
index 702fbd5eedb0..2ac7f47dd0f9 100644
--- a/src/Compiler/AbstractIL/ilwrite.fs
+++ b/src/Compiler/AbstractIL/ilwrite.fs
@@ -1104,9 +1104,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
@@ -2614,6 +2616,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 =
@@ -2664,6 +2669,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
@@ -3820,6 +3826,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"
@@ -3829,6 +3836,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 =
@@ -3840,11 +3848,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 b77387057889..392dd3ad0a7d 100644
--- a/src/Compiler/Driver/CompilerImports.fs
+++ b/src/Compiler/Driver/CompilerImports.fs
@@ -2430,6 +2430,42 @@ 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 = ilGlobals
+ outfile = outfile
+ pdbfile = None
+ portablePDB = false
+ embeddedPDB = false
+ embedAllSource = false
+ embedSourceList = []
+ allGivenSources = []
+ sourceLink = ""
+ checksumAlgorithm = tcConfig.checksumAlgorithm
+ signer = None
+ emitTailcalls = false
+ deterministic = false
+ showTimes = false
+ dumpDebugInfo = false
+ referenceAssemblyOnly = false
+ referenceAssemblyAttribOpt = None
+ pathMap = tcConfig.pathMap }
+ AbstractIL.ILBinaryWriter.WriteILBinaryFile (args, ilModule, id)
+ with Failure msg ->
+ printfn "Export error: %s" msg
+
+ let! dllinfos, _ccuinfos = frameworkTcImports.RegisterAndImportReferencedAssemblies (ctok, tcResolutions.GetAssemblyResolutions())
+ dllinfos |> List.iter writeMetadata
+ let! dllinfos, _ccuinfos = frameworkTcImports.RegisterAndImportReferencedAssemblies (ctok, tcAltResolutions.GetAssemblyResolutions())
+ dllinfos |> List.iter writeMetadata
+#endif
+
return tcGlobals, frameworkTcImports
}
diff --git a/src/Compiler/FSharp.Compiler.Service.fsproj b/src/Compiler/FSharp.Compiler.Service.fsproj
index b76cfa836a0c..c8bbdbc3a36d 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);USE_SHIPPED_FSCORE
$(OtherFlags) --extraoptimizationloops:1