Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion src/fsharp/IlxGen.fs
Original file line number Diff line number Diff line change
Expand Up @@ -764,7 +764,7 @@ let StorageForVal m v eenv =
try eenv.valsInScope.[v]
with :? KeyNotFoundException ->
assert false
errorR(Error(FSComp.SR.ilUndefinedValue(showL(vspecAtBindL v)),m))
errorR(Error(FSComp.SR.ilUndefinedValue(showL(valAtBindL v)),m))
notlazy (Arg 668(* random value for post-hoc diagnostic analysis on generated tree *) )
v.Force()

Expand Down
12 changes: 6 additions & 6 deletions src/fsharp/Optimizer.fs
Original file line number Diff line number Diff line change
Expand Up @@ -976,11 +976,11 @@ let AbstractLazyModulInfoByHiding isAssemblyBoundary mhi =
// Under those checks, the further hidden* checks may be subsumed (meaning, not required anymore).

let hiddenTycon, hiddenTyconRepr, hiddenVal, hiddenRecdField, hiddenUnionCase =
Zset.memberOf mhi.mhiTycons,
Zset.memberOf mhi.mhiTyconReprs,
Zset.memberOf mhi.mhiVals,
Zset.memberOf mhi.mhiRecdFields,
Zset.memberOf mhi.mhiUnionCases
Zset.memberOf mhi.HiddenTycons,
Zset.memberOf mhi.HiddenTyconReprs,
Zset.memberOf mhi.HiddenVals,
Zset.memberOf mhi.HiddenRecdFields,
Zset.memberOf mhi.HiddenUnionCases

let rec abstractExprInfo ivalue =
match ivalue with
Expand Down Expand Up @@ -3229,7 +3229,7 @@ and OptimizeModuleExpr cenv env x =
not (ValueIsUsedOrHasEffect cenv (fun () -> fvs.FreeLocals) (bind, binfo)) &&

// Check the thing is hidden by the signature (if any)
hidden.mhiVals.Contains bind.Var &&
hidden.HiddenVals.Contains bind.Var &&

