Export metadata

.vscode/launch.json

@@ -75,6 +75,16 @@
             },
             "justMyCode": false,
             "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
         }
     ]
 }

buildtools/buildtools.targets

@@ -20,7 +20,7 @@
           BeforeTargets="CoreCompile">
 
     <PropertyGroup>
-        <FsLexPath Condition="'$(FsLexPath)' == ''">$(ArtifactsDir)\Bootstrap\fslex\fslex.dll</FsLexPath>
+        <FsLexPath Condition="'$(FsLexPath)' == ''">$(ArtifactsDir)\bin\fslex\Release\net6.0\fslex.dll</FsLexPath>
     </PropertyGroup>
 
     <!-- Create the output directory -->
@@ -44,7 +44,7 @@
           BeforeTargets="CoreCompile">
 
     <PropertyGroup>
-        <FsYaccPath Condition="'$(FsYaccPath)' == ''">$(ArtifactsDir)\Bootstrap\fsyacc\fsyacc.dll</FsYaccPath>
+        <FsYaccPath Condition="'$(FsYaccPath)' == ''">$(ArtifactsDir)\bin\fsyacc\Release\net6.0\fsyacc.dll</FsYaccPath>
     </PropertyGroup>
 
     <!-- Create the output directory -->

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

fcs/fcs-export/NuGet.config

@@ -0,0 +1,10 @@
+<?xml version="1.0" encoding="utf-8"?>
+<configuration>
+  <packageSources>
+    <clear />
+    <add key="NuGet.org" value="https://api.nuget.org/v3/index.json" />
+  </packageSources>
+  <disabledPackageSources>
+     <clear />
+  </disabledPackageSources>
+</configuration>

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
+
+[<EntryPoint>]
+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

fcs/fcs-export/fcs-export.fsproj

@@ -0,0 +1,31 @@
+<Project Sdk="Microsoft.NET.Sdk">
+
+  <PropertyGroup>
+    <OutputType>Exe</OutputType>
+    <TargetFramework>net6.0</TargetFramework>
+    <DisableImplicitFSharpCoreReference>true</DisableImplicitFSharpCoreReference>
+  </PropertyGroup>
+
+  <ItemGroup>
+    <Compile Include="Program.fs" />
+  </ItemGroup>
+
+  <ItemGroup>
+    <!-- <ProjectReference Include="../../src/Compiler/FSharp.Compiler.Service.fsproj" /> -->
+    <!-- <ProjectReference Include="../../src/Compiler/FSharp.Core/FSharp.Core.fsproj" /> -->
+    <Reference Include="../../artifacts/bin/FSharp.Compiler.Service/Release/netstandard2.0/FSharp.Core.dll" />
+    <Reference Include="../../artifacts/bin/FSharp.Compiler.Service/Release/netstandard2.0/FSharp.Compiler.Service.dll" />
+  </ItemGroup>
+
+  <ItemGroup>
+    <!-- <PackageReference Include="FSharp.Core" Version="6.0.5" /> -->
+    <PackageReference Include="Fable.Core" Version="4.0.0-*" />
+    <PackageReference Include="Dotnet.ProjInfo" Version="0.44.0" />
+    <PackageReference Include="Fable.Browser.Blob" Version="*" />
+    <PackageReference Include="Fable.Browser.Dom" Version="*" />
+    <PackageReference Include="Fable.Browser.Event" Version="*" />
+    <PackageReference Include="Fable.Browser.Gamepad" Version="*" />
+    <PackageReference Include="Fable.Browser.WebGL" Version="*" />
+    <PackageReference Include="Fable.Browser.WebStorage" Version="*" />
+  </ItemGroup>
+</Project>

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
@@ -2610,6 +2612,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 =
@@ -2660,6 +2665,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
@@ -3843,6 +3849,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"
@@ -3852,6 +3859,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 =
@@ -3863,11 +3871,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 =

src/Compiler/Driver/CompilerImports.fs

@@ -2429,6 +2429,42 @@ and [<Sealed>] 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
         }
 

src/Compiler/FSharp.Compiler.Service.fsproj

@@ -12,6 +12,7 @@
     <NoWarn>$(NoWarn);NU5125</NoWarn>
     <AssemblyName>FSharp.Compiler.Service</AssemblyName>
     <AllowCrossTargeting>true</AllowCrossTargeting>
+    <DefineConstants>$(DefineConstants);EXPORT_METADATA</DefineConstants>
     <DefineConstants>$(DefineConstants);COMPILER</DefineConstants>
     <DefineConstants>$(DefineConstants);ENABLE_MONO_SUPPORT</DefineConstants>
     <DefineConstants Condition="'$(FSHARPCORE_USE_PACKAGE)' == 'true'">$(DefineConstants);USE_SHIPPED_FSCORE</DefineConstants>

src/FSharp.Core/prim-types.fsi

@@ -888,7 +888,7 @@ namespace Microsoft.FSharp.Core
         /// <returns>NoDynamicInvocationAttribute</returns>
         new: unit -> NoDynamicInvocationAttribute
 
-        internal new: isLegacy: bool -> NoDynamicInvocationAttribute
+        new: isLegacy: bool -> NoDynamicInvocationAttribute
 
     /// <summary>This attribute is used to indicate that references to the elements of a module, record or union 
     /// type require explicit qualified access.</summary>