Export metadata

.vscode/launch.json

@@ -92,6 +92,16 @@
             "enableStepFiltering": false,
             "requireExactSource": false,
             "allowFastEvaluate": true
+        },
+        {
+            "name": "FCS Export",
+            "type": "coreclr",
+            "request": "launch",
+            "program": "${workspaceFolder}/artifacts/bin/fcs-export/Debug/net8.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\net9.0\linux-x64\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\net9.0\linux-x64\fsyacc.dll</FsYaccPath>
     </PropertyGroup>
 
     <!-- Create the output directory -->

fcs/build.sh

@@ -0,0 +1,6 @@
+#!/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-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,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
+
+[<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>net9.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="9.0.0" /> -->
+    <PackageReference Include="Buildalyzer" Version="*" />
+    <PackageReference Include="Fable.Core" Version="*" />
+    <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

@@ -2,6 +2,10 @@
 
 module internal FSharp.Compiler.AbstractIL.ILBinaryWriter
 
+#if EXPORT_METADATA
+#nowarn "1182"
+#endif
+
 open System
 open System.Collections.Generic
 open System.IO
@@ -1122,9 +1126,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
@@ -2639,6 +2645,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 =
@@ -2689,6 +2698,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
@@ -3851,6 +3861,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"
@@ -3860,6 +3871,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 =
@@ -3871,11 +3883,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

@@ -2623,6 +2623,60 @@ 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 = 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
+                        referenceAssemblySignatureHash = None
+                        pathMap = tcConfig.pathMap
+                    }
+                    AbstractIL.ILBinaryWriter.WriteILBinaryFile (args, ilModule, id)
+                with Failure msg ->
+                    printfn "Export error: %s" msg
+
+            let nonFrameworkTcImports = new TcImports(tcConfigP, tcAltResolutions, None, None)
+            let altResolvedAssemblies = tcAltResolutions.GetAssemblyResolutions()
+            let! nonFrameworkAssemblies = nonFrameworkTcImports.RegisterAndImportReferencedAssemblies(ctok, altResolvedAssemblies)
+
+            nonFrameworkAssemblies
+            |> List.iter (function
+                | ResolvedImportedAssembly (asm, m) ->
+                    let ilShortAssemName = getNameOfScopeRef asm.ILScopeRef
+                    let dllInfo = nonFrameworkTcImports.FindDllInfo(ctok, m, ilShortAssemName)
+                    writeMetadata dllInfo
+                | UnresolvedImportedAssembly (_assemblyName, _m) -> ()
+            )
+
+            _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
         }
 

src/Compiler/FSharp.Compiler.Service.fsproj

@@ -14,6 +14,7 @@
     <OtherFlags>$(OtherFlags) --warnaserror-:1182</OtherFlags>         <!--Temporary fix for sourcebuild -->
     <AssemblyName>FSharp.Compiler.Service</AssemblyName>
     <AllowCrossTargeting>true</AllowCrossTargeting>
+    <DefineConstants>$(DefineConstants);EXPORT_METADATA</DefineConstants>
     <DefineConstants>$(DefineConstants);COMPILER</DefineConstants>
     <CheckNulls>true</CheckNulls>
 	<!-- Nullness checking against ns20 base class libraries is very weak, the APIs were not updated with annotations.