// Check the thing is not compiled as a static field or property, since reflected definitions and other reflective stuff might need it
not (IsCompiledAsStaticProperty cenv.g bind.Var))
Expand Down
4 changes: 2 additions & 2 deletions src/fsharp/SignatureConformance.fs
Original file line number Diff line number Diff line change
Expand Up @@ -37,8 +37,8 @@ type Checker(g, amap, denv, remapInfo: SignatureRepackageInfo, checkingSig) =
// Used when checking attributes.
let sigToImplRemap =
let remap = Remap.Empty
let remap = (remapInfo.mrpiEntities,remap) ||> List.foldBack (fun (implTcref ,signTcref) acc -> addTyconRefRemap signTcref implTcref acc)
let remap = (remapInfo.mrpiVals ,remap) ||> List.foldBack (fun (implValRef,signValRef) acc -> addValRemap signValRef.Deref implValRef.Deref acc)
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)
Expand Down
84 changes: 42 additions & 42 deletions src/fsharp/TastOps.fs
Original file line number Diff line number Diff line change
Expand Up @@ -3442,7 +3442,7 @@ module DebugPrint = begin
let rec MemberL (v:Val) (membInfo:ValMemberInfo) =
(aboveListL [ wordL(tagText "compiled_name! = ") ^^ wordL (tagText v.CompiledName) ;
wordL(tagText "membInfo-slotsig! = ") ^^ listL slotSigL membInfo.ImplementedSlotSigs ])
and vspecAtBindL v =
and valAtBindL v =
let vL = valL v in
let mutL = (if v.IsMutable then wordL(tagText "mutable") ++ vL else vL)
mutL --- (aboveListL (List.concat [[wordL(tagText ":") ^^ typeL v.Type];
Expand Down Expand Up @@ -3512,7 +3512,7 @@ module DebugPrint = begin
then emptyL
else
let iimplsLs = iimpls |> List.map (fun (ty, _, _) -> wordL(tagText "interface") --- typeL ty)
let adhocLs = adhoc |> List.map (fun vref -> vspecAtBindL vref.Deref)
let adhocLs = adhoc |> List.map (fun vref -> valAtBindL vref.Deref)
(wordL(tagText "with") @@-- aboveListL (iimplsLs @ adhocLs)) @@ wordL(tagText "end")

let layoutUnionCaseArgTypes argtys = sepListL (wordL(tagText "*")) (List.map typeL argtys)
Expand Down Expand Up @@ -3559,7 +3559,7 @@ module DebugPrint = begin
let vsprs =
tycon.MembersOfFSharpTyconSorted
|> List.filter (fun v -> v.IsDispatchSlot)
|> List.map (fun vref -> vspecAtBindL vref.Deref)
|> List.map (fun vref -> valAtBindL vref.Deref)
let vals = tycon.TrueFieldsAsList |> List.map (fun f -> (if f.IsStatic then wordL(tagText "static") else emptyL) ^^ wordL(tagText "val") ^^ layoutRecdField f)
let alldecls = inherits @ vsprs @ vals
let emptyMeasure = match tycon.TypeOrMeasureKind with TyparKind.Measure -> isNil alldecls | _ -> false
Expand Down Expand Up @@ -3590,7 +3590,7 @@ module DebugPrint = begin
//--------------------------------------------------------------------------

and bindingL (TBind(v, repr, _)) =
vspecAtBindL v --- (wordL(tagText "=") ^^ exprL repr)
valAtBindL v --- (wordL(tagText "=") ^^ exprL repr)

and exprL expr = exprWrapL false expr
and atomL expr = exprWrapL true expr // true means bracket if needed to be atomic expr
Expand Down Expand Up @@ -3628,11 +3628,11 @@ module DebugPrint = begin
| ThenDoSeq -> "; (*ThenDo*)"
((exprL x0 ^^ rightL (tagText flag)) @@ exprL x1) |> wrap
| Expr.Lambda(_, _, baseValOpt, argvs, body, _, _) ->
let formalsL = spaceListL (List.map vspecAtBindL argvs) in
let formalsL = spaceListL (List.map valAtBindL argvs) in
let bindingL =
match baseValOpt with
| None -> wordL(tagText "lam") ^^ formalsL ^^ rightL(tagText ".")
| Some basev -> wordL(tagText "lam") ^^ (leftL(tagText "base=") ^^ vspecAtBindL basev) --- formalsL ^^ rightL(tagText ".") in
| Some basev -> wordL(tagText "lam") ^^ (leftL(tagText "base=") ^^ valAtBindL basev) --- formalsL ^^ rightL(tagText ".") in
(bindingL ++ exprL body) |> wrap
| Expr.TyLambda(_, argtyvs, body, _, _) ->
((wordL(tagText "LAM") ^^ spaceListL (List.map typarL argtyvs) ^^ rightL(tagText ".")) ++ exprL body) |> wrap
Expand Down Expand Up @@ -3727,7 +3727,7 @@ module DebugPrint = begin
| Expr.Obj (_lambdaId, ty, basev, ccall, overrides, iimpls, _) ->
wordL(tagText "OBJ:") ^^ aboveListL [typeL ty;
exprL ccall;
optionL vspecAtBindL basev;
optionL valAtBindL basev;
aboveListL (List.map overrideL overrides);
aboveListL (List.map iimplL iimpls)]

Expand Down Expand Up @@ -3812,7 +3812,7 @@ module DebugPrint = begin
and tmethodL (TObjExprMethod(TSlotSig(nm, _, _, _, _, _), _, tps, vs, e, _)) =
(wordL(tagText "TObjExprMethod") --- (wordL (tagText nm)) ^^ wordL(tagText "=")) --
(wordL(tagText "METH-LAM") --- angleBracketListL (List.map typarL tps) ^^ rightL(tagText ".")) ---
(wordL(tagText "meth-lam") --- tupleL (List.map (List.map vspecAtBindL >> tupleL) vs) ^^ rightL(tagText ".")) ---
(wordL(tagText "meth-lam") --- tupleL (List.map (List.map valAtBindL >> tupleL) vs) ^^ rightL(tagText ".")) ---
(atomL e)
and overrideL tmeth = wordL(tagText "with") ^^ tmethodL tmeth
and iimplL (ty, tmeths) = wordL(tagText "impl") ^^ aboveListL (typeL ty :: List.map tmethodL tmeths)
Expand Down Expand Up @@ -3850,33 +3850,33 @@ let SigTypeOfImplFile (TImplFile(_, _, mexpr, _, _, _)) = mexpr.Type
//--------------------------------------------------------------------------

type SignatureRepackageInfo =
{ mrpiVals : (ValRef * ValRef) list;
mrpiEntities: (TyconRef * TyconRef) list }
{ RepackagedVals : (ValRef * ValRef) list;
RepackagedEntities: (TyconRef * TyconRef) list }

member remapInfo.ImplToSigMapping = { TypeEquivEnv.Empty with EquivTycons = TyconRefMap.OfList remapInfo.mrpiEntities }
static member Empty = { mrpiVals = []; mrpiEntities= [] }
member remapInfo.ImplToSigMapping = { TypeEquivEnv.Empty with EquivTycons = TyconRefMap.OfList remapInfo.RepackagedEntities }
static member Empty = { RepackagedVals = []; RepackagedEntities= [] }

type SignatureHidingInfo =
{ mhiTycons : Zset<Tycon>;
mhiTyconReprs : Zset<Tycon>;
mhiVals : Zset<Val>;
mhiRecdFields : Zset<RecdFieldRef>;
mhiUnionCases : Zset<UnionCaseRef> }
{ HiddenTycons : Zset<Tycon>;
HiddenTyconReprs : Zset<Tycon>;
HiddenVals : Zset<Val>;
HiddenRecdFields : Zset<RecdFieldRef>;
HiddenUnionCases : Zset<UnionCaseRef> }

static member Empty =
{ mhiTycons = Zset.empty tyconOrder;
mhiTyconReprs = Zset.empty tyconOrder;
mhiVals = Zset.empty valOrder;
mhiRecdFields = Zset.empty recdFieldRefOrder;
mhiUnionCases = Zset.empty unionCaseRefOrder }
{ HiddenTycons = Zset.empty tyconOrder;
HiddenTyconReprs = Zset.empty tyconOrder;
HiddenVals = Zset.empty valOrder;
HiddenRecdFields = Zset.empty recdFieldRefOrder;
HiddenUnionCases = Zset.empty unionCaseRefOrder }

let addValRemap v v' tmenv =
{ tmenv with valRemap= tmenv.valRemap.Add v (mkLocalValRef v') }

let mkRepackageRemapping mrpi =
{ valRemap = ValMap.OfList (mrpi.mrpiVals |> List.map (fun (vref, x) -> vref.Deref, x));
{ valRemap = ValMap.OfList (mrpi.RepackagedVals |> List.map (fun (vref, x) -> vref.Deref, x));
tpinst = emptyTyparInst;
tyconRefRemap = TyconRefMap.OfList mrpi.mrpiEntities
tyconRefRemap = TyconRefMap.OfList mrpi.RepackagedEntities
removeTraitSolutions = false }

//--------------------------------------------------------------------------
Expand All @@ -3888,18 +3888,18 @@ let accEntityRemap (msigty:ModuleOrNamespaceType) (entity:Entity) (mrpi, mhi) =
match sigtyconOpt with
| None ->
// The type constructor is not present in the signature. Hence it is hidden.
let mhi = { mhi with mhiTycons = Zset.add entity mhi.mhiTycons }
let mhi = { mhi with HiddenTycons = Zset.add entity mhi.HiddenTycons }
(mrpi, mhi)
| Some sigtycon ->
// The type constructor is in the signature. Hence record the repackage entry
let sigtcref = mkLocalTyconRef sigtycon
let tcref = mkLocalTyconRef entity
let mrpi = { mrpi with mrpiEntities = ((tcref, sigtcref) :: mrpi.mrpiEntities) }
let mrpi = { mrpi with RepackagedEntities = ((tcref, sigtcref) :: mrpi.RepackagedEntities) }
// OK, now look for hidden things
let mhi =
if (match entity.TypeReprInfo with TNoRepr -> false | _ -> true) && (match sigtycon.TypeReprInfo with TNoRepr -> true | _ -> false) then
// The type representation is absent in the signature, hence it is hidden
{ mhi with mhiTyconReprs = Zset.add entity mhi.mhiTyconReprs }
{ mhi with HiddenTyconReprs = Zset.add entity mhi.HiddenTyconReprs }
else
// The type representation is present in the signature.
// Find the fields that have been hidden or which were non-public anyway.
Expand All @@ -3912,7 +3912,7 @@ let accEntityRemap (msigty:ModuleOrNamespaceType) (entity:Entity) (mrpi, mhi) =
| _ ->
// The field is not in the signature. Hence it is regarded as hidden.
let rfref = tcref.MakeNestedRecdFieldRef rfield
{ mhi with mhiRecdFields = Zset.add rfref mhi.mhiRecdFields })
{ mhi with HiddenRecdFields = Zset.add rfref mhi.HiddenRecdFields })
entity.AllFieldsArray
|> List.foldBack (fun (ucase:UnionCase) mhi ->
match sigtycon.GetUnionCaseByName ucase.DisplayName with
Expand All @@ -3922,7 +3922,7 @@ let accEntityRemap (msigty:ModuleOrNamespaceType) (entity:Entity) (mrpi, mhi) =
| _ ->
// The constructor is not in the signature. Hence it is regarded as hidden.
let ucref = tcref.MakeNestedUnionCaseRef ucase
{ mhi with mhiUnionCases = Zset.add ucref mhi.mhiUnionCases })
{ mhi with HiddenUnionCases = Zset.add ucref mhi.HiddenUnionCases })
(entity.UnionCasesAsList)
(mrpi, mhi)

Expand All @@ -3931,13 +3931,13 @@ let accSubEntityRemap (msigty:ModuleOrNamespaceType) (entity:Entity) (mrpi, mhi)
match sigtyconOpt with
| None ->
// The type constructor is not present in the signature. Hence it is hidden.
let mhi = { mhi with mhiTycons = Zset.add entity mhi.mhiTycons }
let mhi = { mhi with HiddenTycons = Zset.add entity mhi.HiddenTycons }
(mrpi, mhi)
| Some sigtycon ->
// The type constructor is in the signature. Hence record the repackage entry
let sigtcref = mkLocalTyconRef sigtycon
let tcref = mkLocalTyconRef entity
let mrpi = { mrpi with mrpiEntities = ((tcref, sigtcref) :: mrpi.mrpiEntities) }
let mrpi = { mrpi with RepackagedEntities = ((tcref, sigtcref) :: mrpi.RepackagedEntities) }
(mrpi, mhi)

let valLinkageAEquiv g aenv (v1:Val) (v2:Val) =
Expand All @@ -3955,11 +3955,11 @@ let accValRemap g aenv (msigty:ModuleOrNamespaceType) (implVal:Val) (mrpi, mhi)
match sigValOpt with
| None ->
if verbose then dprintf "accValRemap, hide = %s#%d\n" implVal.LogicalName implVal.Stamp
let mhi = { mhi with mhiVals = Zset.add implVal mhi.mhiVals }
let mhi = { mhi with HiddenVals = Zset.add implVal mhi.HiddenVals }
(mrpi, mhi)
| Some (sigVal:Val) ->
// The value is in the signature. Add the repackage entry.
let mrpi = { mrpi with mrpiVals = (vref, mkLocalValRef sigVal) :: mrpi.mrpiVals }
let mrpi = { mrpi with RepackagedVals = (vref, mkLocalValRef sigVal) :: mrpi.RepackagedVals }
(mrpi, mhi)

let getCorrespondingSigTy nm (msigty:ModuleOrNamespaceType) =
Expand Down Expand Up @@ -4053,25 +4053,25 @@ let ComputeRemappingFromImplementationToSignature g mdef msigty =
let accTyconHidingInfoAtAssemblyBoundary (tycon:Tycon) mhi =
if not (canAccessFromEverywhere tycon.Accessibility) then
// The type constructor is not public, hence hidden at the assembly boundary.
{ mhi with mhiTycons = Zset.add tycon mhi.mhiTycons }
{ mhi with HiddenTycons = Zset.add tycon mhi.HiddenTycons }
elif not (canAccessFromEverywhere tycon.TypeReprAccessibility) then
{ mhi with mhiTyconReprs = Zset.add tycon mhi.mhiTyconReprs }
{ mhi with HiddenTyconReprs = Zset.add tycon mhi.HiddenTyconReprs }
else
mhi
|> Array.foldBack
(fun (rfield:RecdField) mhi ->
if not (canAccessFromEverywhere rfield.Accessibility) then
let tcref = mkLocalTyconRef tycon
let rfref = tcref.MakeNestedRecdFieldRef rfield
{ mhi with mhiRecdFields = Zset.add rfref mhi.mhiRecdFields }
{ mhi with HiddenRecdFields = Zset.add rfref mhi.HiddenRecdFields }
else mhi)
tycon.AllFieldsArray
|> List.foldBack
(fun (ucase:UnionCase) mhi ->
if not (canAccessFromEverywhere ucase.Accessibility) then
let tcref = mkLocalTyconRef tycon
let ucref = tcref.MakeNestedUnionCaseRef ucase
{ mhi with mhiUnionCases = Zset.add ucref mhi.mhiUnionCases }
{ mhi with HiddenUnionCases = Zset.add ucref mhi.HiddenUnionCases }
else mhi)
(tycon.UnionCasesAsList)

Expand All @@ -4086,7 +4086,7 @@ let accValHidingInfoAtAssemblyBoundary (vspec:Val) mhi =
// anything that's not a module or member binding gets assembly visibility
not vspec.IsMemberOrModuleBinding then
// The value is not public, hence hidden at the assembly boundary.
{ mhi with mhiVals = Zset.add vspec mhi.mhiVals }
{ mhi with HiddenVals = Zset.add vspec mhi.HiddenVals }
else
mhi

Expand Down Expand Up @@ -4121,10 +4121,10 @@ let IsHidden setF accessF remapF debugF =
if verbose then dprintf "IsHidden, #mrmi = %d, %s = %b\n" mrmi.Length (showL (debugF x)) res;
res

let IsHiddenTycon mrmi x = IsHidden (fun mhi -> mhi.mhiTycons) (fun tc -> tc.Accessibility) (fun rpi x -> (remapTyconRef rpi.tyconRefRemap (mkLocalTyconRef x)).Deref) DebugPrint.tyconL mrmi x
let IsHiddenTyconRepr mrmi x = IsHidden (fun mhi -> mhi.mhiTyconReprs) (fun v -> v.TypeReprAccessibility) (fun rpi x -> (remapTyconRef rpi.tyconRefRemap (mkLocalTyconRef x)).Deref) DebugPrint.tyconL mrmi x
let IsHiddenVal mrmi x = IsHidden (fun mhi -> mhi.mhiVals) (fun v -> v.Accessibility) (fun rpi x -> (remapValRef rpi (mkLocalValRef x)).Deref) DebugPrint.valL mrmi x
let IsHiddenRecdField mrmi x = IsHidden (fun mhi -> mhi.mhiRecdFields) (fun rfref -> rfref.RecdField.Accessibility) (fun rpi x -> remapRecdFieldRef rpi.tyconRefRemap x) DebugPrint.recdFieldRefL mrmi x
let IsHiddenTycon mrmi x = IsHidden (fun mhi -> mhi.HiddenTycons) (fun tc -> tc.Accessibility) (fun rpi x -> (remapTyconRef rpi.tyconRefRemap (mkLocalTyconRef x)).Deref) DebugPrint.tyconL mrmi x
let IsHiddenTyconRepr mrmi x = IsHidden (fun mhi -> mhi.HiddenTyconReprs) (fun v -> v.TypeReprAccessibility) (fun rpi x -> (remapTyconRef rpi.tyconRefRemap (mkLocalTyconRef x)).Deref) DebugPrint.tyconL mrmi x
let IsHiddenVal mrmi x = IsHidden (fun mhi -> mhi.HiddenVals) (fun v -> v.Accessibility) (fun rpi x -> (remapValRef rpi (mkLocalValRef x)).Deref) DebugPrint.valL mrmi x
let IsHiddenRecdField mrmi x = IsHidden (fun mhi -> mhi.HiddenRecdFields) (fun rfref -> rfref.RecdField.Accessibility) (fun rpi x -> remapRecdFieldRef rpi.tyconRefRemap x) DebugPrint.recdFieldRefL mrmi x


//--------------------------------------------------------------------------
Expand Down
Loading