Skip to content

Commit e4eeb2b

Browse files
ncavencave
committed
Export metadata
1 parent 97dd7cc commit e4eeb2b

File tree

10 files changed

+173
-5
lines changed

10 files changed

+173
-5
lines changed

‎fcs/Directory.Build.props

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -31,7 +31,7 @@
3131
<!-- The LKG FSI.EXE requires MSBuild 15 to be installed, which is painful -->
3232
<ToolsetFsiToolPath>$(FSharpSourcesRoot)\..\packages\FSharp.Compiler.Tools.4.1.27\tools</ToolsetFsiToolPath>
3333
<ToolsetFsiToolExe>fsi.exe</ToolsetFsiToolExe>
34-
<FcsFSharpCorePkgVersion>4.6.2</FcsFSharpCorePkgVersion>
34+
<FcsFSharpCorePkgVersion>4.7.1</FcsFSharpCorePkgVersion>
3535
<FcsTargetNetFxFramework>net461</FcsTargetNetFxFramework>
3636
</PropertyGroup>
3737
</Project>

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

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -5,6 +5,7 @@
55
<PropertyGroup>
66
<TargetFrameworks>$(FcsTargetNetFxFramework);netstandard2.0</TargetFrameworks>
77
<DisableImplicitFSharpCoreReference>true</DisableImplicitFSharpCoreReference>
8+
<DefineConstants>$(DefineConstants);EXPORT_METADATA</DefineConstants>
89
<DefineConstants>$(DefineConstants);COMPILER_SERVICE_AS_DLL</DefineConstants>
910
<DefineConstants>$(DefineConstants);COMPILER</DefineConstants>
1011
<DefineConstants>$(DefineConstants);ENABLE_MONO_SUPPORT</DefineConstants>

‎fcs/build.fsx

Lines changed: 19 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -62,6 +62,10 @@ Target.create "BuildVersion" (fun _ ->
6262
Shell.Exec("appveyor", sprintf "UpdateBuild -Version \"%s\"" buildVersion) |> ignore
6363
)
6464

65+
Target.create "BuildTools" (fun _ ->
66+
runDotnet __SOURCE_DIRECTORY__ "build" "../src/buildtools/buildtools.proj -v n -c Proto"
67+
)
68+
6569
Target.create "Build" (fun _ ->
6670
runDotnet __SOURCE_DIRECTORY__ "build" "../src/buildtools/buildtools.proj -v n -c Proto"
6771
let fslexPath = __SOURCE_DIRECTORY__ + "/../artifacts/bin/fslex/Proto/netcoreapp3.0/fslex.dll"
@@ -104,6 +108,17 @@ Target.create "PublishNuGet" (fun _ ->
104108
WorkingDir = releaseDir })
105109
)
106110

111+
// --------------------------------------------------------------------------------------
112+
// Export Metadata binaries
113+
114+
Target.create "Export.Metadata" (fun _ ->
115+
let projPath =
116+
match Environment.environVarOrNone "FCS_EXPORT_PROJECT" with
117+
| Some x -> x
118+
| None -> __SOURCE_DIRECTORY__ + "/fcs-export"
119+
runDotnet projPath "run" "-c Release"
120+
)
121+
107122
// --------------------------------------------------------------------------------------
108123
// Run all targets by default. Invoke 'build <Target>' to override
109124

@@ -147,4 +162,8 @@ open Fake.Core.TargetOperators
147162
"GenerateDocs"
148163
==> "Release"
149164

165+
"Clean"
166+
==> "BuildTools"
167+
==> "Export.Metadata"
168+
150169
Target.runOrDefaultWithArguments "Build"

‎fcs/fcs-export/Program.fs

