Skip to content

Commit

Permalink
Export metadata
Browse files Browse the repository at this point in the history
  • Loading branch information
ncave committed Nov 15, 2021
1 parent dc81e22 commit eaeca04
Show file tree
Hide file tree
Showing 9 changed files with 185 additions and 2 deletions.
18 changes: 18 additions & 0 deletions .vscode/launch.json
Original file line number Diff line number Diff line change
@@ -0,0 +1,18 @@
{
// Use IntelliSense to learn about possible attributes.
// Hover to view descriptions of existing attributes.
// For more information, visit: https://go.microsoft.com/fwlink/?linkid=830387
"version": "0.2.0",
"configurations": [
{
"name": ".NET Core Launch (console)",
"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
}
]
}
5 changes: 5 additions & 0 deletions fcs/build.sh
Original file line number Diff line number Diff line change
@@ -0,0 +1,5 @@
#!/usr/bin/env bash

dotnet build -c Release src/buildtools/buildtools.proj
dotnet build -c Release src/fsharp/FSharp.Compiler.Service
dotnet run -c Release --project fcs/fcs-export
10 changes: 10 additions & 0 deletions fcs/fcs-export/NuGet.config
Original file line number Diff line number Diff line change
@@ -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>
87 changes: 87 additions & 0 deletions fcs/fcs-export/Program.fs
Original file line number Diff line number Diff line change
@@ -0,0 +1,87 @@
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 "--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."
0
24 changes: 24 additions & 0 deletions fcs/fcs-export/fcs-export.fsproj
Original file line number Diff line number Diff line change
@@ -0,0 +1,24 @@
<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/fsharp/FSharp.Compiler.Service/FSharp.Compiler.Service.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.1" /> -->
<PackageReference Include="Fable.Core" Version="3.4.0" />
<PackageReference Include="Dotnet.ProjInfo" Version="0.44.0" />
</ItemGroup>
</Project>
4 changes: 2 additions & 2 deletions src/buildtools/buildtools.targets
Original file line number Diff line number Diff line change
Expand Up @@ -20,7 +20,7 @@
BeforeTargets="CoreCompile">

<PropertyGroup>
<FsLexPath Condition="'$(FsLexPath)' == ''">$(ArtifactsDir)\Bootstrap\fslex\fslex.dll</FsLexPath>
<FsLexPath Condition="'$(FsLexPath)' == ''">$(ArtifactsDir)\bin\fslex\Release\net5.0\fslex.dll</FsLexPath>
</PropertyGroup>

<!-- Create the output directory -->
Expand All @@ -44,7 +44,7 @@
BeforeTargets="CoreCompile">

<PropertyGroup>
<FsYaccPath Condition="'$(FsYaccPath)' == ''">$(ArtifactsDir)\Bootstrap\fsyacc\fsyacc.dll</FsYaccPath>
<FsYaccPath Condition="'$(FsYaccPath)' == ''">$(ArtifactsDir)\bin\fsyacc\Release\net5.0\fsyacc.dll</FsYaccPath>
</PropertyGroup>

<!-- Create the output directory -->
Expand Down
32 changes: 32 additions & 0 deletions src/fsharp/CompilerImports.fs
Original file line number Diff line number Diff line change
Expand Up @@ -1920,6 +1920,38 @@ and [<Sealed>] TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAsse
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
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 }
AbstractIL.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
}

Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -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>
Expand Down
6 changes: 6 additions & 0 deletions src/fsharp/absil/ilwrite.fs
Original file line number Diff line number Diff line change
Expand Up @@ -2516,6 +2516,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 with
| MethodBody.IL ilmbodyLazy ->
let ilmbody = ilmbodyLazy.Value
Expand Down Expand Up @@ -2562,6 +2565,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
Expand Down Expand Up @@ -3599,6 +3603,7 @@ and writeBinaryAndReportMappingsAux (stream: Stream, leaveStreamOpen: bool,
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"
Expand All @@ -3608,6 +3613,7 @@ and writeBinaryAndReportMappingsAux (stream: Stream, leaveStreamOpen: bool,
dprintn "Note: private key when converting the assembly, assuming you have access to"
dprintn "Note: it."
Some (ILStrongNameSigner.OpenPublicKey pubkey))
#endif
| _ -> signer

let modul =
Expand Down

0 comments on commit eaeca04

Please sign in to comment.