Skip to content

Commit 6ae893c

Browse files
ncavencave
committed
Export metadata
1 parent e2f3a3e commit 6ae893c

File tree

10 files changed

+247
-4
lines changed

10 files changed

+247
-4
lines changed

‎.vscode/launch.json

Lines changed: 10 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -75,6 +75,16 @@
7575
},
7676
"justMyCode": true,
7777
"enableStepFiltering": false,
78+
},
79+
{
80+
"name": "FCS Export",
81+
"type": "coreclr",
82+
"request": "launch",
83+
"program": "${workspaceFolder}/artifacts/bin/fcs-export/Debug/net7.0/fcs-export.dll",
84+
"args": [],
85+
"cwd": "${workspaceFolder}/fcs/fcs-export",
86+
"console": "internalConsole",
87+
"stopAtEntry": false
7888
}
7989
]
8090
}

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

‎global.json

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,11 +1,11 @@
11
{
22
"sdk": {
3-
"version": "7.0.100-rc.2.22477.23",
3+
"version": "7.0.100",
44
"allowPrerelease": true,
55
"rollForward": "latestPatch"
66
},
77
"tools": {
8-
"dotnet": "7.0.100-rc.2.22477.23",
8+
"dotnet": "7.0.100",
99
"vs": {
1010
"version": "17.2",
1111
"components": [

‎src/Compiler/AbstractIL/ilwrite.fs

Lines changed: 10 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1104,9 +1104,11 @@ let FindMethodDefIdx cenv mdkey =
11041104
else sofar) None) with
11051105
| Some x -> x
11061106
| None -> raise MethodDefNotFound
1107+
#if !EXPORT_METADATA
11071108
let (TdKey (tenc, tname)) = typeNameOfIdx mdkey.TypeIdx
11081109
dprintn ("The local method '"+(String.concat "." (tenc@[tname]))+"'::'"+mdkey.Name+"' was referenced but not declared")
11091110
dprintn ("generic arity: "+string mdkey.GenericArity)
1111+
#endif
11101112
cenv.methodDefIdxsByKey.dict |> Seq.iter (fun (KeyValue(mdkey2, _)) ->
11111113
if mdkey2.TypeIdx = mdkey.TypeIdx && mdkey.Name = mdkey2.Name then
11121114
let (TdKey (tenc2, tname2)) = typeNameOfIdx mdkey2.TypeIdx
@@ -2614,6 +2616,9 @@ let GenMethodDefAsRow cenv env midx (mdef: ILMethodDef) =
26142616
if cenv.entrypoint <> None then failwith "duplicate entrypoint"
26152617
else cenv.entrypoint <- Some (true, midx)
26162618
let codeAddr =
2619+
#if EXPORT_METADATA
2620+
0x0000
2621+
#else
26172622
(match mdef.Body with
26182623
| MethodBody.IL ilmbodyLazy ->
26192624
let ilmbody =
@@ -2664,6 +2669,7 @@ let GenMethodDefAsRow cenv env midx (mdef: ILMethodDef) =
26642669
| MethodBody.Native ->
26652670
failwith "cannot write body of native method - Abstract IL cannot roundtrip mixed native/managed binaries"
26662671
| _ -> 0x0000)
2672+
#endif
26672673

26682674
UnsharedRow
26692675
[| ULong codeAddr
@@ -3820,6 +3826,7 @@ let writeBinaryAux (stream: Stream, options: options, modul, normalizeAssemblyRe
38203826
match options.signer, modul.Manifest with
38213827
| Some _, _ -> options.signer
38223828
| _, None -> options.signer
3829+
#if !EXPORT_METADATA
38233830
| None, Some {PublicKey=Some pubkey} ->
38243831
(dprintn "Note: The output assembly will be delay-signed using the original public"
38253832
dprintn "Note: key. In order to load it you will need to either sign it with"
@@ -3829,6 +3836,7 @@ let writeBinaryAux (stream: Stream, options: options, modul, normalizeAssemblyRe
38293836
dprintn "Note: private key when converting the assembly, assuming you have access to"
38303837
dprintn "Note: it."
38313838
Some (ILStrongNameSigner.OpenPublicKey pubkey))
3839+
#endif
38323840
| _ -> options.signer
38333841

38343842
let modul =
@@ -3840,11 +3848,13 @@ let writeBinaryAux (stream: Stream, options: options, modul, normalizeAssemblyRe
38403848
with exn ->
38413849
failwith ("A call to StrongNameGetPublicKey failed (" + exn.Message + ")")
38423850
None
3851+
#if !EXPORT_METADATA
38433852
match modul.Manifest with
38443853
| None -> ()
38453854
| Some m ->
38463855
if m.PublicKey <> None && m.PublicKey <> pubkey then
38473856
dprintn "Warning: The output assembly is being signed or delay-signed with a strong name that is different to the original."
3857+
#endif
38483858
{ modul with Manifest = match modul.Manifest with None -> None | Some m -> Some {m with PublicKey = pubkey} }
38493859

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

‎src/Compiler/Driver/CompilerImports.fs

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

‎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)