Skip to content

Commit 7606fd1

Browse files
ncavencave
committed
Export metadata
1 parent 8397008 commit 7606fd1

File tree

8 files changed

+168
-4
lines changed

8 files changed

+168
-4
lines changed

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

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

‎fcs/build.fsx

Lines changed: 20 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -31,7 +31,7 @@ let dotnetExePath =
3131
if File.Exists(pathToCli) then
3232
pathToCli
3333
else
34-
DotNetCli.InstallDotNetSDK "2.2.105"
34+
DotNetCli.InstallDotNetSDK "2.2.107"
3535

3636
let runDotnet workingDir args =
3737
let result =
@@ -90,6 +90,10 @@ Target "BuildVersion" (fun _ ->
9090
Shell.Exec("appveyor", sprintf "UpdateBuild -Version \"%s\"" buildVersion) |> ignore
9191
)
9292

93+
Target "BuildTools" (fun _ ->
94+
runDotnet __SOURCE_DIRECTORY__ "build ../src/buildtools/buildtools.proj -v n -c Proto"
95+
)
96+
9397
Target "Build" (fun _ ->
9498
runDotnet __SOURCE_DIRECTORY__ "build ../src/buildtools/buildtools.proj -v n -c Proto"
9599
let fslexPath = __SOURCE_DIRECTORY__ + "/../artifacts/bin/fslex/Proto/netcoreapp2.1/fslex.dll"
@@ -129,6 +133,17 @@ Target "PublishNuGet" (fun _ ->
129133
WorkingDir = releaseDir })
130134
)
131135

136+
// --------------------------------------------------------------------------------------
137+
// Export Metadata binaries
138+
139+
Target "Export.Metadata" (fun _ ->
140+
let projPath =
141+
match environVarOrNone "FCS_EXPORT_PROJECT" with
142+
| Some x -> x
143+
| None -> __SOURCE_DIRECTORY__ + "/fcs-export"
144+
runDotnet projPath "run -c Release"
145+
)
146+
132147
// --------------------------------------------------------------------------------------
133148
// Run all targets by default. Invoke 'build <Target>' to override
134149

@@ -170,4 +185,8 @@ Target "TestAndNuGet" DoNothing
170185
"GenerateDocs"
171186
==> "Release"
172187

188+
"Clean"
189+
==> "BuildTools"
190+
==> "Export.Metadata"
191+
173192
RunTargetOrDefault "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: 19 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,19 @@
1+
<Project Sdk="Microsoft.NET.Sdk">
2+
3+
<PropertyGroup>
4+
<OutputType>Exe</OutputType>
5+
<TargetFramework>netcoreapp2.2</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+
<PackageReference Include="Dotnet.ProjInfo" Version="*" />
16+
<PackageReference Include="FSharp.Core" Version="4.6.*" />
17+
<PackageReference Include="Fable.Core" Version="3.0.*" />
18+
</ItemGroup>
19+
</Project>

‎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.0.100-preview5-011568",
3+
"dotnet": "2.2.107",
44
"vs": {
55
"version": "16.0",
66
"components": [

‎src/absil/ilwrite.fs

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -2504,6 +2504,9 @@ let GenMethodDefAsRow cenv env midx (md: ILMethodDef) =
25042504
if cenv.entrypoint <> None then failwith "duplicate entrypoint"
25052505
else cenv.entrypoint <- Some (true, midx)
25062506
let codeAddr =
2507+
#if EXPORT_METADATA
2508+
0x0000
2509+
#else
25072510
(match md.Body.Contents with
25082511
| MethodBody.IL ilmbody ->
25092512
let addr = cenv.nextCodeAddr
@@ -2549,6 +2552,7 @@ let GenMethodDefAsRow cenv env midx (md: ILMethodDef) =
25492552
| MethodBody.Native ->
25502553
failwith "cannot write body of native method - Abstract IL cannot roundtrip mixed native/managed binaries"
25512554
| _ -> 0x0000)
2555+
#endif
25522556

25532557
UnsharedRow
25542558
[| ULong codeAddr
@@ -3528,6 +3532,7 @@ let writeBinaryAndReportMappings (outfile,
35283532
match signer, modul.Manifest with
35293533
| Some _, _ -> signer
35303534
| _, None -> signer
3535+
#if !EXPORT_METADATA
35313536
| None, Some {PublicKey=Some pubkey} ->
35323537
(dprintn "Note: The output assembly will be delay-signed using the original public"
35333538
dprintn "Note: key. In order to load it you will need to either sign it with"
@@ -3537,6 +3542,7 @@ let writeBinaryAndReportMappings (outfile,
35373542
dprintn "Note: private key when converting the assembly, assuming you have access to"
35383543
dprintn "Note: it."
35393544
Some (ILStrongNameSigner.OpenPublicKey pubkey))
3545+
#endif
35403546
| _ -> signer
35413547

35423548
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.dll</FsLexPath>
23+
<FsLexPath Condition="'$(FsLexPath)' == ''">$(ArtifactsDir)\bin\fslex\Proto\netcoreapp2.1\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.dll</FsYaccPath>
46+
<FsYaccPath Condition="'$(FsYaccPath)' == ''">$(ArtifactsDir)\bin\fsyacc\Proto\netcoreapp2.1\fsyacc.dll</FsYaccPath>
4747
</PropertyGroup>
4848

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

‎src/fsharp/CompileOps.fs

Lines changed: 31 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -4656,6 +4656,37 @@ type TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAssemblyResolu
46564656
FSharp.Compiler.AbstractIL.Internal.AsciiConstants.parseILGlobals := tcGlobals.ilg
46574657
#endif
46584658
frameworkTcImports.SetTcGlobals tcGlobals
4659+
4660+
#if EXPORT_METADATA
4661+
let metadataPath = __SOURCE_DIRECTORY__ + "/../../temp/metadata2/"
4662+
let writeMetadata (dllInfo: ImportedBinary) =
4663+
let outfile = Path.GetFullPath(metadataPath + Path.GetFileName(dllInfo.FileName))
4664+
let ilModule = dllInfo.RawMetadata.TryGetILModuleDef().Value
4665+
try
4666+
let args: ILBinaryWriter.options = {
4667+
ilg = ilGlobals
4668+
pdbfile = None
4669+
emitTailcalls = false
4670+
deterministic = false
4671+
showTimes = false
4672+
portablePDB = false
4673+
embeddedPDB = false
4674+
embedAllSource = false
4675+
embedSourceList = []
4676+
sourceLink = ""
4677+
signer = None
4678+
dumpDebugInfo = false
4679+
pathMap = tcConfig.pathMap }
4680+
ILBinaryWriter.WriteILBinary (outfile, args, ilModule, id)
4681+
with Failure msg ->
4682+
printfn "Export error: %s" msg
4683+
4684+
let! dllinfos, _ccuinfos = frameworkTcImports.RegisterAndImportReferencedAssemblies (ctok, tcResolutions.GetAssemblyResolutions())
4685+
dllinfos |> List.iter writeMetadata
4686+
let! dllinfos, _ccuinfos = frameworkTcImports.RegisterAndImportReferencedAssemblies (ctok, tcAltResolutions.GetAssemblyResolutions())
4687+
dllinfos |> List.iter writeMetadata
4688+
#endif
4689+
46594690
return tcGlobals, frameworkTcImports
46604691
}
46614692

0 commit comments

Comments
 (0)