Lines changed: 88 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,88 @@
1+
open System.IO
2+
open System.Collections.Generic
3+
open FSharp.Compiler
4+
open FSharp.Compiler.SourceCodeServices
5+
6+
let readRefs (folder : string) (projectFile: string) =
7+
let runProcess (workingDir: string) (exePath: string) (args: string) =
8+
let psi = System.Diagnostics.ProcessStartInfo()
9+
psi.FileName <- exePath
10+
psi.WorkingDirectory <- workingDir
11+
psi.RedirectStandardOutput <- false
12+
psi.RedirectStandardError <- false
13+
psi.Arguments <- args
14+
psi.CreateNoWindow <- true
15+
psi.UseShellExecute <- false
16+
17+
use p = new System.Diagnostics.Process()
18+
p.StartInfo <- psi
19+
p.Start() |> ignore
20+
p.WaitForExit()
21+
22+
let exitCode = p.ExitCode
23+
exitCode, ()
24+
25+
let runCmd exePath args = runProcess folder exePath (args |> String.concat " ")
26+
let msbuildExec = Dotnet.ProjInfo.Inspect.dotnetMsbuild runCmd
27+
let result = Dotnet.ProjInfo.Inspect.getProjectInfo ignore msbuildExec Dotnet.ProjInfo.Inspect.getFscArgs projectFile
28+
match result with
29+
| Ok(Dotnet.ProjInfo.Inspect.GetResult.FscArgs x) ->
30+
x
31+
|> List.filter (fun s -> s.StartsWith("-r:"))
32+
|> List.map (fun s -> s.Replace("-r:", ""))
33+
| _ -> []
34+
35+
let mkStandardProjectReferences () =
36+
let file = "fcs-export.fsproj"
37+
let projDir = __SOURCE_DIRECTORY__
38+
readRefs projDir file
39+
40+
let mkProjectCommandLineArgsForScript (dllName, fileNames) =
41+
[| yield "--simpleresolution"
42+
yield "--noframework"
43+
yield "--debug:full"
44+
yield "--define:DEBUG"
45+
yield "--optimize-"
46+
yield "--out:" + dllName
47+
yield "--doc:test.xml"
48+
yield "--warn:3"
49+
yield "--fullpaths"
50+
yield "--flaterrors"
51+
yield "--target:library"
52+
for x in fileNames do
53+
yield x
54+
let references = mkStandardProjectReferences ()
55+
for r in references do
56+
yield "-r:" + r
57+
|]
58+
59+
let checker = FSharpChecker.Create()
60+
61+
let parseAndCheckScript (file, input) =
62+
let dllName = Path.ChangeExtension(file, ".dll")
63+
let projName = Path.ChangeExtension(file, ".fsproj")
64+
let args = mkProjectCommandLineArgsForScript (dllName, [file])
65+
// printfn "file: %s" file
66+
// args |> Array.iter (printfn "args: %s")
67+
let projectOptions = checker.GetProjectOptionsFromCommandLineArgs (projName, args)
68+
let parseRes, typedRes = checker.ParseAndCheckFileInProject(file, 0, input, projectOptions) |> Async.RunSynchronously
69+
70+
if parseRes.Errors.Length > 0 then
71+
printfn "---> Parse Input = %A" input
72+
printfn "---> Parse Error = %A" parseRes.Errors
73+
74+
match typedRes with
75+
| FSharpCheckFileAnswer.Succeeded(res) -> parseRes, res
76+
| res -> failwithf "Parsing did not finish... (%A)" res
77+
78+
[<EntryPoint>]
79+
let main argv =
80+
ignore argv
81+
printfn "Exporting metadata..."
82+
let file = "/temp/test.fsx"
83+
let input = "let a = 42"
84+
let sourceText = FSharp.Compiler.Text.SourceText.ofString input
85+
// parse script just to export metadata
86+
let parseRes, typedRes = parseAndCheckScript(file, sourceText)
87+
printfn "Exporting is done."
88+
0

‎fcs/fcs-export/fcs-export.fsproj

Lines changed: 22 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,22 @@
1+
<Project Sdk="Microsoft.NET.Sdk">
2+
3+
<PropertyGroup>
4+
<OutputType>Exe</OutputType>
5+
<TargetFramework>netcoreapp3.1</TargetFramework>
6+
<DisableImplicitFSharpCoreReference>true</DisableImplicitFSharpCoreReference>
7+
</PropertyGroup>
8+
9+
<ItemGroup>
10+
<Compile Include="Program.fs" />
11+
</ItemGroup>
12+
13+
<ItemGroup>
14+
<ProjectReference Include="../FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj" />
15+
</ItemGroup>
16+
17+
<ItemGroup>
18+
<PackageReference Include="FSharp.Core" Version="4.7.1" />
19+
<PackageReference Include="Fable.Core" Version="3.1.*" />
20+
<PackageReference Include="Dotnet.ProjInfo" Version="*" />
21+
</ItemGroup>
22+
</Project>

‎fcs/global.json

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,5 @@
11
{
22
"sdk": {
3-
"version": "3.1.100"
3+
"version": "3.1.201"
44
}
55
}

