Export metadata

fcs/Directory.Build.props

@@ -31,7 +31,7 @@
     <!-- The LKG FSI.EXE requires MSBuild 15 to be installed, which is painful -->
     <ToolsetFsiToolPath>$(FSharpSourcesRoot)\..\packages\FSharp.Compiler.Tools.4.1.27\tools</ToolsetFsiToolPath>
     <ToolsetFsiToolExe>fsi.exe</ToolsetFsiToolExe>
-    <FcsFSharpCorePkgVersion>4.6.2</FcsFSharpCorePkgVersion>
+    <FcsFSharpCorePkgVersion>4.7.0</FcsFSharpCorePkgVersion>
     <FcsTargetNetFxFramework>net461</FcsTargetNetFxFramework>
   </PropertyGroup>
 </Project>

fcs/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj

@@ -5,6 +5,7 @@
   <PropertyGroup>
     <TargetFrameworks>$(FcsTargetNetFxFramework);netstandard2.0</TargetFrameworks>
     <DisableImplicitFSharpCoreReference>true</DisableImplicitFSharpCoreReference>
+    <DefineConstants>$(DefineConstants);EXPORT_METADATA</DefineConstants>
     <DefineConstants>$(DefineConstants);COMPILER_SERVICE_AS_DLL</DefineConstants>
     <DefineConstants>$(DefineConstants);COMPILER</DefineConstants>
     <DefineConstants>$(DefineConstants);ENABLE_MONO_SUPPORT</DefineConstants>

fcs/build.fsx

@@ -62,6 +62,10 @@ Target.create "BuildVersion" (fun _ ->
     Shell.Exec("appveyor", sprintf "UpdateBuild -Version \"%s\"" buildVersion) |> ignore
 )
 
+Target.create "BuildTools" (fun _ ->
+    runDotnet __SOURCE_DIRECTORY__ "build" "../src/buildtools/buildtools.proj -v n -c Proto"
+)
+
 Target.create "Build" (fun _ ->
     runDotnet __SOURCE_DIRECTORY__ "build" "../src/buildtools/buildtools.proj -v n -c Proto"
     let fslexPath = __SOURCE_DIRECTORY__ + "/../artifacts/bin/fslex/Proto/netcoreapp3.0/fslex.dll"
@@ -104,6 +108,17 @@ Target.create "PublishNuGet" (fun _ ->
             WorkingDir = releaseDir })
 )
 
+// --------------------------------------------------------------------------------------
+// Export Metadata binaries
+
+Target.create "Export.Metadata" (fun _ ->
+    let projPath =
+        match Environment.environVarOrNone "FCS_EXPORT_PROJECT" with
+        | Some x -> x
+        | None -> __SOURCE_DIRECTORY__ + "/fcs-export"
+    runDotnet projPath "run" "-c Release"
+)
+
 // --------------------------------------------------------------------------------------
 // Run all targets by default. Invoke 'build <Target>' to override
 
@@ -147,4 +162,8 @@ open Fake.Core.TargetOperators
 "GenerateDocs"
   ==> "Release"
 
+"Clean"
+  ==> "BuildTools"
+  ==> "Export.Metadata"
+
 Target.runOrDefaultWithArguments "Build"

fcs/fcs-export/Program.fs

@@ -0,0 +1,88 @@
+open System.IO
+open System.Collections.Generic
+open FSharp.Compiler
+open FSharp.Compiler.SourceCodeServices
+
+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 "--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.Errors.Length > 0 then
+        printfn "---> Parse Input = %A" input
+        printfn "---> Parse Error = %A" parseRes.Errors
+
+    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."
+    0

fcs/fcs-export/fcs-export.fsproj

@@ -0,0 +1,20 @@
+<Project Sdk="Microsoft.NET.Sdk">
+
+  <PropertyGroup>
+    <OutputType>Exe</OutputType>
+    <TargetFramework>netcoreapp3.1</TargetFramework>
+  </PropertyGroup>
+
+  <ItemGroup>
+    <Compile Include="Program.fs" />
+  </ItemGroup>
+
+  <ItemGroup>
+    <ProjectReference Include="../FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj" />
+  </ItemGroup>
+
+  <ItemGroup>
+    <PackageReference Include="Fable.Core" Version="3.1.*" />
+    <PackageReference Include="Dotnet.ProjInfo" Version="*" />
+  </ItemGroup>
+</Project>

