From 20257d2e037332f77ee75169f4a1dc9caf0be882 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Sat, 12 May 2018 13:26:26 +0100 Subject: [PATCH 1/2] rename and cleanup --- src/absil/il.fs | 40 ++++++------ src/fsharp/Optimizer.fs | 6 +- src/fsharp/TastOps.fs | 31 ++++----- src/fsharp/TastOps.fsi | 6 +- src/fsharp/TypeChecker.fs | 6 +- src/fsharp/tast.fs | 128 +++++++++++++++++++++++++++++--------- 6 files changed, 143 insertions(+), 74 deletions(-) diff --git a/src/absil/il.fs b/src/absil/il.fs index cfe88edba0a..53402a182d1 100644 --- a/src/absil/il.fs +++ b/src/absil/il.fs @@ -633,8 +633,6 @@ and static member Create(tref,inst) = { tspecTypeRef =tref; tspecInst=inst } - override x.ToString() = x.TypeRef.ToString() + if isNil x.GenericArgs then "" else "<...>" - member x.BasicQualifiedName = let tc = x.TypeRef.BasicQualifiedName if isNil x.GenericArgs then @@ -647,6 +645,8 @@ and member x.FullName=x.TypeRef.FullName + override x.ToString() = x.TypeRef.ToString() + if isNil x.GenericArgs then "" else "<...>" + and [] ILType = | Void @@ -685,34 +685,34 @@ and [] x.AddQualifiedNameExtension(x.BasicQualifiedName) member x.TypeSpec = - match x with - | ILType.Boxed tr | ILType.Value tr -> tr - | _ -> invalidOp "not a nominal type" + match x with + | ILType.Boxed tr | ILType.Value tr -> tr + | _ -> invalidOp "not a nominal type" member x.Boxity = - match x with - | ILType.Boxed _ -> AsObject - | ILType.Value _ -> AsValue - | _ -> invalidOp "not a nominal type" + match x with + | ILType.Boxed _ -> AsObject + | ILType.Value _ -> AsValue + | _ -> invalidOp "not a nominal type" member x.TypeRef = - match x with - | ILType.Boxed tspec | ILType.Value tspec -> tspec.TypeRef - | _ -> invalidOp "not a nominal type" + match x with + | ILType.Boxed tspec | ILType.Value tspec -> tspec.TypeRef + | _ -> invalidOp "not a nominal type" member x.IsNominal = - match x with - | ILType.Boxed _ | ILType.Value _ -> true - | _ -> false + match x with + | ILType.Boxed _ | ILType.Value _ -> true + | _ -> false member x.GenericArgs = - match x with - | ILType.Boxed tspec | ILType.Value tspec -> tspec.GenericArgs - | _ -> [] + match x with + | ILType.Boxed tspec | ILType.Value tspec -> tspec.GenericArgs + | _ -> [] member x.IsTyvar = - match x with - | ILType.TypeVar _ -> true | _ -> false + match x with + | ILType.TypeVar _ -> true | _ -> false and [] ILCallingSignature = diff --git a/src/fsharp/Optimizer.fs b/src/fsharp/Optimizer.fs index 308736ddbd4..858a190aa61 100644 --- a/src/fsharp/Optimizer.fs +++ b/src/fsharp/Optimizer.fs @@ -1261,9 +1261,9 @@ and OpHasEffect g op = | TOp.Recd (ctor, tcref) -> match ctor with | RecdExprIsObjInit -> true - | RecdExpr -> isRecdOrUnionOrStructTyconRefAllocObservable g tcref - | TOp.UnionCase ucref -> isRecdOrUnionOrStructTyconRefAllocObservable g ucref.TyconRef - | TOp.ExnConstr ecref -> isExnAllocObservable ecref + | RecdExpr -> isRecdOrUnionOrStructTyconRefDefinitelyMutable g tcref + | TOp.UnionCase ucref -> isRecdOrUnionOrStructTyconRefDefinitelyMutable g ucref.TyconRef + | TOp.ExnConstr ecref -> isExnDefinitelyMutable ecref | TOp.Bytes _ | TOp.UInt16s _ | TOp.Array -> true (* alloc observable *) | TOp.UnionCaseTagGet _ -> false | TOp.UnionCaseProof _ -> false diff --git a/src/fsharp/TastOps.fs b/src/fsharp/TastOps.fs index 55dd3af0459..bcffa8d3a34 100644 --- a/src/fsharp/TastOps.fs +++ b/src/fsharp/TastOps.fs @@ -5217,27 +5217,28 @@ and remarkBind m (TBind(v, repr, _)) = //-------------------------------------------------------------------------- -// Reference semantics? +// Mutability analysis //-------------------------------------------------------------------------- -let isRecdOrStructFieldAllocObservable (f:RecdField) = not f.IsStatic && f.IsMutable -let isUnionCaseAllocObservable (uc:UnionCase) = uc.FieldTable.FieldsByIndex |> Array.exists isRecdOrStructFieldAllocObservable -let isUnionCaseRefAllocObservable (uc:UnionCaseRef) = uc.UnionCase |> isUnionCaseAllocObservable +let isRecdOrStructFieldDefinitelyMutable (f:RecdField) = not f.IsStatic && f.IsMutable +let isUnionCaseDefinitelyMutable (uc:UnionCase) = uc.FieldTable.FieldsByIndex |> Array.exists isRecdOrStructFieldDefinitelyMutable +let isUnionCaseRefDefinitelyMutable (uc:UnionCaseRef) = uc.UnionCase |> isUnionCaseDefinitelyMutable -let isRecdOrUnionOrStructTyconAllocObservable (_g:TcGlobals) (tycon:Tycon) = +/// This is an incomplete check for .NET struct types. Returning 'false' doesn't mean the thing is immutable. +let isRecdOrUnionOrStructTyconDefinitelyMutable (_g:TcGlobals) (tycon:Tycon) = if tycon.IsUnionTycon then - tycon.UnionCasesArray |> Array.exists isUnionCaseAllocObservable + tycon.UnionCasesArray |> Array.exists isUnionCaseDefinitelyMutable elif tycon.IsRecordTycon || tycon.IsStructOrEnumTycon then - tycon.AllFieldsArray |> Array.exists isRecdOrStructFieldAllocObservable + tycon.AllFieldsArray |> Array.exists isRecdOrStructFieldDefinitelyMutable else false -let isRecdOrUnionOrStructTyconRefAllocObservable g (tcr : TyconRef) = isRecdOrUnionOrStructTyconAllocObservable g tcr.Deref +let isRecdOrUnionOrStructTyconRefDefinitelyMutable g (tcr : TyconRef) = isRecdOrUnionOrStructTyconDefinitelyMutable g tcr.Deref // Although from the pure F# perspective exception values cannot be changed, the .NET // implementation of exception objects attaches a whole bunch of stack information to // each raised object. Hence we treat exception objects as if they have identity -let isExnAllocObservable (_ecref:TyconRef) = true +let isExnDefinitelyMutable (_ecref:TyconRef) = true // Some of the implementations of library functions on lists use mutation on the tail // of the cons cell. These cells are always private, i.e. not accessible by any other @@ -5556,11 +5557,11 @@ let mkAndSimplifyMatch spBind exprm matchm ty tree targets = type Mutates = DefinitelyMutates | PossiblyMutates | NeverMutates exception DefensiveCopyWarning of string * range -let isRecdOrStructTyImmutable g ty = +let isRecdOrStructTyReadOnly g ty = match tryDestAppTy g ty with | None -> false | Some tcref -> - not (isRecdOrUnionOrStructTyconRefAllocObservable g tcref) || + not (isRecdOrUnionOrStructTyconRefDefinitelyMutable g tcref) || tyconRefEq g tcref g.decimal_tcr || tyconRefEq g tcref g.date_tcr @@ -5575,7 +5576,7 @@ let isRecdOrStructTyImmutable g ty = // let g1 = A.G(1) // (fun () -> g1.x1) // -// Note: isRecdOrStructTyImmutable implies PossiblyMutates or NeverMutates +// Note: isRecdOrStructTyReadOnly implies PossiblyMutates or NeverMutates // // We only do this for true local or closure fields because we can't take addresses of immutable static // fields across assemblies. @@ -5586,7 +5587,7 @@ let CanTakeAddressOfImmutableVal g (v:ValRef) mut = not v.IsMemberOrModuleBinding && (match mut with | NeverMutates -> true - | PossiblyMutates -> isRecdOrStructTyImmutable g v.Type + | PossiblyMutates -> isRecdOrStructTyReadOnly g v.Type | DefinitelyMutates -> false) let MustTakeAddressOfVal (g:TcGlobals) (v:ValRef) = @@ -5605,13 +5606,13 @@ let CanTakeAddressOfRecdFieldRef (g:TcGlobals) (rfref: RecdFieldRef) mut tinst = mut <> DefinitelyMutates && // We only do this if the field is defined in this assembly because we can't take addresses across assemblies for immutable fields entityRefInThisAssembly g.compilingFslib rfref.TyconRef && - isRecdOrStructTyImmutable g (actualTyOfRecdFieldRef rfref tinst) + isRecdOrStructTyReadOnly g (actualTyOfRecdFieldRef rfref tinst) let CanTakeAddressOfUnionFieldRef (g:TcGlobals) (uref: UnionCaseRef) mut tinst cidx = mut <> DefinitelyMutates && // We only do this if the field is defined in this assembly because we can't take addresses across assemblies for immutable fields entityRefInThisAssembly g.compilingFslib uref.TyconRef && - isRecdOrStructTyImmutable g (actualTyOfUnionFieldRef uref cidx tinst) + isRecdOrStructTyReadOnly g (actualTyOfUnionFieldRef uref cidx tinst) let rec mkExprAddrOfExprAux g mustTakeAddress useReadonlyForGenericArrayAddress mut e addrExprVal m = diff --git a/src/fsharp/TastOps.fsi b/src/fsharp/TastOps.fsi index 63ee7ee670a..4325f04cfa6 100755 --- a/src/fsharp/TastOps.fsi +++ b/src/fsharp/TastOps.fsi @@ -1091,9 +1091,9 @@ val TypeHasDefaultValue : TcGlobals -> range -> TType -> bool val isAbstractTycon : Tycon -> bool -val isUnionCaseRefAllocObservable : UnionCaseRef -> bool -val isRecdOrUnionOrStructTyconRefAllocObservable : TcGlobals -> TyconRef -> bool -val isExnAllocObservable : TyconRef -> bool +val isUnionCaseRefDefinitelyMutable : UnionCaseRef -> bool +val isRecdOrUnionOrStructTyconRefDefinitelyMutable : TcGlobals -> TyconRef -> bool +val isExnDefinitelyMutable : TyconRef -> bool val isUnionCaseFieldMutable : TcGlobals -> UnionCaseRef -> int -> bool val isExnFieldMutable : TyconRef -> int -> bool diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index b2afcc0b0bd..79d084e2edb 100755 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -2169,13 +2169,13 @@ module GeneralizationHelpers = | Expr.Op(op, _, args, _) -> match op with | TOp.Tuple _ -> true - | TOp.UnionCase uc -> not (isUnionCaseRefAllocObservable uc) + | TOp.UnionCase uc -> not (isUnionCaseRefDefinitelyMutable uc) | TOp.Recd(ctorInfo, tcref) -> match ctorInfo with - | RecdExpr -> not (isRecdOrUnionOrStructTyconRefAllocObservable g tcref) + | RecdExpr -> not (isRecdOrUnionOrStructTyconRefDefinitelyMutable g tcref) | RecdExprIsObjInit -> false | TOp.Array -> isNil args - | TOp.ExnConstr ec -> not (isExnAllocObservable ec) + | TOp.ExnConstr ec -> not (isExnDefinitelyMutable ec) | TOp.ILAsm([], _) -> true diff --git a/src/fsharp/tast.fs b/src/fsharp/tast.fs index 460da789220..35acae837fc 100644 --- a/src/fsharp/tast.fs +++ b/src/fsharp/tast.fs @@ -198,7 +198,7 @@ type ValFlags(flags:int64) = | _ -> failwith "unreachable" - member x.SetIsMemberOrModuleBinding = ValFlags(flags ||| 0b0000000000010000000L) + member x.WithIsMemberOrModuleBinding = ValFlags(flags ||| 0b0000000000010000000L) member x.IsExtensionMember = (flags &&& 0b0000000000100000000L) <> 0L @@ -211,7 +211,7 @@ type ValFlags(flags:int64) = | 0b0000001000000000000L -> ValInRecScope(false) | _ -> failwith "unreachable" - member x.SetRecursiveValInfo(recValInfo) = + member x.WithRecursiveValInfo(recValInfo) = let flags = (flags &&& ~~~0b0000001100000000000L) ||| (match recValInfo with @@ -222,23 +222,23 @@ type ValFlags(flags:int64) = member x.MakesNoCriticalTailcalls = (flags &&& 0b0000010000000000000L) <> 0L - member x.SetMakesNoCriticalTailcalls = ValFlags(flags ||| 0b0000010000000000000L) + member x.WithMakesNoCriticalTailcalls = ValFlags(flags ||| 0b0000010000000000000L) member x.PermitsExplicitTypeInstantiation = (flags &&& 0b0000100000000000000L) <> 0L member x.HasBeenReferenced = (flags &&& 0b0001000000000000000L) <> 0L - member x.SetHasBeenReferenced = ValFlags(flags ||| 0b0001000000000000000L) + member x.WithHasBeenReferenced = ValFlags(flags ||| 0b0001000000000000000L) member x.IsCompiledAsStaticPropertyWithoutField = (flags &&& 0b0010000000000000000L) <> 0L - member x.SetIsCompiledAsStaticPropertyWithoutField = ValFlags(flags ||| 0b0010000000000000000L) + member x.WithIsCompiledAsStaticPropertyWithoutField = ValFlags(flags ||| 0b0010000000000000000L) member x.IsGeneratedEventVal = (flags &&& 0b0100000000000000000L) <> 0L member x.IsFixed = (flags &&& 0b1000000000000000000L) <> 0L - member x.SetIsFixed = ValFlags(flags ||| 0b1000000000000000000L) + member x.WithIsFixed = ValFlags(flags ||| 0b1000000000000000000L) /// Get the flags as included in the F# binary metadata @@ -364,32 +364,32 @@ type TyparFlags(flags:int32) = type EntityFlags(flags:int64) = new (usesPrefixDisplay, isModuleOrNamespace, preEstablishedHasDefaultCtor, hasSelfReferentialCtor, isStructRecordOrUnionType) = - EntityFlags((if isModuleOrNamespace then 0b00000000001L else 0L) ||| - (if usesPrefixDisplay then 0b00000000010L else 0L) ||| - (if preEstablishedHasDefaultCtor then 0b00000000100L else 0L) ||| - (if hasSelfReferentialCtor then 0b00000001000L else 0L) ||| - (if isStructRecordOrUnionType then 0b00000100000L else 0L)) - - member x.IsModuleOrNamespace = (flags &&& 0b00000000001L) <> 0x0L - member x.IsPrefixDisplay = (flags &&& 0b00000000010L) <> 0x0L + EntityFlags((if isModuleOrNamespace then 0b000000000000001L else 0L) ||| + (if usesPrefixDisplay then 0b000000000000010L else 0L) ||| + (if preEstablishedHasDefaultCtor then 0b000000000000100L else 0L) ||| + (if hasSelfReferentialCtor then 0b000000000001000L else 0L) ||| + (if isStructRecordOrUnionType then 0b000000000100000L else 0L)) + + member x.IsModuleOrNamespace = (flags &&& 0b000000000000001L) <> 0x0L + member x.IsPrefixDisplay = (flags &&& 0b000000000000010L) <> 0x0L // This bit is not pickled, only used while establishing a type constructor. It is needed because the type constructor // is known to satisfy the default constructor constraint even before any of its members have been established. - member x.PreEstablishedHasDefaultConstructor = (flags &&& 0b00000000100L) <> 0x0L + member x.PreEstablishedHasDefaultConstructor = (flags &&& 0b000000000000100L) <> 0x0L // This bit represents an F# specific condition where a type has at least one constructor that may access // the 'this' pointer prior to successful initialization of the partial contents of the object. In this // case sub-classes must protect themselves against early access to their contents. - member x.HasSelfReferentialConstructor = (flags &&& 0b00000001000L) <> 0x0L + member x.HasSelfReferentialConstructor = (flags &&& 0b000000000001000L) <> 0x0L /// This bit represents a F# record that is a value type, or a struct record. - member x.IsStructRecordOrUnionType = (flags &&& 0b00000100000L) <> 0x0L + member x.IsStructRecordOrUnionType = (flags &&& 0b000000000100000L) <> 0x0L /// This bit is reserved for us in the pickle format, see pickle.fs, it's being listed here to stop it ever being used for anything else - static member ReservedBitForPickleFormatTyconReprFlag = 0b00000010000L + static member ReservedBitForPickleFormatTyconReprFlag = 0b000000000010000L /// Get the flags as included in the F# binary metadata - member x.PickledBits = (flags &&& ~~~0b00000000100L) + member x.PickledBits = (flags &&& ~~~0b000000000000100L) #if DEBUG @@ -2723,17 +2723,17 @@ and [] member x.DisplayName = DemangleOperatorName x.CoreDisplayName - member x.SetValRec b = x.val_flags <- x.val_flags.SetRecursiveValInfo b + member x.SetValRec b = x.val_flags <- x.val_flags.WithRecursiveValInfo b - member x.SetIsMemberOrModuleBinding() = x.val_flags <- x.val_flags.SetIsMemberOrModuleBinding + member x.SetIsMemberOrModuleBinding() = x.val_flags <- x.val_flags.WithIsMemberOrModuleBinding - member x.SetMakesNoCriticalTailcalls() = x.val_flags <- x.val_flags.SetMakesNoCriticalTailcalls + member x.SetMakesNoCriticalTailcalls() = x.val_flags <- x.val_flags.WithMakesNoCriticalTailcalls - member x.SetHasBeenReferenced() = x.val_flags <- x.val_flags.SetHasBeenReferenced + member x.SetHasBeenReferenced() = x.val_flags <- x.val_flags.WithHasBeenReferenced - member x.SetIsCompiledAsStaticPropertyWithoutField() = x.val_flags <- x.val_flags.SetIsCompiledAsStaticPropertyWithoutField + member x.SetIsCompiledAsStaticPropertyWithoutField() = x.val_flags <- x.val_flags.WithIsCompiledAsStaticPropertyWithoutField - member x.SetIsFixed() = x.val_flags <- x.val_flags.SetIsFixed + member x.SetIsFixed() = x.val_flags <- x.val_flags.WithIsFixed member x.SetValReprInfo info = match x.val_opt_data with @@ -3980,24 +3980,34 @@ and PickledCcuInfo = and Attribs = Attrib list and AttribKind = + /// Indicates an attribute refers to a type defined in an imported .NET assembly | ILAttrib of ILMethodRef + /// Indicates an attribute refers to a type defined in an imported F# assembly | FSAttrib of ValRef + override x.ToString() = sprintf "AttribKind(...)" + /// Attrib(kind,unnamedArgs,propVal,appliedToAGetterOrSetter,targetsOpt,range) and Attrib = | Attrib of TyconRef * AttribKind * AttribExpr list * AttribNamedArg list * bool * AttributeTargets option * range + override x.ToString() = sprintf "Attrib(...)" + /// We keep both source expression and evaluated expression around to help intellisense and signature printing and AttribExpr = /// AttribExpr(source, evaluated) | AttribExpr of Expr * Expr + override x.ToString() = sprintf "AttribExpr(...)" + /// AttribNamedArg(name,type,isField,value) and AttribNamedArg = | AttribNamedArg of (string*TType*bool*AttribExpr) + override x.ToString() = sprintf "AttribNamedArg(...)" + /// Constants in expressions and [] Const = @@ -4019,7 +4029,6 @@ and [] | Decimal of Decimal | Unit | Zero // null/zero-bit-pattern - /// Decision trees. Pattern matching has been compiled down to /// a decision tree by this point. The right-hand-sides (actions) of @@ -4055,6 +4064,8 @@ and /// body -- the rest of the decision tree | TDBind of Binding * DecisionTree + override x.ToString() = sprintf "DecisionTree(...)" + /// Represents a test and a subsequent decision tree and DecisionTreeCase = | TCase of DecisionTreeTest * DecisionTree @@ -4065,6 +4076,8 @@ and DecisionTreeCase = /// Get the decision tree or a successful test member x.CaseTree = let (TCase(_,d)) = x in d + override x.ToString() = sprintf "DecisionTreeCase(...)" + and [] DecisionTreeTest = @@ -4096,11 +4109,14 @@ and /// activePatternInfo -- The extracted info for the active pattern. | ActivePatternCase of Expr * TTypes * (ValRef * TypeInst) option * int * ActivePatternInfo + override x.ToString() = sprintf "DecisionTreeTest(...)" /// A target of a decision tree. Can be thought of as a little function, though is compiled as a local block. and DecisionTreeTarget = | TTarget of Vals * Expr * SequencePointInfoForTarget + override x.ToString() = sprintf "DecisionTreeTarget(...)" + /// A collection of simultaneous bindings and Bindings = Binding list @@ -4116,7 +4132,9 @@ and Binding = /// The information about whether to emit a sequence point for the binding member x.SequencePointInfo = (let (TBind(_,_,sp)) = x in sp) - + + override x.ToString() = sprintf "TBind(%s, ...)" x.Var.CompiledName + /// Represents a reference to an active pattern element. The /// integer indicates which choice in the target set is being selected by this item. and ActivePatternElemRef = @@ -4131,6 +4149,8 @@ and ActivePatternElemRef = /// Get the index of the active pattern element within the overall active pattern member x.CaseIndex = (let (APElemRef(_,_,n)) = x in n) + override __.ToString() = "ActivePatternElemRef(...)" + /// Records the "extra information" for a value compiled as a method (rather /// than a closure or a local), including argument names, attributes etc. and ValReprInfo = @@ -4168,6 +4188,8 @@ and ValReprInfo = | (_::_::h)::t -> loop t (acc + h.Length + 2) loop args 0 + override __.ToString() = "ValReprInfo(...)" + /// Records the "extra information" for an argument compiled as a real /// method argument, specifically the argument name and attributes. and @@ -4180,6 +4202,8 @@ and // MUTABILITY: used when propagating names of parameters from signature into the implementation. mutable Name : Ident option } + override __.ToString() = "ArgReprInfo(...)" + /// Records the extra metadata stored about typars for type parameters /// compiled as "real" IL type parameters, specifically for values with /// ValReprInfo. Any information here is propagated from signature through @@ -4274,6 +4298,8 @@ and /// appropriate type instantiation. These are immediately eliminated on subsequent rewrites. | Link of Expr ref + override __.ToString() = "Expr(...)" + and [] TOp = @@ -4386,6 +4412,7 @@ and /// retTy -- the types of pushed values, if any | ILCall of bool * bool * bool * bool * ValUseFlag * bool * bool * ILMethodRef * TypeInst * TypeInst * TTypes + override __.ToString() = "TOp(...)" /// Indicates the kind of record construction operation. and RecordConstructionInfo = @@ -4395,7 +4422,6 @@ and RecordConstructionInfo = /// Normal record construction | RecdExpr - /// If this is Some(ty) then it indicates that a .NET 2.0 constrained call is required, with the given type as the /// static type of the object argument. @@ -4464,7 +4490,9 @@ and ValUseFlag = /// Indicates the kind of an F# core library static optimization construct and StaticOptimization = + | TTyconEqualsTycon of TType * TType + | TTyconIsStruct of TType /// A representation of a method in an object expression. @@ -4474,25 +4502,38 @@ and ObjExprMethod = | TObjExprMethod of SlotSig * Attribs * Typars * Val list list * Expr * range member x.Id = let (TObjExprMethod(slotsig,_,_,_,_,m)) = x in mkSynId m slotsig.Name + override x.ToString() = sprintf "TObjExprMethod(%s, ...)" x.Id.idText + /// Represents an abstract method slot, or delegate signature. /// /// TSlotSig(methodName,declaringType,declaringTypeParameters,methodTypeParameters,slotParameters,returnTy) and SlotSig = | TSlotSig of string * TType * Typars * Typars * SlotParam list list * TType option + member ss.Name = let (TSlotSig(nm,_,_,_,_,_)) = ss in nm + member ss.ImplementedType = let (TSlotSig(_,ty,_,_,_,_)) = ss in ty + member ss.ClassTypars = let (TSlotSig(_,_,ctps,_,_,_)) = ss in ctps + member ss.MethodTypars = let (TSlotSig(_,_,_,mtps,_,_)) = ss in mtps + member ss.FormalParams = let (TSlotSig(_,_,_,_,ps,_)) = ss in ps + member ss.FormalReturnType = let (TSlotSig(_,_,_,_,_,rt)) = ss in rt + override ss.ToString() = sprintf "TSlotSig(%s, ...)" ss.Name + /// Represents a parameter to an abstract method slot. /// /// TSlotParam(nm,ty,inFlag,outFlag,optionalFlag,attribs) and SlotParam = | TSlotParam of string option * TType * bool (* in *) * bool (* out *) * bool (* optional *) * Attribs + member x.Type = let (TSlotParam(_,ty,_,_,_,_)) = x in ty + override x.ToString() = "TSlotParam(...)" + /// A type for a module-or-namespace-fragment and the actual definition of the module-or-namespace-fragment /// The first ModuleOrNamespaceType is the signature and is a binder. However the bindings are not used in the ModuleOrNamespaceExpr: it is only referenced from the 'outside' /// is for use by FCS only to report the "hidden" contents of the assembly prior to applying the signature. @@ -4501,8 +4542,11 @@ and ModuleOrNamespaceExprWithSig = ModuleOrNamespaceType * ModuleOrNamespaceExpr * range + member x.Type = let (ModuleOrNamespaceExprWithSig(mtyp,_,_)) = x in mtyp + override x.ToString() = "ModuleOrNamespaceExprWithSig(...)" + /// The contents of a module-or-namespace-fragment definition and ModuleOrNamespaceExpr = /// Indicates the module is a module with a signature @@ -4520,6 +4564,8 @@ and ModuleOrNamespaceExpr = /// Indicates the module fragment is a 'rec' or 'non-rec' definition of types and modules | TMDefRec of isRec:bool * Tycon list * ModuleOrNamespaceBinding list * range + override x.ToString() = "ModuleOrNamespaceExpr(...)" + /// A named module-or-namespace-fragment definition and [] ModuleOrNamespaceBinding = @@ -4533,15 +4579,23 @@ and [] /// This is the body of the module/namespace ModuleOrNamespaceExpr + override x.ToString() = "ModuleOrNamespaceBinding(...)" + /// Represents a complete typechecked implementation file, including its typechecked signature if any. /// /// TImplFile(qualifiedNameOfFile,pragmas,implementationExpressionWithSignature,hasExplicitEntryPoint,isScript) -and TypedImplFile = TImplFile of QualifiedNameOfFile * ScopedPragma list * ModuleOrNamespaceExprWithSig * bool * bool +and TypedImplFile = + | TImplFile of QualifiedNameOfFile * ScopedPragma list * ModuleOrNamespaceExprWithSig * bool * bool + + override x.ToString() = "TImplFile(...)" /// Represents a complete typechecked assembly, made up of multiple implementation files. /// -and TypedAssemblyAfterOptimization = TypedAssemblyAfterOptimization of (TypedImplFile * (* optimizeDuringCodeGen: *) (Expr -> Expr)) list +and TypedAssemblyAfterOptimization = + | TypedAssemblyAfterOptimization of (TypedImplFile * (* optimizeDuringCodeGen: *) (Expr -> Expr)) list + + override x.ToString() = "TypedAssemblyAfterOptimization(...)" //--------------------------------------------------------------------------- // Freevars. Computed and cached by later phases (never computed type checking). Cached in terms. Not pickled. @@ -4578,6 +4632,7 @@ and FreeTyvars = /// and we have to check various conditions associated with that. FreeTypars: FreeTypars } + override x.ToString() = "FreeTyvars(...)" /// Represents an amortized computation of the free variables in an expression and FreeVarsCache = FreeVars cache @@ -4611,6 +4666,8 @@ and FreeVars = /// See FreeTyvars above. FreeTyvars: FreeTyvars } + override x.ToString() = "FreeVars(...)" + /// Specifies the compiled representations of type and exception definitions. Basically /// just an ILTypeRef. Computed and cached by later phases. Stored in /// type and exception definitions. Not pickled. Store an optional ILType object for @@ -4639,6 +4696,8 @@ and [] // type ilsigptr<'T> = (# "!0*" #) | ILAsmOpen of ILType + override x.ToString() = "CompiledTypeRepr(...)" + //--------------------------------------------------------------------------- // Basic properties on type definitions //--------------------------------------------------------------------------- @@ -4647,16 +4706,25 @@ and [] /// Metadata on values (names of arguments etc. [] module ValReprInfo = + let unnamedTopArg1 : ArgReprInfo = { Attribs=[]; Name=None } + let unnamedTopArg = [unnamedTopArg1] + let unitArgData : ArgReprInfo list list = [[]] + let unnamedRetVal : ArgReprInfo = { Attribs = []; Name=None } + let selfMetadata = unnamedTopArg + let emptyValData = ValReprInfo([],[],unnamedRetVal) 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 } + let InferArgReprInfos (vs:Val list list) = ValReprInfo([],List.mapSquared InferArgReprInfo vs,unnamedRetVal) + let HasNoArgs (ValReprInfo(n,args,_)) = n.IsEmpty && args.IsEmpty //--------------------------------------------------------------------------- From b735db412464f34525414fea47e02b88a2c91d0e Mon Sep 17 00:00:00 2001 From: Don Syme Date: Sat, 12 May 2018 13:36:16 +0100 Subject: [PATCH 2/2] rename and cleanup and docs --- src/fsharp/tast.fs | 111 ++++++++++++++++++++++++++++++++++----------- 1 file changed, 85 insertions(+), 26 deletions(-) diff --git a/src/fsharp/tast.fs b/src/fsharp/tast.fs index 35acae837fc..2910388fd5e 100644 --- a/src/fsharp/tast.fs +++ b/src/fsharp/tast.fs @@ -58,12 +58,16 @@ type StampMap<'T> = Map [] type ValInline = + /// Indicates the value must always be inlined and no .NET IL code is generated for the value/function | PseudoVal + /// Indicates the value is inlined but the .NET IL code for the function still exists, e.g. to satisfy interfaces on objects, but that it is also always inlined | Always + /// Indicates the value may optionally be inlined by the optimizer | Optional + /// Indicates the value must never be inlined by the optimizer | Never @@ -76,8 +80,10 @@ type ValInline = /// A flag associated with values that indicates whether the recursive scope of the value is currently being processed, and /// if the value has been generalized or not as yet. type ValRecursiveScopeInfo = + /// Set while the value is within its recursive scope. The flag indicates if the value has been eagerly generalized and accepts generic-recursive calls | ValInRecScope of bool + /// The normal value for this flag when the value is not within its recursive scope | ValNotInRecScope @@ -88,27 +94,30 @@ type ValMutability = [] /// Indicates if a type parameter is needed at runtime and may not be eliminated type TyparDynamicReq = + /// Indicates the type parameter is not needed at runtime and may be eliminated | No + /// Indicates the type parameter is needed at runtime and may not be eliminated | Yes type ValBaseOrThisInfo = + /// Indicates a ref-cell holding 'this' or the implicit 'this' used throughout an /// implicit constructor to access and set values | CtorThisVal + /// Indicates the value called 'base' available for calling base class members | BaseVal + /// Indicates a normal value | NormalVal + /// Indicates the 'this' value specified in a memberm e.g. 'x' in 'member x.M() = 1' | MemberThisVal -//--------------------------------------------------------------------------- -// Flags on values -//--------------------------------------------------------------------------- - [] +/// Flags on values type ValFlags(flags:int64) = new (recValInfo, baseOrThis, isCompGen, inlineInfo, isMutable, isModuleOrMemberBinding, isExtensionMember, isIncrClassSpecialMember, isTyFunc, allowTypeInst, isGeneratedEventVal) = @@ -202,7 +211,9 @@ type ValFlags(flags:int64) = member x.IsExtensionMember = (flags &&& 0b0000000000100000000L) <> 0L + member x.IsIncrClassSpecialMember = (flags &&& 0b0000000001000000000L) <> 0L + member x.IsTypeFunction = (flags &&& 0b0000000010000000000L) <> 0L member x.RecursiveValInfo = match (flags &&& 0b0000001100000000000L) with @@ -225,6 +236,7 @@ type ValFlags(flags:int64) = member x.WithMakesNoCriticalTailcalls = ValFlags(flags ||| 0b0000010000000000000L) member x.PermitsExplicitTypeInstantiation = (flags &&& 0b0000100000000000000L) <> 0L + member x.HasBeenReferenced = (flags &&& 0b0001000000000000000L) <> 0L member x.WithHasBeenReferenced = ValFlags(flags ||| 0b0001000000000000000L) @@ -232,7 +244,6 @@ type ValFlags(flags:int64) = member x.IsCompiledAsStaticPropertyWithoutField = (flags &&& 0b0010000000000000000L) <> 0L member x.WithIsCompiledAsStaticPropertyWithoutField = ValFlags(flags ||| 0b0010000000000000000L) - member x.IsGeneratedEventVal = (flags &&& 0b0100000000000000000L) <> 0L @@ -240,7 +251,6 @@ type ValFlags(flags:int64) = member x.WithIsFixed = ValFlags(flags ||| 0b1000000000000000000L) - /// Get the flags as included in the F# binary metadata member x.PickledBits = // Clear the RecursiveValInfo, only used during inference and irrelevant across assembly boundaries @@ -252,7 +262,9 @@ type ValFlags(flags:int64) = /// Represents the kind of a type parameter [] type TyparKind = + | Type + | Measure member x.AttrName = @@ -269,19 +281,27 @@ type TyparKind = /// Indicates if the type variable can be solved or given new constraints. The status of a type variable /// evolves towards being either rigid or solved. type TyparRigidity = + /// Indicates the type parameter can't be solved | Rigid + /// Indicates the type parameter can't be solved, but the variable is not set to "rigid" until after inference is complete | WillBeRigid + /// Indicates we give a warning if the type parameter is ever solved | WarnIfNotRigid + /// Indicates the type parameter is an inference variable may be solved | Flexible + /// Indicates the type parameter derives from an '_' anonymous type /// For units-of-measure, we give a warning if this gets solved to '1' | Anon + member x.ErrorIfUnified = match x with TyparRigidity.Rigid -> true | _ -> false + member x.WarnIfUnified = match x with TyparRigidity.WillBeRigid | TyparRigidity.WarnIfNotRigid -> true | _ -> false + member x.WarnIfMissingConstraint = match x with TyparRigidity.WillBeRigid -> true | _ -> false @@ -314,8 +334,10 @@ type TyparFlags(flags:int32) = /// Indicates if the type inference variable was generated after an error when type checking expressions or patterns member x.IsFromError = (flags &&& 0b0000000000010) <> 0x0 + /// Indicates if the type variable is compiler generated, i.e. is an implicit type inference variable member x.IsCompilerGenerated = (flags &&& 0b0000000000100) <> 0x0 + /// Indicates if the type variable has a static "head type" requirement, i.e. ^a variables used in FSharp.Core and member constraints. member x.StaticReq = match (flags &&& 0b0000000001000) with @@ -370,7 +392,10 @@ type EntityFlags(flags:int64) = (if hasSelfReferentialCtor then 0b000000000001000L else 0L) ||| (if isStructRecordOrUnionType then 0b000000000100000L else 0L)) + /// Indicates the Entity is actually a module or namespace, not a type definition member x.IsModuleOrNamespace = (flags &&& 0b000000000000001L) <> 0x0L + + /// Indicates the type prefers the "tycon" syntax for display etc. member x.IsPrefixDisplay = (flags &&& 0b000000000000010L) <> 0x0L // This bit is not pickled, only used while establishing a type constructor. It is needed because the type constructor @@ -415,15 +440,16 @@ let KeyTyconByAccessNames nm x = [| KeyValuePair(nm,x) |] type ModuleOrNamespaceKind = + /// Indicates that a module is compiled to a class with the "Module" suffix added. | FSharpModuleWithSuffix + /// Indicates that a module is compiled to a class with the same name as the original module | ModuleOrType + /// Indicates that a 'module' is really a namespace | Namespace - - let getNameOfScopeRef sref = match sref with | ILScopeRef.Local -> "" @@ -523,7 +549,6 @@ type EntityOptionalData = override x.ToString() = "EntityOptionalData(...)" - and /// Represents a type definition, exception definition, module definition or namespace definition. [] Entity = @@ -792,7 +817,7 @@ and /// Represents a type definition, exception definition, module definition or /// Indicates the type prefers the "tycon" syntax for display etc. member x.IsPrefixDisplay = x.entity_flags.IsPrefixDisplay - /// Indicates the "tycon blob" is actually a module + /// Indicates the Entity is actually a module or namespace, not a type definition member x.IsModuleOrNamespace = x.entity_flags.IsModuleOrNamespace /// Indicates if the entity is a namespace @@ -1230,9 +1255,13 @@ and } member tcaug.SetCompare x = tcaug.tcaug_compare <- Some x + member tcaug.SetCompareWith x = tcaug.tcaug_compare_withc <- Some x + member tcaug.SetEquals x = tcaug.tcaug_equals <- Some x + member tcaug.SetHashAndEqualsWith x = tcaug.tcaug_hash_and_equals_withc <- Some x + member tcaug.SetHasObjectGetHashCode b = tcaug.tcaug_hasObjectGetHashCode <- b static member Create() = @@ -1955,7 +1984,11 @@ and [] /// The declared attributes of the type parameter. Empty for type inference variables. mutable typar_attribs: Attribs } + + override __.ToString() = sprintf "TyparOptionalData(...)" + and TyparData = Typar + and [] [] @@ -2841,6 +2874,8 @@ and and ValPublicPath = | ValPubPath of PublicPath * ValLinkageFullKey + override __.ToString() = sprintf "ValPubPath(...)" + /// Index into the namespace/module structure of a particular CCU and NonLocalEntityRef = | NonLocalEntityRef of CcuThunk * string[] @@ -3625,6 +3660,8 @@ and UnionCaseRef = /// Get a field of the union case by index member x.FieldByIndex n = x.UnionCase.FieldTable.FieldByIndex n + override x.ToString() = sprintf "UnionCase(%s)" x.CaseName + /// Represents a reference to a field in a record, class or struct and RecdFieldRef = | RFRef of TyconRef * string @@ -3668,6 +3705,8 @@ and RecdFieldRef = with :? KeyNotFoundException -> error(InternalError(sprintf "field %s not found in type %s" id tcref.LogicalName, tcref.Range)) + override x.ToString() = sprintf "RecdField(%s)" x.FieldName + and /// The algebra of types [] @@ -3706,20 +3745,6 @@ and /// Indicates the type is a unit-of-measure expression being used as an argument to a type or member | TType_measure of Measure - override x.ToString() = - match x with - | TType_forall (_tps,ty) -> "forall _. " + ty.ToString() - | TType_app (tcref, tinst) -> tcref.DisplayName + (match tinst with [] -> "" | tys -> "<" + String.concat "," (List.map string tys) + ">") - | TType_tuple (tupInfo, tinst) -> - (match tupInfo with - | TupInfo.Const false -> "" - | TupInfo.Const true -> "struct ") - + String.concat "," (List.map string tinst) + ")" - | TType_fun (d,r) -> "(" + string d + " -> " + string r + ")" - | TType_ucase (uc,tinst) -> "union case type " + uc.CaseName + (match tinst with [] -> "" | tys -> "<" + String.concat "," (List.map string tys) + ">") - | TType_var tp -> tp.DisplayName - | TType_measure ms -> sprintf "%A" ms - /// For now, used only as a discriminant in error message. /// See https://github.com/Microsoft/visualfsharp/issues/2561 member x.GetAssemblyName() = @@ -3734,7 +3759,25 @@ and let (TILObjectReprData(scope,_nesting,_definition)) = _uc.Tycon.ILTyconInfo scope.QualifiedName + override x.ToString() = + match x with + | TType_forall (_tps,ty) -> "forall _. " + ty.ToString() + | TType_app (tcref, tinst) -> tcref.DisplayName + (match tinst with [] -> "" | tys -> "<" + String.concat "," (List.map string tys) + ">") + | TType_tuple (tupInfo, tinst) -> + (match tupInfo with + | TupInfo.Const false -> "" + | TupInfo.Const true -> "struct ") + + String.concat "," (List.map string tinst) + ")" + | TType_fun (d,r) -> "(" + string d + " -> " + string r + ")" + | TType_ucase (uc,tinst) -> "union case type " + uc.CaseName + (match tinst with [] -> "" | tys -> "<" + String.concat "," (List.map string tys) + ">") + | TType_var tp -> + match tp.Solution with + | None -> tp.DisplayName + | Some _ -> tp.DisplayName + " (solved, see Solution property)" + | TType_measure ms -> sprintf "%A" ms + and TypeInst = TType list + and TTypes = TType list and [] TupInfo = @@ -3760,6 +3803,7 @@ and [] Measure = /// Raising a measure to a rational power | RationalPower of Measure * Rational + override x.ToString() = "Measure(...)" and [] @@ -3812,6 +3856,8 @@ and /// The table of .NET CLI type forwarders for this assembly TypeForwarders : CcuTypeForwarderTable } + override x.ToString() = sprintf "CcuData(%A)" x.FileName + /// Represents a table of .NET CLI type forwarders for an assembly and CcuTypeForwarderTable = Map> @@ -3962,9 +4008,13 @@ and CcuThunk = /// The result of attempting to resolve an assembly name to a full ccu. /// UnresolvedCcu will contain the name of the assembly that could not be resolved. and CcuResolutionResult = + | ResolvedCcu of CcuThunk + | UnresolvedCcu of string + override __.ToString() = "CcuResolutionResult(...)" + /// Represents the information saved in the assembly signature data resource for an F# assembly and PickledCcuInfo = { mspec: ModuleOrNamespace @@ -3973,6 +4023,10 @@ and PickledCcuInfo = usesQuotations : bool } + override __.ToString() = "PickledCcuInfo(...)" + + + //--------------------------------------------------------------------------- // Attributes //--------------------------------------------------------------------------- @@ -3991,12 +4045,14 @@ and AttribKind = /// Attrib(kind,unnamedArgs,propVal,appliedToAGetterOrSetter,targetsOpt,range) and Attrib = + | Attrib of TyconRef * AttribKind * AttribExpr list * AttribNamedArg list * bool * AttributeTargets option * range override x.ToString() = sprintf "Attrib(...)" /// We keep both source expression and evaluated expression around to help intellisense and signature printing and AttribExpr = + /// AttribExpr(source, evaluated) | AttribExpr of Expr * Expr @@ -4025,7 +4081,7 @@ and [] | Single of single | Double of double | Char of char - | String of string // in unicode + | String of string | Decimal of Decimal | Unit | Zero // null/zero-bit-pattern @@ -4177,7 +4233,7 @@ and ValReprInfo = /// Get the total number of arguments member x.TotalArgCount = - let (ValReprInfo(_,args,_)) = x in + let (ValReprInfo(_,args,_)) = x // This is List.sumBy List.length args // We write this by hand as it can be a performance bottleneck in LinkagePartialKey let rec loop (args:ArgReprInfo list list) acc = @@ -4499,7 +4555,9 @@ and StaticOptimization = /// /// TObjExprMethod(slotsig,attribs,methTyparsOfOverridingMethod,methodParams,methodBodyExpr,m) and ObjExprMethod = + | TObjExprMethod of SlotSig * Attribs * Typars * Val list list * Expr * range + member x.Id = let (TObjExprMethod(slotsig,_,_,_,_,m)) = x in mkSynId m slotsig.Name override x.ToString() = sprintf "TObjExprMethod(%s, ...)" x.Id.idText @@ -4508,6 +4566,7 @@ and ObjExprMethod = /// /// TSlotSig(methodName,declaringType,declaringTypeParameters,methodTypeParameters,slotParameters,returnTy) and SlotSig = + | TSlotSig of string * TType * Typars * Typars * SlotParam list list * TType option member ss.Name = let (TSlotSig(nm,_,_,_,_,_)) = ss in nm