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
52 changes: 31 additions & 21 deletions src/Compiler/Checking/CheckExpressions.fs
Original file line number Diff line number Diff line change
Expand Up @@ -578,6 +578,7 @@ type ValScheme =
id: Ident *
typeScheme: GeneralizedType *
valReprInfo: ValReprInfo option *
valReprInfoForDisplay: ValReprInfo option *
memberInfo: PrelimMemberInfo option *
isMutable: bool *
inlineInfo: ValInline *
Expand Down Expand Up @@ -1500,7 +1501,7 @@ let MakeAndPublishVal (cenv: cenv) env (altActualParent, inSig, declKind, valRec

let g = cenv.g

let (ValScheme(id, typeScheme, valReprInfo, memberInfoOpt, isMutable, inlineFlag, baseOrThis, vis, isCompGen, isIncrClass, isTyFunc, hasDeclaredTypars)) = vscheme
let (ValScheme(id, typeScheme, valReprInfo, valReprInfoForDisplay, memberInfoOpt, isMutable, inlineFlag, baseOrThis, vis, isCompGen, isIncrClass, isTyFunc, hasDeclaredTypars)) = vscheme

let ty = GeneralizedTypeForTypeScheme typeScheme

Expand Down Expand Up @@ -1608,6 +1609,10 @@ let MakeAndPublishVal (cenv: cenv) env (altActualParent, inSig, declKind, valRec
xmlDoc, isTopBinding, isExtrinsic, isIncrClass, isTyFunc,
(hasDeclaredTypars || inSig), isGeneratedEventVal, konst, actualParent)

match valReprInfoForDisplay with
| Some info when not (ValReprInfo.IsEmpty info) ->
vspec.SetValReprInfoForDisplay valReprInfoForDisplay
| _ -> ()

CheckForAbnormalOperatorNames cenv id.idRange vspec.DisplayNameCoreMangled memberInfoOpt

Expand Down Expand Up @@ -1641,10 +1646,11 @@ let MakeAndPublishVals cenv env (altActualParent, inSig, declKind, valRecInfo, v
valSchemes
Map.empty

/// Create a Val node for "base" in a class
let MakeAndPublishBaseVal cenv env baseIdOpt ty =
baseIdOpt
|> Option.map (fun (id: Ident) ->
let valscheme = ValScheme(id, NonGenericTypeScheme ty, None, None, false, ValInline.Never, BaseVal, None, false, false, false, false)
let valscheme = ValScheme(id, NonGenericTypeScheme ty, None, None, None, false, ValInline.Never, BaseVal, None, false, false, false, false)
MakeAndPublishVal cenv env (ParentNone, false, ExpressionBinding, ValNotInRecScope, valscheme, [], XmlDoc.Empty, None, false))

// Make the "delayed reference" value where the this pointer will reside after calling the base class constructor
Expand All @@ -1657,7 +1663,7 @@ let MakeAndPublishSafeThisVal (cenv: cenv) env (thisIdOpt: Ident option) thisTy
if not (isFSharpObjModelTy g thisTy) then
errorR(Error(FSComp.SR.tcStructsCanOnlyBindThisAtMemberDeclaration(), thisId.idRange))

let valScheme = ValScheme(thisId, NonGenericTypeScheme(mkRefCellTy g thisTy), None, None, false, ValInline.Never, CtorThisVal, None, false, false, false, false)
let valScheme = ValScheme(thisId, NonGenericTypeScheme(mkRefCellTy g thisTy), None, None, None, false, ValInline.Never, CtorThisVal, None, false, false, false, false)
Some(MakeAndPublishVal cenv env (ParentNone, false, ExpressionBinding, ValNotInRecScope, valScheme, [], XmlDoc.Empty, None, false))

| None ->
Expand Down Expand Up @@ -1742,11 +1748,11 @@ let ChooseCanonicalDeclaredTyparsAfterInference g denv declaredTypars m =
declaredTypars

let ChooseCanonicalValSchemeAfterInference g denv vscheme m =
let (ValScheme(id, typeScheme, arityInfo, memberInfoOpt, isMutable, inlineFlag, baseOrThis, vis, isCompGen, isIncrClass, isTyFunc, hasDeclaredTypars)) = vscheme
let (ValScheme(id, typeScheme, valReprInfo, valReprInfoForDisplay, memberInfoOpt, isMutable, inlineFlag, baseOrThis, vis, isCompGen, isIncrClass, isTyFunc, hasDeclaredTypars)) = vscheme
let (GeneralizedType(generalizedTypars, ty)) = typeScheme
let generalizedTypars = ChooseCanonicalDeclaredTyparsAfterInference g denv generalizedTypars m
let typeScheme = GeneralizedType(generalizedTypars, ty)
let valscheme = ValScheme(id, typeScheme, arityInfo, memberInfoOpt, isMutable, inlineFlag, baseOrThis, vis, isCompGen, isIncrClass, isTyFunc, hasDeclaredTypars)
let valscheme = ValScheme(id, typeScheme, valReprInfo, valReprInfoForDisplay, memberInfoOpt, isMutable, inlineFlag, baseOrThis, vis, isCompGen, isIncrClass, isTyFunc, hasDeclaredTypars)
valscheme

let PlaceTyparsInDeclarationOrder declaredTypars generalizedTypars =
Expand Down Expand Up @@ -1817,10 +1823,11 @@ let ComputeIsTyFunc(id: Ident, hasDeclaredTypars, arityInfo: ValReprInfo option)
| Some info -> info.NumCurriedArgs = 0)

let UseSyntacticArity declKind typeScheme prelimValReprInfo =
let valReprInfo = InferGenericArityFromTyScheme typeScheme prelimValReprInfo
if DeclKind.MustHaveArity declKind then
Some(InferGenericArityFromTyScheme typeScheme prelimValReprInfo)
Some valReprInfo, None
else
None
None, Some valReprInfo

/// Combine the results of InferSynValData and InferArityOfExpr.
//
Expand Down Expand Up @@ -1855,18 +1862,17 @@ let UseSyntacticArity declKind typeScheme prelimValReprInfo =
// { new Base<unit> with
// member x.M(v: unit) = () }
//
let CombineSyntacticAndInferredArities g declKind rhsExpr prelimScheme =
let CombineSyntacticAndInferredArities g rhsExpr prelimScheme =
let (PrelimVal2(_, typeScheme, partialValReprInfoOpt, memberInfoOpt, isMutable, _, _, ArgAndRetAttribs(argAttribs, retAttribs), _, _, _)) = prelimScheme
match partialValReprInfoOpt, DeclKind.MustHaveArity declKind with
| _, false -> None
| None, true -> Some(PrelimValReprInfo([], ValReprInfo.unnamedRetVal))
match partialValReprInfoOpt with
| None -> Some(PrelimValReprInfo([], ValReprInfo.unnamedRetVal))
// Don't use any expression information for members, where syntax dictates the arity completely
| _ when memberInfoOpt.IsSome ->
partialValReprInfoOpt
// Don't use any expression information for 'let' bindings where return attributes are present
| _ when retAttribs.Length > 0 ->
partialValReprInfoOpt
| Some partialValReprInfoFromSyntax, true ->
| Some partialValReprInfoFromSyntax ->
let (PrelimValReprInfo(curriedArgInfosFromSyntax, retInfoFromSyntax)) = partialValReprInfoFromSyntax
let partialArityInfo =
if isMutable then
Expand Down Expand Up @@ -1899,16 +1905,20 @@ let CombineSyntacticAndInferredArities g declKind rhsExpr prelimScheme =

let BuildValScheme declKind partialArityInfoOpt prelimScheme =
let (PrelimVal2(id, typeScheme, _, memberInfoOpt, isMutable, inlineFlag, baseOrThis, _, vis, isCompGen, hasDeclaredTypars)) = prelimScheme
let valReprInfo =
let valReprInfoOpt =
partialArityInfoOpt
|> Option.map (InferGenericArityFromTyScheme typeScheme)

let valReprInfo, valReprInfoForDisplay =
if DeclKind.MustHaveArity declKind then
Option.map (InferGenericArityFromTyScheme typeScheme) partialArityInfoOpt
valReprInfoOpt, None
else
None
None, valReprInfoOpt
let isTyFunc = ComputeIsTyFunc(id, hasDeclaredTypars, valReprInfo)
ValScheme(id, typeScheme, valReprInfo, memberInfoOpt, isMutable, inlineFlag, baseOrThis, vis, isCompGen, false, isTyFunc, hasDeclaredTypars)
ValScheme(id, typeScheme, valReprInfo, valReprInfoForDisplay, memberInfoOpt, isMutable, inlineFlag, baseOrThis, vis, isCompGen, false, isTyFunc, hasDeclaredTypars)

let UseCombinedArity g declKind rhsExpr prelimScheme =
let partialArityInfoOpt = CombineSyntacticAndInferredArities g declKind rhsExpr prelimScheme
let partialArityInfoOpt = CombineSyntacticAndInferredArities g rhsExpr prelimScheme
BuildValScheme declKind partialArityInfoOpt prelimScheme

let UseNoArity prelimScheme =
Expand Down Expand Up @@ -10229,7 +10239,7 @@ and TcNormalizedBinding declKind (cenv: cenv) env tpenv overallTy safeThisValOpt
| [] -> valSynData
| {Range=mHead} :: _ ->
let (SynValData(valMf, SynValInfo(args, SynArgInfo(attrs, opt, retId)), valId)) = valSynData
in SynValData(valMf, SynValInfo(args, SynArgInfo({Attributes=rotRetSynAttrs; Range=mHead} :: attrs, opt, retId)), valId)
SynValData(valMf, SynValInfo(args, SynArgInfo({Attributes=rotRetSynAttrs; Range=mHead} :: attrs, opt, retId)), valId)
retAttribs, valAttribs, valSynData

let isVolatile = HasFSharpAttribute g g.attrib_VolatileFieldAttribute valAttribs
Expand Down Expand Up @@ -10779,7 +10789,7 @@ and TcLetBinding cenv isUse env containerInfo declKind tpenv (synBinds, synBinds

// If the overall declaration is declaring statics or a module value, then force the patternInputTmp to also
// have representation as module value.
if (DeclKind.MustHaveArity declKind) then
if DeclKind.MustHaveArity declKind then
AdjustValToTopVal tmp altActualParent (InferArityOfExprBinding g AllowTypeDirectedDetupling.Yes tmp rhsExpr)

tmp, checkedPat
Expand Down Expand Up @@ -11355,9 +11365,9 @@ and AnalyzeAndMakeAndPublishRecursiveValue
// NOTE: top arity, type and typars get fixed-up after inference
let prelimTyscheme = GeneralizedType(enclosingDeclaredTypars@declaredTypars, ty)
let prelimValReprInfo = TranslateSynValInfo mBinding (TcAttributes cenv envinner) valSynInfo
let valReprInfo = UseSyntacticArity declKind prelimTyscheme prelimValReprInfo
let valReprInfo, valReprInfoForDisplay = UseSyntacticArity declKind prelimTyscheme prelimValReprInfo
let hasDeclaredTypars = not (List.isEmpty declaredTypars)
let prelimValScheme = ValScheme(bindingId, prelimTyscheme, valReprInfo, memberInfoOpt, false, inlineFlag, NormalVal, vis, false, false, false, hasDeclaredTypars)
let prelimValScheme = ValScheme(bindingId, prelimTyscheme, valReprInfo, valReprInfoForDisplay, memberInfoOpt, false, inlineFlag, NormalVal, vis, false, false, false, hasDeclaredTypars)

// Check the literal r.h.s., if any
let _, literalValue = TcLiteral cenv ty envinner tpenv (bindingAttribs, bindingExpr)
Expand Down
3 changes: 2 additions & 1 deletion src/Compiler/Checking/CheckExpressions.fsi
Original file line number Diff line number Diff line change
Expand Up @@ -584,12 +584,13 @@ type RecursiveBindingInfo =
[<Sealed>]
type CheckedBindingInfo

/// Represnts the results of the second phase of checking simple values
/// Represents the results of the second phase of checking simple values
type ValScheme =
| ValScheme of
id: Ident *
typeScheme: GeneralizedType *
valReprInfo: ValReprInfo option *
valReprInfoForDisplay: ValReprInfo option *
memberInfo: PrelimMemberInfo option *
isMutable: bool *
inlineInfo: ValInline *
Expand Down
8 changes: 4 additions & 4 deletions src/Compiler/Checking/CheckIncrementalClasses.fs
Original file line number Diff line number Diff line change
Expand Up @@ -133,7 +133,7 @@ let TcImplicitCtorLhs_Phase2A(cenv: cenv, env, tpenv, tcref: TyconRef, vis, attr
let prelimTyschemeG = GeneralizedType(copyOfTyconTypars, ctorTy)
let isComplete = ComputeIsComplete copyOfTyconTypars [] ctorTy
let varReprInfo = InferGenericArityFromTyScheme prelimTyschemeG prelimValReprInfo
let ctorValScheme = ValScheme(id, prelimTyschemeG, Some varReprInfo, Some memberInfo, false, ValInline.Never, NormalVal, vis, false, true, false, false)
let ctorValScheme = ValScheme(id, prelimTyschemeG, Some varReprInfo, None, Some memberInfo, false, ValInline.Never, NormalVal, vis, false, true, false, false)
let paramNames = varReprInfo.ArgNames
let xmlDoc = xmlDoc.ToXmlDoc(true, Some paramNames)
let ctorVal = MakeAndPublishVal cenv env (Parent tcref, false, ModuleOrMemberBinding, ValInRecScope isComplete, ctorValScheme, attribs, xmlDoc, None, false)
Expand All @@ -154,15 +154,15 @@ let TcImplicitCtorLhs_Phase2A(cenv: cenv, env, tpenv, tcref: TyconRef, vis, attr
let prelimValReprInfo = TranslateSynValInfo m (TcAttributes cenv env) valSynData
let prelimTyschemeG = GeneralizedType(copyOfTyconTypars, cctorTy)
let valReprInfo = InferGenericArityFromTyScheme prelimTyschemeG prelimValReprInfo
let cctorValScheme = ValScheme(id, prelimTyschemeG, Some valReprInfo, Some memberInfo, false, ValInline.Never, NormalVal, Some (SynAccess.Private Range.Zero), false, true, false, false)
let cctorValScheme = ValScheme(id, prelimTyschemeG, Some valReprInfo, None, Some memberInfo, false, ValInline.Never, NormalVal, Some (SynAccess.Private Range.Zero), false, true, false, false)

let cctorVal = MakeAndPublishVal cenv env (Parent tcref, false, ModuleOrMemberBinding, ValNotInRecScope, cctorValScheme, [(* no attributes*)], XmlDoc.Empty, None, false)
cctorArgs, cctorVal, cctorValScheme

let thisVal =
// --- Create this for use inside constructor
let thisId = ident ("this", m)
let thisValScheme = ValScheme(thisId, NonGenericTypeScheme thisTy, None, None, false, ValInline.Never, CtorThisVal, None, true, false, false, false)
let thisValScheme = ValScheme(thisId, NonGenericTypeScheme thisTy, None, None, None, false, ValInline.Never, CtorThisVal, None, true, false, false, false)
let thisVal = MakeAndPublishVal cenv env (ParentNone, false, ClassLetBinding false, ValNotInRecScope, thisValScheme, [], XmlDoc.Empty, None, false)
thisVal

Expand Down Expand Up @@ -350,7 +350,7 @@ type IncrClassReprInfo =

// NOTE: putting isCompilerGenerated=true here is strange. The method is not public, nor is
// it a "member" in the F# sense, but the F# spec says it is generated and it is reasonable to reflect on it.
let memberValScheme = ValScheme(id, prelimTyschemeG, Some valReprInfo, Some memberInfo, false, ValInline.Never, NormalVal, None, true (* isCompilerGenerated *), true (* isIncrClass *), false, false)
let memberValScheme = ValScheme(id, prelimTyschemeG, Some valReprInfo, None, Some memberInfo, false, ValInline.Never, NormalVal, None, true (* isCompilerGenerated *), true (* isIncrClass *), false, false)

let methodVal = MakeAndPublishVal cenv env (Parent tcref, false, ModuleOrMemberBinding, ValNotInRecScope, memberValScheme, v.Attribs, XmlDoc.Empty, None, false)

Expand Down
3 changes: 2 additions & 1 deletion src/Compiler/Checking/NicePrint.fs
Original file line number Diff line number Diff line change
Expand Up @@ -1270,7 +1270,8 @@ module PrintTastMemberOrVals =
let layoutNonMemberVal denv (tps, v: Val, tau, cxs) =
let env = SimplifyTypes.CollectInfo true [tau] cxs
let cxs = env.postfixConstraints
let argInfos, retTy = GetTopTauTypeInFSharpForm denv.g (arityOfVal v).ArgInfos tau v.Range
let valReprInfo = arityOfValForDisplay v
let argInfos, retTy = GetTopTauTypeInFSharpForm denv.g valReprInfo.ArgInfos tau v.Range
let nameL =

let tagF =
Expand Down
19 changes: 19 additions & 0 deletions src/Compiler/TypedTree/TypedTree.fs
Original file line number Diff line number Diff line change
Expand Up @@ -2488,6 +2488,9 @@ type ValOptionalData =
/// Used to implement [<ReflectedDefinition>]
mutable val_defn: Expr option

/// Records the "extra information" for a value compiled as a method (rather
/// than a closure or a local), including argument names, attributes etc.
//
// MUTABILITY CLEANUP: mutability of this field is used by
// -- adjustAllUsesOfRecValue
// -- TLR optimizations
Expand All @@ -2497,6 +2500,10 @@ type ValOptionalData =
// type-checked expression.
mutable val_repr_info: ValReprInfo option

/// Records the "extra information" for display purposes for expression-level function definitions
/// that may be compiled as closures (that is are not necessarily compiled as top-level methods).
mutable val_repr_info_for_display: ValReprInfo option

/// How visible is this?
/// MUTABILITY: for unpickle linkage
mutable val_access: Accessibility
Expand Down Expand Up @@ -2556,6 +2563,7 @@ type Val =
val_const = None
val_defn = None
val_repr_info = None
val_repr_info_for_display = None
val_access = TAccess []
val_xmldoc = XmlDoc.Empty
val_member_info = None
Expand Down Expand Up @@ -2620,6 +2628,11 @@ type Val =
| Some optData -> optData.val_repr_info
| _ -> None

member x.ValReprInfoForDisplay: ValReprInfo option =
match x.val_opt_data with
| Some optData -> optData.val_repr_info_for_display
| _ -> None

member x.Id = ident(x.LogicalName, x.Range)

/// Is this represented as a "top level" static binding (i.e. a static field, static member,
Expand Down Expand Up @@ -2998,6 +3011,11 @@ type Val =
| Some optData -> optData.val_repr_info <- info
| _ -> x.val_opt_data <- Some { Val.NewEmptyValOptData() with val_repr_info = info }

member x.SetValReprInfoForDisplay info =
match x.val_opt_data with
| Some optData -> optData.val_repr_info_for_display <- info
| _ -> x.val_opt_data <- Some { Val.NewEmptyValOptData() with val_repr_info_for_display = info }

member x.SetType ty = x.val_type <- ty

member x.SetOtherRange m =
Expand Down Expand Up @@ -3055,6 +3073,7 @@ type Val =
val_other_range = tg.val_other_range
val_const = tg.val_const
val_defn = tg.val_defn
val_repr_info_for_display = tg.val_repr_info_for_display
val_repr_info = tg.val_repr_info
val_access = tg.val_access
val_xmldoc = tg.val_xmldoc
Expand Down
13 changes: 13 additions & 0 deletions src/Compiler/TypedTree/TypedTree.fsi
Original file line number Diff line number Diff line change
Expand Up @@ -1777,8 +1777,15 @@ type ValOptionalData =
/// What is the original, unoptimized, closed-term definition, if any?
/// Used to implement [<ReflectedDefinition>]
mutable val_defn: Expr option

/// Records the "extra information" for a value compiled as a method (rather
/// than a closure or a local), including argument names, attributes etc.
mutable val_repr_info: ValReprInfo option

/// Records the "extra information" for display purposes for expression-level function definitions
/// that may be compiled as closures (that is are not necessarily compiled as top-level methods).
mutable val_repr_info_for_display: ValReprInfo option

/// How visible is this?
/// MUTABILITY: for unpickle linkage
mutable val_access: Accessibility
Expand Down Expand Up @@ -1888,6 +1895,8 @@ type Val =

member SetValReprInfo: info: ValReprInfo option -> unit

member SetValReprInfoForDisplay: info: ValReprInfo option -> unit

override ToString: unit -> string

/// How visible is this value, function or member?
Expand Down Expand Up @@ -2134,6 +2143,10 @@ type Val =
/// represent as "top level" bindings.
member ValReprInfo: ValReprInfo option

/// Records the "extra information" for display purposes for expression-level function definitions
/// that may be compiled as closures (that is are not necessarily compiled as top-level methods).
member ValReprInfoForDisplay: ValReprInfo option

/// Get the declared documentation for the value
member XmlDoc: XmlDoc

Expand Down
20 changes: 18 additions & 2 deletions src/Compiler/TypedTree/TypedTreeBasics.fs
Original file line number Diff line number Diff line change
Expand Up @@ -26,7 +26,7 @@ let getNameOfScopeRef sref =
| ILScopeRef.Assembly aref -> aref.Name
| ILScopeRef.PrimaryAssembly -> "<primary>"

/// Metadata on values (names of arguments etc.
/// Metadata on values (names of arguments etc.)
module ValReprInfo =

let unnamedTopArg1: ArgReprInfo = { Attribs=[]; Name=None }
Expand All @@ -41,6 +41,11 @@ module ValReprInfo =

let emptyValData = ValReprInfo([], [], unnamedRetVal)

let IsEmpty info =
match info with
| ValReprInfo([], [], { Attribs = []; Name=None }) -> true
| _ -> false

let InferTyparInfo (tps: Typar list) = tps |> List.map (fun tp -> TyparReprInfo(tp.Id, tp.Kind))

let InferArgReprInfo (v: Val) : ArgReprInfo = { Attribs = []; Name= Some v.Id }
Expand All @@ -59,7 +64,18 @@ let typesOfVals (v: Val list) = v |> List.map (fun v -> v.Type)

let nameOfVal (v: Val) = v.LogicalName

let arityOfVal (v: Val) = (match v.ValReprInfo with None -> ValReprInfo.emptyValData | Some arities -> arities)
let arityOfVal (v: Val) =
match v.ValReprInfo with
| None -> ValReprInfo.emptyValData
| Some info -> info

let arityOfValForDisplay (v: Val) =
match v.ValReprInfoForDisplay with
| Some info -> info
| None ->
match v.ValReprInfo with
| None -> ValReprInfo.emptyValData
| Some info -> info

let tupInfoRef = TupInfo.Const false

Expand Down
Loading