Skip to content

Commit 99f1f7a

Browse files
ncavencave
committed
Minor cleanup
1 parent ec51dec commit 99f1f7a

File tree

7 files changed

+301
-254
lines changed

7 files changed

+301
-254
lines changed

‎fcs/fcs-fable/TcImports_shim.fs‎

Lines changed: 262 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,262 @@
1+
// Copyright (c) Microsoft Corporation. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information.
2+
3+
// Open up the compiler as an incremental service for parsing,
4+
// type checking and intellisense-like environment-reporting.
5+
6+
namespace Microsoft.FSharp.Compiler.SourceCodeServices
7+
8+
open Internal.Utilities
9+
open Internal.Utilities.Collections
10+
open Microsoft.FSharp.Collections
11+
open Microsoft.FSharp.Control
12+
13+
open System
14+
open System.Text
15+
open System.Threading
16+
open System.Collections.Concurrent
17+
open System.Collections.Generic
18+
19+
open Microsoft.FSharp.Compiler
20+
open Microsoft.FSharp.Compiler.AbstractIL
21+
open Microsoft.FSharp.Compiler.AbstractIL.IL
22+
open Microsoft.FSharp.Compiler.AbstractIL.ILBinaryReader
23+
open Microsoft.FSharp.Compiler.AbstractIL.Diagnostics
24+
open Microsoft.FSharp.Compiler.AbstractIL.Internal
25+
open Microsoft.FSharp.Compiler.AbstractIL.Internal.Library
26+
27+
open Microsoft.FSharp.Compiler.AccessibilityLogic
28+
open Microsoft.FSharp.Compiler.Ast
29+
open Microsoft.FSharp.Compiler.CompileOps
30+
open Microsoft.FSharp.Compiler.CompileOptions
31+
open Microsoft.FSharp.Compiler.ErrorLogger
32+
open Microsoft.FSharp.Compiler.Lib
33+
open Microsoft.FSharp.Compiler.ReferenceResolver
34+
open Microsoft.FSharp.Compiler.PrettyNaming
35+
open Microsoft.FSharp.Compiler.Parser
36+
open Microsoft.FSharp.Compiler.Range
37+
open Microsoft.FSharp.Compiler.Lexhelp
38+
open Microsoft.FSharp.Compiler.Layout
39+
open Microsoft.FSharp.Compiler.Tast
40+
open Microsoft.FSharp.Compiler.Tastops
41+
open Microsoft.FSharp.Compiler.Tastops.DebugPrint
42+
open Microsoft.FSharp.Compiler.TcGlobals
43+
open Microsoft.FSharp.Compiler.Infos
44+
open Microsoft.FSharp.Compiler.InfoReader
45+
open Microsoft.FSharp.Compiler.NameResolution
46+
open Microsoft.FSharp.Compiler.TypeChecker
47+
48+
module TcImports =
49+
50+
let internal BuildTcImports (tcConfig: TcConfig, references: string[], readAllBytes: string -> byte[]) =
51+
let tcImports = TcImports ()
52+
let ilGlobals = IL.EcmaMscorlibILGlobals
53+
54+
let sigDataReaders ilModule =
55+
[ for resource in ilModule.Resources.AsList do
56+
if IsSignatureDataResource resource then
57+
let _ccuName = GetSignatureDataResourceName resource
58+
yield resource.GetBytes() ]
59+
60+
let optDataReaders ilModule =
61+
[ for resource in ilModule.Resources.AsList do
62+
if IsOptimizationDataResource resource then
63+
let _ccuName = GetOptimizationDataResourceName resource
64+
yield resource.GetBytes() ]
65+
66+
let LoadMod (ccuName: string) =
67+
let fileName =
68+
if ccuName.EndsWith(".dll", StringComparison.OrdinalIgnoreCase)
69+
then ccuName
70+
else ccuName + ".dll"
71+
let bytes = readAllBytes fileName
72+
let opts: ILReaderOptions =
73+
{ ilGlobals = ilGlobals
74+
metadataOnly = MetadataOnlyFlag.Yes
75+
reduceMemoryUsage = ReduceMemoryFlag.Yes
76+
pdbDirPath = None
77+
tryGetMetadataSnapshot = (fun _ -> None) }
78+
79+
let reader = ILBinaryReader.OpenILModuleReaderFromBytes fileName bytes opts
80+
reader.ILModuleDef //reader.ILAssemblyRefs
81+
82+
let GetSignatureData (fileName:string, ilScopeRef, ilModule:ILModuleDef option, bytes:byte[]) =
83+
TastPickle.unpickleObjWithDanglingCcus fileName ilScopeRef ilModule TastPickle.unpickleCcuInfo bytes
84+
85+
let GetOptimizationData (fileName:string, ilScopeRef, ilModule:ILModuleDef option, bytes:byte[]) =
86+
TastPickle.unpickleObjWithDanglingCcus fileName ilScopeRef ilModule Optimizer.u_CcuOptimizationInfo bytes
87+
88+
let memoize_mod = new MemoizationTable<_,_> (LoadMod, keyComparer=HashIdentity.Structural)
89+
90+
let LoadSigData ccuName =
91+
let ilModule = memoize_mod.Apply ccuName
92+
let ilShortAssemName = ilModule.ManifestOfAssembly.Name
93+
let ilScopeRef = ILScopeRef.Assembly (mkSimpleAssemblyRef ilShortAssemName)
94+
let fileName = ilModule.Name //TODO: try with ".sigdata" extension
95+
match sigDataReaders ilModule with
96+
| [] -> None
97+
| bytes::_ -> Some (GetSignatureData (fileName, ilScopeRef, Some ilModule, bytes))
98+
99+
let LoadOptData ccuName =
100+
let ilModule = memoize_mod.Apply ccuName
101+
let ilShortAssemName = ilModule.ManifestOfAssembly.Name
102+
let ilScopeRef = ILScopeRef.Assembly (mkSimpleAssemblyRef ilShortAssemName)
103+
let fileName = ilModule.Name //TODO: try with ".optdata" extension
104+
match optDataReaders ilModule with
105+
| [] -> None
106+
| bytes::_ -> Some (GetOptimizationData (fileName, ilScopeRef, Some ilModule, bytes))
107+
108+
let memoize_sig = new MemoizationTable<_,_> (LoadSigData, keyComparer=HashIdentity.Structural)
109+
let memoize_opt = new MemoizationTable<_,_> (LoadOptData, keyComparer=HashIdentity.Structural)
110+
111+
let GetCustomAttributesOfIlModule (ilModule: ILModuleDef) =
112+
(match ilModule.Manifest with Some m -> m.CustomAttrs | None -> ilModule.CustomAttrs).AsList
113+
114+
let GetAutoOpenAttributes ilg ilModule =
115+
ilModule |> GetCustomAttributesOfIlModule |> List.choose (TryFindAutoOpenAttr ilg)
116+
117+
let GetInternalsVisibleToAttributes ilg ilModule =
118+
ilModule |> GetCustomAttributesOfIlModule |> List.choose (TryFindInternalsVisibleToAttr ilg)
119+
120+
let HasAnyFSharpSignatureDataAttribute ilModule =
121+
let attrs = GetCustomAttributesOfIlModule ilModule
122+
List.exists IsSignatureDataVersionAttr attrs
123+
124+
let mkCcuInfo ilg ilScopeRef ilModule ccu : ImportedAssembly =
125+
{ ILScopeRef = ilScopeRef
126+
FSharpViewOfMetadata = ccu
127+
AssemblyAutoOpenAttributes = GetAutoOpenAttributes ilg ilModule
128+
AssemblyInternalsVisibleToAttributes = GetInternalsVisibleToAttributes ilg ilModule
129+
#if !NO_EXTENSIONTYPING
130+
IsProviderGenerated = false
131+
TypeProviders = []
132+
#endif
133+
FSharpOptimizationData = notlazy None }
134+
135+
let GetCcuIL m ccuName =
136+
let auxModuleLoader = function
137+
| ILScopeRef.Local -> failwith "Unsupported reference"
138+
| ILScopeRef.Module x -> memoize_mod.Apply x.Name
139+
| ILScopeRef.Assembly x -> memoize_mod.Apply x.Name
140+
let ilModule = memoize_mod.Apply ccuName
141+
let ilShortAssemName = ilModule.ManifestOfAssembly.Name
142+
let ilScopeRef = ILScopeRef.Assembly (mkSimpleAssemblyRef ilShortAssemName)
143+
let fileName = ilModule.Name
144+
let invalidateCcu = new Event<_>()
145+
let ccu = Import.ImportILAssembly(
146+
tcImports.GetImportMap, m, auxModuleLoader, ilScopeRef,
147+
tcConfig.implicitIncludeDir, Some fileName, ilModule, invalidateCcu.Publish)
148+
let ccuInfo = mkCcuInfo ilGlobals ilScopeRef ilModule ccu
149+
ccuInfo, None
150+
151+
let GetCcuFS m ccuName =
152+
let sigdata = memoize_sig.Apply ccuName
153+
let ilModule = memoize_mod.Apply ccuName
154+
let ilShortAssemName = ilModule.ManifestOfAssembly.Name
155+
let ilScopeRef = ILScopeRef.Assembly (mkSimpleAssemblyRef ilShortAssemName)
156+
let fileName = ilModule.Name
157+
let GetRawTypeForwarders ilModule =
158+
match ilModule.Manifest with
159+
| Some manifest -> manifest.ExportedTypes
160+
| None -> mkILExportedTypes []
161+
#if !NO_EXTENSIONTYPING
162+
let invalidateCcu = new Event<_>()
163+
#endif
164+
let minfo: PickledCcuInfo = sigdata.Value.RawData //TODO: handle missing sigdata
165+
let codeDir = minfo.compileTimeWorkingDir
166+
let ccuData: CcuData =
167+
{ ILScopeRef = ilScopeRef
168+
Stamp = newStamp()
169+
FileName = Some fileName
170+
QualifiedName = Some (ilScopeRef.QualifiedName)
171+
SourceCodeDirectory = codeDir
172+
IsFSharp = true
173+
Contents = minfo.mspec
174+
#if !NO_EXTENSIONTYPING
175+
InvalidateEvent=invalidateCcu.Publish
176+
IsProviderGenerated = false
177+
ImportProvidedType = (fun ty -> Import.ImportProvidedType (tcImports.GetImportMap()) m ty)
178+
#endif
179+
UsesFSharp20PlusQuotations = minfo.usesQuotations
180+
MemberSignatureEquality = (fun ty1 ty2 -> Tastops.typeEquivAux EraseAll (tcImports.GetTcGlobals()) ty1 ty2)
181+
TryGetILModuleDef = (fun () -> Some ilModule)
182+
TypeForwarders = Import.ImportILAssemblyTypeForwarders(tcImports.GetImportMap, m, GetRawTypeForwarders ilModule)
183+
}
184+
185+
let optdata = lazy (
186+
match memoize_opt.Apply ccuName with
187+
| None -> None
188+
| Some data ->
189+
let findCcuInfo name = tcImports.FindCcu (m, name)
190+
Some (data.OptionalFixup findCcuInfo) )
191+
192+
let ccu = CcuThunk.Create(ilShortAssemName, ccuData)
193+
let ccuInfo = mkCcuInfo ilGlobals ilScopeRef ilModule ccu
194+
let ccuOptInfo = { ccuInfo with FSharpOptimizationData = optdata }
195+
ccuOptInfo, sigdata
196+
197+
let rec GetCcu m ccuName =
198+
let ilModule = memoize_mod.Apply ccuName
199+
if HasAnyFSharpSignatureDataAttribute ilModule then
200+
GetCcuFS m ccuName
201+
else
202+
GetCcuIL m ccuName
203+
204+
let fixupCcuInfo refCcusUnfixed =
205+
let refCcus = refCcusUnfixed |> List.map fst
206+
let findCcuInfo name =
207+
refCcus
208+
|> List.tryFind (fun (x: ImportedAssembly) -> x.FSharpViewOfMetadata.AssemblyName = name)
209+
|> Option.map (fun x -> x.FSharpViewOfMetadata)
210+
let fixup (data: TastPickle.PickledDataWithReferences<_>) =
211+
data.OptionalFixup findCcuInfo |> ignore
212+
refCcusUnfixed |> List.choose snd |> List.iter fixup
213+
refCcus
214+
215+
let m = range.Zero
216+
let refCcusUnfixed = List.ofArray references |> List.map (GetCcu m)
217+
let refCcus = fixupCcuInfo refCcusUnfixed
218+
let sysCcus = refCcus |> List.filter (fun x -> x.FSharpViewOfMetadata.AssemblyName <> "FSharp.Core")
219+
let fslibCcu = refCcus |> List.find (fun x -> x.FSharpViewOfMetadata.AssemblyName = "FSharp.Core")
220+
221+
let ccuInfos = [fslibCcu] @ sysCcus
222+
let ccuMap = ccuInfos |> List.map (fun ccuInfo -> ccuInfo.FSharpViewOfMetadata.AssemblyName, ccuInfo) |> Map.ofList
223+
224+
// search over all imported CCUs for each cached type
225+
let ccuHasType (ccu: CcuThunk) (nsname: string list) (tname: string) =
226+
let findEntity (entityOpt: Entity option) n =
227+
match entityOpt with
228+
| None -> None
229+
| Some entity -> entity.ModuleOrNamespaceType.AllEntitiesByCompiledAndLogicalMangledNames.TryFind n
230+
let entityOpt = (Some ccu.Contents, nsname) ||> List.fold findEntity
231+
match entityOpt with
232+
| Some ns ->
233+
match Map.tryFind tname ns.ModuleOrNamespaceType.TypesByMangledName with
234+
| Some _ -> true
235+
| None -> false
236+
| None -> false
237+
238+
// Search for a type
239+
let tryFindSysTypeCcu nsname typeName =
240+
let search = sysCcus |> List.tryFind (fun ccuInfo -> ccuHasType ccuInfo.FSharpViewOfMetadata nsname typeName)
241+
match search with
242+
| Some x -> Some x.FSharpViewOfMetadata
243+
| None ->
244+
#if DEBUG
245+
printfn "Cannot find type %s.%s" (String.concat "." nsname) typeName
246+
#endif
247+
None
248+
249+
let tcGlobals = TcGlobals (
250+
tcConfig.compilingFslib, ilGlobals, fslibCcu.FSharpViewOfMetadata,
251+
tcConfig.implicitIncludeDir, tcConfig.mlCompatibility,
252+
tcConfig.isInteractive, tryFindSysTypeCcu,
253+
tcConfig.emitDebugInfoInQuotations, tcConfig.noDebugData)
254+
255+
#if DEBUG
256+
// the global_g reference cell is used only for debug printing
257+
do global_g := Some tcGlobals
258+
#endif
259+
// do this prior to parsing, since parsing IL assembly code may refer to mscorlib
260+
do tcImports.SetCcuMap(ccuMap)
261+
do tcImports.SetTcGlobals(tcGlobals)
262+
tcImports, tcGlobals

‎fcs/fcs-fable/fcs-fable.fsproj‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -213,6 +213,7 @@
213213
<!-- <Compile Include="$(FSharpSourcesRoot)/fsharp/service/ServiceAnalysis.fs"/> -->
214214
<!-- <Compile Include="$(FSharpSourcesRoot)/fsharp/fsi/fsi.fsi"/> -->
215215
<!-- <Compile Include="$(FSharpSourcesRoot)/fsharp/fsi/fsi.fs"/> -->
216+
<Compile Include="TcImports_shim.fs"/>
216217
<Compile Include="service_slim.fs"/>
217218
<Compile Include="ast_print.fs"/>
218219
</ItemGroup>

0 commit comments

Comments
 (0)