fcs/global.json

@@ -1,5 +1,5 @@
 {
   "sdk": {
-    "version": "3.0.100"
+    "version": "3.1.101"
   }
 }

global.json

@@ -1,6 +1,6 @@
 {
   "tools": {
-    "dotnet": "3.1.100",
+    "dotnet": "3.1.101",
     "vs": {
       "version": "16.3",
       "components": [

src/absil/ilwrite.fs

@@ -2501,6 +2501,9 @@ let GenMethodDefAsRow cenv env midx (md: ILMethodDef) =
         if cenv.entrypoint <> None then failwith "duplicate entrypoint"
         else cenv.entrypoint <- Some (true, midx)
     let codeAddr = 
+#if EXPORT_METADATA
+        0x0000
+#else
       (match md.Body.Contents with 
       | MethodBody.IL ilmbody -> 
           let addr = cenv.nextCodeAddr
@@ -2546,6 +2549,7 @@ let GenMethodDefAsRow cenv env midx (md: ILMethodDef) =
       | MethodBody.Native -> 
           failwith "cannot write body of native method - Abstract IL cannot roundtrip mixed native/managed binaries"
       | _ -> 0x0000)
+#endif
 
     UnsharedRow 
        [| ULong codeAddr  
@@ -3522,6 +3526,7 @@ let writeBinaryAndReportMappings (outfile,
         match signer, modul.Manifest with
         | Some _, _ -> signer
         | _, None -> 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"
@@ -3531,6 +3536,7 @@ let writeBinaryAndReportMappings (outfile,
              dprintn "Note: private key when converting the assembly, assuming you have access to"
              dprintn "Note: it."
              Some (ILStrongNameSigner.OpenPublicKey pubkey))
+#endif
         | _ -> signer
 
     let modul = 

src/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\Proto\netcoreapp3.0\fslex.dll</FsLexPath>
     </PropertyGroup>
 
     <!-- Create the output directory -->
@@ -43,7 +43,7 @@
           BeforeTargets="CoreCompile">
 
     <PropertyGroup>
-        <FsYaccPath Condition="'$(FsYaccPath)' == ''">$(ArtifactsDir)\Bootstrap\fsyacc\fsyacc.dll</FsYaccPath>
+        <FsYaccPath Condition="'$(FsYaccPath)' == ''">$(ArtifactsDir)\bin\fsyacc\Proto\netcoreapp3.0\fsyacc.dll</FsYaccPath>
     </PropertyGroup>
 
     <!-- Create the output directory -->

src/fsharp/CompileOps.fs

@@ -4771,6 +4771,38 @@ and [<Sealed>] TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAsse
         FSharp.Compiler.AbstractIL.Internal.AsciiConstants.parseILGlobals <- tcGlobals.ilg 
 #endif
         frameworkTcImports.SetTcGlobals tcGlobals
+
+#if EXPORT_METADATA
+        let metadataPath = __SOURCE_DIRECTORY__ + "/../../temp/metadata2/"
+        let writeMetadata (dllInfo: ImportedBinary) =
+            let outfile = Path.GetFullPath(metadataPath + Path.GetFileName(dllInfo.FileName))
+            let ilModule = dllInfo.RawMetadata.TryGetILModuleDef().Value
+            try
+                let args: ILBinaryWriter.options = {
+                    ilg = ilGlobals
+                    pdbfile = None
+                    emitTailcalls = false
+                    deterministic = false
+                    showTimes = false
+                    portablePDB = false
+                    embeddedPDB = false
+                    embedAllSource = false
+                    embedSourceList = []
+                    sourceLink = ""
+                    checksumAlgorithm = tcConfig.checksumAlgorithm
+                    signer = None
+                    dumpDebugInfo = false
+                    pathMap = tcConfig.pathMap }
+                ILBinaryWriter.WriteILBinary (outfile, 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
       }