Skip to content

Commit 37be621

Browse files
ncavencave
committed
Export metadata
1 parent e22bc22 commit 37be621

File tree

9 files changed

+246
-2
lines changed

9 files changed

+246
-2
lines changed

‎.vscode/launch.json

Lines changed: 10 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -84,6 +84,16 @@
8484
},
8585
"justMyCode": true,
8686
"enableStepFiltering": false,
87+
},
88+
{
89+
"name": "FCS Export",
90+
"type": "coreclr",
91+
"request": "launch",
92+
"program": "${workspaceFolder}/artifacts/bin/fcs-export/Debug/net7.0/fcs-export.dll",
93+
"args": [],
94+
"cwd": "${workspaceFolder}/fcs/fcs-export",
95+
"console": "internalConsole",
96+
"stopAtEntry": false
8797
}
8898
]
8999
}

‎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\Release\net7.0\fslex.dll</FsLexPath>
2424
</PropertyGroup>
2525

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

4646
<PropertyGroup>
47-
<FsYaccPath Condition="'$(FsYaccPath)' == ''">$(ArtifactsDir)\Bootstrap\fsyacc\fsyacc.dll</FsYaccPath>
47+
<FsYaccPath Condition="'$(FsYaccPath)' == ''">$(ArtifactsDir)\bin\fsyacc\Release\net7.0\fsyacc.dll</FsYaccPath>
4848
</PropertyGroup>
4949

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

‎fcs/build.sh

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,5 @@
1+
#!/usr/bin/env bash
2+
3+
dotnet build -c Release buildtools
4+
dotnet build -c Release src/Compiler
5+
dotnet run -c Release --project fcs/fcs-export

‎fcs/fcs-export/NuGet.config

Lines changed: 10 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,10 @@
1+
<?xml version="1.0" encoding="utf-8"?>
2+
<configuration>
3+
<packageSources>
4+
<clear />
5+
<add key="NuGet.org" value="https://api.nuget.org/v3/index.json" />
6+
</packageSources>
7+
<disabledPackageSources>
8+
<clear />
9+
</disabledPackageSources>
10+
</configuration>

‎fcs/fcs-export/Program.fs

