Skip to content

Commit

Permalink
Export metadata
Browse files Browse the repository at this point in the history
  • Loading branch information
ncave committed Nov 3, 2020
1 parent 05b0569 commit 4f4a8a8
Show file tree
Hide file tree
Showing 9 changed files with 178 additions and 4 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/netcoreapp3.1/fcs-export.dll",
"args": [],
"cwd": "${workspaceFolder}/fcs/fcs-export",
"console": "internalConsole",
"stopAtEntry": false
}
]
}
4 changes: 2 additions & 2 deletions eng/Versions.props
Original file line number Diff line number Diff line change
Expand Up @@ -68,7 +68,7 @@
<!-- https://pkgs.dev.azure.com/azure-public/vside/_packaging/vs-buildservices/nuget/v3/index.json; --></RestoreSources>
<!-- System.* packages -->
<SystemBuffersVersion>4.5.1</SystemBuffersVersion>
<SystemCollectionsImmutableVersion>5.0.0-preview.8.20407.11</SystemCollectionsImmutableVersion>
<SystemCollectionsImmutableVersion>1.7.1</SystemCollectionsImmutableVersion>
<SystemConsoleVersion>4.3.0</SystemConsoleVersion>
<SystemDataSqlClientPackageVersion>4.3.0</SystemDataSqlClientPackageVersion>
<SystemDesignVersion>4.0.0</SystemDesignVersion>
Expand All @@ -81,7 +81,7 @@
<SystemNetRequestsVersion>4.3.0</SystemNetRequestsVersion>
<SystemNetSecurityVersion>4.3.0</SystemNetSecurityVersion>
<SystemReflectionEmitVersion>4.3.0</SystemReflectionEmitVersion>
<SystemReflectionMetadataVersion>5.0.0-preview.8.20407.11</SystemReflectionMetadataVersion>
<SystemReflectionMetadataVersion>1.8.1</SystemReflectionMetadataVersion>
<SystemReflectionTypeExtensionsVersion>4.3.0</SystemReflectionTypeExtensionsVersion>
<SystemRuntimeCachingVersion>1.5.0</SystemRuntimeCachingVersion>
<SystemRuntimeVersion>4.3.0</SystemRuntimeVersion>
Expand Down
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 -p fcs/fcs-export
88 changes: 88 additions & 0 deletions fcs/fcs-export/Program.fs
Original file line number Diff line number Diff line change
@@ -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
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>netcoreapp3.1</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="5.0.0" /> -->
<PackageReference Include="Fable.Core" Version="3.1.6" />
<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\netcoreapp3.1\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\netcoreapp3.1\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 @@ -1779,6 +1779,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: 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
}

Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -5,6 +5,7 @@
<TargetFrameworks>netstandard2.0</TargetFrameworks>
<NoWarn>$(NoWarn);44;62;69;65;54;61;75;62;9;2003;NU5125</NoWarn>
<AllowCrossTargeting>true</AllowCrossTargeting>
<DefineConstants>$(DefineConstants);EXPORT_METADATA</DefineConstants>
<DefineConstants>$(DefineConstants);COMPILER_SERVICE_AS_DLL</DefineConstants>
<DefineConstants>$(DefineConstants);COMPILER</DefineConstants>
<DefineConstants>$(DefineConstants);ENABLE_MONO_SUPPORT</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 @@ -2444,6 +2444,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
Expand Down Expand Up @@ -2489,6 +2492,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 @@ -3465,6 +3469,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"
Expand All @@ -3474,6 +3479,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 =
Expand Down

0 comments on commit 4f4a8a8

Please sign in to comment.