‎global.json

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
{
22
"tools": {
3-
"dotnet": "3.1.100",
3+
"dotnet": "3.1.201",
44
"vs": {
55
"version": "16.3",
66
"components": [

‎src/absil/ilwrite.fs

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -2502,6 +2502,9 @@ let GenMethodDefAsRow cenv env midx (md: ILMethodDef) =
25022502
if cenv.entrypoint <> None then failwith "duplicate entrypoint"
25032503
else cenv.entrypoint <- Some (true, midx)
25042504
let codeAddr =
2505+
#if EXPORT_METADATA
2506+
0x0000
2507+
#else
25052508
(match md.Body.Contents with
25062509
| MethodBody.IL ilmbody ->
25072510
let addr = cenv.nextCodeAddr
@@ -2547,6 +2550,7 @@ let GenMethodDefAsRow cenv env midx (md: ILMethodDef) =
25472550
| MethodBody.Native ->
25482551
failwith "cannot write body of native method - Abstract IL cannot roundtrip mixed native/managed binaries"
25492552
| _ -> 0x0000)
2553+
#endif
25502554

25512555
UnsharedRow
25522556
[| ULong codeAddr
@@ -3523,6 +3527,7 @@ let writeBinaryAndReportMappings (outfile,
35233527
match signer, modul.Manifest with
35243528
| Some _, _ -> signer
35253529
| _, None -> signer
3530+
#if !EXPORT_METADATA
35263531
| None, Some {PublicKey=Some pubkey} ->
35273532
(dprintn "Note: The output assembly will be delay-signed using the original public"
35283533
dprintn "Note: key. In order to load it you will need to either sign it with"
@@ -3532,6 +3537,7 @@ let writeBinaryAndReportMappings (outfile,
35323537
dprintn "Note: private key when converting the assembly, assuming you have access to"
35333538
dprintn "Note: it."
35343539
Some (ILStrongNameSigner.OpenPublicKey pubkey))
3540+
#endif
35353541
| _ -> signer
35363542

35373543
let modul =

‎src/buildtools/buildtools.targets

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -20,7 +20,7 @@
2020
BeforeTargets="CoreCompile">
2121

2222
<PropertyGroup>
23-
<FsLexPath Condition="'$(FsLexPath)' == ''">$(ArtifactsDir)\Bootstrap\fslex\fslex.dll</FsLexPath>
23+
<FsLexPath Condition="'$(FsLexPath)' == ''">$(ArtifactsDir)\bin\fslex\Proto\netcoreapp3.0\fslex.dll</FsLexPath>
2424
</PropertyGroup>
2525

2626
<!-- Create the output directory -->
@@ -43,7 +43,7 @@
4343
BeforeTargets="CoreCompile">
4444

4545
<PropertyGroup>
46-
<FsYaccPath Condition="'$(FsYaccPath)' == ''">$(ArtifactsDir)\Bootstrap\fsyacc\fsyacc.dll</FsYaccPath>
46+
<FsYaccPath Condition="'$(FsYaccPath)' == ''">$(ArtifactsDir)\bin\fsyacc\Proto\netcoreapp3.0\fsyacc.dll</FsYaccPath>
4747
</PropertyGroup>
4848

4949
<!-- Create the output directory -->

‎src/fsharp/CompileOps.fs

Lines changed: 32 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -4905,6 +4905,38 @@ and [<Sealed>] TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAsse
49054905
FSharp.Compiler.AbstractIL.Internal.AsciiConstants.parseILGlobals <- tcGlobals.ilg
49064906
#endif
49074907
frameworkTcImports.SetTcGlobals tcGlobals
4908+
4909+
#if EXPORT_METADATA
4910+
let metadataPath = __SOURCE_DIRECTORY__ + "/../../temp/metadata2/"
4911+
let writeMetadata (dllInfo: ImportedBinary) =
4912+
let outfile = Path.GetFullPath(metadataPath + Path.GetFileName(dllInfo.FileName))
4913+
let ilModule = dllInfo.RawMetadata.TryGetILModuleDef().Value
4914+
try
4915+
let args: ILBinaryWriter.options = {
4916+
ilg = ilGlobals
4917+
pdbfile = None
4918+
emitTailcalls = false
4919+
deterministic = false
4920+
showTimes = false
4921+
portablePDB = false
4922+
embeddedPDB = false
4923+
embedAllSource = false
4924+
embedSourceList = []
4925+
sourceLink = ""
4926+
checksumAlgorithm = tcConfig.checksumAlgorithm
4927+
signer = None
4928+
dumpDebugInfo = false
4929+
pathMap = tcConfig.pathMap }
4930+
ILBinaryWriter.WriteILBinary (outfile, args, ilModule, id)
4931+
with Failure msg ->
4932+
printfn "Export error: %s" msg
4933+
4934+
let! dllinfos, _ccuinfos = frameworkTcImports.RegisterAndImportReferencedAssemblies (ctok, tcResolutions.GetAssemblyResolutions())
4935+
dllinfos |> List.iter writeMetadata
4936+
let! dllinfos, _ccuinfos = frameworkTcImports.RegisterAndImportReferencedAssemblies (ctok, tcAltResolutions.GetAssemblyResolutions())
4937+
dllinfos |> List.iter writeMetadata
4938+
#endif
4939+
49084940
return tcGlobals, frameworkTcImports
49094941
}
49104942

0 commit comments

Comments
 (0)