Lines changed: 137 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,137 @@
1+
open System.IO
2+
open System.Text.RegularExpressions
3+
open FSharp.Compiler.CodeAnalysis
4+
open Buildalyzer
5+
6+
let getProjectOptionsFromProjectFile (isMain: bool) (projFile: string) =
7+
8+
let tryGetResult (isMain: bool) (manager: AnalyzerManager) (maybeCsprojFile: string) =
9+
10+
let analyzer = manager.GetProject(maybeCsprojFile)
11+
let env = analyzer.EnvironmentFactory.GetBuildEnvironment(Environment.EnvironmentOptions(DesignTime=true,Restore=false))
12+
// If System.the project targets multiple frameworks, multiple results will be returned
13+
// For now we just take the first one with non-empty command
14+
let results = analyzer.Build(env)
15+
results
16+
|> Seq.tryFind (fun r -> System.String.IsNullOrEmpty(r.Command) |> not)
17+
18+
let manager =
19+
let log = new StringWriter()
20+
let options = AnalyzerManagerOptions(LogWriter = log)
21+
let m = AnalyzerManager(options)
22+
m
23+
24+
// Because Buildalyzer works better with .csproj, we first "dress up" the project as if it were a C# one
25+
// and try to adapt the results. If it doesn't work, we try again to analyze the .fsproj directly
26+
let csprojResult =
27+
let csprojFile = projFile.Replace(".fsproj", ".csproj")
28+
if File.Exists(csprojFile) then
29+
None
30+
else
31+
try
32+
File.Copy(projFile, csprojFile)
33+
tryGetResult isMain manager csprojFile
34+
|> Option.map (fun (r: IAnalyzerResult) ->
35+
// Careful, options for .csproj start with / but so do root paths in unix
36+
let reg = Regex(@"^\/[^\/]+?(:?:|$)")
37+
let comArgs =
38+
r.CompilerArguments
39+
|> Array.map (fun line ->
40+
if reg.IsMatch(line) then
41+
if line.StartsWith("/reference") then "-r" + line.Substring(10)
42+
else "--" + line.Substring(1)
43+
else line)
44+
let comArgs =
45+
match r.Properties.TryGetValue("OtherFlags") with
46+
| false, _ -> comArgs
47+
| true, otherFlags ->
48+
let otherFlags = otherFlags.Split(' ', System.StringSplitOptions.RemoveEmptyEntries)
49+
Array.append otherFlags comArgs
50+
comArgs, r)
51+
finally
52+
File.Delete(csprojFile)
53+
54+
let compilerArgs, result =
55+
csprojResult
56+
|> Option.orElseWith (fun () ->
57+
tryGetResult isMain manager projFile
58+
|> Option.map (fun r ->
59+
// result.CompilerArguments doesn't seem to work well in Linux
60+
let comArgs = Regex.Split(r.Command, @"\r?\n")
61+
comArgs, r))
62+
|> function
63+
| Some result -> result
64+
// TODO: Get Buildalyzer errors from the log
65+
| None -> failwith $"Cannot parse {projFile}"
66+
67+
let projDir = Path.GetDirectoryName(projFile)
68+
let projOpts =
69+
compilerArgs
70+
|> Array.skipWhile (fun line -> not(line.StartsWith("-")))
71+
|> Array.map (fun f ->
72+
if f.EndsWith(".fs") || f.EndsWith(".fsi") then
73+
if Path.IsPathRooted f then f else Path.Combine(projDir, f)
74+
else f)
75+
projOpts,
76+
Seq.toArray result.ProjectReferences,
77+
result.Properties,
78+
result.TargetFramework
79+
80+
let mkStandardProjectReferences () =
81+
let file = "fcs-export.fsproj"
82+
let projDir = __SOURCE_DIRECTORY__
83+
let projFile = Path.Combine(projDir, file)
84+
let (args, _, _, _) = getProjectOptionsFromProjectFile true projFile
85+
args
86+
|> Array.filter (fun s -> s.StartsWith("-r:"))
87+
88+
let mkProjectCommandLineArgsForScript (dllName, fileNames) =
89+
[| yield "--simpleresolution"
90+
yield "--noframework"
91+
yield "--debug:full"
92+
yield "--define:DEBUG"
93+
yield "--targetprofile:netcore"
94+
yield "--optimize-"
95+
yield "--out:" + dllName
96+
yield "--doc:test.xml"
97+
yield "--warn:3"
98+
yield "--fullpaths"
99+
yield "--flaterrors"
100+
yield "--target:library"
101+
for x in fileNames do
102+
yield x
103+
let references = mkStandardProjectReferences ()
104+
for r in references do
105+
yield r
106+
|]
107+
108+
let checker = FSharpChecker.Create()
109+
110+
let parseAndCheckScript (file, input) =
111+
let dllName = Path.ChangeExtension(file, ".dll")
112+
let projName = Path.ChangeExtension(file, ".fsproj")
113+
let args = mkProjectCommandLineArgsForScript (dllName, [file])
114+
printfn "file: %s" file
115+
args |> Array.iter (printfn "args: %s")
116+
let projectOptions = checker.GetProjectOptionsFromCommandLineArgs (projName, args)
117+
let parseRes, typedRes = checker.ParseAndCheckFileInProject(file, 0, input, projectOptions) |> Async.RunSynchronously
118+
119+
if parseRes.Diagnostics.Length > 0 then
120+
printfn "---> Parse Input = %A" input
121+
printfn "---> Parse Error = %A" parseRes.Diagnostics
122+
123+
match typedRes with
124+
| FSharpCheckFileAnswer.Succeeded(res) -> parseRes, res
125+
| res -> failwithf "Parsing did not finish... (%A)" res
126+
127+
[<EntryPoint>]
128+
let main argv =
129+
ignore argv
130+
printfn "Exporting metadata..."
131+
let file = "/temp/test.fsx"
132+
let input = "let a = 42"
133+
let sourceText = FSharp.Compiler.Text.SourceText.ofString input
134+
// parse script just to export metadata
135+
let parseRes, typedRes = parseAndCheckScript(file, sourceText)
136+
printfn "Exporting is done. Binaries can be found in ./temp/metadata/"
137+
0

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

