Skip to content

Commit

Permalink
Export metadata
Browse files Browse the repository at this point in the history
  • Loading branch information
ncave committed Apr 7, 2020
1 parent 97dd7cc commit e4eeb2b
Show file tree
Hide file tree
Showing 10 changed files with 173 additions and 5 deletions.
2 changes: 1 addition & 1 deletion fcs/Directory.Build.props
Original file line number Diff line number Diff line change
Expand Up @@ -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.1</FcsFSharpCorePkgVersion>
<FcsTargetNetFxFramework>net461</FcsTargetNetFxFramework>
</PropertyGroup>
</Project>
1 change: 1 addition & 0 deletions fcs/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj
Original file line number Diff line number Diff line change
Expand Up @@ -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>
Expand Down
19 changes: 19 additions & 0 deletions fcs/build.fsx
Original file line number Diff line number Diff line change
Expand Up @@ -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"
Expand Down Expand Up @@ -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

Expand Down Expand Up @@ -147,4 +162,8 @@ open Fake.Core.TargetOperators
"GenerateDocs"
==> "Release"

"Clean"
==> "BuildTools"
==> "Export.Metadata"

Target.runOrDefaultWithArguments "Build"
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
22 changes: 22 additions & 0 deletions fcs/fcs-export/fcs-export.fsproj
Original file line number Diff line number Diff line change
@@ -0,0 +1,22 @@
<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="../FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj" />
</ItemGroup>

<ItemGroup>
<PackageReference Include="FSharp.Core" Version="4.7.1" />
<PackageReference Include="Fable.Core" Version="3.1.*" />
<PackageReference Include="Dotnet.ProjInfo" Version="*" />
</ItemGroup>
</Project>
2 changes: 1 addition & 1 deletion fcs/global.json
Original file line number Diff line number Diff line change
@@ -1,5 +1,5 @@
{
"sdk": {
"version": "3.1.100"
"version": "3.1.201"
}
}
2 changes: 1 addition & 1 deletion global.json
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
{
"tools": {
"dotnet": "3.1.100",
"dotnet": "3.1.201",
"vs": {
"version": "16.3",
"components": [
Expand Down
6 changes: 6 additions & 0 deletions src/absil/ilwrite.fs
Original file line number Diff line number Diff line change
Expand Up @@ -2502,6 +2502,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 @@ -2547,6 +2550,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 @@ -3523,6 +3527,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 @@ -3532,6 +3537,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
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\Proto\netcoreapp3.0\fslex.dll</FsLexPath>
</PropertyGroup>

<!-- Create the output directory -->
Expand All @@ -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 -->
Expand Down
32 changes: 32 additions & 0 deletions src/fsharp/CompileOps.fs
Original file line number Diff line number Diff line change
Expand Up @@ -4905,6 +4905,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
}

Expand Down

0 comments on commit e4eeb2b

Please sign in to comment.