Skip to content

Commit

Permalink
temp
Browse files Browse the repository at this point in the history
  • Loading branch information
KevinRansom committed Nov 8, 2024
1 parent f5bbd29 commit f5c256f
Show file tree
Hide file tree
Showing 12 changed files with 157 additions and 136 deletions.
2 changes: 1 addition & 1 deletion src/Compiler/Checking/CheckDeclarations.fs
Original file line number Diff line number Diff line change
Expand Up @@ -1042,7 +1042,7 @@ module MutRecBindingChecking =
AddLocalTyconRefs true g cenv.amap tcref.Range [tcref] initialEnvForTycon

// Make fresh version of the class type for type checking the members and lets *
let _, copyOfTyconTypars, _, objTy, thisTy = FreshenObjectArgType cenv tcref.Range TyparRigidity.WillBeRigid tcref isExtrinsic declaredTyconTypars
let _, copyOfTyconTypars, _, objTy, thisTy = FreshenObjectArgType cenv tcref.Range TyparRigidity.WillBeRigid tcref isExtrinsic declaredTyconTypars true //@@@@@@ (not cenv.g.realsig)

// The basic iteration over the declarations in a single type definition
let initialInnerState = (None, envForTycon, tpenv, recBindIdx, uncheckedBindsRev)
Expand Down
27 changes: 16 additions & 11 deletions src/Compiler/Checking/Expressions/CheckExpressions.fs
Original file line number Diff line number Diff line change
Expand Up @@ -1834,13 +1834,18 @@ let MakeAndPublishSimpleValsForMergedScope (cenv: cenv) env m (names: NameMap<_>
// to C<_> occurs then generate C<?ty> for a fresh type inference variable ?ty.
//-------------------------------------------------------------------------

let FreshenTyconRef (g: TcGlobals) m rigid (tcref: TyconRef) declaredTyconTypars =
let FreshenTyconRef (g: TcGlobals) m rigid (tcref: TyconRef) declaredTyconTypars doCopyTypars =
let origTypars = declaredTyconTypars
let clearStaticReq = g.langVersion.SupportsFeature LanguageFeature.InterfacesWithAbstractStaticMembers
let freshTypars = copyTypars clearStaticReq origTypars
if rigid <> TyparRigidity.Rigid then
for tp in freshTypars do
tp.SetRigidity rigid
let freshTypars =
if doCopyTypars then
let typars = copyTypars clearStaticReq origTypars
if rigid <> TyparRigidity.Rigid then
for tp in typars do
tp.SetRigidity rigid
typars
else
origTypars

let renaming, tinst = FixupNewTypars m [] [] origTypars freshTypars
let origTy = TType_app(tcref, List.map mkTyparTy origTypars, g.knownWithoutNull)
Expand Down Expand Up @@ -2673,11 +2678,11 @@ module EventDeclarationNormalization =

/// Make a copy of the "this" type for a generic object type, e.g. List<'T> --> List<'?> for a fresh inference variable.
/// Also adjust the "this" type to take into account whether the type is a struct.
let FreshenObjectArgType (cenv: cenv) m rigid tcref isExtrinsic declaredTyconTypars =
let FreshenObjectArgType (cenv: cenv) m rigid tcref isExtrinsic declaredTyconTypars (doCopyTypars: bool) =
let g = cenv.g

let tcrefObjTy, enclosingDeclaredTypars, renaming, objTy =
FreshenTyconRef g m rigid tcref declaredTyconTypars
FreshenTyconRef g m rigid tcref declaredTyconTypars doCopyTypars

// Struct members have a byref 'this' type (unless they are extrinsic extension members)
let thisTy =
Expand Down Expand Up @@ -4208,7 +4213,7 @@ and TcValSpec (cenv: cenv) env declKind newOk containerInfo memFlagsOpt thisTyOp
| Some(MemberOrValContainerInfo(tcref, _, _, _, declaredTyconTypars)) ->
let isExtrinsic = (declKind = ExtrinsicExtensionBinding)
let _, enclosingDeclaredTypars, _, _, thisTy =
FreshenObjectArgType cenv m TyparRigidity.Rigid tcref isExtrinsic declaredTyconTypars
FreshenObjectArgType cenv m TyparRigidity.Rigid tcref isExtrinsic declaredTyconTypars true //@@@@@@ (not cenv.g.realsig)

// An implemented interface type is in terms of the type's type parameters.
// We need a signature in terms of the values' type parameters.
Expand Down Expand Up @@ -11894,7 +11899,7 @@ and AnalyzeRecursiveStaticMemberOrValDecl
CheckForNonAbstractInterface g declKind tcref memberFlags true id.idRange

let isExtrinsic = (declKind = ExtrinsicExtensionBinding)
let tcrefObjTy, enclosingDeclaredTypars, renaming, _, _ = FreshenObjectArgType cenv mBinding TyparRigidity.WillBeRigid tcref isExtrinsic declaredTyconTypars
let tcrefObjTy, enclosingDeclaredTypars, renaming, _, _ = FreshenObjectArgType cenv mBinding TyparRigidity.WillBeRigid tcref isExtrinsic declaredTyconTypars true //@@@@@@ (not cenv.g.realsig)
let envinner = AddDeclaredTypars CheckForDuplicateTypars enclosingDeclaredTypars envinner
let envinner = MakeInnerEnvForTyconRef envinner tcref isExtrinsic

Expand All @@ -11919,7 +11924,7 @@ and AnalyzeRecursiveStaticMemberOrValDecl
error(Error(FSComp.SR.tcConstructorsDisallowedInExceptionAugmentation(), id.idRange))

let isExtrinsic = (declKind = ExtrinsicExtensionBinding)
let _, enclosingDeclaredTypars, _, objTy, thisTy = FreshenObjectArgType cenv mBinding TyparRigidity.WillBeRigid tcref isExtrinsic declaredTyconTypars
let _, enclosingDeclaredTypars, _, objTy, thisTy = FreshenObjectArgType cenv mBinding TyparRigidity.WillBeRigid tcref isExtrinsic declaredTyconTypars true
let envinner = AddDeclaredTypars CheckForDuplicateTypars enclosingDeclaredTypars envinner
let envinner = MakeInnerEnvForTyconRef envinner tcref isExtrinsic

Expand Down Expand Up @@ -12005,7 +12010,7 @@ and AnalyzeRecursiveInstanceMemberDecl

// The type being augmented tells us the type of 'this'
let isExtrinsic = (declKind = ExtrinsicExtensionBinding)
let tcrefObjTy, enclosingDeclaredTypars, renaming, objTy, thisTy = FreshenObjectArgType cenv mBinding TyparRigidity.WillBeRigid tcref isExtrinsic declaredTyconTypars
let tcrefObjTy, enclosingDeclaredTypars, renaming, objTy, thisTy = FreshenObjectArgType cenv mBinding TyparRigidity.WillBeRigid tcref isExtrinsic declaredTyconTypars true //@@@@@@ (not cenv.g.realsig)

let envinner = AddDeclaredTypars CheckForDuplicateTypars enclosingDeclaredTypars envinner

Expand Down
3 changes: 2 additions & 1 deletion src/Compiler/Checking/Expressions/CheckExpressions.fsi
Original file line number Diff line number Diff line change
Expand Up @@ -483,7 +483,8 @@ val FreshenObjectArgType:
tcref: TyconRef ->
isExtrinsic: bool ->
declaredTyconTypars: Typar list ->
TType * Typar list * TyparInstantiation * TType * TType
bool ->
TType * Typar list * TyparInstantiation * TType * TType

/// Get the accumulated module/namespace type for the current module/namespace being processed.
val GetCurrAccumulatedModuleOrNamespaceType: env: TcEnv -> ModuleOrNamespaceType
Expand Down
4 changes: 2 additions & 2 deletions src/Compiler/Checking/PostInferenceChecks.fs
Original file line number Diff line number Diff line change
Expand Up @@ -2664,9 +2664,9 @@ and CheckModuleSpec cenv env mbind =
let env = { env with reflect = env.reflect || HasFSharpAttribute cenv.g cenv.g.attrib_ReflectedDefinitionAttribute mspec.Attribs }
CheckDefnInModule cenv env rhs

let CheckImplFileContents cenv env implFileTy implFileContents =
let CheckImplFileContents cenv env implFileTy implFileContents =
let rpi, mhi = ComputeRemappingFromImplementationToSignature cenv.g implFileContents implFileTy
let env = { env with sigToImplRemapInfo = (mkRepackageRemapping rpi, mhi) :: env.sigToImplRemapInfo }
let env = { env with sigToImplRemapInfo = (mkRepackageRemapping rpi cenv.g.realsig, mhi) :: env.sigToImplRemapInfo }
UpdatePrettyTyparNames.updateModuleOrNamespaceType implFileTy
CheckDefnInModule cenv env implFileContents

Expand Down
7 changes: 4 additions & 3 deletions src/Compiler/Checking/SignatureConformance.fs
Original file line number Diff line number Diff line change
Expand Up @@ -15,6 +15,7 @@ open FSharp.Compiler.Features
open FSharp.Compiler.InfoReader
open FSharp.Compiler.Syntax
open FSharp.Compiler.SyntaxTreeOps
open FSharp.Compiler.TcGlobals
open FSharp.Compiler.Text
open FSharp.Compiler.TypedTree
open FSharp.Compiler.TypedTreeBasics
Expand Down Expand Up @@ -48,16 +49,16 @@ exception DefinitionsInSigAndImplNotCompatibleAbbreviationsDiffer of
range: range

// Use a type to capture the constant, common parameters
type Checker(g, amap, denv, remapInfo: SignatureRepackageInfo, checkingSig) =
type Checker(g: TcGlobals, amap, denv, remapInfo: SignatureRepackageInfo, checkingSig) =

// Build a remap that maps tcrefs in the signature to tcrefs in the implementation
// Used when checking attributes.
let sigToImplRemap =
let remap = Remap.Empty
let remap = {Remap.Empty with realsig = g.realsig}
let remap = (remapInfo.RepackagedEntities, remap) ||> List.foldBack (fun (implTcref, signTcref) acc -> addTyconRefRemap signTcref implTcref acc)
let remap = (remapInfo.RepackagedVals, remap) ||> List.foldBack (fun (implValRef, signValRef) acc -> addValRemap signValRef.Deref implValRef.Deref acc)
remap

// For all attributable elements (types, modules, exceptions, record fields, unions, parameters, generic type parameters)
//
// (a) Start with lists AImpl and ASig containing the attributes in the implementation and signature, in declaration order
Expand Down
49 changes: 29 additions & 20 deletions src/Compiler/CodeGen/IlxGen.fs
Original file line number Diff line number Diff line change
Expand Up @@ -1197,6 +1197,10 @@ and IlxGenEnv =
/// Full list of enclosing bound values. First non-compiler-generated element is used to help give nice names for closures and other expressions.
letBoundVars: ValRef list


/// nested type generic parameters for currentloc
nestedTypars: Zset<Typar>

/// The set of IL local variable indexes currently in use by lexically scoped variables, to allow reuse on different branches.
/// Really an integer set.
liveLocals: IntMap<unit>
Expand Down Expand Up @@ -1259,7 +1263,7 @@ let AddTyparsToEnv typars (eenv: IlxGenEnv) =

let AddSignatureRemapInfo _msg (rpi, mhi) eenv =
{ eenv with
sigToImplRemapInfo = (mkRepackageRemapping rpi, mhi) :: eenv.sigToImplRemapInfo
sigToImplRemapInfo = (mkRepackageRemapping rpi eenv.realsig, mhi) :: eenv.sigToImplRemapInfo
}

//--------------------------------------------------------------------------
Expand All @@ -1281,7 +1285,7 @@ let AddStorageForVal (g: TcGlobals) (v, s) eenv =
if g.compilingFSharpCore then
// Passing an empty remap is sufficient for FSharp.Core.dll because it turns out the remapped type signature can
// still be resolved.
match tryRescopeVal g.fslibCcu Remap.Empty v with
match tryRescopeVal g.fslibCcu { Remap.Empty with realsig = g.realsig } v with
| ValueNone -> eenv
| ValueSome vref ->
match vref.TryDeref with
Expand Down Expand Up @@ -6892,14 +6896,6 @@ and GenFreevar cenv m eenvouter tyenvinner (fv: Val) =
and GetIlxClosureFreeVars cenv m (thisVars: ValRef list) boxity eenv takenNames expr =
let g = cenv.g

// Choose a base name for the closure
let basename =
let boundv = eenv.letBoundVars |> List.tryFind (fun v -> not v.IsCompilerGenerated)

match boundv with
| Some v -> v.CompiledName cenv.g.CompilerGlobalState
| None -> "clo"

// Get a unique stamp for the closure. This must be stable for things that can be part of a let rec.
let uniq =
match expr with
Expand All @@ -6909,18 +6905,28 @@ and GetIlxClosureFreeVars cenv m (thisVars: ValRef list) boxity eenv takenNames
| _ -> newUnique ()

// Choose a name for the closure
let ilCloTypeRef =
let ilCloTypeRef, initialFreeTyvars =
let boundvar =
eenv.letBoundVars |> List.tryFind (fun v -> not v.IsCompilerGenerated)

let basename =
match boundvar with
| Some v -> v.CompiledName cenv.g.CompilerGlobalState
| None -> "clo"

// FSharp 1.0 bug 3404: System.Reflection doesn't like '.' and '`' in type names
let basenameSafeForUseAsTypename = CleanUpGeneratedTypeName basename

let suffixmark = expr.Range

let cloName =
// Ensure that we have an g.CompilerGlobalState
assert (g.CompilerGlobalState |> Option.isSome)
g.CompilerGlobalState.Value.StableNameGenerator.GetUniqueCompilerGeneratedName(basenameSafeForUseAsTypename, suffixmark, uniq)
g.CompilerGlobalState.Value.StableNameGenerator.GetUniqueCompilerGeneratedName(basenameSafeForUseAsTypename, expr.Range, uniq)

let ilCloTypeRef = NestedTypeRefForCompLoc eenv.cloc cloName

let initialFreeTyvars = emptyFreeTyvars //@@@@@@@@@@ { emptyFreeTyvars with FreeTypars = eenv.nestedTypars }

NestedTypeRefForCompLoc eenv.cloc cloName
ilCloTypeRef, initialFreeTyvars

// Collect the free variables of the closure
let cloFreeVarResults =
Expand All @@ -6931,7 +6937,8 @@ and GetIlxClosureFreeVars cenv m (thisVars: ValRef list) boxity eenv takenNames
| None -> opts
| Some(tcref, _, typars, _) -> opts.WithTemplateReplacement(tyconRefEq g tcref, typars)

freeInExpr opts expr
//freeInExpr opts expr
accFreeInExpr opts expr { emptyFreeVars with FreeTyvars = initialFreeTyvars }

// Partition the free variables when some can be accessed from places besides the immediate environment
// Also filter out the current value being bound, if any, as it is available from the "this"
Expand Down Expand Up @@ -8166,7 +8173,7 @@ and GenLetRecFixup cenv cgbuf eenv (ilxCloSpec: IlxClosureSpec, e, ilField: ILFi
CG.EmitInstr cgbuf (pop 2) Push0 (mkNormalStfld (mkILFieldSpec (ilField.FieldRef, ilxCloSpec.ILType)))

/// Generate letrec bindings
and GenLetRecBindings cenv (cgbuf: CodeGenBuffer) eenv (allBinds: Bindings, m) (dict: Dictionary<Stamp, ILTypeRef> option) =
and GenLetRecBindings cenv (cgbuf: CodeGenBuffer) eenv (allBinds: Bindings, m) (dict: Dictionary<Stamp, Entity * ILTypeRef> option) =

// 'let rec' bindings are always considered to be in loops, that is each may have backward branches for the
// tailcalls back to the entry point. This means we don't rely on zero-init of mutable locals
Expand Down Expand Up @@ -8320,7 +8327,8 @@ and GenLetRecBindings cenv (cgbuf: CodeGenBuffer) eenv (allBinds: Bindings, m) (
||> List.fold (fun forwardReferenceSet (bind: Binding) ->
GenBinding cenv cgbuf eenv bind false
updateForwardReferenceSet bind forwardReferenceSet)
| true, tref ->
| true, (tc, tref) ->
let eenv = { eenv with nestedTypars = (eenv.nestedTypars |> Zset.addList tc.TyparsNoRange) }
CodeGenInitMethod
cenv
cgbuf
Expand Down Expand Up @@ -10250,7 +10258,7 @@ and GenModuleOrNamespaceContents cenv (cgbuf: CodeGenBuffer) qname lazyInitInfo
| TMDefRec(_isRec, opens, tycons, mbinds, m) ->
let eenvinner = AddDebugImportsToEnv cenv eenv opens

let dict = Some(Dictionary<Stamp, ILTypeRef>())
let dict = Some(Dictionary<Stamp, Entity * ILTypeRef>())

for tc in tycons do
let optTref =
Expand All @@ -10260,7 +10268,7 @@ and GenModuleOrNamespaceContents cenv (cgbuf: CodeGenBuffer) qname lazyInitInfo
GenTypeDef cenv cgbuf.mgbuf lazyInitInfo eenv m tc

match optTref with
| Some tref -> dict.Value.Add(tc.Stamp, tref)
| Some tref -> dict.Value.Add(tc.Stamp, (tc, tref))
| None -> ()

// Generate chunks of non-nested bindings together to allow recursive fixups.
Expand Down Expand Up @@ -11984,6 +11992,7 @@ let GetEmptyIlxGenEnv (g: TcGlobals) ccu =
someTypeInThisAssembly = g.ilg.typ_Object // dummy value
isFinalFile = false
letBoundVars = []
nestedTypars = Zset.empty typarOrder
liveLocals = IntMap.empty ()
innerVals = []
sigToImplRemapInfo = [] (* "module remap info" *)
Expand Down
2 changes: 1 addition & 1 deletion src/Compiler/Driver/fsc.fs
Original file line number Diff line number Diff line change
Expand Up @@ -841,7 +841,7 @@ let main3
=
// Encode the signature data
ReportTime tcConfig "Encode Interface Data"
let exportRemapping = MakeExportRemapping generatedCcu generatedCcu.Contents
let exportRemapping = MakeExportRemapping generatedCcu generatedCcu.Contents tcConfig.realsig

let sigDataAttributes, sigDataResources =
try
Expand Down
6 changes: 3 additions & 3 deletions src/Compiler/Optimize/Optimizer.fs
Original file line number Diff line number Diff line change
Expand Up @@ -588,7 +588,7 @@ let BindExternalLocalVal cenv (v: Val) vval env =
if g.compilingFSharpCore then
// Passing an empty remap is sufficient for FSharp.Core.dll because it turns out the remapped type signature can
// still be resolved.
match tryRescopeVal g.fslibCcu Remap.Empty v with
match tryRescopeVal g.fslibCcu {Remap.Empty with realsig = g.realsig} v with
| ValueSome vref -> BindValueForFslib vref.nlr v vval env
| _ -> env
else env
Expand Down Expand Up @@ -1523,8 +1523,8 @@ let RemapOptimizationInfo g tmenv =
remapLazyModulInfo

/// Hide information when a value is no longer visible
let AbstractAndRemapModulInfo g (repackage, hidden) info =
let mrpi = mkRepackageRemapping repackage
let AbstractAndRemapModulInfo (g: TcGlobals) (repackage, hidden) info =
let mrpi = mkRepackageRemapping repackage g.realsig
let info = info |> AbstractLazyModulInfoByHiding false hidden
let info = info |> RemapOptimizationInfo g mrpi
info
Expand Down
4 changes: 2 additions & 2 deletions src/Compiler/Service/IncrementalBuild.fs
Original file line number Diff line number Diff line change
Expand Up @@ -634,9 +634,9 @@ module Utilities =
/// as a cross-assembly reference. Note the assembly has not been generated on disk, so this is
/// a virtualized view of the assembly contents as computed by background checking.
[<Sealed>]
type RawFSharpAssemblyDataBackedByLanguageService (tcConfig, tcGlobals, generatedCcu: CcuThunk, outfile, topAttrs, assemblyName, ilAssemRef) =
type RawFSharpAssemblyDataBackedByLanguageService (tcConfig: TcConfig, tcGlobals, generatedCcu: CcuThunk, outfile, topAttrs, assemblyName, ilAssemRef) =

let exportRemapping = MakeExportRemapping generatedCcu generatedCcu.Contents
let exportRemapping = MakeExportRemapping generatedCcu generatedCcu.Contents tcConfig.realsig

let sigData =
let _sigDataAttributes, sigDataResources = EncodeSignatureData(tcConfig, tcGlobals, exportRemapping, generatedCcu, outfile, true)
Expand Down
4 changes: 3 additions & 1 deletion src/Compiler/TypedTree/CompilerGlobalState.fs
Original file line number Diff line number Diff line change
Expand Up @@ -73,4 +73,6 @@ let newUnique() = System.Threading.Interlocked.Increment &uniqueCount
/// Unique name generator for stamps attached to to val_specs, tycon_specs etc.
//++GLOBAL MUTABLE STATE (concurrency-safe)
let mutable private stampCount = 0L
let newStamp() = System.Threading.Interlocked.Increment &stampCount
let newStamp() =
let x = System.Threading.Interlocked.Increment &stampCount
x
Loading

0 comments on commit f5c256f

Please sign in to comment.