Lines changed: 31 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,31 @@
1+
<Project Sdk="Microsoft.NET.Sdk">
2+
3+
<PropertyGroup>
4+
<OutputType>Exe</OutputType>
5+
<TargetFramework>net7.0</TargetFramework>
6+
<DisableImplicitFSharpCoreReference>true</DisableImplicitFSharpCoreReference>
7+
</PropertyGroup>
8+
9+
<ItemGroup>
10+
<Compile Include="Program.fs" />
11+
</ItemGroup>
12+
13+
<ItemGroup>
14+
<!-- <ProjectReference Include="../../src/Compiler/FSharp.Compiler.Service.fsproj" /> -->
15+
<!-- <ProjectReference Include="../../src/Compiler/FSharp.Core/FSharp.Core.fsproj" /> -->
16+
<Reference Include="../../artifacts/bin/FSharp.Compiler.Service/Release/netstandard2.0/FSharp.Core.dll" />
17+
<Reference Include="../../artifacts/bin/FSharp.Compiler.Service/Release/netstandard2.0/FSharp.Compiler.Service.dll" />
18+
</ItemGroup>
19+
20+
<ItemGroup>
21+
<!-- <PackageReference Include="FSharp.Core" Version="7.0.0" /> -->
22+
<PackageReference Include="Buildalyzer" Version="4.1.6" />
23+
<PackageReference Include="Fable.Core" Version="4.0.0-*" />
24+
<PackageReference Include="Fable.Browser.Blob" Version="*" />
25+
<PackageReference Include="Fable.Browser.Dom" Version="*" />
26+
<PackageReference Include="Fable.Browser.Event" Version="*" />
27+
<PackageReference Include="Fable.Browser.Gamepad" Version="*" />
28+
<PackageReference Include="Fable.Browser.WebGL" Version="*" />
29+
<PackageReference Include="Fable.Browser.WebStorage" Version="*" />
30+
</ItemGroup>
31+
</Project>

‎src/Compiler/AbstractIL/ilwrite.fs

