Skip to content

Commit

Permalink
up
Browse files Browse the repository at this point in the history
  • Loading branch information
psfinaki committed Dec 18, 2024
1 parent 6a61fc7 commit edf940e
Show file tree
Hide file tree
Showing 10 changed files with 419 additions and 15 deletions.
54 changes: 51 additions & 3 deletions src/Compiler/Driver/CompilerImports.fs
Original file line number Diff line number Diff line change
Expand Up @@ -337,6 +337,54 @@ let EncodeOptimizationData (tcGlobals, tcConfig: TcConfig, outfile, exportRemapp
else
[]

let GetTypecheckingData (file, ilScopeRef, ilModule, byteReaderA, byteReaderB) =

let memA = byteReaderA ()

let memB =
match byteReaderB with
| None -> ByteMemory.Empty.AsReadOnly()
| Some br -> br ()

unpickleObjWithDanglingCcus file ilScopeRef ilModule unpickleTcInfo memA memB

let WriteTypecheckingData (tcConfig: TcConfig, tcGlobals, fileName, inMem, ccu, tcInfo) =

// need to understand the naming and if we even want two resources here...
let rName = "FSharpTypecheckingData"
let rNameB = "FSharpTypecheckingDataB"

PickleToResource
inMem
fileName
tcGlobals
tcConfig.compressMetadata
ccu
(rName + ccu.AssemblyName)
(rNameB + ccu.AssemblyName)
pickleTcInfo
tcInfo

let EncodeTypecheckingData (tcConfig: TcConfig, tcGlobals, generatedCcu, outfile, isIncrementalBuild, tcInfo) =
let r1, r2 =
WriteTypecheckingData(
tcConfig,
tcGlobals,
outfile,
isIncrementalBuild,
generatedCcu,
tcInfo)

let resources =
[
r1
match r2 with
| None -> ()
| Some r -> r
]

resources

exception AssemblyNotResolved of originalName: string * range: range

exception MSBuildReferenceResolutionWarning of message: string * warningCode: string * range: range
Expand Down Expand Up @@ -901,17 +949,17 @@ type TcAssemblyResolutions(tcConfig: TcConfig, results: AssemblyResolution list,

for UnresolvedAssemblyReference (referenceText, _ranges) in unresolved do
if referenceText.Contains("mscorlib") then
Debug.Assert(false, sprintf "whoops, did not resolve mscorlib: '%s'%s" referenceText addedText)
//Debug.Assert(false, sprintf "whoops, did not resolve mscorlib: '%s'%s" referenceText addedText)
itFailed <- true

for x in frameworkDLLs do
if not (FileSystem.IsPathRootedShim(x.resolvedPath)) then
Debug.Assert(false, sprintf "frameworkDLL should be absolute path: '%s'%s" x.resolvedPath addedText)
//Debug.Assert(false, sprintf "frameworkDLL should be absolute path: '%s'%s" x.resolvedPath addedText)
itFailed <- true

for x in nonFrameworkReferences do
if not (FileSystem.IsPathRootedShim(x.resolvedPath)) then
Debug.Assert(false, sprintf "nonFrameworkReference should be absolute path: '%s'%s" x.resolvedPath addedText)
//Debug.Assert(false, sprintf "nonFrameworkReference should be absolute path: '%s'%s" x.resolvedPath addedText)
itFailed <- true

if itFailed then
Expand Down
18 changes: 18 additions & 0 deletions src/Compiler/Driver/CompilerImports.fsi
Original file line number Diff line number Diff line change
Expand Up @@ -19,6 +19,7 @@ open FSharp.Compiler.TcGlobals
open FSharp.Compiler.BuildGraph
open FSharp.Compiler.IO
open FSharp.Compiler.Text
open FSharp.Compiler.TypedTreePickle
open FSharp.Core.CompilerServices

#if !NO_TYPEPROVIDERS
Expand Down Expand Up @@ -71,6 +72,23 @@ val EncodeOptimizationData:
isIncrementalBuild: bool ->
ILResource list

val GetTypecheckingData:
file: string *
ilScopeRef: ILScopeRef *
ilModule: ILModuleDef option *
byteReaderA: (unit -> ReadOnlyByteMemory) *
byteReaderB: (unit -> ReadOnlyByteMemory) option ->
PickledDataWithReferences<PickledTcInfo>

val EncodeTypecheckingData:
tcConfig: TcConfig *
tcGlobals: TcGlobals *
generatedCcu: CcuThunk *
outfile: string *
isIncrementalBuild: bool *
tcInfo: PickledTcInfo ->
ILResource list

[<RequireQualifiedAccess>]
type ResolveAssemblyReferenceMode =
| Speculative
Expand Down
77 changes: 65 additions & 12 deletions src/Compiler/Driver/fsc.fs
Original file line number Diff line number Diff line change
Expand Up @@ -149,7 +149,8 @@ let TypeCheck
tcEnv0,
openDecls0,
inputs,
exiter: Exiter
exiter: Exiter,
outfile: string
) =
try
if isNil inputs then
Expand All @@ -162,17 +163,69 @@ let TypeCheck

let eagerFormat (diag: PhasedDiagnostic) = diag.EagerlyFormatCore true

CheckClosedInputSet(
ctok,
diagnosticsLogger.CheckForErrors,
tcConfig,
tcImports,
tcGlobals,
None,
if false then
// I don't know yet if this is the right thing even
let assembly = (tcImports.DllTable.TryFind tcConfig.primaryAssembly.Name).Value

// these should be restored from raw resources probably
let byteReaderA () = ByteMemory.Empty.AsReadOnly()
let byteReaderB = None

let tcInfo =
GetTypecheckingData(
assembly.FileName,
assembly.ILScopeRef,
assembly.RawMetadata.TryGetILModuleDef(),
byteReaderA,
byteReaderB)

let rawData = tcInfo.RawData
let topAttrs = {
mainMethodAttrs = rawData.MainMethodAttrs
netModuleAttrs = rawData.NetModuleAttrs
assemblyAttrs = rawData.AssemblyAttrs
}

// need to understand where if anything can be used here, pickling state is hard
tcInitialState,
eagerFormat,
inputs
)
topAttrs,
rawData.DeclaredImpls,
// this is quite definitely wrong, need to figure out what to do with the environment
tcInitialState.TcEnvFromImpls

else
let tcState, topAttrs, declaredImpls, tcEnvAtEndOfLastFile = CheckClosedInputSet(
ctok,
diagnosticsLogger.CheckForErrors,
tcConfig,
tcImports,
tcGlobals,
None,
tcInitialState,
eagerFormat,
inputs
)

if false then
let tcInfo = {
MainMethodAttrs = topAttrs.mainMethodAttrs
NetModuleAttrs = topAttrs.netModuleAttrs
AssemblyAttrs = topAttrs.assemblyAttrs
DeclaredImpls = declaredImpls
}

// will need to pass results further somewhere
let _typecheckingDataResources = EncodeTypecheckingData(
tcConfig,
tcGlobals,
tcState.Ccu,
outfile,
false,
tcInfo)

()

tcState, topAttrs, declaredImpls, tcEnvAtEndOfLastFile
with exn ->
errorRecovery exn rangeStartup
exiter.Exit 1
Expand Down Expand Up @@ -692,7 +745,7 @@ let main1
let inputs = inputs |> List.map fst

let tcState, topAttrs, typedAssembly, _tcEnvAtEnd =
TypeCheck(ctok, tcConfig, tcImports, tcGlobals, diagnosticsLogger, assemblyName, tcEnv0, openDecls0, inputs, exiter)
TypeCheck(ctok, tcConfig, tcImports, tcGlobals, diagnosticsLogger, assemblyName, tcEnv0, openDecls0, inputs, exiter, outfile)

AbortOnError(diagnosticsLogger, exiter)
ReportTime tcConfig "Typechecked"
Expand Down
18 changes: 18 additions & 0 deletions src/Compiler/Driver/fsc.fsi
Original file line number Diff line number Diff line change
Expand Up @@ -12,6 +12,24 @@ open FSharp.Compiler.DiagnosticsLogger
open FSharp.Compiler.CodeAnalysis
open FSharp.Compiler.Syntax
open FSharp.Compiler.TcGlobals
open FSharp.Compiler.TypedTree
open FSharp.Compiler.ParseAndCheckInputs
open FSharp.Compiler.CheckDeclarations

/// for testing puproses, will remove
val internal TypeCheck:
ctok: CompilationThreadToken *
tcConfig: TcConfig *
tcImports: TcImports *
tcGlobals: TcGlobals *
diagnosticsLogger: DiagnosticsLogger *
assemblyName: string *
tcEnv0: CheckBasics.TcEnv *
openDecls0: TypedTree.OpenDeclaration list *
inputs: ParsedInput list *
exiter: Exiter *
outfile: string ->
TcState * TopAttribs * CheckedImplFile list * CheckBasics.TcEnv

/// DiagnosticLoggers can be sensitive to the TcConfig flags. During the checking
/// of the flags themselves we have to create temporary loggers, until the full configuration is
Expand Down
6 changes: 6 additions & 0 deletions src/Compiler/TypedTree/TypedTree.fs
Original file line number Diff line number Diff line change
Expand Up @@ -5899,6 +5899,12 @@ type PickledCcuInfo =

override _.ToString() = "PickledCcuInfo(...)"

type PickledTcInfo = {
MainMethodAttrs: Attribs
NetModuleAttrs: Attribs
AssemblyAttrs: Attribs
DeclaredImpls: CheckedImplFile list
}

/// Represents a set of free local values. Computed and cached by later phases
/// (never cached type checking). Cached in expressions. Not pickled.
Expand Down
7 changes: 7 additions & 0 deletions src/Compiler/TypedTree/TypedTree.fsi
Original file line number Diff line number Diff line change
Expand Up @@ -4297,6 +4297,13 @@ type PickledCcuInfo =
[<DebuggerBrowsable(DebuggerBrowsableState.Never)>]
member DebugText: string
type PickledTcInfo = {
MainMethodAttrs: Attribs
NetModuleAttrs: Attribs
AssemblyAttrs: Attribs
DeclaredImpls: CheckedImplFile list
}
/// Represents a set of free local values. Computed type cached by later phases
/// (never cached type checking). Cached in expressions. Not pickled.
type FreeLocals = Zset<Val>
Expand Down
81 changes: 81 additions & 0 deletions src/Compiler/TypedTree/TypedTreePickle.fs
Original file line number Diff line number Diff line change
Expand Up @@ -2177,6 +2177,32 @@ and p_modul_typ (x: ModuleOrNamespaceType) st =
(x.ModuleOrNamespaceKind, x.AllValsAndMembers, x.AllEntities)
st

and p_qualified_name_of_file qualifiedNameOfFile st =
let (QualifiedNameOfFile ident) = qualifiedNameOfFile
p_ident ident st

and p_pragma pragma st =
let (ScopedPragma.WarningOff (range, warningNumber)) = pragma
p_range range st
p_int warningNumber st

and p_pragmas x st =
p_list p_pragma x st

and p_checked_impl_file (file: CheckedImplFile) st =
p_tup5
p_qualified_name_of_file
p_pragmas
p_modul_typ
p_bool
p_bool
(file.QualifiedNameOfFile,
file.Pragmas,
file.Signature,
file.HasExplicitEntryPoint,
file.IsScript)
st

and u_tycon_repr st =
let tag1 = u_byte st
match tag1 with
Expand Down Expand Up @@ -2510,6 +2536,40 @@ and u_modul_typ st =
(u_qlist u_entity_spec) st
ModuleOrNamespaceType(x1, x3, x5)

and u_qualified_name_of_file st =
let ident = u_ident st
QualifiedNameOfFile(ident)

and u_pragma st =
let range = u_range st
let warningNumber = u_int st
ScopedPragma.WarningOff (range, warningNumber)

and u_pragmas st =
u_list u_pragma st

and u_checked_impl_file st =
let qualifiedNameOfFile, pragmas, signature, hasExplicitEntryPoint, isScript =
u_tup5
u_qualified_name_of_file
u_pragmas
u_modul_typ
u_bool
u_bool
st

CheckedImplFile(
qualifiedNameOfFile,
pragmas,
signature,
// ModuleOrNamespaceContents needs implementing, feels hard but doable
Unchecked.defaultof<_>,
hasExplicitEntryPoint,
isScript,
// this anon record map can be likely easily built in top of primitives here
Unchecked.defaultof<_>,
// something about debug points, not sure we care here
Unchecked.defaultof<_>)

//---------------------------------------------------------------------------
// Pickle/unpickle for F# expressions (for optimization data)
Expand Down Expand Up @@ -2906,8 +2966,29 @@ let pickleModuleOrNamespace mspec st = p_entity_spec mspec st
let pickleCcuInfo (minfo: PickledCcuInfo) st =
p_tup4 pickleModuleOrNamespace p_string p_bool (p_space 3) (minfo.mspec, minfo.compileTimeWorkingDir, minfo.usesQuotations, ()) st

let pickleTcInfo (tcInfo: PickledTcInfo) (st: WriterState) =
p_attribs tcInfo.MainMethodAttrs st
p_attribs tcInfo.NetModuleAttrs st
p_attribs tcInfo.AssemblyAttrs st

p_list p_checked_impl_file tcInfo.DeclaredImpls st

let unpickleModuleOrNamespace st = u_entity_spec st

let unpickleCcuInfo st =
let a, b, c, _space = u_tup4 unpickleModuleOrNamespace u_string u_bool (u_space 3) st
{ mspec=a; compileTimeWorkingDir=b; usesQuotations=c }

let unpickleTcInfo st : PickledTcInfo =
let mainMethodAttrs = u_attribs st
let netModuleAttrs = u_attribs st
let assemblyAttrs = u_attribs st

let declaredImpls = u_list u_checked_impl_file st

{
MainMethodAttrs = mainMethodAttrs
NetModuleAttrs = netModuleAttrs
AssemblyAttrs = assemblyAttrs
DeclaredImpls = declaredImpls
}
6 changes: 6 additions & 0 deletions src/Compiler/TypedTree/TypedTreePickle.fsi
Original file line number Diff line number Diff line change
Expand Up @@ -83,6 +83,9 @@ val internal p_ty: pickler<TType>
/// Serialize a TAST description of a compilation unit
val internal pickleCcuInfo: pickler<PickledCcuInfo>

/// Serialize typechecking info
val internal pickleTcInfo: pickler<PickledTcInfo>

/// Serialize an arbitrary object using the given pickler
val pickleObjWithDanglingCcus:
inMem: bool -> file: string -> TcGlobals -> scope: CcuThunk -> pickler<'T> -> 'T -> ByteBuffer * ByteBuffer
Expand Down Expand Up @@ -145,6 +148,9 @@ val internal u_ty: unpickler<TType>
/// Deserialize a TAST description of a compilation unit
val internal unpickleCcuInfo: ReaderState -> PickledCcuInfo

/// Deserialize typechecking info
val internal unpickleTcInfo: ReaderState -> PickledTcInfo

/// Deserialize an arbitrary object which may have holes referring to other compilation units
val internal unpickleObjWithDanglingCcus:
file: string ->
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -74,6 +74,7 @@
<Compile Include="SourceTextTests.fs" />
<Compile Include="SynExprTests.fs" />
<Compile Include="SynPatTests.fs" />
<Compile Include="TypedTreePickleTests.fs" />
</ItemGroup>

<ItemGroup>
Expand Down
Loading

0 comments on commit edf940e

Please sign in to comment.