Lines changed: 10 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1086,9 +1086,11 @@ let FindMethodDefIdx cenv mdkey =
10861086
else sofar) None) with
10871087
| Some x -> x
10881088
| None -> raise MethodDefNotFound
1089+
#if !EXPORT_METADATA
10891090
let (TdKey (tenc, tname)) = typeNameOfIdx mdkey.TypeIdx
10901091
dprintn ("The local method '"+(String.concat "." (tenc@[tname]))+"'::'"+mdkey.Name+"' was referenced but not declared")
10911092
dprintn ("generic arity: "+string mdkey.GenericArity)
1093+
#endif
10921094
cenv.methodDefIdxsByKey.dict |> Seq.iter (fun (KeyValue(mdkey2, _)) ->
10931095
if mdkey2.TypeIdx = mdkey.TypeIdx && mdkey.Name = mdkey2.Name then
10941096
let (TdKey (tenc2, tname2)) = typeNameOfIdx mdkey2.TypeIdx
@@ -2599,6 +2601,9 @@ let GenMethodDefAsRow cenv env midx (mdef: ILMethodDef) =
25992601
if cenv.entrypoint <> None then failwith "duplicate entrypoint"
26002602
else cenv.entrypoint <- Some (true, midx)
26012603
let codeAddr =
2604+
#if EXPORT_METADATA
2605+
0x0000
2606+
#else
26022607
(match mdef.Body with
26032608
| MethodBody.IL ilmbodyLazy ->
26042609
let ilmbody =
@@ -2649,6 +2654,7 @@ let GenMethodDefAsRow cenv env midx (mdef: ILMethodDef) =
26492654
| MethodBody.Native ->
26502655
failwith "cannot write body of native method - Abstract IL cannot roundtrip mixed native/managed binaries"
26512656
| _ -> 0x0000)
2657+
#endif
26522658

26532659
UnsharedRow
26542660
[| ULong codeAddr
@@ -3799,6 +3805,7 @@ let writeBinaryAux (stream: Stream, options: options, modul, normalizeAssemblyRe
37993805
match options.signer, modul.Manifest with
38003806
| Some _, _ -> options.signer
38013807
| _, None -> options.signer
3808+
#if !EXPORT_METADATA
38023809
| None, Some {PublicKey=Some pubkey} ->
38033810
(dprintn "Note: The output assembly will be delay-signed using the original public"
38043811
dprintn "Note: key. In order to load it you will need to either sign it with"
@@ -3808,6 +3815,7 @@ let writeBinaryAux (stream: Stream, options: options, modul, normalizeAssemblyRe
38083815
dprintn "Note: private key when converting the assembly, assuming you have access to"
38093816
dprintn "Note: it."
38103817
Some (ILStrongNameSigner.OpenPublicKey pubkey))
3818+
#endif
38113819
| _ -> options.signer
38123820

38133821
let modul =
@@ -3819,11 +3827,13 @@ let writeBinaryAux (stream: Stream, options: options, modul, normalizeAssemblyRe
38193827
with exn ->
38203828
failwith ("A call to StrongNameGetPublicKey failed (" + exn.Message + ")")
38213829
None
3830+
#if !EXPORT_METADATA
38223831
match modul.Manifest with
38233832
| None -> ()
38243833
| Some m ->
38253834
if m.PublicKey <> None && m.PublicKey <> pubkey then
38263835
dprintn "Warning: The output assembly is being signed or delay-signed with a strong name that is different to the original."
3836+
#endif
38273837
{ modul with Manifest = match modul.Manifest with None -> None | Some m -> Some {m with PublicKey = pubkey} }
38283838

38293839
let pdbData, pdbInfoOpt, debugDirectoryChunk, debugDataChunk, debugChecksumPdbChunk, debugEmbeddedPdbChunk, debugDeterministicPdbChunk, textV2P, mappings =

‎src/Compiler/Driver/CompilerImports.fs

Lines changed: 40 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -2503,6 +2503,46 @@ and [<Sealed>] TcImports
25032503
global_g <- Some tcGlobals
25042504
#endif
25052505
frameworkTcImports.SetTcGlobals tcGlobals
2506+
2507+
#if EXPORT_METADATA
2508+
let metadataPath = __SOURCE_DIRECTORY__ + "/../../../temp/metadata/"
2509+
let writeMetadata (dllInfo: ImportedBinary) =
2510+
let outfile = Path.GetFullPath(metadataPath + Path.GetFileName(dllInfo.FileName))
2511+
let ilModule = dllInfo.RawMetadata.TryGetILModuleDef().Value
2512+
try
2513+
let args: AbstractIL.ILBinaryWriter.options = {
2514+
ilg = tcGlobals.ilg
2515+
outfile = outfile
2516+
pdbfile = None //pdbfile
2517+
emitTailcalls = tcConfig.emitTailcalls
2518+
deterministic = tcConfig.deterministic
2519+
portablePDB = tcConfig.portablePDB
2520+
embeddedPDB = tcConfig.embeddedPDB
2521+
embedAllSource = tcConfig.embedAllSource
2522+
embedSourceList = tcConfig.embedSourceList
2523+
allGivenSources = [] //ilSourceDocs
2524+
sourceLink = tcConfig.sourceLink
2525+
checksumAlgorithm = tcConfig.checksumAlgorithm
2526+
signer = None //GetStrongNameSigner signingInfo
2527+
dumpDebugInfo = tcConfig.dumpDebugInfo
2528+
referenceAssemblyOnly = false
2529+
referenceAssemblyAttribOpt = None
2530+
pathMap = tcConfig.pathMap
2531+
}
2532+
AbstractIL.ILBinaryWriter.WriteILBinaryFile (args, ilModule, id)
2533+
with Failure msg ->
2534+
printfn "Export error: %s" msg
2535+
2536+
_assemblies
2537+
|> List.iter (function
2538+
| ResolvedImportedAssembly (asm, m) ->
2539+
let ilShortAssemName = getNameOfScopeRef asm.ILScopeRef
2540+
let dllInfo = frameworkTcImports.FindDllInfo(ctok, m, ilShortAssemName)
2541+
writeMetadata dllInfo
2542+
| UnresolvedImportedAssembly (_assemblyName, _m) -> ()
2543+
)
2544+
#endif
2545+
25062546
return tcGlobals, frameworkTcImports
25072547
}
25082548

‎src/Compiler/FSharp.Compiler.Service.fsproj

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -12,6 +12,7 @@
1212
<NoWarn>$(NoWarn);NU5125</NoWarn>
1313
<AssemblyName>FSharp.Compiler.Service</AssemblyName>
1414
<AllowCrossTargeting>true</AllowCrossTargeting>
15+
<DefineConstants>$(DefineConstants);EXPORT_METADATA</DefineConstants>
1516
<DefineConstants>$(DefineConstants);COMPILER</DefineConstants>
1617
<DefineConstants Condition="'$(FSHARPCORE_USE_PACKAGE)' == 'true'">$(DefineConstants);FSHARPCORE_USE_PACKAGE</DefineConstants>
1718
<OtherFlags>$(OtherFlags) --extraoptimizationloops:1</OtherFlags>

0 commit comments

Comments
 (0)