From 9a7920d1b8dde1c5653a613ab0e5f90b01cffcf2 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Tue, 18 Oct 2022 01:49:05 +0100 Subject: [PATCH 01/45] Ease restrictions on static members and static let in union and record types --- src/Compiler/Checking/CheckDeclarations.fs | 515 ++++++++++-------- .../Checking/CheckIncrementalClasses.fs | 236 ++++---- .../Checking/CheckIncrementalClasses.fsi | 48 +- src/Compiler/Checking/NicePrint.fs | 26 +- src/Compiler/Checking/PostInferenceChecks.fs | 4 +- src/Compiler/Checking/SignatureConformance.fs | 42 +- src/Compiler/CodeGen/IlxGen.fs | 76 +-- .../Service/SemanticClassification.fs | 16 +- .../Service/ServiceDeclarationLists.fs | 6 +- src/Compiler/Symbols/Symbols.fs | 2 +- src/Compiler/TypedTree/TypedTree.fs | 89 +-- src/Compiler/TypedTree/TypedTree.fsi | 34 +- src/Compiler/TypedTree/TypedTreeOps.fs | 32 +- src/Compiler/TypedTree/TypedTreePickle.fs | 103 +++- 14 files changed, 723 insertions(+), 506 deletions(-) diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index c4c2798a2df..ec97a756d23 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -181,12 +181,14 @@ module MutRecShapes = /// Indicates a declaration is contained in the given module -let ModuleOrNamespaceContainerInfo modref = ContainerInfo(Parent modref, Some(MemberOrValContainerInfo(modref, None, None, NoSafeInitInfo, []))) +let ModuleOrNamespaceContainerInfo modref = + ContainerInfo(Parent modref, Some(MemberOrValContainerInfo(modref, None, None, NoSafeInitInfo, []))) /// Indicates a declaration is contained in the given type definition in the given module -let TyconContainerInfo (parent, tcref, declaredTyconTypars, safeInitInfo) = ContainerInfo(parent, Some(MemberOrValContainerInfo(tcref, None, None, safeInitInfo, declaredTyconTypars))) +let TyconContainerInfo (parent, tcref, declaredTyconTypars, safeInitInfo) = + ContainerInfo(parent, Some(MemberOrValContainerInfo(tcref, None, None, safeInitInfo, declaredTyconTypars))) -type TyconBindingDefn = TyconBindingDefn of ContainerInfo * NewSlotsOK * DeclKind * SynMemberDefn * range +type TyconBindingDefn = TyconBindingDefn of ContainerInfo * NewSlotsOK * DeclKind * SynMemberDefn option * range type MutRecSigsInitialData = MutRecShape list type MutRecDefnsInitialData = MutRecShape list @@ -727,23 +729,29 @@ module MutRecBindingChecking = /// Represents one element in a type definition, after the first phase type TyconBindingPhase2A = /// An entry corresponding to the definition of the implicit constructor for a class - | Phase2AIncrClassCtor of IncrClassCtorLhs + | Phase2AIncrClassCtor of StaticCtorInfo * IncrClassCtorInfo option + /// An 'inherit' declaration in an incremental class /// /// Phase2AInherit (ty, arg, baseValOpt, m) | Phase2AInherit of SynType * SynExpr * Val option * range + /// A set of value or function definitions in an incremental class /// /// Phase2AIncrClassBindings (tcref, letBinds, isStatic, isRec, m) | Phase2AIncrClassBindings of TyconRef * SynBinding list * bool * bool * range + /// A 'member' definition in a class | Phase2AMember of PreCheckingRecursiveBinding + #if OPEN_IN_TYPE_DECLARATIONS /// A dummy declaration, should we ever support 'open' in type definitions | Phase2AOpen of SynOpenDeclTarget * range #endif + /// Indicates the super init has just been called, 'this' may now be published | Phase2AIncrClassCtorJustAfterSuperInit + /// Indicates the last 'field' has been initialized, only 'do' comes after | Phase2AIncrClassCtorJustAfterLastLet @@ -756,14 +764,20 @@ module MutRecBindingChecking = /// Represents one element in a type definition, after the second phase type TyconBindingPhase2B = - | Phase2BIncrClassCtor of IncrClassCtorLhs * Binding option - | Phase2BInherit of Expr * Val option + | Phase2BIncrClassCtor of staticCtorInfo: StaticCtorInfo * incrCtorInfoOpt: IncrClassCtorInfo option * safeThisValBindOpt: Binding option + + | Phase2BInherit of inheritsExpr: Expr + /// A set of value of function definitions in a class definition with an implicit constructor. | Phase2BIncrClassBindings of IncrClassBindingGroup list + + /// A member, by index | Phase2BMember of int + /// An intermediate definition that represent the point in an implicit class definition where /// the super type has been initialized. | Phase2BIncrClassCtorJustAfterSuperInit + /// An intermediate definition that represent the point in an implicit class definition where /// the last 'field' has been initialized, i.e. only 'do' and 'member' definitions come after /// this point. @@ -775,12 +789,17 @@ module MutRecBindingChecking = /// Represents one element in a type definition, after the third phase type TyconBindingPhase2C = - | Phase2CIncrClassCtor of IncrClassCtorLhs * Binding option - | Phase2CInherit of Expr * Val option + | Phase2CIncrClassCtor of StaticCtorInfo * IncrClassCtorInfo option * Binding option + + | Phase2CInherit of Expr + | Phase2CIncrClassBindings of IncrClassBindingGroup list + | Phase2CMember of PreInitializationGraphEliminationBinding + // Indicates the last 'field' has been initialized, only 'do' comes after | Phase2CIncrClassCtorJustAfterSuperInit + | Phase2CIncrClassCtorJustAfterLastLet type TyconBindingsPhase2C = TyconBindingsPhase2C of Tycon option * TyconRef * TyconBindingPhase2C list @@ -835,15 +854,14 @@ module MutRecBindingChecking = // 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 - // The basic iteration over the declarations in a single type definition let initialInnerState = (None, envForTycon, tpenv, recBindIdx, uncheckedBindsRev) - let defnAs, (_, _envForTycon, tpenv, recBindIdx, uncheckedBindsRev) = + let defnAs, (_, _envForTycon, tpenv, recBindIdx, uncheckedBindsRev) = (initialInnerState, binds) ||> List.collectFold (fun innerState defn -> let (TyconBindingDefn(containerInfo, newslotsOK, declKind, classMemberDef, m)) = defn - let incrClassCtorLhsOpt, envForTycon, tpenv, recBindIdx, uncheckedBindsRev = innerState + let incrCtorInfoOpt, envForTycon, tpenv, recBindIdx, uncheckedBindsRev = innerState if tcref.IsTypeAbbrev then // ideally we'd have the 'm' of the type declaration stored here, to avoid needing to trim to line to approx @@ -854,30 +872,44 @@ module MutRecBindingChecking = error(Error(FSComp.SR.tcEnumerationsMayNotHaveMembers(), (trimRangeToLine m))) match classMemberDef, containerInfo with - | SynMemberDefn.ImplicitCtor (vis, Attributes attrs, SynSimplePats.SimplePats(spats, _), thisIdOpt, xmlDoc, m), ContainerInfo(_, Some(MemberOrValContainerInfo(tcref, _, baseValOpt, safeInitInfo, _))) -> + | None, ContainerInfo(_, Some memberContainerInfo) -> + + let (MemberOrValContainerInfo(tcref, _, _, _, _)) = memberContainerInfo + let staticCtorInfo = TcStaticImplicitCtorInfo_Phase2A(cenv, envForTycon, tcref, m, copyOfTyconTypars) + let envForTycon = AddDeclaredTypars CheckForDuplicateTypars staticCtorInfo.IncrCtorDeclaredTypars envForTycon + let innerState = (None, envForTycon, tpenv, recBindIdx, uncheckedBindsRev) + [Phase2AIncrClassCtor (staticCtorInfo, None)], innerState + + | Some (SynMemberDefn.ImplicitCtor (vis, Attributes attrs, SynSimplePats.SimplePats(spats, _), thisIdOpt, xmlDoc, m)), ContainerInfo(_, Some memberContainerInfo) -> + + let (MemberOrValContainerInfo(tcref, _, baseValOpt, safeInitInfo, _)) = memberContainerInfo + if tcref.TypeOrMeasureKind = TyparKind.Measure then error(Error(FSComp.SR.tcMeasureDeclarationsRequireStaticMembers(), m)) - // Phase2A: make incrClassCtorLhs - ctorv, thisVal etc, type depends on argty(s) - let incrClassCtorLhs = TcImplicitCtorLhs_Phase2A(cenv, envForTycon, tpenv, tcref, vis, attrs, spats, thisIdOpt, baseValOpt, safeInitInfo, m, copyOfTyconTypars, objTy, thisTy, xmlDoc) + // Phase2A: make staticCtorInfo - ctorv, thisVal etc, type depends on argty(s) + let staticCtorInfo = TcStaticImplicitCtorInfo_Phase2A(cenv, envForTycon, tcref, m, copyOfTyconTypars) + + // Phase2A: make incrCtorInfo - ctorv, thisVal etc, type depends on argty(s) + let incrCtorInfo = TcImplicitCtorInfo_Phase2A(cenv, envForTycon, tpenv, tcref, vis, attrs, spats, thisIdOpt, baseValOpt, safeInitInfo, m, copyOfTyconTypars, objTy, thisTy, xmlDoc) - // Phase2A: Add copyOfTyconTypars from incrClassCtorLhs - or from tcref - let envForTycon = AddDeclaredTypars CheckForDuplicateTypars incrClassCtorLhs.InstanceCtorDeclaredTypars envForTycon - let innerState = (Some incrClassCtorLhs, envForTycon, tpenv, recBindIdx, uncheckedBindsRev) + // Phase2A: Add copyOfTyconTypars from incrCtorInfo - or from tcref + let envForTycon = AddDeclaredTypars CheckForDuplicateTypars staticCtorInfo.IncrCtorDeclaredTypars envForTycon + let innerState = (Some incrCtorInfo, envForTycon, tpenv, recBindIdx, uncheckedBindsRev) - [Phase2AIncrClassCtor incrClassCtorLhs], innerState + [Phase2AIncrClassCtor (staticCtorInfo, Some incrCtorInfo)], innerState - | SynMemberDefn.ImplicitInherit (ty, arg, _baseIdOpt, m), _ -> + | Some (SynMemberDefn.ImplicitInherit (ty, arg, _baseIdOpt, m)), _ -> if tcref.TypeOrMeasureKind = TyparKind.Measure then error(Error(FSComp.SR.tcMeasureDeclarationsRequireStaticMembers(), m)) // Phase2A: inherit ty(arg) as base - pass through // Phase2A: pick up baseValOpt! - let baseValOpt = incrClassCtorLhsOpt |> Option.bind (fun x -> x.InstanceCtorBaseValOpt) - let innerState = (incrClassCtorLhsOpt, envForTycon, tpenv, recBindIdx, uncheckedBindsRev) + let baseValOpt = incrCtorInfoOpt |> Option.bind (fun x -> x.InstanceCtorBaseValOpt) + let innerState = (incrCtorInfoOpt, envForTycon, tpenv, recBindIdx, uncheckedBindsRev) [Phase2AInherit (ty, arg, baseValOpt, m); Phase2AIncrClassCtorJustAfterSuperInit], innerState - | SynMemberDefn.LetBindings (letBinds, isStatic, isRec, m), _ -> + | Some (SynMemberDefn.LetBindings (letBinds, isStatic, isRec, m)), _ -> match tcref.TypeOrMeasureKind, isStatic with | TyparKind.Measure, false -> error(Error(FSComp.SR.tcMeasureDeclarationsRequireStaticMembers(), m)) | _ -> () @@ -891,14 +923,14 @@ module MutRecBindingChecking = // Code for potential future design change to allow functions-compiled-as-members in structs errorR(Error(FSComp.SR.tcStructsMayNotContainLetBindings(), (trimRangeToLine m))) - if isStatic && Option.isNone incrClassCtorLhsOpt then - errorR(Error(FSComp.SR.tcStaticLetBindingsRequireClassesWithImplicitConstructors(), m)) + //if isStatic && Option.isNone incrCtorInfoOpt then + // errorR(Error(FSComp.SR.tcStaticLetBindingsRequireClassesWithImplicitConstructors(), m)) // Phase2A: let-bindings - pass through - let innerState = (incrClassCtorLhsOpt, envForTycon, tpenv, recBindIdx, uncheckedBindsRev) + let innerState = (incrCtorInfoOpt, envForTycon, tpenv, recBindIdx, uncheckedBindsRev) [Phase2AIncrClassBindings (tcref, letBinds, isStatic, isRec, m)], innerState - | SynMemberDefn.Member (bind, m), _ -> + | Some (SynMemberDefn.Member (bind, m)), _ -> // Phase2A: member binding - create prelim valspec (for recursive reference) and RecursiveBindingInfo let NormalizedBinding(_, _, _, _, _, _, _, valSynData, _, _, _, _) as bind = BindingNormalization.NormalizeBinding ValOrMemberBinding cenv envForTycon bind let (SynValData(memberFlagsOpt, _, _)) = valSynData @@ -915,7 +947,7 @@ module MutRecBindingChecking = | _ -> () let envForMember = - match incrClassCtorLhsOpt with + match incrCtorInfoOpt with | None -> AddDeclaredTypars CheckForDuplicateTypars copyOfTyconTypars envForTycon | Some _ -> envForTycon @@ -924,12 +956,12 @@ module MutRecBindingChecking = let (binds, _values), (tpenv, recBindIdx) = AnalyzeAndMakeAndPublishRecursiveValue overridesOK false cenv envForMember (tpenv, recBindIdx) rbind let cbinds = [ for rbind in binds -> Phase2AMember rbind ] - let innerState = (incrClassCtorLhsOpt, envForTycon, tpenv, recBindIdx, List.rev binds @ uncheckedBindsRev) + let innerState = (incrCtorInfoOpt, envForTycon, tpenv, recBindIdx, List.rev binds @ uncheckedBindsRev) cbinds, innerState #if OPEN_IN_TYPE_DECLARATIONS - | SynMemberDefn.Open (target, m), _ -> - let innerState = (incrClassCtorLhsOpt, env, tpenv, recBindIdx, prelimRecValuesRev, uncheckedBindsRev) + | Some (SynMemberDefn.Open (target, m)), _ -> + let innerState = (incrCtorInfoOpt, env, tpenv, recBindIdx, prelimRecValuesRev, uncheckedBindsRev) [ Phase2AOpen (target, m) ], innerState #endif @@ -1059,18 +1091,33 @@ module MutRecBindingChecking = match defnA with // Phase2B for the definition of an implicit constructor. Enrich the instance environments // with the implicit ctor args. - | Phase2AIncrClassCtor incrClassCtorLhs -> - - let envInstance = AddDeclaredTypars CheckForDuplicateTypars incrClassCtorLhs.InstanceCtorDeclaredTypars envInstance - let envStatic = AddDeclaredTypars CheckForDuplicateTypars incrClassCtorLhs.InstanceCtorDeclaredTypars envStatic - let envInstance = match incrClassCtorLhs.InstanceCtorSafeThisValOpt with Some v -> AddLocalVal g cenv.tcSink scopem v envInstance | None -> envInstance - let envInstance = List.foldBack (AddLocalValPrimitive g) incrClassCtorLhs.InstanceCtorArgs envInstance - let envNonRec = match incrClassCtorLhs.InstanceCtorSafeThisValOpt with Some v -> AddLocalVal g cenv.tcSink scopem v envNonRec | None -> envNonRec - let envNonRec = List.foldBack (AddLocalValPrimitive g) incrClassCtorLhs.InstanceCtorArgs envNonRec - let safeThisValBindOpt = TcLetrecComputeCtorSafeThisValBind cenv incrClassCtorLhs.InstanceCtorSafeThisValOpt + | Phase2AIncrClassCtor (staticCtorInfo, incrCtorInfoOpt) -> + + let envInstance = AddDeclaredTypars CheckForDuplicateTypars staticCtorInfo.IncrCtorDeclaredTypars envInstance + let envStatic = AddDeclaredTypars CheckForDuplicateTypars staticCtorInfo.IncrCtorDeclaredTypars envStatic + let envInstance = + match incrCtorInfoOpt with + | None -> envInstance + | Some incrCtorInfo -> match incrCtorInfo.InstanceCtorSafeThisValOpt with Some v -> AddLocalVal g cenv.tcSink scopem v envInstance | None -> envInstance + let envInstance = + match incrCtorInfoOpt with + | None -> envInstance + | Some incrCtorInfo -> List.foldBack (AddLocalValPrimitive g) incrCtorInfo.InstanceCtorArgs envInstance + let envNonRec = + match incrCtorInfoOpt with + | None -> envNonRec + | Some incrCtorInfo -> match incrCtorInfo.InstanceCtorSafeThisValOpt with Some v -> AddLocalVal g cenv.tcSink scopem v envNonRec | None -> envNonRec + let envNonRec = + match incrCtorInfoOpt with + | None -> envNonRec + | Some incrCtorInfo -> List.foldBack (AddLocalValPrimitive g) incrCtorInfo.InstanceCtorArgs envNonRec + let safeThisValBindOpt = + match incrCtorInfoOpt with + | None -> None + | Some incrCtorInfo -> TcLetrecComputeCtorSafeThisValBind cenv incrCtorInfo.InstanceCtorSafeThisValOpt let innerState = (tpenv, envInstance, envStatic, envNonRec, generalizedRecBinds, preGeneralizationRecBinds, uncheckedRecBindsTable) - Phase2BIncrClassCtor (incrClassCtorLhs, safeThisValBindOpt), innerState + Phase2BIncrClassCtor (staticCtorInfo, incrCtorInfoOpt, safeThisValBindOpt), innerState // Phase2B: typecheck the argument to an 'inherits' call and build the new object expr for the inherit-call | Phase2AInherit (synBaseTy, arg, baseValOpt, m) -> @@ -1085,7 +1132,7 @@ module MutRecBindingChecking = let envInstance = match baseValOpt with Some baseVal -> AddLocalVal g cenv.tcSink scopem baseVal envInstance | None -> envInstance let envNonRec = match baseValOpt with Some baseVal -> AddLocalVal g cenv.tcSink scopem baseVal envNonRec | None -> envNonRec let innerState = (tpenv, envInstance, envStatic, envNonRec, generalizedRecBinds, preGeneralizationRecBinds, uncheckedRecBindsTable) - Phase2BInherit (inheritsExpr, baseValOpt), innerState + Phase2BInherit inheritsExpr, innerState // Phase2B: let and let rec value and function definitions | Phase2AIncrClassBindings (tcref, binds, isStatic, isRec, mBinds) -> @@ -1210,14 +1257,17 @@ module MutRecBindingChecking = // Phase2C: Generalise implicit ctor val match defnB with - | Phase2BIncrClassCtor (incrClassCtorLhs, safeThisValBindOpt) -> - let valscheme = incrClassCtorLhs.InstanceCtorValScheme - let valscheme = ChooseCanonicalValSchemeAfterInference g denv valscheme scopem - AdjustRecType incrClassCtorLhs.InstanceCtorVal valscheme - Phase2CIncrClassCtor (incrClassCtorLhs, safeThisValBindOpt) - - | Phase2BInherit (inheritsExpr, basevOpt) -> - Phase2CInherit (inheritsExpr, basevOpt) + | Phase2BIncrClassCtor (staticCtorInfo, incrCtorInfoOpt, safeThisValBindOpt) -> + match incrCtorInfoOpt with + | Some incrCtorInfo -> + let valscheme = incrCtorInfo.InstanceCtorValScheme + let valscheme = ChooseCanonicalValSchemeAfterInference g denv valscheme scopem + AdjustRecType incrCtorInfo.InstanceCtorVal valscheme + | None -> () + Phase2CIncrClassCtor (staticCtorInfo, incrCtorInfoOpt, safeThisValBindOpt) + + | Phase2BInherit inheritsExpr -> + Phase2CInherit inheritsExpr | Phase2BIncrClassBindings bindRs -> Phase2CIncrClassBindings bindRs @@ -1234,6 +1284,7 @@ module MutRecBindingChecking = let vxbind = TcLetrecAdjustMemberForSpecialVals cenv generalizedBinding let pgbrind = FixupLetrecBind cenv denv generalizedTyparsForRecursiveBlock vxbind Phase2CMember pgbrind) + TyconBindingsPhase2C(tyconOpt, tcref, defnCs)) // Phase2C: Fixup let bindings @@ -1253,7 +1304,7 @@ module MutRecBindingChecking = // let (fixupValueExprBinds, methodBinds) = (envMutRec, defnsCs) ||> MutRecShapes.mapTyconsWithEnv (fun envForDecls (TyconBindingsPhase2C(tyconOpt, tcref, defnCs)) -> match defnCs with - | Phase2CIncrClassCtor (incrClassCtorLhs, safeThisValBindOpt) :: defnCs -> + | Phase2CIncrClassCtor (staticCtorInfo, incrCtorInfoOpt, safeThisValBindOpt) :: defnCs -> // Determine is static fields in this type need to be "protected" against invalid recursive initialization let safeStaticInitInfo = @@ -1294,17 +1345,21 @@ module MutRecBindingChecking = // This is the type definition we're processing - let tcref = incrClassCtorLhs.TyconRef + let tcref = staticCtorInfo.TyconRef // Assumes inherit call immediately follows implicit ctor. Checked by CheckMembersForm - let inheritsExpr, inheritsIsVisible, _, defnCs = + let instanceInfo, defnCs = + match incrCtorInfoOpt with + | None -> None, defnCs + | Some incrCtorInfo -> + match defnCs |> List.partition (function Phase2CInherit _ -> true | _ -> false) with - | [Phase2CInherit (inheritsExpr, baseValOpt)], defnCs -> - inheritsExpr, true, baseValOpt, defnCs + | [Phase2CInherit inheritsExpr], defnCs -> + Some(incrCtorInfo, inheritsExpr, true), defnCs | _ -> if tcref.IsStructOrEnumTycon then - mkUnit g tcref.Range, false, None, defnCs + Some (incrCtorInfo, mkUnit g tcref.Range, false), defnCs else let inheritsExpr, _ = TcNewExpr cenv envForDecls tpenv g.obj_ty None true (SynExpr.Const (SynConst.Unit, tcref.Range)) tcref.Range @@ -1327,7 +1382,7 @@ module MutRecBindingChecking = mkDebugPoint tcref.Range inheritsExpr else inheritsExpr - inheritsExpr, false, None, defnCs + Some (incrCtorInfo, inheritsExpr, false), defnCs let envForTycon = MakeInnerEnvForTyconRef envForDecls tcref false @@ -1349,7 +1404,7 @@ module MutRecBindingChecking = | Some bind -> Phase2CIncrClassBindings [IncrClassBindingGroup([bind], false, false)] :: localDecs // Carve out the initialization sequence and decide on the localRep - let ctorBodyLambdaExpr, cctorBodyLambdaExprOpt, methodBinds, localReps = + let ctorBodyLambdaExprOpt, cctorBodyLambdaExprOpt, methodBinds, localReps = let localDecs = [ for localDec in localDecs do @@ -1359,25 +1414,27 @@ module MutRecBindingChecking = | Phase2CIncrClassCtorJustAfterLastLet -> yield Phase2CCtorJustAfterLastLet | _ -> () ] let memberBinds = memberBindsWithFixups |> List.map (fun x -> x.Binding) - MakeCtorForIncrClassConstructionPhase2C(cenv, envForTycon, incrClassCtorLhs, inheritsExpr, inheritsIsVisible, localDecs, memberBinds, generalizedTyparsForRecursiveBlock, safeStaticInitInfo) + MakeCtorForIncrClassConstructionPhase2C(cenv, envForTycon, staticCtorInfo, instanceInfo, localDecs, memberBinds, generalizedTyparsForRecursiveBlock, safeStaticInitInfo) // Generate the (value, expr) pairs for the implicit // object constructor and implicit static initializer let ctorValueExprBindings = - [ (let ctorValueExprBinding = TBind(incrClassCtorLhs.InstanceCtorVal, ctorBodyLambdaExpr, DebugPointAtBinding.NoneAtSticky) - let rbind = { ValScheme = incrClassCtorLhs.InstanceCtorValScheme ; Binding = ctorValueExprBinding } - FixupLetrecBind cenv envForDecls.DisplayEnv generalizedTyparsForRecursiveBlock rbind) ] - @ - ( match cctorBodyLambdaExprOpt with - | None -> [] + [ match incrCtorInfoOpt, ctorBodyLambdaExprOpt with + | None, _ | _, None -> () + | Some incrCtorInfo, Some ctorBodyLambdaExpr -> + let ctorValueExprBinding = TBind(incrCtorInfo.InstanceCtorVal, ctorBodyLambdaExpr, DebugPointAtBinding.NoneAtSticky) + let rbind = { ValScheme = incrCtorInfo.InstanceCtorValScheme ; Binding = ctorValueExprBinding } + FixupLetrecBind cenv envForDecls.DisplayEnv generalizedTyparsForRecursiveBlock rbind + match cctorBodyLambdaExprOpt with + | None -> () | Some cctorBodyLambdaExpr -> - [ (let _, cctorVal, cctorValScheme = incrClassCtorLhs.StaticCtorValInfo.Force() - let cctorValueExprBinding = TBind(cctorVal, cctorBodyLambdaExpr, DebugPointAtBinding.NoneAtSticky) - let rbind = { ValScheme = cctorValScheme; Binding = cctorValueExprBinding } - FixupLetrecBind cenv envForDecls.DisplayEnv generalizedTyparsForRecursiveBlock rbind) ] ) + let _, cctorVal, cctorValScheme = staticCtorInfo.StaticCtorValInfo.Force() + let cctorValueExprBinding = TBind(cctorVal, cctorBodyLambdaExpr, DebugPointAtBinding.NoneAtSticky) + let rbind = { ValScheme = cctorValScheme; Binding = cctorValueExprBinding } + FixupLetrecBind cenv envForDecls.DisplayEnv generalizedTyparsForRecursiveBlock rbind ] // Publish the fields of the representation to the type - localReps.PublishIncrClassFields (cenv, denv, cpath, incrClassCtorLhs, safeStaticInitInfo) (* mutation *) + localReps.PublishIncrClassFields (cenv, denv, cpath, staticCtorInfo, safeStaticInitInfo) // Fixup members let memberBindsWithFixups = @@ -1536,7 +1593,7 @@ module MutRecBindingChecking = decls |> MutRecShapes.topTycons |> List.collect (fun (TyconBindingsPhase2A(_, _, _, _, _, _, defnAs)) -> [ for defnB in defnAs do match defnB with - | Phase2AIncrClassCtor incrClassCtorLhs -> yield incrClassCtorLhs.InstanceCtorVal + | Phase2AIncrClassCtor (_, Some incrCtorInfo) -> yield incrCtorInfo.InstanceCtorVal | _ -> () ]) let envForDeclsUpdated = @@ -1586,8 +1643,8 @@ module MutRecBindingChecking = for TyconBindingsPhase2B(_tyconOpt, _tcref, defnBs) in MutRecShapes.collectTycons defnsBs do for defnB in defnBs do match defnB with - | Phase2BIncrClassCtor (incrClassCtorLhs, _) -> - yield incrClassCtorLhs.InstanceCtorVal.Type + | Phase2BIncrClassCtor (_, Some incrCtorInfo, _) -> + yield incrCtorInfo.InstanceCtorVal.Type | _ -> () ] @@ -1681,16 +1738,23 @@ let TcMutRecDefns_Phase2 (cenv: cenv) envInitial mBinds scopem mutRecNSInfo (env let interfaceMembersFromTypeDefn tyconMembersData (intfTyR, defn, _) implTySet = let (MutRecDefnsPhase2DataForTycon(_, parent, declKind, tcref, baseValOpt, safeInitInfo, declaredTyconTypars, _, _, newslotsOK, _)) = tyconMembersData let containerInfo = ContainerInfo(parent, Some(MemberOrValContainerInfo(tcref, Some(intfTyR, implTySet), baseValOpt, safeInitInfo, declaredTyconTypars))) - defn |> List.choose (fun mem -> + [ for mem in defn do match mem with - | SynMemberDefn.Member(_, m) -> Some(TyconBindingDefn(containerInfo, newslotsOK, declKind, mem, m)) - | SynMemberDefn.AutoProperty(range=m) -> Some(TyconBindingDefn(containerInfo, newslotsOK, declKind, mem, m)) - | _ -> errorR(Error(FSComp.SR.tcMemberNotPermittedInInterfaceImplementation(), mem.Range)); None) + | SynMemberDefn.Member(_, m) -> TyconBindingDefn(containerInfo, newslotsOK, declKind, Some mem, m) + | SynMemberDefn.AutoProperty(range=m) -> TyconBindingDefn(containerInfo, newslotsOK, declKind, Some mem, m) + | mem -> errorR(Error(FSComp.SR.tcMemberNotPermittedInInterfaceImplementation(), mem.Range)) ] let tyconBindingsOfTypeDefn (MutRecDefnsPhase2DataForTycon(_, parent, declKind, tcref, baseValOpt, safeInitInfo, declaredTyconTypars, members, _, newslotsOK, _)) = let containerInfo = ContainerInfo(parent, Some(MemberOrValContainerInfo(tcref, None, baseValOpt, safeInitInfo, declaredTyconTypars))) - members - |> List.choose (fun memb -> + [ // Yield a fake member marking the ability to do static incremental construction + match members with + | SynMemberDefn.ImplicitCtor _ :: _ -> () + | _ -> + if not tcref.IsFSharpEnumTycon && not tcref.IsFSharpDelegateTycon && not tcref.IsFSharpException && not tcref.IsTypeAbbrev then + TyconBindingDefn(containerInfo, newslotsOK, declKind, None, tcref.Range) + + // Yield the other members + for memb in members do match memb with | SynMemberDefn.ImplicitCtor _ | SynMemberDefn.ImplicitInherit _ @@ -1699,16 +1763,16 @@ let TcMutRecDefns_Phase2 (cenv: cenv) envInitial mBinds scopem mutRecNSInfo (env | SynMemberDefn.Member _ | SynMemberDefn.GetSetMember _ | SynMemberDefn.Open _ - -> Some(TyconBindingDefn(containerInfo, newslotsOK, declKind, memb, memb.Range)) + -> TyconBindingDefn(containerInfo, newslotsOK, declKind, Some memb, memb.Range) // Interfaces exist in the member list - handled above in interfaceMembersFromTypeDefn - | SynMemberDefn.Interface _ -> None + | SynMemberDefn.Interface _ -> () // The following should have been List.unzip out already in SplitTyconDefn | SynMemberDefn.AbstractSlot _ | SynMemberDefn.ValField _ | SynMemberDefn.Inherit _ -> error(InternalError("Unexpected declaration element", memb.Range)) - | SynMemberDefn.NestedType _ -> error(Error(FSComp.SR.tcTypesCannotContainNestedTypes(), memb.Range))) + | SynMemberDefn.NestedType _ -> error(Error(FSComp.SR.tcTypesCannotContainNestedTypes(), memb.Range)) ] let tpenv = emptyUnscopedTyparEnv @@ -1718,19 +1782,19 @@ let TcMutRecDefns_Phase2 (cenv: cenv) envInitial mBinds scopem mutRecNSInfo (env let (MutRecDefnsPhase2DataForTycon(_, _, declKind, tcref, _, _, _, members, m, newslotsOK, _)) = tyconData let tcaug = tcref.TypeContents if tcaug.tcaug_closed && declKind <> ExtrinsicExtensionBinding then - error(InternalError("Intrinsic augmentations of types are only permitted in the same file as the definition of the type", m)) - members |> List.iter (fun mem -> + error(InternalError("Intrinsic augmentations of types are only permitted in the same file as the definition of the type", m)) + for mem in members do match mem with | SynMemberDefn.Member _ | SynMemberDefn.GetSetMember _ - | SynMemberDefn.Interface _ -> () - | SynMemberDefn.Open _ | SynMemberDefn.AutoProperty _ | SynMemberDefn.LetBindings _ // accept local definitions + | SynMemberDefn.Interface _ -> () + | SynMemberDefn.Open _ | SynMemberDefn.ImplicitCtor _ // accept implicit ctor pattern, should be first! | SynMemberDefn.ImplicitInherit _ when newslotsOK = NewSlotsOK -> () // accept implicit ctor pattern, should be first! // The rest should have been removed by splitting, they belong to "core" (they are "shape" of type, not implementation) - | _ -> error(Error(FSComp.SR.tcDeclarationElementNotPermittedInAugmentation(), mem.Range)))) + | _ -> error(Error(FSComp.SR.tcDeclarationElementNotPermittedInAugmentation(), mem.Range))) let binds: MutRecDefnsPhase2Info = @@ -2283,11 +2347,10 @@ module TcExceptionDeclarations = let binds, exnc = TcExnDefnCore cenv envInitial parent core let envMutRec = AddLocalExnDefnAndReport cenv.tcSink scopem (AddLocalTycons g cenv.amap scopem [exnc] envInitial) exnc let ecref = mkLocalEntityRef exnc - let vals, _ = TcTyconMemberSpecs cenv envMutRec (ContainerInfo(parent, Some(MemberOrValContainerInfo(ecref, None, None, NoSafeInitInfo, [])))) ModuleOrMemberBinding tpenv aug + let containerInfo = ContainerInfo(parent, Some(MemberOrValContainerInfo(ecref, None, None, NoSafeInitInfo, []))) + let vals, _ = TcTyconMemberSpecs cenv envMutRec containerInfo ModuleOrMemberBinding tpenv aug binds, vals, ecref, envMutRec - - /// Bind type definitions /// /// We first establish the cores of a set of type definitions (i.e. everything @@ -2637,10 +2700,8 @@ module EstablishTypeDefinitionCores = InferTyconKind g (SynTypeDefnKind.Opaque, attrs, [], [], inSig, true, m) |> ignore if not inSig && not hasMeasureAttr then errorR(Error(FSComp.SR.tcTypeRequiresDefinition(), m)) - if hasMeasureAttr then - TFSharpObjectRepr { fsobjmodel_kind = TFSharpClass - fsobjmodel_vslots = [] - fsobjmodel_rfields = Construct.MakeRecdFieldsTable [] } + if hasMeasureAttr then + TFSharpTyconRepr (Construct.NewEmptyFSharpTyconData TFSharpClass) else TNoRepr @@ -2670,7 +2731,7 @@ module EstablishTypeDefinitionCores = InferTyconKind g (SynTypeDefnKind.Record, attrs, [], [], inSig, true, m) |> ignore // Note: the table of record fields is initially empty - TFSharpRecdRepr (Construct.MakeRecdFieldsTable []) + TFSharpTyconRepr (Construct.NewEmptyFSharpTyconData TFSharpRecord) | SynTypeDefnSimpleRepr.General (kind, _, slotsigs, fields, isConcrete, _, _, _) -> let kind = InferTyconKind g (kind, attrs, slotsigs, fields, inSig, isConcrete, m) @@ -2686,21 +2747,10 @@ module EstablishTypeDefinitionCores = | SynTypeDefnKind.Struct -> TFSharpStruct | _ -> error(InternalError("should have inferred tycon kind", m)) - let repr = - { fsobjmodel_kind = kind - fsobjmodel_vslots = [] - fsobjmodel_rfields = Construct.MakeRecdFieldsTable [] } - - TFSharpObjectRepr repr + TFSharpTyconRepr (Construct.NewEmptyFSharpTyconData kind) | SynTypeDefnSimpleRepr.Enum _ -> - let kind = TFSharpEnum - let repr = - { fsobjmodel_kind = kind - fsobjmodel_vslots = [] - fsobjmodel_rfields = Construct.MakeRecdFieldsTable [] } - - TFSharpObjectRepr repr + TFSharpTyconRepr (Construct.NewEmptyFSharpTyconData TFSharpEnum) // OK, now fill in the (partially computed) type representation tycon.entity_tycon_repr <- repr @@ -3206,9 +3256,7 @@ module EstablishTypeDefinitionCores = hiddenReprChecks false noAllowNullLiteralAttributeCheck() if hasMeasureAttr then - let repr = TFSharpObjectRepr { fsobjmodel_kind=TFSharpClass - fsobjmodel_vslots=[] - fsobjmodel_rfields= Construct.MakeRecdFieldsTable [] } + let repr = TFSharpTyconRepr (Construct.NewEmptyFSharpTyconData TFSharpClass) repr, None, NoSafeInitInfo else TNoRepr, None, NoSafeInitInfo @@ -3275,7 +3323,7 @@ module EstablishTypeDefinitionCores = let recdFields = TcRecdUnionAndEnumDeclarations.TcNamedFieldDecls cenv envinner innerParent false tpenv fields recdFields |> CheckDuplicates (fun f -> f.Id) "field" |> ignore writeFakeRecordFieldsToSink recdFields - let repr = TFSharpRecdRepr (Construct.MakeRecdFieldsTable recdFields) + let repr = TFSharpTyconRepr (Construct.NewEmptyFSharpTyconData TFSharpRecord) repr, None, NoSafeInitInfo | SynTypeDefnSimpleRepr.LibraryOnlyILAssembly (s, _) -> @@ -3408,8 +3456,9 @@ module EstablishTypeDefinitionCores = let safeInitFields = match safeInitInfo with SafeInitField (_, fld) -> [fld] | NoSafeInitInfo -> [] let repr = - TFSharpObjectRepr - { fsobjmodel_kind = kind + TFSharpTyconRepr + { fsobjmodel_cases = Construct.MakeUnionCases [] + fsobjmodel_kind = kind fsobjmodel_vslots = abstractSlots fsobjmodel_rfields = Construct.MakeRecdFieldsTable (userFields @ implicitStructFields @ safeInitFields) } repr, baseValOpt, safeInitInfo @@ -3430,8 +3479,9 @@ module EstablishTypeDefinitionCores = writeFakeRecordFieldsToSink fields' let repr = - TFSharpObjectRepr - { fsobjmodel_kind=kind + TFSharpTyconRepr + { fsobjmodel_cases = Construct.MakeUnionCases [] + fsobjmodel_kind=kind fsobjmodel_vslots=[] fsobjmodel_rfields= Construct.MakeRecdFieldsTable (vfld :: fields') } repr, None, NoSafeInitInfo @@ -3732,7 +3782,7 @@ module EstablishTypeDefinitionCores = // Phase 1B. Establish the kind of each type constructor // Here we run InferTyconKind and record partial information about the kind of the type constructor. - // This means TyconFSharpObjModelKind is set, which means isSealedTy, isInterfaceTy etc. give accurate results. + // This means FSharpTyconKind is set, which means isSealedTy, isInterfaceTy etc. give accurate results. let withAttrs = (envMutRecPrelim, withEnvs) ||> MutRecShapes.mapTyconsWithEnv (fun envForDecls (origInfo, tyconOpt) -> let res = @@ -3986,6 +4036,116 @@ module TcDeclarations = | SynMemberDefn.NestedType (range=m) :: _ -> errorR(InternalError("CheckMembersForm: List.takeUntil is wrong", m)) | _ -> () + // Check order for static incremental construction + let _, ds2 = ds |> List.takeUntil (function SynMemberDefn.LetBindings _ -> false | _ -> true) + let _, ds2 = ds2 |> List.takeUntil (allFalse [isMember;isAbstractSlot;isInterface;isAutoProperty]) + + match ds2 with + | SynMemberDefn.LetBindings (range=m) :: _ -> errorR(Error(FSComp.SR.tcTypeDefinitionsWithImplicitConstructionMustHaveLocalBindingsBeforeMembers(), m)) + | _ -> () + + + /// Split auto-properties into 'let' and 'member' bindings + let private SplitAutoProps members = + let membersIncludingAutoProps = + members |> List.filter (fun memb -> + match memb with + | SynMemberDefn.Interface _ + | SynMemberDefn.Member _ + | SynMemberDefn.GetSetMember _ + | SynMemberDefn.LetBindings _ + | SynMemberDefn.ImplicitCtor _ + | SynMemberDefn.AutoProperty _ + | SynMemberDefn.Open _ + | SynMemberDefn.ImplicitInherit _ -> true + | SynMemberDefn.NestedType (_, _, m) -> error(Error(FSComp.SR.tcTypesCannotContainNestedTypes(), m)); false + // covered above + | SynMemberDefn.ValField _ + | SynMemberDefn.Inherit _ + | SynMemberDefn.AbstractSlot _ -> false) + + // Convert auto properties to let bindings in the pre-list + let rec preAutoProps memb = + match memb with + | SynMemberDefn.AutoProperty(attributes=Attributes attribs; isStatic=isStatic; ident=id; typeOpt=tyOpt; propKind=propKind; xmlDoc=xmlDoc; synExpr=synExpr; range=mWholeAutoProp) -> + // Only the keep the field-targeted attributes + let attribs = attribs |> List.filter (fun a -> match a.Target with Some t when t.idText = "field" -> true | _ -> false) + let mLetPortion = synExpr.Range + let fldId = ident (CompilerGeneratedName id.idText, mLetPortion) + let headPat = SynPat.LongIdent (SynLongIdent([fldId], [], [None]), None, Some noInferredTypars, SynArgPats.Pats [], None, mLetPortion) + let retInfo = match tyOpt with None -> None | Some ty -> Some (None, SynReturnInfo((ty, SynInfo.unnamedRetVal), ty.Range)) + let isMutable = + match propKind with + | SynMemberKind.PropertySet + | SynMemberKind.PropertyGetSet -> true + | _ -> false + let attribs = mkAttributeList attribs mWholeAutoProp + let binding = mkSynBinding (xmlDoc, headPat) (None, false, isMutable, mLetPortion, DebugPointAtBinding.NoneAtInvisible, retInfo, synExpr, synExpr.Range, [], attribs, None, SynBindingTrivia.Zero) + + [(SynMemberDefn.LetBindings ([binding], isStatic, false, mWholeAutoProp))] + + | SynMemberDefn.Interface (members=Some membs) -> membs |> List.collect preAutoProps + | SynMemberDefn.LetBindings _ + | SynMemberDefn.ImplicitCtor _ + | SynMemberDefn.Open _ + | SynMemberDefn.ImplicitInherit _ -> [memb] + | _ -> [] + + // Convert auto properties to member bindings in the post-list + let rec postAutoProps memb = + match memb with + | SynMemberDefn.AutoProperty(attributes=Attributes attribs; isStatic=isStatic; ident=id; typeOpt=tyOpt; propKind=propKind; memberFlags=memberFlags; memberFlagsForSet=memberFlagsForSet; xmlDoc=xmlDoc; accessibility=access; trivia = { GetSetKeyword = mGetSetOpt }) -> + let mMemberPortion = id.idRange + // Only the keep the non-field-targeted attributes + let attribs = attribs |> List.filter (fun a -> match a.Target with Some t when t.idText = "field" -> false | _ -> true) + let fldId = ident (CompilerGeneratedName id.idText, mMemberPortion) + let headPatIds = if isStatic then [id] else [ident ("__", mMemberPortion);id] + let headPat = SynPat.LongIdent (SynLongIdent(headPatIds, [], List.replicate headPatIds.Length None), None, Some noInferredTypars, SynArgPats.Pats [], None, mMemberPortion) + let memberFlags = { memberFlags with GetterOrSetterIsCompilerGenerated = true } + let memberFlagsForSet = { memberFlagsForSet with GetterOrSetterIsCompilerGenerated = true } + + match propKind, mGetSetOpt with + | SynMemberKind.PropertySet, Some m -> errorR(Error(FSComp.SR.parsMutableOnAutoPropertyShouldBeGetSetNotJustSet(), m)) + | _ -> () + + [ + match propKind with + | SynMemberKind.Member + | SynMemberKind.PropertyGet + | SynMemberKind.PropertyGetSet -> + let getter = + let rhsExpr = SynExpr.Ident fldId + let retInfo = match tyOpt with None -> None | Some ty -> Some (None, SynReturnInfo((ty, SynInfo.unnamedRetVal), ty.Range)) + let attribs = mkAttributeList attribs mMemberPortion + let binding = mkSynBinding (xmlDoc, headPat) (access, false, false, mMemberPortion, DebugPointAtBinding.NoneAtInvisible, retInfo, rhsExpr, rhsExpr.Range, [], attribs, Some memberFlags, SynBindingTrivia.Zero) + SynMemberDefn.Member (binding, mMemberPortion) + yield getter + | _ -> () + + match propKind with + | SynMemberKind.PropertySet + | SynMemberKind.PropertyGetSet -> + let setter = + let vId = ident("v", mMemberPortion) + let headPat = SynPat.LongIdent (SynLongIdent(headPatIds, [], List.replicate headPatIds.Length None), None, Some noInferredTypars, SynArgPats.Pats [mkSynPatVar None vId], None, mMemberPortion) + let rhsExpr = mkSynAssign (SynExpr.Ident fldId) (SynExpr.Ident vId) + let binding = mkSynBinding (xmlDoc, headPat) (access, false, false, mMemberPortion, DebugPointAtBinding.NoneAtInvisible, None, rhsExpr, rhsExpr.Range, [], [], Some memberFlagsForSet, SynBindingTrivia.Zero) + SynMemberDefn.Member (binding, mMemberPortion) + yield setter + | _ -> ()] + | SynMemberDefn.Interface (ty, mWith, Some membs, m) -> + let membs' = membs |> List.collect postAutoProps + [SynMemberDefn.Interface (ty, mWith, Some membs', m)] + | SynMemberDefn.LetBindings _ + | SynMemberDefn.ImplicitCtor _ + | SynMemberDefn.Open _ + | SynMemberDefn.ImplicitInherit _ -> [] + | _ -> [memb] + + let preMembers = membersIncludingAutoProps |> List.collect preAutoProps + let postMembers = membersIncludingAutoProps |> List.collect postAutoProps + + preMembers @ postMembers /// Separates the definition into core (shape) and body. /// @@ -3995,121 +4155,27 @@ module TcDeclarations = /// where members contain methods/overrides, also implicit ctor, inheritCall and local definitions. let rec private SplitTyconDefn (SynTypeDefn(typeInfo=synTyconInfo;typeRepr=trepr; members=extraMembers)) = let extraMembers = desugarGetSetMembers extraMembers - let implements1 = List.choose (function SynMemberDefn.Interface (interfaceType=ty) -> Some(ty, ty.Range) | _ -> None) extraMembers + let extraMembers = SplitAutoProps extraMembers + let implements1 = extraMembers |> List.choose (function SynMemberDefn.Interface (interfaceType=ty) -> Some(ty, ty.Range) | _ -> None) + match trepr with - | SynTypeDefnRepr.ObjectModel(kind, cspec, m) -> - let cspec = desugarGetSetMembers cspec - CheckMembersForm cspec - let fields = cspec |> List.choose (function SynMemberDefn.ValField (fieldInfo = f) -> Some f | _ -> None) - let implements2 = cspec |> List.choose (function SynMemberDefn.Interface (interfaceType=ty) -> Some(ty, ty.Range) | _ -> None) + | SynTypeDefnRepr.ObjectModel(kind, members, m) -> + let members = desugarGetSetMembers members + + CheckMembersForm members + + let fields = members |> List.choose (function SynMemberDefn.ValField (fieldInfo = f) -> Some f | _ -> None) + let implements2 = members |> List.choose (function SynMemberDefn.Interface (interfaceType=ty) -> Some(ty, ty.Range) | _ -> None) let inherits = - cspec |> List.choose (function + members |> List.choose (function | SynMemberDefn.Inherit (ty, idOpt, m) -> Some(ty, m, idOpt) | SynMemberDefn.ImplicitInherit (ty, _, idOpt, m) -> Some(ty, m, idOpt) | _ -> None) + //let nestedTycons = cspec |> List.choose (function SynMemberDefn.NestedType (x, _, _) -> Some x | _ -> None) - let slotsigs = cspec |> List.choose (function SynMemberDefn.AbstractSlot (x, y, _) -> Some(x, y) | _ -> None) + let slotsigs = members |> List.choose (function SynMemberDefn.AbstractSlot (x, y, _) -> Some(x, y) | _ -> None) - let members = - let membersIncludingAutoProps = - cspec |> List.filter (fun memb -> - match memb with - | SynMemberDefn.Interface _ - | SynMemberDefn.Member _ - | SynMemberDefn.GetSetMember _ - | SynMemberDefn.LetBindings _ - | SynMemberDefn.ImplicitCtor _ - | SynMemberDefn.AutoProperty _ - | SynMemberDefn.Open _ - | SynMemberDefn.ImplicitInherit _ -> true - | SynMemberDefn.NestedType (_, _, m) -> error(Error(FSComp.SR.tcTypesCannotContainNestedTypes(), m)); false - // covered above - | SynMemberDefn.ValField _ - | SynMemberDefn.Inherit _ - | SynMemberDefn.AbstractSlot _ -> false) - - // Convert auto properties to let bindings in the pre-list - let rec preAutoProps memb = - match memb with - | SynMemberDefn.AutoProperty(attributes=Attributes attribs; isStatic=isStatic; ident=id; typeOpt=tyOpt; propKind=propKind; xmlDoc=xmlDoc; synExpr=synExpr; range=mWholeAutoProp) -> - // Only the keep the field-targeted attributes - let attribs = attribs |> List.filter (fun a -> match a.Target with Some t when t.idText = "field" -> true | _ -> false) - let mLetPortion = synExpr.Range - let fldId = ident (CompilerGeneratedName id.idText, mLetPortion) - let headPat = SynPat.LongIdent (SynLongIdent([fldId], [], [None]), None, Some noInferredTypars, SynArgPats.Pats [], None, mLetPortion) - let retInfo = match tyOpt with None -> None | Some ty -> Some (None, SynReturnInfo((ty, SynInfo.unnamedRetVal), ty.Range)) - let isMutable = - match propKind with - | SynMemberKind.PropertySet - | SynMemberKind.PropertyGetSet -> true - | _ -> false - let attribs = mkAttributeList attribs mWholeAutoProp - let binding = mkSynBinding (xmlDoc, headPat) (None, false, isMutable, mLetPortion, DebugPointAtBinding.NoneAtInvisible, retInfo, synExpr, synExpr.Range, [], attribs, None, SynBindingTrivia.Zero) - - [(SynMemberDefn.LetBindings ([binding], isStatic, false, mWholeAutoProp))] - - | SynMemberDefn.Interface (members=Some membs) -> membs |> List.collect preAutoProps - | SynMemberDefn.LetBindings _ - | SynMemberDefn.ImplicitCtor _ - | SynMemberDefn.Open _ - | SynMemberDefn.ImplicitInherit _ -> [memb] - | _ -> [] - - // Convert auto properties to member bindings in the post-list - let rec postAutoProps memb = - match memb with - | SynMemberDefn.AutoProperty(attributes=Attributes attribs; isStatic=isStatic; ident=id; typeOpt=tyOpt; propKind=propKind; memberFlags=memberFlags; memberFlagsForSet=memberFlagsForSet; xmlDoc=xmlDoc; accessibility=access; trivia = { GetSetKeyword = mGetSetOpt }) -> - let mMemberPortion = id.idRange - // Only the keep the non-field-targeted attributes - let attribs = attribs |> List.filter (fun a -> match a.Target with Some t when t.idText = "field" -> false | _ -> true) - let fldId = ident (CompilerGeneratedName id.idText, mMemberPortion) - let headPatIds = if isStatic then [id] else [ident ("__", mMemberPortion);id] - let headPat = SynPat.LongIdent (SynLongIdent(headPatIds, [], List.replicate headPatIds.Length None), None, Some noInferredTypars, SynArgPats.Pats [], None, mMemberPortion) - let memberFlags = { memberFlags with GetterOrSetterIsCompilerGenerated = true } - let memberFlagsForSet = { memberFlagsForSet with GetterOrSetterIsCompilerGenerated = true } - - match propKind, mGetSetOpt with - | SynMemberKind.PropertySet, Some m -> errorR(Error(FSComp.SR.parsMutableOnAutoPropertyShouldBeGetSetNotJustSet(), m)) - | _ -> () - - [ - match propKind with - | SynMemberKind.Member - | SynMemberKind.PropertyGet - | SynMemberKind.PropertyGetSet -> - let getter = - let rhsExpr = SynExpr.Ident fldId - let retInfo = match tyOpt with None -> None | Some ty -> Some (None, SynReturnInfo((ty, SynInfo.unnamedRetVal), ty.Range)) - let attribs = mkAttributeList attribs mMemberPortion - let binding = mkSynBinding (xmlDoc, headPat) (access, false, false, mMemberPortion, DebugPointAtBinding.NoneAtInvisible, retInfo, rhsExpr, rhsExpr.Range, [], attribs, Some memberFlags, SynBindingTrivia.Zero) - SynMemberDefn.Member (binding, mMemberPortion) - yield getter - | _ -> () - - match propKind with - | SynMemberKind.PropertySet - | SynMemberKind.PropertyGetSet -> - let setter = - let vId = ident("v", mMemberPortion) - let headPat = SynPat.LongIdent (SynLongIdent(headPatIds, [], List.replicate headPatIds.Length None), None, Some noInferredTypars, SynArgPats.Pats [mkSynPatVar None vId], None, mMemberPortion) - let rhsExpr = mkSynAssign (SynExpr.Ident fldId) (SynExpr.Ident vId) - let binding = mkSynBinding (xmlDoc, headPat) (access, false, false, mMemberPortion, DebugPointAtBinding.NoneAtInvisible, None, rhsExpr, rhsExpr.Range, [], [], Some memberFlagsForSet, SynBindingTrivia.Zero) - SynMemberDefn.Member (binding, mMemberPortion) - yield setter - | _ -> ()] - | SynMemberDefn.Interface (ty, mWith, Some membs, m) -> - let membs' = membs |> List.collect postAutoProps - [SynMemberDefn.Interface (ty, mWith, Some membs', m)] - | SynMemberDefn.LetBindings _ - | SynMemberDefn.ImplicitCtor _ - | SynMemberDefn.Open _ - | SynMemberDefn.ImplicitInherit _ -> [] - | _ -> [memb] - - let preMembers = membersIncludingAutoProps |> List.collect preAutoProps - let postMembers = membersIncludingAutoProps |> List.collect postAutoProps - - preMembers @ postMembers + let members = SplitAutoProps members let isConcrete = members |> List.exists (function @@ -4151,6 +4217,7 @@ module TcDeclarations = core, members @ extraMembers | SynTypeDefnRepr.Simple(repr, _) -> + let members = [] let isAtOriginalTyconDefn = true let core = MutRecDefnsPhase1DataForTycon(synTyconInfo, repr, implements1, false, false, isAtOriginalTyconDefn) diff --git a/src/Compiler/Checking/CheckIncrementalClasses.fs b/src/Compiler/Checking/CheckIncrementalClasses.fs index 893cdc4e193..1befa8ec6ba 100644 --- a/src/Compiler/Checking/CheckIncrementalClasses.fs +++ b/src/Compiler/Checking/CheckIncrementalClasses.fs @@ -35,20 +35,32 @@ type IncrClassBindingGroup = | IncrClassDo of expr: Expr * isStatic: bool * range: Range /// Typechecked info for implicit constructor and it's arguments -type IncrClassCtorLhs = +type StaticCtorInfo = { /// The TyconRef for the type being defined TyconRef: TyconRef - /// The type parameters allocated for the implicit instance constructor. - /// These may be equated with other (WillBeRigid) type parameters through equi-recursive inference, and so - /// should always be renormalized/canonicalized when used. - InstanceCtorDeclaredTypars: Typars + /// The type parameters allocated for the implicit construction. + IncrCtorDeclaredTypars: Typars /// The value representing the static implicit constructor. /// Lazy to ensure the static ctor value is only published if needed. StaticCtorValInfo: Lazy + /// The name generator used to generate the names of fields etc. within the type. + NameGenerator: NiceNameGenerator + } + + /// Get the type parameters of the implicit constructor, after taking equi-recursive inference into account. + member ctorInfo.GetNormalizedIncrCtorDeclaredTypars (cenv: cenv) denv m = + let g = cenv.g + let ctorDeclaredTypars = ctorInfo.IncrCtorDeclaredTypars + let ctorDeclaredTypars = ChooseCanonicalDeclaredTyparsAfterInference g denv ctorDeclaredTypars m + ctorDeclaredTypars + +/// Typechecked info for implicit constructor and it's arguments +type IncrClassCtorInfo = + { /// The value representing the implicit constructor. InstanceCtorVal: Val @@ -71,20 +83,46 @@ type IncrClassCtorLhs = /// The value representing the 'this' variable within the implicit instance constructor. InstanceCtorThisVal: Val - /// The name generator used to generate the names of fields etc. within the type. - NameGenerator: NiceNameGenerator } - /// Get the type parameters of the implicit constructor, after taking equi-recursive inference into account. - member ctorInfo.GetNormalizedInstanceCtorDeclaredTypars (cenv: cenv) denv m = - let g = cenv.g - let ctorDeclaredTypars = ctorInfo.InstanceCtorDeclaredTypars - let ctorDeclaredTypars = ChooseCanonicalDeclaredTyparsAfterInference g denv ctorDeclaredTypars m - ctorDeclaredTypars +/// Check and elaborate the "left hand side" of the implicit class construction +/// syntax. +let TcStaticImplicitCtorInfo_Phase2A(cenv: cenv, env, tcref: TyconRef, m, copyOfTyconTypars) = + + let g = cenv.g + + // Add class typars to env + let env = AddDeclaredTypars CheckForDuplicateTypars copyOfTyconTypars env + + // We only generate the cctor on demand, because we don't need it if there are no cctor actions. + // The code below has a side-effect (MakeAndPublishVal), so we only want to run it once if at all. + // The .cctor is never referenced by any other code. + let cctorValInfo = + lazy + let cctorArgs = [ fst(mkCompGenLocal m "unitVar" g.unit_ty) ] + + let cctorTy = mkFunTy g g.unit_ty g.unit_ty + let valSynData = SynValInfo([[]], SynInfo.unnamedRetVal) + let id = ident ("cctor", m) + CheckForNonAbstractInterface ModuleOrMemberBinding tcref ClassCtorMemberFlags id.idRange + let memberInfo = MakeMemberDataAndMangledNameForMemberVal(g, tcref, false, [], [], ClassCtorMemberFlags, valSynData, id, false) + 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, 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 + + { TyconRef = tcref + IncrCtorDeclaredTypars = copyOfTyconTypars + StaticCtorValInfo = cctorValInfo + NameGenerator = NiceNameGenerator() + } /// Check and elaborate the "left hand side" of the implicit class construction /// syntax. -let TcImplicitCtorLhs_Phase2A(cenv: cenv, env, tpenv, tcref: TyconRef, vis, attrs, spats, thisIdOpt, baseValOpt: Val option, safeInitInfo, m, copyOfTyconTypars, objTy, thisTy, xmlDoc: PreXmlDoc) = +let TcImplicitCtorInfo_Phase2A(cenv: cenv, env, tpenv, tcref: TyconRef, vis, attrs, spats, thisIdOpt, baseValOpt: Val option, safeInitInfo, m, copyOfTyconTypars, objTy, thisTy, xmlDoc: PreXmlDoc) = let g = cenv.g let baseValOpt = @@ -139,26 +177,6 @@ let TcImplicitCtorLhs_Phase2A(cenv: cenv, env, tpenv, tcref: TyconRef, vis, attr let ctorVal = MakeAndPublishVal cenv env (Parent tcref, false, ModuleOrMemberBinding, ValInRecScope isComplete, ctorValScheme, attribs, xmlDoc, None, false) ctorValScheme, ctorVal - // We only generate the cctor on demand, because we don't need it if there are no cctor actions. - // The code below has a side-effect (MakeAndPublishVal), so we only want to run it once if at all. - // The .cctor is never referenced by any other code. - let cctorValInfo = - lazy - let cctorArgs = [ fst(mkCompGenLocal m "unitVar" g.unit_ty) ] - - let cctorTy = mkFunTy g g.unit_ty g.unit_ty - let valSynData = SynValInfo([[]], SynInfo.unnamedRetVal) - let id = ident ("cctor", m) - CheckForNonAbstractInterface ModuleOrMemberBinding tcref ClassCtorMemberFlags id.idRange - let memberInfo = MakeMemberDataAndMangledNameForMemberVal(g, tcref, false, [], [], ClassCtorMemberFlags, valSynData, id, false) - 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, 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) @@ -166,18 +184,13 @@ let TcImplicitCtorLhs_Phase2A(cenv: cenv, env, tpenv, tcref: TyconRef, vis, attr let thisVal = MakeAndPublishVal cenv env (ParentNone, false, ClassLetBinding false, ValNotInRecScope, thisValScheme, [], XmlDoc.Empty, None, false) thisVal - { TyconRef = tcref - InstanceCtorDeclaredTypars = copyOfTyconTypars - StaticCtorValInfo = cctorValInfo - InstanceCtorArgs = ctorArgs + { InstanceCtorArgs = ctorArgs InstanceCtorVal = ctorVal InstanceCtorValScheme = ctorValScheme InstanceCtorBaseValOpt = baseValOpt InstanceCtorSafeThisValOpt = safeThisValOpt InstanceCtorSafeInitInfo = safeInitInfo InstanceCtorThisVal = thisVal - // For generating names of local fields - NameGenerator = NiceNameGenerator() } @@ -256,13 +269,15 @@ type IncrClassReprInfo = /// /// /// - /// + /// + /// /// The vars forced to be fields due to static member bindings, instance initialization expressions or instance member bindings /// The vars forced to be fields due to instance member bindings /// /// member localRep.ChooseRepresentation (cenv: cenv, env: TcEnv, isStatic, isCtorArg, - ctorInfo: IncrClassCtorLhs, + staticCtorInfo: StaticCtorInfo, + ctorInfoOpt: IncrClassCtorInfo option, staticForcedFieldVars: FreeLocals, instanceForcedFieldVars: FreeLocals, takenFieldNames: Set, @@ -271,7 +286,7 @@ type IncrClassReprInfo = let v = bind.Var let relevantForcedFieldVars = (if isStatic then staticForcedFieldVars else instanceForcedFieldVars) - let tcref = ctorInfo.TyconRef + let tcref = staticCtorInfo.TyconRef let name, takenFieldNames = let isNameTaken = @@ -282,7 +297,7 @@ type IncrClassReprInfo = let nm = if isNameTaken then - ctorInfo.NameGenerator.FreshCompilerGeneratedName (v.LogicalName, v.Range) + staticCtorInfo.NameGenerator.FreshCompilerGeneratedName (v.LogicalName, v.Range) else v.LogicalName nm, takenFieldNames.Add nm @@ -326,7 +341,7 @@ type IncrClassReprInfo = let id = mkSynId v.Range name let memberInfo = MakeMemberDataAndMangledNameForMemberVal(g, tcref, false, [], [], memberFlags, valSynInfo, mkSynId v.Range name, true) - let copyOfTyconTypars = ctorInfo.GetNormalizedInstanceCtorDeclaredTypars cenv env.DisplayEnv ctorInfo.TyconRef.Range + let copyOfTyconTypars = staticCtorInfo.GetNormalizedIncrCtorDeclaredTypars cenv env.DisplayEnv staticCtorInfo.TyconRef.Range AdjustValToHaveValReprInfo v (Parent tcref) valReprInfo @@ -336,10 +351,13 @@ type IncrClassReprInfo = if isStatic then tauTy, valReprInfo else - let tauTy = mkFunTy g ctorInfo.InstanceCtorThisVal.Type v.TauType - let (ValReprInfo(tpNames, args, ret)) = valReprInfo - let valReprInfo = ValReprInfo(tpNames, ValReprInfo.selfMetadata :: args, ret) - tauTy, valReprInfo + match ctorInfoOpt with + | None -> tauTy, valReprInfo + | Some ctorInfo -> + let tauTy = mkFunTy g ctorInfo.InstanceCtorThisVal.Type v.TauType + let (ValReprInfo(tpNames, args, ret)) = valReprInfo + let valReprInfo = ValReprInfo(tpNames, ValReprInfo.selfMetadata :: args, ret) + tauTy, valReprInfo // Add the enclosing type parameters on to the function let valReprInfo = @@ -360,9 +378,9 @@ type IncrClassReprInfo = repr, takenFieldNames /// Extend the known local representations by choosing a representation for a binding - member localRep.ChooseAndAddRepresentation(cenv: cenv, env: TcEnv, isStatic, isCtorArg, ctorInfo: IncrClassCtorLhs, staticForcedFieldVars: FreeLocals, instanceForcedFieldVars: FreeLocals, bind: Binding) = + member localRep.ChooseAndAddRepresentation(cenv, env, isStatic, isCtorArg, staticCtorInfo, ctorInfoOpt, staticForcedFieldVars, instanceForcedFieldVars, bind: Binding) = let v = bind.Var - let repr, takenFieldNames = localRep.ChooseRepresentation (cenv, env, isStatic, isCtorArg, ctorInfo, staticForcedFieldVars, instanceForcedFieldVars, localRep.TakenFieldNames, bind ) + let repr, takenFieldNames = localRep.ChooseRepresentation (cenv, env, isStatic, isCtorArg, staticCtorInfo, ctorInfoOpt, staticForcedFieldVars, instanceForcedFieldVars, localRep.TakenFieldNames, bind ) // OK, representation chosen, now add it {localRep with TakenFieldNames=takenFieldNames @@ -448,8 +466,8 @@ type IncrClassReprInfo = /// Mutate a type definition by adding fields /// Used as part of processing "let" bindings in a type definition. - member localRep.PublishIncrClassFields (cenv, denv, cpath, ctorInfo: IncrClassCtorLhs, safeStaticInitInfo) = - let tcref = ctorInfo.TyconRef + member localRep.PublishIncrClassFields (cenv, denv, cpath, staticCtorInfo: StaticCtorInfo, safeStaticInitInfo) = + let tcref = staticCtorInfo.TyconRef let rfspecs = [ for KeyValue(v, repr) in localRep.ValReprs do match repr with @@ -458,7 +476,7 @@ type IncrClassReprInfo = // constructor arguments. This is important for the "default value" and "does it have an implicit default constructor" // semantic conditions for structs - see bug FSharp 1.0 5304. if isStatic || not tcref.IsFSharpStructOrEnumTycon then - let ctorDeclaredTypars = ctorInfo.GetNormalizedInstanceCtorDeclaredTypars cenv denv ctorInfo.TyconRef.Range + let ctorDeclaredTypars = staticCtorInfo.GetNormalizedIncrCtorDeclaredTypars cenv denv staticCtorInfo.TyconRef.Range // Note: tcrefObjTy contains the original "formal" typars, thisTy is the "fresh" one... f<>fresh. let revTypeInst = List.zip ctorDeclaredTypars (tcref.TyparsNoRange |> List.map mkTyparTy) @@ -474,7 +492,7 @@ type IncrClassReprInfo = let recdFields = Construct.MakeRecdFieldsTable (rfspecs @ tcref.AllFieldsAsList) // Mutate the entity_tycon_repr to publish the fields - tcref.Deref.entity_tycon_repr <- TFSharpObjectRepr { tcref.FSharpObjectModelTypeInfo with fsobjmodel_rfields = recdFields} + tcref.Deref.entity_tycon_repr <- TFSharpTyconRepr { tcref.FSharpTyconRepresentationData with fsobjmodel_rfields = recdFields} /// Given localRep saying how locals have been represented, e.g. as fields. @@ -533,25 +551,13 @@ type IncrClassConstructionBindingsPhase2C = | Phase2CCtorJustAfterSuperInit | Phase2CCtorJustAfterLastLet -/// /// Given a set of 'let' bindings (static or not, recursive or not) that make up a class, /// generate their initialization expression(s). -/// -/// -/// -/// The lhs information about the implicit constructor -/// The call to the super class constructor -/// Should we place a sequence point at the 'inheritedTys call? -/// The declarations -/// -/// Record any unconstrained type parameters generalized for the outer members as "free choices" in the let bindings -/// let MakeCtorForIncrClassConstructionPhase2C( cenv: cenv, env: TcEnv, - ctorInfo: IncrClassCtorLhs, - inheritsExpr, - inheritsIsVisible, + staticCtorInfo: StaticCtorInfo, + instanceInfo: (IncrClassCtorInfo * Expr * bool) option, decs: IncrClassConstructionBindingsPhase2C list, memberBinds: Binding list, generalizedTyparsForRecursiveBlock, @@ -561,15 +567,30 @@ let MakeCtorForIncrClassConstructionPhase2C( let denv = env.DisplayEnv let g = cenv.g - let thisVal = ctorInfo.InstanceCtorThisVal - let m = thisVal.Range - let ctorDeclaredTypars = ctorInfo.GetNormalizedInstanceCtorDeclaredTypars cenv denv m + let thisValOpt = + match instanceInfo with + | None -> None + | Some (ctorInfo, _, _) -> Some ctorInfo.InstanceCtorThisVal + + let ctorInfoOpt = + match instanceInfo with + | None -> None + | Some (ctorInfo, _, _) -> Some ctorInfo + + let m = + match thisValOpt with + | Some thisVal -> thisVal.Range + | None -> staticCtorInfo.TyconRef.Range + + let ctorDeclaredTypars = staticCtorInfo.GetNormalizedIncrCtorDeclaredTypars cenv denv m ctorDeclaredTypars |> List.iter (SetTyparRigid env.DisplayEnv m) // Reconstitute the type with the correct quantified type variables. - ctorInfo.InstanceCtorVal.SetType (mkForallTyIfNeeded ctorDeclaredTypars ctorInfo.InstanceCtorVal.TauType) + match instanceInfo with + | Some (ctorInfo, _, _) -> ctorInfo.InstanceCtorVal.SetType (mkForallTyIfNeeded ctorDeclaredTypars ctorInfo.InstanceCtorVal.TauType) + | None -> () let freeChoiceTypars = ListSet.subtract typarEq generalizedTyparsForRecursiveBlock ctorDeclaredTypars @@ -624,7 +645,10 @@ let MakeCtorForIncrClassConstructionPhase2C( let instanceForcedFieldVars = (instanceForcedFieldVars, memberBinds) ||> accFreeInBindings // Any references to static variables in the 'inherits' expression force those static variables to be represented as fields - let staticForcedFieldVars = (staticForcedFieldVars, inheritsExpr) ||> accFreeInExpr + let staticForcedFieldVars = + match instanceInfo with + | Some (_, inheritsExpr, _) -> (staticForcedFieldVars, inheritsExpr) ||> accFreeInExpr + | None -> staticForcedFieldVars (staticForcedFieldVars.FreeLocals, instanceForcedFieldVars.FreeLocals) @@ -634,13 +658,16 @@ let MakeCtorForIncrClassConstructionPhase2C( let TransBind (reps: IncrClassReprInfo) (TBind(v, rhsExpr, spBind)) = if v.MustInline then error(Error(FSComp.SR.tcLocalClassBindingsCannotBeInline(), v.Range)) - let rhsExpr = reps.FixupIncrClassExprPhase2C cenv (Some thisVal) safeStaticInitInfo thisTyInst rhsExpr + let rhsExpr = reps.FixupIncrClassExprPhase2C cenv thisValOpt safeStaticInitInfo thisTyInst rhsExpr // The initialization of the 'ref cell' variable for 'this' is the only binding which comes prior to the super init let isPriorToSuperInit = - match ctorInfo.InstanceCtorSafeThisValOpt with + match instanceInfo with | None -> false - | Some v2 -> valEq v v2 + | Some (ctorInfo, _, _) -> + match ctorInfo.InstanceCtorSafeThisValOpt with + | None -> false + | Some v2 -> valEq v v2 match reps.LookupRepr v with | InMethod(isStatic, methodVal, _) -> @@ -658,8 +685,11 @@ let MakeCtorForIncrClassConstructionPhase2C( if isStatic then tauExpr, tauTy else - let e = mkLambda m thisVal (tauExpr, tauTy) - e, tyOfExpr g e + match thisValOpt with + | None -> tauExpr, tauTy + | Some thisVal -> + let e = mkLambda m thisVal (tauExpr, tauTy) + e, tyOfExpr g e // Replace the type parameters that used to be on the rhs with // the full set of type parameters including the type parameters of the enclosing class @@ -681,14 +711,14 @@ let MakeCtorForIncrClassConstructionPhase2C( | DebugPointAtBinding.Yes m, _ -> m | _ -> v.Range - let assignExpr = reps.MakeValueAssign (Some thisVal) thisTyInst NoSafeInitInfo v rhsExpr m + let assignExpr = reps.MakeValueAssign thisValOpt thisTyInst NoSafeInitInfo v rhsExpr m let adjustSafeInitFieldExprOpt = if isStatic then match safeStaticInitInfo with | SafeInitField (rfref, _) -> let setExpr = mkStaticRecdFieldSet (rfref, thisTyInst, mkInt g m idx, m) - let setExpr = reps.FixupIncrClassExprPhase2C cenv (Some thisVal) NoSafeInitInfo thisTyInst setExpr + let setExpr = reps.FixupIncrClassExprPhase2C cenv thisValOpt NoSafeInitInfo thisTyInst setExpr Some setExpr | NoSafeInitInfo -> None @@ -714,7 +744,7 @@ let MakeCtorForIncrClassConstructionPhase2C( match dec with | IncrClassBindingGroup(binds, isStatic, isRec) -> let actions, reps, methodBinds = - let reps = (reps, binds) ||> List.fold (fun rep bind -> rep.ChooseAndAddRepresentation(cenv, env, isStatic, isCtorArg, ctorInfo, staticForcedFieldVars, instanceForcedFieldVars, bind)) // extend + let reps = (reps, binds) ||> List.fold (fun rep bind -> rep.ChooseAndAddRepresentation(cenv, env, isStatic, isCtorArg, staticCtorInfo, ctorInfoOpt, staticForcedFieldVars, instanceForcedFieldVars, bind)) // extend if isRec then // Note: the recursive calls are made via members on the object // or via access to fields. This means the recursive loop is "broken", @@ -733,7 +763,7 @@ let MakeCtorForIncrClassConstructionPhase2C( ([], actions, methodBinds), reps | IncrClassDo (doExpr, isStatic, mFull) -> - let doExpr = reps.FixupIncrClassExprPhase2C cenv (Some thisVal) safeStaticInitInfo thisTyInst doExpr + let doExpr = reps.FixupIncrClassExprPhase2C cenv thisValOpt safeStaticInitInfo thisTyInst doExpr // Extend the range of any immediate debug point to include the 'do' let doExpr = match doExpr with @@ -754,11 +784,14 @@ let MakeCtorForIncrClassConstructionPhase2C( // The call to the base class constructor is done so we can set the ref cell | Phase2CCtorJustAfterSuperInit -> let binders = - [ match ctorInfo.InstanceCtorSafeThisValOpt with + [ match instanceInfo with + | None -> () + | Some (ctorInfo, _, _) -> + match ctorInfo.InstanceCtorSafeThisValOpt with | None -> () | Some v -> let setExpr = mkRefCellSet g m ctorInfo.InstanceCtorThisVal.Type (exprForVal m v) (exprForVal m ctorInfo.InstanceCtorThisVal) - let setExpr = reps.FixupIncrClassExprPhase2C cenv (Some thisVal) safeStaticInitInfo thisTyInst setExpr + let setExpr = reps.FixupIncrClassExprPhase2C cenv thisValOpt safeStaticInitInfo thisTyInst setExpr let binder = (fun e -> mkSequential setExpr.Range setExpr e) let isPriorToSuperInit = false yield (isPriorToSuperInit, binder) ] @@ -769,10 +802,13 @@ let MakeCtorForIncrClassConstructionPhase2C( // which now allows members to be called. | Phase2CCtorJustAfterLastLet -> let binders = - [ match ctorInfo.InstanceCtorSafeInitInfo with + [ match instanceInfo with + | None -> () + | Some (ctorInfo, _, _) -> + match ctorInfo.InstanceCtorSafeInitInfo with | SafeInitField (rfref, _) -> - let setExpr = mkRecdFieldSetViaExprAddr (exprForVal m thisVal, rfref, thisTyInst, mkOne g m, m) - let setExpr = reps.FixupIncrClassExprPhase2C cenv (Some thisVal) safeStaticInitInfo thisTyInst setExpr + let setExpr = mkRecdFieldSetViaExprAddr (exprForVal m ctorInfo.InstanceCtorThisVal, rfref, thisTyInst, mkOne g m, m) + let setExpr = reps.FixupIncrClassExprPhase2C cenv thisValOpt safeStaticInitInfo thisTyInst setExpr let binder = (fun e -> mkSequential setExpr.Range setExpr e) let isPriorToSuperInit = false yield (isPriorToSuperInit, binder) @@ -801,7 +837,11 @@ let MakeCtorForIncrClassConstructionPhase2C( // the value is already available as an argument, and that nothing special needs to be done unless the // value is being stored into a field. let (cctorInitActions1, ctorInitActions1, methodBinds1), reps = - let binds = ctorInfo.InstanceCtorArgs |> List.map (fun v -> mkInvisibleBind v (exprForVal v.Range v)) + let binds = + match instanceInfo with + | None -> [] + | Some (ctorInfo, _, _) -> + ctorInfo.InstanceCtorArgs |> List.map (fun v -> mkInvisibleBind v (exprForVal v.Range v)) TransTrueDec true reps (IncrClassBindingGroup(binds, false, false)) // We expect that only ctorInitActions1 will be non-empty here, and even then only if some elements are stored in the field @@ -815,7 +855,10 @@ let MakeCtorForIncrClassConstructionPhase2C( let ctorInitActions = ctorInitActions1 @ List.concat ctorInitActions2 let methodBinds = methodBinds1 @ List.concat methodBinds2 - let ctorBody = + let ctorBodyOpt = + match instanceInfo with + | None -> None + | Some (ctorInfo, inheritsExpr, inheritsIsVisible) -> // Build the elements of the implicit constructor body, starting from the bottom // // @@ -840,7 +883,7 @@ let MakeCtorForIncrClassConstructionPhase2C( // // As a result, the most natural way to implement this would be to simply capture arg0 if needed // and access all variables via that. This would be done by rewriting the inheritsExpr as follows: - // let inheritsExpr = reps.FixupIncrClassExprPhase2C (Some thisVal) thisTyInst inheritsExpr + // let inheritsExpr = reps.FixupIncrClassExprPhase2C thisValOpt thisTyInst inheritsExpr // However, the rules of IL mean we are not actually allowed to capture arg0 // and store it as a closure field before the base class constructor is called. // @@ -854,7 +897,7 @@ let MakeCtorForIncrClassConstructionPhase2C( // Rewrite the expression to convert it to a load of a field if needed. // We are allowed to load fields from our own object even though we haven't called // the super class constructor yet. - let ldexpr = reps.FixupIncrClassExprPhase2C cenv (Some thisVal) safeStaticInitInfo thisTyInst (exprForVal m v) + let ldexpr = reps.FixupIncrClassExprPhase2C cenv thisValOpt safeStaticInitInfo thisTyInst (exprForVal m v) mkInvisibleLet m v ldexpr inheritsExpr | _ -> inheritsExpr @@ -872,9 +915,9 @@ let MakeCtorForIncrClassConstructionPhase2C( let ctorBody = List.foldBack (fun (_, binder) acc -> binder acc) ctorInitActionsPre ctorBody // Add the final wrapping to make this into a method - let ctorBody = mkMemberLambdas g m [] (Some thisVal) ctorInfo.InstanceCtorBaseValOpt [ctorInfo.InstanceCtorArgs] (ctorBody, g.unit_ty) + let ctorBody = mkMemberLambdas g m [] thisValOpt ctorInfo.InstanceCtorBaseValOpt [ctorInfo.InstanceCtorArgs] (ctorBody, g.unit_ty) - ctorBody + Some ctorBody let cctorBodyOpt = // Omit the .cctor if it's empty @@ -882,11 +925,10 @@ let MakeCtorForIncrClassConstructionPhase2C( | [] -> None | _ -> let cctorInitAction = List.foldBack (fun (_, binder) acc -> binder acc) cctorInitActions (mkUnit g m) - let m = thisVal.Range - let cctorArgs, cctorVal, _ = ctorInfo.StaticCtorValInfo.Force() + let cctorArgs, cctorVal, _ = staticCtorInfo.StaticCtorValInfo.Force() // Reconstitute the type of the implicit class constructor with the correct quantified type variables. cctorVal.SetType (mkForallTyIfNeeded ctorDeclaredTypars cctorVal.TauType) let cctorBody = mkMemberLambdas g m [] None None [cctorArgs] (cctorInitAction, g.unit_ty) Some cctorBody - ctorBody, cctorBodyOpt, methodBinds, reps + ctorBodyOpt, cctorBodyOpt, methodBinds, reps diff --git a/src/Compiler/Checking/CheckIncrementalClasses.fsi b/src/Compiler/Checking/CheckIncrementalClasses.fsi index cef65f2a33f..2ed5c559d80 100644 --- a/src/Compiler/Checking/CheckIncrementalClasses.fsi +++ b/src/Compiler/Checking/CheckIncrementalClasses.fsi @@ -13,21 +13,26 @@ open FSharp.Compiler.Xml exception ParameterlessStructCtor of range: range -/// Typechecked info for implicit constructor and it's arguments -type IncrClassCtorLhs = +/// Typechecked info for implicit static constructor +type StaticCtorInfo = { /// The TyconRef for the type being defined TyconRef: TyconRef - /// The type parameters allocated for the implicit instance constructor. - /// These may be equated with other (WillBeRigid) type parameters through equi-recursive inference, and so - /// should always be renormalized/canonicalized when used. - InstanceCtorDeclaredTypars: Typars + /// The copy of the type parameters allocated for implicit construction + IncrCtorDeclaredTypars: Typars /// The value representing the static implicit constructor. /// Lazy to ensure the static ctor value is only published if needed. StaticCtorValInfo: Lazy + /// The name generator used to generate the names of fields etc. within the type. + NameGenerator: NiceNameGenerator + } + +/// Typechecked info for implicit instance constructor and it's arguments +type IncrClassCtorInfo = + { /// The value representing the implicit constructor. InstanceCtorVal: Val @@ -49,9 +54,6 @@ type IncrClassCtorLhs = /// The value representing the 'this' variable within the implicit instance constructor. InstanceCtorThisVal: Val - - /// The name generator used to generate the names of fields etc. within the type. - NameGenerator: NiceNameGenerator } /// Indicates how is a 'let' bound value in a class with implicit construction is represented in @@ -90,7 +92,7 @@ type IncrClassReprInfo = cenv: TcFileState * denv: DisplayEnv * cpath: CompilationPath * - ctorInfo: IncrClassCtorLhs * + staticCtorInfo: StaticCtorInfo * safeStaticInitInfo: SafeInitData -> unit @@ -116,7 +118,17 @@ type IncrClassConstructionBindingsPhase2C = /// Check and elaborate the "left hand side" of the implicit class construction /// syntax. -val TcImplicitCtorLhs_Phase2A: +val TcStaticImplicitCtorInfo_Phase2A: + cenv: TcFileState * + env: TcEnv * + tcref: TyconRef * + m: range * + copyOfTyconTypars: Typar list -> + StaticCtorInfo + +/// Check and elaborate the "left hand side" of the implicit class construction +/// syntax. +val TcImplicitCtorInfo_Phase2A: cenv: TcFileState * env: TcEnv * tpenv: UnscopedTyparEnv * @@ -132,7 +144,7 @@ val TcImplicitCtorLhs_Phase2A: objTy: TType * thisTy: TType * xmlDoc: PreXmlDoc -> - IncrClassCtorLhs + IncrClassCtorInfo /// /// Given a set of 'let' bindings (static or not, recursive or not) that make up a class, @@ -140,9 +152,8 @@ val TcImplicitCtorLhs_Phase2A: /// /// /// -/// The lhs information about the implicit constructor -/// The call to the super class constructor -/// Should we place a sequence point at the 'inheritedTys call? +/// The information about the static implicit constructor +/// The lhs information about the implicit constructor, the call to the super class constructor and whether we should we place a sequence point at the 'inheritedTys call? /// The declarations /// /// Record any unconstrained type parameters generalized for the outer members as "free choices" in the let bindings @@ -150,11 +161,10 @@ val TcImplicitCtorLhs_Phase2A: val MakeCtorForIncrClassConstructionPhase2C: cenv: TcFileState * env: TcEnv * - ctorInfo: IncrClassCtorLhs * - inheritsExpr: Expr * - inheritsIsVisible: bool * + staticCtorInfo: StaticCtorInfo * + instanceInfo: (IncrClassCtorInfo * Expr * bool) option * decs: IncrClassConstructionBindingsPhase2C list * memberBinds: Binding list * generalizedTyparsForRecursiveBlock: Typar list * safeStaticInitInfo: SafeInitData -> - Expr * Expr option * Binding list * IncrClassReprInfo + Expr option * Expr option * Binding list * IncrClassReprInfo diff --git a/src/Compiler/Checking/NicePrint.fs b/src/Compiler/Checking/NicePrint.fs index 6f2bcb62f80..0ad24d0f9ea 100644 --- a/src/Compiler/Checking/NicePrint.fs +++ b/src/Compiler/Checking/NicePrint.fs @@ -1696,11 +1696,13 @@ module TastDefinitionPrinting = let breakTypeDefnEqn repr = match repr with | TILObjectRepr _ -> true - | TFSharpObjectRepr _ -> true - | TFSharpRecdRepr _ -> true - | TFSharpUnionRepr r -> - not (isNilOrSingleton r.CasesTable.UnionCasesAsList) || - r.CasesTable.UnionCasesAsList |> List.exists (fun uc -> not uc.XmlDoc.IsEmpty) + | TFSharpTyconRepr d -> + match d.fsobjmodel_kind with + | TFSharpUnion -> + let r = d.fsobjmodel_cases + not (isNilOrSingleton r.UnionCasesAsList) || + r.UnionCasesAsList |> List.exists (fun uc -> not uc.XmlDoc.IsEmpty) + | _ -> true | TAsmRepr _ | TMeasureableRepr _ #if !NO_TYPEPROVIDERS @@ -2002,7 +2004,7 @@ module TastDefinitionPrinting = let typeDeclL = match repr with - | TFSharpRecdRepr _ -> + | TFSharpTyconRepr { fsobjmodel_kind=TFSharpRecord } -> let denv = denv.AddAccessibility tycon.TypeReprAccessibility // For records, use multi-line layout as soon as there is XML doc @@ -2038,7 +2040,7 @@ module TastDefinitionPrinting = |> addMaxMembers |> addLhs - | TFSharpUnionRepr _ -> + | TFSharpTyconRepr { fsobjmodel_kind = TFSharpUnion } -> let denv = denv.AddAccessibility tycon.TypeReprAccessibility tycon.UnionCasesAsList |> layoutUnionCases denv infoReader tcref @@ -2048,7 +2050,7 @@ module TastDefinitionPrinting = |> addMaxMembers |> addLhs - | TFSharpObjectRepr { fsobjmodel_kind = TFSharpDelegate slotSig } -> + | TFSharpTyconRepr { fsobjmodel_kind = TFSharpDelegate slotSig } -> let (TSlotSig(_, _, _, _, paraml, retTy)) = slotSig let retTy = GetFSharpViewOfReturnType denv.g retTy let delegateL = WordL.keywordDelegate ^^ WordL.keywordOf -* layoutTopType denv SimplifyTypes.typeSimplificationInfo0 (paraml |> List.mapSquared (fun sp -> (sp.Type, ValReprInfo.unnamedTopArg1))) retTy [] @@ -2056,10 +2058,10 @@ module TastDefinitionPrinting = |> addLhs // Measure declarations are '[] type kg' unless abbreviations - | TFSharpObjectRepr _ when isMeasure -> + | TFSharpTyconRepr _ when isMeasure -> lhsL - | TFSharpObjectRepr { fsobjmodel_kind = TFSharpEnum } -> + | TFSharpTyconRepr { fsobjmodel_kind = TFSharpEnum } -> tycon.TrueFieldsAsList |> List.map (fun f -> match f.LiteralValue with @@ -2072,7 +2074,7 @@ module TastDefinitionPrinting = |> aboveListL |> addLhs - | TFSharpObjectRepr objRepr when isNil allDecls -> + | TFSharpTyconRepr objRepr when isNil allDecls -> match objRepr.fsobjmodel_kind with | TFSharpClass -> WordL.keywordClass ^^ WordL.keywordEnd @@ -2085,7 +2087,7 @@ module TastDefinitionPrinting = |> addLhs | _ -> lhsL - | TFSharpObjectRepr _ -> + | TFSharpTyconRepr _ -> allDecls |> applyMaxMembers denv.maxMembers |> aboveListL diff --git a/src/Compiler/Checking/PostInferenceChecks.fs b/src/Compiler/Checking/PostInferenceChecks.fs index 9338abd28f5..8ed798cd1d1 100644 --- a/src/Compiler/Checking/PostInferenceChecks.fs +++ b/src/Compiler/Checking/PostInferenceChecks.fs @@ -2465,7 +2465,7 @@ let CheckEntityDefn cenv env (tycon: Entity) = if TyconRefHasAttribute g m g.attrib_IsReadOnlyAttribute tcref && not tycon.IsStructOrEnumTycon then errorR(Error(FSComp.SR.tcIsReadOnlyNotStruct(), tycon.Range)) - // Considers TFSharpObjectRepr, TFSharpRecdRepr and TFSharpUnionRepr. + // Considers TFSharpTyconRepr and TFSharpUnionRepr. // [Review] are all cases covered: TILObjectRepr, TAsmRepr. [Yes - these are FSharp.Core.dll only] tycon.AllFieldsArray |> Array.iter (CheckRecdField false cenv env tycon) @@ -2503,7 +2503,7 @@ let CheckEntityDefn cenv env (tycon: Entity) = if tycon.IsFSharpDelegateTycon then match tycon.TypeReprInfo with - | TFSharpObjectRepr r -> + | TFSharpTyconRepr r -> match r.fsobjmodel_kind with | TFSharpDelegate ss -> //ss.ClassTypars diff --git a/src/Compiler/Checking/SignatureConformance.fs b/src/Compiler/Checking/SignatureConformance.fs index 8e10990d11d..cf8ee250af9 100644 --- a/src/Compiler/Checking/SignatureConformance.fs +++ b/src/Compiler/Checking/SignatureConformance.fs @@ -495,15 +495,13 @@ type Checker(g, amap, denv, remapInfo: SignatureRepackageInfo, checkingSig) = | l -> (errorR (Error (FSComp.SR.DefinitionsInSigAndImplNotCompatibleImplDefinesButSignatureDoesNot(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName, k, String.concat ";" l), m)); false) match implTycon.TypeReprInfo, sigTypeRepr with - | (TFSharpRecdRepr _ - | TFSharpUnionRepr _ - | TILObjectRepr _ + | (TILObjectRepr _ #if !NO_TYPEPROVIDERS | TProvidedTypeRepr _ | TProvidedNamespaceRepr _ #endif ), TNoRepr -> true - | TFSharpObjectRepr r, TNoRepr -> + | TFSharpTyconRepr r, TNoRepr -> match r.fsobjmodel_kind with | TFSharpStruct | TFSharpEnum -> (errorR (Error(FSComp.SR.DefinitionsInSigAndImplNotCompatibleImplDefinesStruct(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName), m)); false) @@ -513,23 +511,33 @@ type Checker(g, amap, denv, remapInfo: SignatureRepackageInfo, checkingSig) = (errorR (Error(FSComp.SR.DefinitionsInSigAndImplNotCompatibleDotNetTypeRepresentationIsHidden(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName), m)); false) | TMeasureableRepr _, TNoRepr -> (errorR (Error(FSComp.SR.DefinitionsInSigAndImplNotCompatibleTypeIsHidden(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName), m)); false) - | TFSharpUnionRepr r1, TFSharpUnionRepr r2 -> + + // Union types are compatible with union types in signature + | TFSharpTyconRepr { fsobjmodel_kind=TFSharpUnion; fsobjmodel_cases=r1}, + TFSharpTyconRepr { fsobjmodel_kind=TFSharpUnion; fsobjmodel_cases=r2} -> let ucases1 = r1.UnionCasesAsList let ucases2 = r2.UnionCasesAsList if ucases1.Length <> ucases2.Length then let names (l: UnionCase list) = l |> List.map (fun c -> c.Id.idText) reportNiceError "union case" (names ucases1) (names ucases2) else List.forall2 (checkUnionCase aenv infoReader implTycon) ucases1 ucases2 - | TFSharpRecdRepr implFields, TFSharpRecdRepr sigFields -> + + // Record types are compatible with union types in signature + | TFSharpTyconRepr { fsobjmodel_kind=TFSharpRecord; fsobjmodel_rfields=implFields}, + TFSharpTyconRepr { fsobjmodel_kind=TFSharpRecord; fsobjmodel_rfields=sigFields} -> checkRecordFields m aenv infoReader implTycon implFields sigFields - | TFSharpObjectRepr r1, TFSharpObjectRepr r2 -> - if not (match r1.fsobjmodel_kind, r2.fsobjmodel_kind with - | TFSharpClass, TFSharpClass -> true - | TFSharpInterface, TFSharpInterface -> true - | TFSharpStruct, TFSharpStruct -> true - | TFSharpEnum, TFSharpEnum -> true - | TFSharpDelegate (TSlotSig(_, typ1, ctps1, mtps1, ps1, rty1)), - TFSharpDelegate (TSlotSig(_, typ2, ctps2, mtps2, ps2, rty2)) -> + + // Record types are compatible with union types in signature + | TFSharpTyconRepr r1, TFSharpTyconRepr r2 -> + let compat = + match r1.fsobjmodel_kind, r2.fsobjmodel_kind with + | TFSharpRecord, TFSharpClass -> true + | TFSharpClass, TFSharpClass -> true + | TFSharpInterface, TFSharpInterface -> true + | TFSharpStruct, TFSharpStruct -> true + | TFSharpEnum, TFSharpEnum -> true + | TFSharpDelegate (TSlotSig(_, typ1, ctps1, mtps1, ps1, rty1)), + TFSharpDelegate (TSlotSig(_, typ2, ctps2, mtps2, ps2, rty2)) -> (typeAEquiv g aenv typ1 typ2) && (ctps1.Length = ctps2.Length) && (let aenv = aenv.BindEquivTypars ctps1 ctps2 @@ -539,8 +547,10 @@ type Checker(g, amap, denv, remapInfo: SignatureRepackageInfo, checkingSig) = (typarsAEquiv g aenv mtps1 mtps2) && ((ps1, ps2) ||> List.lengthsEqAndForall2 (List.lengthsEqAndForall2 (fun p1 p2 -> typeAEquiv g aenv p1.Type p2.Type))) && (returnTypesAEquiv g aenv rty1 rty2))) - | _, _ -> false) then - (errorR (Error(FSComp.SR.DefinitionsInSigAndImplNotCompatibleTypeIsDifferentKind(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName), m)); false) + | _ -> false + if not compat then + errorR (Error(FSComp.SR.DefinitionsInSigAndImplNotCompatibleTypeIsDifferentKind(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName), m)) + false else let isStruct = (match r1.fsobjmodel_kind with TFSharpStruct -> true | _ -> false) checkClassFields isStruct m aenv infoReader implTycon r1.fsobjmodel_rfields r2.fsobjmodel_rfields && diff --git a/src/Compiler/CodeGen/IlxGen.fs b/src/Compiler/CodeGen/IlxGen.fs index 20208e2870c..66f7483f523 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/src/Compiler/CodeGen/IlxGen.fs @@ -1709,7 +1709,7 @@ let AddExternalCcusToIlxGenEnv cenv g eenv ccus = let AddBindingsForTycon allocVal (cloc: CompileLocation) (tycon: Tycon) eenv = let unrealizedSlots = if tycon.IsFSharpObjectModelTycon then - tycon.FSharpObjectModelTypeInfo.fsobjmodel_vslots + tycon.FSharpTyconRepresentationData.fsobjmodel_vslots else [] @@ -2165,28 +2165,30 @@ type AssemblyBuilder(cenv: cenv, anonTypeTable: AnonTypeGenerationTable) as mgbu if isStruct then tycon.SetIsStructRecordOrUnion true - - tycon.entity_tycon_repr <- - TFSharpRecdRepr( - Construct.MakeRecdFieldsTable( - (tps, flds) - ||> List.map2 (fun tp (propName, _fldName, _fldTy) -> - Construct.NewRecdField - false - None - (mkSynId m propName) - false - (mkTyparTy tp) - true - false - [] - [] - XmlDoc.Empty - taccessPublic - false) - ) - ) - + let rfields = + (tps, flds) + ||> List.map2 (fun tp (propName, _fldName, _fldTy) -> + Construct.NewRecdField + false + None + (mkSynId m propName) + false + (mkTyparTy tp) + true + false + [] + [] + XmlDoc.Empty + taccessPublic + false) + let data = + { + fsobjmodel_cases = Construct.MakeUnionCases [] + fsobjmodel_rfields = Construct.MakeRecdFieldsTable rfields + fsobjmodel_kind = TFSharpRecord + fsobjmodel_vslots = [] + } + tycon.entity_tycon_repr <- TFSharpTyconRepr data let tcref = mkLocalTyconRef tycon let ty = generalizedTyconRef g tcref let tcaug = tcref.TypeContents @@ -10522,9 +10524,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) = | TAsmRepr _ | TILObjectRepr _ | TMeasureableRepr _ -> () - | TFSharpObjectRepr _ - | TFSharpRecdRepr _ - | TFSharpUnionRepr _ -> + | TFSharpTyconRepr _ -> let eenvinner = EnvForTycon tycon eenv let thisTy = generalizedTyconRef g tcref @@ -10690,15 +10690,17 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) = let ilTypeDefKind = match tyconRepr with - | TFSharpObjectRepr o -> + | TFSharpTyconRepr o -> match o.fsobjmodel_kind with + | TFSharpUnion + | TFSharpRecord -> + if tycon.IsStructOrEnumTycon then ILTypeDefKind.ValueType + else ILTypeDefKind.Class | TFSharpClass -> ILTypeDefKind.Class | TFSharpStruct -> ILTypeDefKind.ValueType | TFSharpInterface -> ILTypeDefKind.Interface | TFSharpEnum -> ILTypeDefKind.Enum | TFSharpDelegate _ -> ILTypeDefKind.Delegate - | TFSharpRecdRepr _ - | TFSharpUnionRepr _ when tycon.IsStructOrEnumTycon -> ILTypeDefKind.ValueType | _ -> ILTypeDefKind.Class let requiresExtraField = @@ -10800,7 +10802,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) = let extraAttribs = match tyconRepr with - | TFSharpRecdRepr _ when not useGenuineField -> + | TFSharpTyconRepr { fsobjmodel_kind = TFSharpRecord } when not useGenuineField -> [ g.CompilerGeneratedAttribute; g.DebuggerBrowsableNeverAttribute ] | _ -> [] // don't hide fields in classes in debug display @@ -11004,7 +11006,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) = // Build record constructors and the funky methods that go with records and delegate types. // Constructors and delegate methods have the same access as the representation match tyconRepr with - | TFSharpRecdRepr _ when not tycon.IsEnumTycon -> + | TFSharpTyconRepr { fsobjmodel_kind = TFSharpRecord } when not tycon.IsEnumTycon -> // No constructor for enum types // Otherwise find all the non-static, non zero-init fields and build a constructor let relevantFields = @@ -11049,7 +11051,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) = if not (tycon.HasMember g "ToString" []) then yield! GenToStringMethod cenv eenv ilThisTy m - | TFSharpObjectRepr r when tycon.IsFSharpDelegateTycon -> + | TFSharpTyconRepr r when tycon.IsFSharpDelegateTycon -> // Build all the methods that go with a delegate type match r.fsobjmodel_kind with @@ -11070,7 +11072,8 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) = yield! mkILDelegateMethods reprAccess g.ilg (g.iltyp_AsyncCallback, g.iltyp_IAsyncResult) (parameters, ret) | _ -> () - | TFSharpUnionRepr _ when not (tycon.HasMember g "ToString" []) -> yield! GenToStringMethod cenv eenv ilThisTy m + | TFSharpTyconRepr { fsobjmodel_kind = TFSharpUnion } when not (tycon.HasMember g "ToString" []) -> + yield! GenToStringMethod cenv eenv ilThisTy m | _ -> () ] @@ -11093,15 +11096,14 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) = tdef, None - | TFSharpRecdRepr _ - | TFSharpObjectRepr _ as tyconRepr -> + | TFSharpTyconRepr { fsobjmodel_kind = k } when (match k with TFSharpUnion -> false | _ -> true) -> let super = superOfTycon g tycon let ilBaseTy = GenType cenv m eenvinner.tyenv super // Build a basic type definition let isObjectType = (match tyconRepr with - | TFSharpObjectRepr _ -> true + | TFSharpTyconRepr _ -> true | _ -> false) let ilAttrs = @@ -11251,7 +11253,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) = tdef, None - | TFSharpUnionRepr _ -> + | TFSharpTyconRepr { fsobjmodel_kind = k } when (match k with TFSharpUnion -> true | _ -> false) -> let alternatives = tycon.UnionCasesArray |> Array.mapi (fun i ucspec -> diff --git a/src/Compiler/Service/SemanticClassification.fs b/src/Compiler/Service/SemanticClassification.fs index f1fdc92c0bb..3edfedc8074 100644 --- a/src/Compiler/Service/SemanticClassification.fs +++ b/src/Compiler/Service/SemanticClassification.fs @@ -101,19 +101,19 @@ module TcResolutionsExtensions = let reprToClassificationType g repr tcref = match repr with - | TFSharpObjectRepr om -> + | TFSharpTyconRepr om -> match om.fsobjmodel_kind with + | TFSharpUnion + | TFSharpRecord -> + if isStructTyconRef g tcref then + SemanticClassificationType.ValueType + else + SemanticClassificationType.Type | TFSharpClass -> SemanticClassificationType.ReferenceType | TFSharpInterface -> SemanticClassificationType.Interface | TFSharpStruct -> SemanticClassificationType.ValueType | TFSharpDelegate _ -> SemanticClassificationType.Delegate | TFSharpEnum -> SemanticClassificationType.Enumeration - | TFSharpRecdRepr _ - | TFSharpUnionRepr _ -> - if isStructTyconRef g tcref then - SemanticClassificationType.ValueType - else - SemanticClassificationType.Type | TILObjectRepr (TILObjectReprData (_, _, td)) -> if td.IsClass then SemanticClassificationType.ReferenceType @@ -170,7 +170,7 @@ module TcResolutionsExtensions = let (|EnumCaseFieldInfo|_|) (rfinfo: RecdFieldInfo) = match rfinfo.TyconRef.TypeReprInfo with - | TFSharpObjectRepr x -> + | TFSharpTyconRepr x -> match x.fsobjmodel_kind with | TFSharpEnum -> Some() | _ -> None diff --git a/src/Compiler/Service/ServiceDeclarationLists.fs b/src/Compiler/Service/ServiceDeclarationLists.fs index 06cf656b078..59fd54b9e94 100644 --- a/src/Compiler/Service/ServiceDeclarationLists.fs +++ b/src/Compiler/Service/ServiceDeclarationLists.fs @@ -856,15 +856,15 @@ module internal DescriptionListsImpl = /// Find the glyph for the given representation. let reprToGlyph repr = match repr with - | TFSharpObjectRepr om -> + | TFSharpTyconRepr om -> match om.fsobjmodel_kind with + | TFSharpUnion -> FSharpGlyph.Union + | TFSharpRecord -> FSharpGlyph.Type | TFSharpClass -> FSharpGlyph.Class | TFSharpInterface -> FSharpGlyph.Interface | TFSharpStruct -> FSharpGlyph.Struct | TFSharpDelegate _ -> FSharpGlyph.Delegate | TFSharpEnum -> FSharpGlyph.Enum - | TFSharpRecdRepr _ -> FSharpGlyph.Type - | TFSharpUnionRepr _ -> FSharpGlyph.Union | TILObjectRepr (TILObjectReprData (_, _, td)) -> if td.IsClass then FSharpGlyph.Class elif td.IsStruct then FSharpGlyph.Struct diff --git a/src/Compiler/Symbols/Symbols.fs b/src/Compiler/Symbols/Symbols.fs index 4b8f8c4684b..791c5bf30d7 100644 --- a/src/Compiler/Symbols/Symbols.fs +++ b/src/Compiler/Symbols/Symbols.fs @@ -576,7 +576,7 @@ type FSharpEntity(cenv: SymbolEnv, entity: EntityRef) = member _.FSharpDelegateSignature = checkIsResolved() match entity.TypeReprInfo with - | TFSharpObjectRepr r when entity.IsFSharpDelegateTycon -> + | TFSharpTyconRepr r when entity.IsFSharpDelegateTycon -> match r.fsobjmodel_kind with | TFSharpDelegate ss -> FSharpDelegateSignature(cenv, ss) | _ -> invalidOp "not a delegate type" diff --git a/src/Compiler/TypedTree/TypedTree.fs b/src/Compiler/TypedTree/TypedTree.fs index dfdc9640a0c..767258fd3a9 100644 --- a/src/Compiler/TypedTree/TypedTree.fs +++ b/src/Compiler/TypedTree/TypedTree.fs @@ -945,7 +945,7 @@ type Entity = /// static fields, 'val' declarations and hidden fields from the compilation of implicit class constructions. member x.AllFieldTable = match x.TypeReprInfo with - | TFSharpRecdRepr x | TFSharpObjectRepr {fsobjmodel_rfields=x} -> x + | TFSharpTyconRepr {fsobjmodel_rfields=x} -> x | _ -> match x.ExceptionInfo with | TExnFresh x -> x @@ -981,12 +981,15 @@ type Entity = member x.GetFieldByName n = x.AllFieldTable.FieldByName n /// Indicate if this is a type whose r.h.s. is known to be a union type definition. - member x.IsUnionTycon = match x.TypeReprInfo with | TFSharpUnionRepr _ -> true | _ -> false + member x.IsUnionTycon = + match x.TypeReprInfo with + | TFSharpTyconRepr {fsobjmodel_kind=TFSharpUnion} -> true + | _ -> false /// Get the union cases and other union-type information for a type, if any member x.UnionTypeInfo = match x.TypeReprInfo with - | TFSharpUnionRepr x -> ValueSome x + | TFSharpTyconRepr {fsobjmodel_kind=TFSharpUnion; fsobjmodel_cases=x} -> ValueSome x | _ -> ValueNone /// Get the union cases for a type, if any @@ -1057,9 +1060,9 @@ type Entity = member x.IsLinked = match box x.entity_attribs with null -> false | _ -> true /// Get the blob of information associated with an F# object-model type definition, i.e. class, interface, struct etc. - member x.FSharpObjectModelTypeInfo = + member x.FSharpTyconRepresentationData = match x.TypeReprInfo with - | TFSharpObjectRepr x -> x + | TFSharpTyconRepr x -> x | _ -> failwith "not an F# object model type definition" /// Indicate if this is a type definition backed by Abstract IL metadata. @@ -1073,10 +1076,17 @@ type Entity = member x.ILTyconRawMetadata = let (TILObjectReprData(_, _, td)) = x.ILTyconInfo in td /// Indicates if this is an F# type definition whose r.h.s. is known to be a record type definition. - member x.IsRecordTycon = match x.TypeReprInfo with | TFSharpRecdRepr _ -> true | _ -> false + member x.IsRecordTycon = + match x.TypeReprInfo with + | TFSharpTyconRepr {fsobjmodel_kind=TFSharpRecord} -> true + | _ -> false /// Indicates if this is an F# type definition whose r.h.s. is known to be a record type definition that is a value type. - member x.IsStructRecordOrUnionTycon = match x.TypeReprInfo with TFSharpRecdRepr _ | TFSharpUnionRepr _ -> x.entity_flags.IsStructRecordOrUnionType | _ -> false + member x.IsStructRecordOrUnionTycon = + match x.TypeReprInfo with + | TFSharpTyconRepr { fsobjmodel_kind=TFSharpRecord } -> x.entity_flags.IsStructRecordOrUnionType + | TFSharpTyconRepr { fsobjmodel_kind=TFSharpUnion } -> x.entity_flags.IsStructRecordOrUnionType + | _ -> false /// The on-demand analysis about whether the entity has the IsByRefLike attribute member x.TryIsByRefLike = x.entity_flags.TryIsByRefLike @@ -1097,7 +1107,7 @@ type Entity = member x.SetIsAssumedReadOnly b = x.entity_flags <- x.entity_flags.WithIsAssumedReadOnly b /// Indicates if this is an F# type definition whose r.h.s. is known to be some kind of F# object model definition - member x.IsFSharpObjectModelTycon = match x.TypeReprInfo with | TFSharpObjectRepr _ -> true | _ -> false + member x.IsFSharpObjectModelTycon = match x.TypeReprInfo with | TFSharpTyconRepr _ -> true | _ -> false /// Indicates if this is an F# type definition which is one of the special types in FSharp.Core.dll which uses /// an assembly-code representation for the type, e.g. the primitive array type constructor. @@ -1112,16 +1122,16 @@ type Entity = member x.IsHiddenReprTycon = match x.TypeAbbrev, x.TypeReprInfo with | None, TNoRepr -> true | _ -> false /// Indicates if this is an F#-defined interface type definition - member x.IsFSharpInterfaceTycon = x.IsFSharpObjectModelTycon && match x.FSharpObjectModelTypeInfo.fsobjmodel_kind with TFSharpInterface -> true | _ -> false + member x.IsFSharpInterfaceTycon = x.IsFSharpObjectModelTycon && match x.FSharpTyconRepresentationData.fsobjmodel_kind with TFSharpInterface -> true | _ -> false /// Indicates if this is an F#-defined delegate type definition - member x.IsFSharpDelegateTycon = x.IsFSharpObjectModelTycon && match x.FSharpObjectModelTypeInfo.fsobjmodel_kind with TFSharpDelegate _ -> true | _ -> false + member x.IsFSharpDelegateTycon = x.IsFSharpObjectModelTycon && match x.FSharpTyconRepresentationData.fsobjmodel_kind with TFSharpDelegate _ -> true | _ -> false /// Indicates if this is an F#-defined enum type definition - member x.IsFSharpEnumTycon = x.IsFSharpObjectModelTycon && match x.FSharpObjectModelTypeInfo.fsobjmodel_kind with TFSharpEnum -> true | _ -> false + member x.IsFSharpEnumTycon = x.IsFSharpObjectModelTycon && match x.FSharpTyconRepresentationData.fsobjmodel_kind with TFSharpEnum -> true | _ -> false /// Indicates if this is an F#-defined class type definition - member x.IsFSharpClassTycon = x.IsFSharpObjectModelTycon && match x.FSharpObjectModelTypeInfo.fsobjmodel_kind with TFSharpClass -> true | _ -> false + member x.IsFSharpClassTycon = x.IsFSharpObjectModelTycon && match x.FSharpTyconRepresentationData.fsobjmodel_kind with TFSharpClass -> true | _ -> false /// Indicates if this is a .NET-defined enum type definition member x.IsILEnumTycon = x.IsILTycon && x.ILTyconRawMetadata.IsEnum @@ -1140,10 +1150,9 @@ type Entity = /// Indicates if this is an F#-defined struct or enum type definition, i.e. a value type definition member x.IsFSharpStructOrEnumTycon = match x.TypeReprInfo with - | TFSharpRecdRepr _ -> x.IsStructRecordOrUnionTycon - | TFSharpUnionRepr _ -> x.IsStructRecordOrUnionTycon - | TFSharpObjectRepr info -> + | TFSharpTyconRepr info -> match info.fsobjmodel_kind with + | TFSharpRecord | TFSharpUnion -> x.IsStructRecordOrUnionTycon | TFSharpClass | TFSharpInterface | TFSharpDelegate _ -> false | TFSharpStruct | TFSharpEnum -> true | _ -> false @@ -1409,13 +1418,7 @@ type TyconAugmentation = type TyconRepresentation = /// Indicates the type is a class, struct, enum, delegate or interface - | TFSharpObjectRepr of TyconObjModelData - - /// Indicates the type is a record - | TFSharpRecdRepr of TyconRecdFields - - /// Indicates the type is a discriminated union - | TFSharpUnionRepr of TyconUnionData + | TFSharpTyconRepr of FSharpTyconData /// Indicates the type is a type from a .NET assembly without F# metadata. | TILObjectRepr of TILObjectReprData @@ -1529,7 +1532,13 @@ type TProvidedTypeInfo = #endif -type TyconFSharpObjModelKind = +type FSharpTyconKind = + /// Indicates the type is an F#-declared record + | TFSharpRecord + + /// Indicates the type is an F#-declared union + | TFSharpUnion + /// Indicates the type is an F#-declared class (also used for units-of-measure) | TFSharpClass @@ -1545,18 +1554,15 @@ type TyconFSharpObjModelKind = /// Indicates the type is an F#-declared enumeration | TFSharpEnum - /// Indicates if the type definition is a value type - member x.IsValueType = - match x with - | TFSharpClass | TFSharpInterface | TFSharpDelegate _ -> false - | TFSharpStruct | TFSharpEnum -> true - /// Represents member values and class fields relating to the F# object model [] -type TyconObjModelData = +type FSharpTyconData = { + /// Indicates the cases of a union type + fsobjmodel_cases: TyconUnionData + /// Indicates whether the type declaration is an F# class, interface, enum, delegate or struct - fsobjmodel_kind: TyconFSharpObjModelKind + fsobjmodel_kind: FSharpTyconKind /// The declared abstract slots of the class, interface or struct fsobjmodel_vslots: ValRef list @@ -1568,7 +1574,7 @@ type TyconObjModelData = [] member x.DebugText = x.ToString() - override x.ToString() = "TyconObjModelData(...)" + override x.ToString() = "FSharpTyconData(...)" /// Represents record fields in an F# type definition [] @@ -1631,6 +1637,7 @@ type TyconUnionCases = [] type TyconUnionData = { + /// The cases contained in the discriminated union. CasesTable: TyconUnionCases @@ -3604,7 +3611,7 @@ type EntityRef = member x.GetUnionCaseByName n = x.Deref.GetUnionCaseByName n /// Get the blob of information associated with an F# object-model type definition, i.e. class, interface, struct etc. - member x.FSharpObjectModelTypeInfo = x.Deref.FSharpObjectModelTypeInfo + member x.FSharpTyconRepresentationData = x.Deref.FSharpTyconRepresentationData /// Gets the immediate interface definitions of an F# type definition. Further interfaces may be supported through class and interface inheritance. member x.ImmediateInterfacesOfFSharpTycon = x.Deref.ImmediateInterfacesOfFSharpTycon @@ -5673,6 +5680,12 @@ type Construct() = static member NewEmptyModuleOrNamespaceType mkind = Construct.NewModuleOrNamespaceType mkind [] [] + static member NewEmptyFSharpTyconData kind = + { fsobjmodel_cases = Construct.MakeUnionCases [] + fsobjmodel_kind = kind + fsobjmodel_vslots = [] + fsobjmodel_rfields = Construct.MakeRecdFieldsTable [] } + #if !NO_TYPEPROVIDERS /// Create a new node for the representation information for a provided type definition @@ -5801,7 +5814,15 @@ type Construct() = CompiledRepresentation=newCache() } /// Create a node for a union type - static member MakeUnionRepr ucs = TFSharpUnionRepr (Construct.MakeUnionCases ucs) + static member MakeUnionRepr ucs = + let repr = + { + fsobjmodel_cases = Construct.MakeUnionCases ucs + fsobjmodel_rfields = Construct.MakeRecdFieldsTable [] + fsobjmodel_kind = TFSharpUnion + fsobjmodel_vslots = [] + } + TFSharpTyconRepr repr /// Create a new type parameter node static member NewTypar (kind, rigid, SynTypar(id, staticReq, isCompGen), isFromError, dynamicReq, attribs, eqDep, compDep) = diff --git a/src/Compiler/TypedTree/TypedTree.fsi b/src/Compiler/TypedTree/TypedTree.fsi index b63942d2c8c..55f31ccd284 100644 --- a/src/Compiler/TypedTree/TypedTree.fsi +++ b/src/Compiler/TypedTree/TypedTree.fsi @@ -554,7 +554,7 @@ type Entity = member ExceptionInfo: ExceptionInfo /// Get the blob of information associated with an F# object-model type definition, i.e. class, interface, struct etc. - member FSharpObjectModelTypeInfo: TyconObjModelData + member FSharpTyconRepresentationData: FSharpTyconData /// Gets any implicit CompareTo methods added to an F# record, union or struct type definition. member GeneratedCompareToValues: (ValRef * ValRef) option @@ -871,13 +871,7 @@ type TyconAugmentation = type TyconRepresentation = /// Indicates the type is a class, struct, enum, delegate or interface - | TFSharpObjectRepr of TyconObjModelData - - /// Indicates the type is a record - | TFSharpRecdRepr of TyconRecdFields - - /// Indicates the type is a discriminated union - | TFSharpUnionRepr of TyconUnionData + | TFSharpTyconRepr of FSharpTyconData /// Indicates the type is a type from a .NET assembly without F# metadata. | TILObjectRepr of TILObjectReprData @@ -984,7 +978,12 @@ type TProvidedTypeInfo = #endif -type TyconFSharpObjModelKind = +type FSharpTyconKind = + /// Indicates the type is an F#-declared record + | TFSharpRecord + + /// Indicates the type is an F#-declared union + | TFSharpUnion /// Indicates the type is an F#-declared class (also used for units-of-measure) | TFSharpClass @@ -1001,16 +1000,15 @@ type TyconFSharpObjModelKind = /// Indicates the type is an F#-declared enumeration | TFSharpEnum - /// Indicates if the type definition is a value type - member IsValueType: bool - /// Represents member values type class fields relating to the F# object model [] -type TyconObjModelData = +type FSharpTyconData = { + /// Indicates the cases of a union type + fsobjmodel_cases: TyconUnionData /// Indicates whether the type declaration is an F# class, interface, enum, delegate or struct - fsobjmodel_kind: TyconFSharpObjModelKind + fsobjmodel_kind: FSharpTyconKind /// The declared abstract slots of the class, interface or struct fsobjmodel_vslots: ValRef list @@ -2411,7 +2409,7 @@ type EntityRef = member ExceptionInfo: ExceptionInfo /// Get the blob of information associated with an F# object-model type definition, i.e. class, interface, struct etc. - member FSharpObjectModelTypeInfo: TyconObjModelData + member FSharpTyconRepresentationData: FSharpTyconData /// Gets any implicit CompareTo methods added to an F# record, union or struct type definition. member GeneratedCompareToValues: (ValRef * ValRef) option @@ -4221,10 +4219,9 @@ type FreeVars = member DebugText: string /// A set of static methods for constructing types. +[] type Construct = - new: unit -> Construct - #if !NO_TYPEPROVIDERS /// Compute the definition location of a provided item static member ComputeDefinitionLocationOfProvidedItem: @@ -4261,6 +4258,9 @@ type Construct = /// Create a new node for an empty module or namespace contents static member NewEmptyModuleOrNamespaceType: mkind: ModuleOrNamespaceKind -> ModuleOrNamespaceType + /// Create a new node for an empty F# tycon data + static member NewEmptyFSharpTyconData: kind: FSharpTyconKind -> FSharpTyconData + /// Create a new TAST Entity node for an F# exception definition static member NewExn: cpath: CompilationPath option -> diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index f57954f7bf5..acfdf65a2b3 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -1896,9 +1896,9 @@ let rankOfArrayTy g ty = rankOfArrayTyconRef g (tcrefOfAppTy g ty) let isFSharpObjModelRefTy g ty = isFSharpObjModelTy g ty && let tcref = tcrefOfAppTy g ty - match tcref.FSharpObjectModelTypeInfo.fsobjmodel_kind with + match tcref.FSharpTyconRepresentationData.fsobjmodel_kind with | TFSharpClass | TFSharpInterface | TFSharpDelegate _ -> true - | TFSharpStruct | TFSharpEnum -> false + | TFSharpUnion | TFSharpRecord | TFSharpStruct | TFSharpEnum -> false let isFSharpClassTy g ty = match tryTcrefOfAppTy g ty with @@ -4200,10 +4200,9 @@ module DebugPrint = let tyconReprL (repr, tycon: Tycon) = match repr with - | TFSharpRecdRepr _ -> - tycon.TrueFieldsAsList |> List.map (fun fld -> layoutRecdField fld ^^ rightL(tagText ";")) |> aboveListL - - | TFSharpObjectRepr r -> + | TFSharpTyconRepr { fsobjmodel_kind = TFSharpUnion } -> + tycon.UnionCasesAsList |> layoutUnionCases |> aboveListL + | TFSharpTyconRepr r -> match r.fsobjmodel_kind with | TFSharpDelegate _ -> wordL(tagText "delegate ...") @@ -4238,7 +4237,6 @@ module DebugPrint = if emptyMeasure then emptyL else (wordL (tagText start) @@-- aboveListL alldecls) @@ wordL(tagText "end") - | TFSharpUnionRepr _ -> tycon.UnionCasesAsList |> layoutUnionCases |> aboveListL | TAsmRepr _ -> wordL(tagText "(# ... #)") | TMeasureableRepr ty -> typeL ty | TILObjectRepr (TILObjectReprData(_, _, td)) -> wordL (tagText td.Name) @@ -4520,7 +4518,7 @@ module DebugPrint = |> List.filter (fun v -> isNil (Option.get v.MemberInfo).ImplementedSlotSigs) let iimpls = match tycon.TypeReprInfo with - | TFSharpObjectRepr r when (match r.fsobjmodel_kind with TFSharpInterface -> true | _ -> false) -> [] + | TFSharpTyconRepr r when (match r.fsobjmodel_kind with TFSharpInterface -> true | _ -> false) -> [] | _ -> tycon.ImmediateInterfacesOfFSharpTycon let iimpls = iimpls |> List.filter (fun (_, compgen, _) -> not compgen) // if TFSharpInterface, the iimpls should be printed as inherited interfaces @@ -4764,7 +4762,7 @@ let ComputeRemappingFromInferredSignatureToExplicitSignature g mty msigty = /// virtual slots to aid with finding this babies. let abstractSlotValRefsOfTycons (tycons: Tycon list) = tycons - |> List.collect (fun tycon -> if tycon.IsFSharpObjectModelTycon then tycon.FSharpObjectModelTypeInfo.fsobjmodel_vslots else []) + |> List.collect (fun tycon -> if tycon.IsFSharpObjectModelTycon then tycon.FSharpTyconRepresentationData.fsobjmodel_vslots else []) let abstractSlotValsOfTycons (tycons: Tycon list) = abstractSlotValRefsOfTycons tycons @@ -5111,10 +5109,11 @@ and accLocalTyconRepr opts b fvs = if Zset.contains b fvs.FreeLocalTyconReprs then fvs else { fvs with FreeLocalTyconReprs = Zset.add b fvs.FreeLocalTyconReprs } -and accUsedRecdOrUnionTyconRepr opts (tc: Tycon) fvs = - if match tc.TypeReprInfo with TFSharpObjectRepr _ | TFSharpRecdRepr _ | TFSharpUnionRepr _ -> true | _ -> false - then accLocalTyconRepr opts tc fvs - else fvs +and accUsedRecdOrUnionTyconRepr opts (tc: Tycon) fvs = + if (match tc.TypeReprInfo with TFSharpTyconRepr _ -> true | _ -> false) then + accLocalTyconRepr opts tc fvs + else + fvs and accFreeUnionCaseRef opts ucref fvs = if not opts.includeUnionCases then fvs else @@ -6022,19 +6021,18 @@ and remapUnionCases ctxt tmenv (x: TyconUnionData) = and remapFsObjData ctxt tmenv x = { x with + fsobjmodel_cases = remapUnionCases ctxt tmenv x.fsobjmodel_cases fsobjmodel_kind = (match x.fsobjmodel_kind with | TFSharpDelegate slotsig -> TFSharpDelegate (remapSlotSig (remapAttribs ctxt tmenv) tmenv slotsig) - | TFSharpClass | TFSharpInterface | TFSharpStruct | TFSharpEnum -> x.fsobjmodel_kind) + | _ -> x.fsobjmodel_kind) fsobjmodel_vslots = x.fsobjmodel_vslots |> List.map (remapValRef tmenv) fsobjmodel_rfields = x.fsobjmodel_rfields |> remapRecdFields ctxt tmenv } and remapTyconRepr ctxt tmenv repr = match repr with - | TFSharpObjectRepr x -> TFSharpObjectRepr (remapFsObjData ctxt tmenv x) - | TFSharpRecdRepr x -> TFSharpRecdRepr (remapRecdFields ctxt tmenv x) - | TFSharpUnionRepr x -> TFSharpUnionRepr (remapUnionCases ctxt tmenv x) + | TFSharpTyconRepr x -> TFSharpTyconRepr (remapFsObjData ctxt tmenv x) | TILObjectRepr _ -> failwith "cannot remap IL type definitions" #if !NO_TYPEPROVIDERS | TProvidedNamespaceRepr _ -> repr diff --git a/src/Compiler/TypedTree/TypedTreePickle.fs b/src/Compiler/TypedTree/TypedTreePickle.fs index 90fd15fa1e2..c53928401be 100644 --- a/src/Compiler/TypedTree/TypedTreePickle.fs +++ b/src/Compiler/TypedTree/TypedTreePickle.fs @@ -1879,34 +1879,81 @@ let u_istype st = | 2 -> Namespace true | _ -> ufailwith st "u_istype" -let u_cpath st = let a, b = u_tup2 u_ILScopeRef (u_list (u_tup2 u_string u_istype)) st in (CompPath(a, b)) +let u_cpath st = + let a, b = u_tup2 u_ILScopeRef (u_list (u_tup2 u_string u_istype)) st + CompPath(a, b) - -let rec dummy x = x -and p_tycon_repr x st = +let rec p_tycon_repr x st = // The leading "p_byte 1" and "p_byte 0" come from the F# 2.0 format, which used an option value at this point. match x with - | TFSharpRecdRepr fs -> p_byte 1 st; p_byte 0 st; p_rfield_table fs st; false - | TFSharpUnionRepr x -> p_byte 1 st; p_byte 1 st; p_array p_unioncase_spec x.CasesTable.CasesByIndex st; false - | TAsmRepr ilTy -> p_byte 1 st; p_byte 2 st; p_ILType ilTy st; false - | TFSharpObjectRepr r -> p_byte 1 st; p_byte 3 st; p_tycon_objmodel_data r st; false - | TMeasureableRepr ty -> p_byte 1 st; p_byte 4 st; p_ty ty st; false - | TNoRepr -> p_byte 0 st; false + // Records + | TFSharpTyconRepr { fsobjmodel_rfields = fs; fsobjmodel_kind = TFSharpRecord } -> + p_byte 1 st + p_byte 0 st + p_rfield_table fs st + false + + // Unions without static fields + | TFSharpTyconRepr { fsobjmodel_cases = x; fsobjmodel_kind = TFSharpUnion; fsobjmodel_rfields = fs } when fs.FieldsByIndex.Length = 0 -> + p_byte 1 st + p_byte 1 st + p_array p_unioncase_spec x.CasesTable.CasesByIndex st + false + + // Unions with static fields, added to format + | TFSharpTyconRepr ({ fsobjmodel_cases = x; fsobjmodel_kind = TFSharpUnion } as r) -> + p_byte 2 st + p_array p_unioncase_spec x.CasesTable.CasesByIndex st + p_tycon_objmodel_data r st + false + + | TAsmRepr ilTy -> + p_byte 1 st + p_byte 2 st + p_ILType ilTy st + false + + | TFSharpTyconRepr r -> + p_byte 1 st + p_byte 3 st + p_tycon_objmodel_data r st + false + + | TMeasureableRepr ty -> + p_byte 1 st + p_byte 4 st + p_ty ty st + false + + | TNoRepr -> + p_byte 0 st + false + #if !NO_TYPEPROVIDERS | TProvidedTypeRepr info -> if info.IsErased then // Pickle erased type definitions as a NoRepr - p_byte 0 st; false + p_byte 0 st + false else // Pickle generated type definitions as a TAsmRepr - p_byte 1 st; p_byte 2 st; p_ILType (mkILBoxedType(ILTypeSpec.Create(TypeProviders.GetILTypeRefOfProvidedType(info.ProvidedType, range0), []))) st; true - | TProvidedNamespaceRepr _ -> p_byte 0 st; false + p_byte 1 st + p_byte 2 st + p_ILType (mkILBoxedType(ILTypeSpec.Create(TypeProviders.GetILTypeRefOfProvidedType(info.ProvidedType, range0), []))) st + true + + | TProvidedNamespaceRepr _ -> + p_byte 0 st + false #endif - | TILObjectRepr (TILObjectReprData (_, _, td)) -> error (Failure("Unexpected IL type definition"+td.Name)) + + | TILObjectRepr (TILObjectReprData (_, _, td)) -> + error (Failure("Unexpected IL type definition"+td.Name)) and p_tycon_objmodel_data x st = - p_tup3 p_tycon_objmodel_kind (p_vrefs "vslots") p_rfield_table - (x.fsobjmodel_kind, x.fsobjmodel_vslots, x.fsobjmodel_rfields) st + p_tycon_objmodel_kind x.fsobjmodel_kind st + p_vrefs "vslots" x.fsobjmodel_vslots st + p_rfield_table x.fsobjmodel_rfields st and p_attribs_ext f x st = p_list_ext f p_attrib x st @@ -2030,6 +2077,8 @@ and p_member_info (x: ValMemberInfo) st = and p_tycon_objmodel_kind x st = match x with + | TFSharpUnion -> failwith "unreachable, see p_tycon_repr" + | TFSharpRecord -> failwith "unreachable, see p_tycon_repr" | TFSharpClass -> p_byte 0 st | TFSharpInterface -> p_byte 1 st | TFSharpStruct -> p_byte 2 st @@ -2086,7 +2135,14 @@ and u_tycon_repr st = match tag2 with | 0 -> let v = u_rfield_table st - (fun _flagBit -> TFSharpRecdRepr v) + (fun _flagBit -> + TFSharpTyconRepr + { + fsobjmodel_cases = Construct.MakeUnionCases [] + fsobjmodel_kind=TFSharpRecord + fsobjmodel_vslots=[] + fsobjmodel_rfields=v + }) | 1 -> let v = u_list u_unioncase_spec st (fun _flagBit -> Construct.MakeUnionRepr v) @@ -2117,16 +2173,25 @@ and u_tycon_repr st = TAsmRepr v) | 3 -> let v = u_tycon_objmodel_data st - (fun _flagBit -> TFSharpObjectRepr v) + (fun _flagBit -> TFSharpTyconRepr v) | 4 -> let v = u_ty st (fun _flagBit -> TMeasureableRepr v) | _ -> ufailwith st "u_tycon_repr" + | 2 -> + let cases = u_array u_unioncase_spec st + let data = u_tycon_objmodel_data st + fun _flagBit -> TFSharpTyconRepr { data with fsobjmodel_cases = Construct.MakeUnionCases (Array.toList cases) } | _ -> ufailwith st "u_tycon_repr" and u_tycon_objmodel_data st = let x1, x2, x3 = u_tup3 u_tycon_objmodel_kind u_vrefs u_rfield_table st - {fsobjmodel_kind=x1; fsobjmodel_vslots=x2; fsobjmodel_rfields=x3 } + { + fsobjmodel_cases = Construct.MakeUnionCases [] + fsobjmodel_kind=x1 + fsobjmodel_vslots=x2 + fsobjmodel_rfields=x3 + } and u_attribs_ext extraf st = u_list_ext extraf u_attrib st and u_unioncase_spec st = From c6cd691dd8ecbd67aa6b51a0e7a678b6f7eea7a0 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Tue, 18 Oct 2022 02:09:50 +0100 Subject: [PATCH 02/45] Ease restrictions on static members and static let in union and record types --- src/Compiler/Checking/CheckDeclarations.fs | 3 --- src/Compiler/Checking/CheckExpressions.fs | 4 ++-- 2 files changed, 2 insertions(+), 5 deletions(-) diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index ec97a756d23..389d96e2236 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -923,9 +923,6 @@ module MutRecBindingChecking = // Code for potential future design change to allow functions-compiled-as-members in structs errorR(Error(FSComp.SR.tcStructsMayNotContainLetBindings(), (trimRangeToLine m))) - //if isStatic && Option.isNone incrCtorInfoOpt then - // errorR(Error(FSComp.SR.tcStaticLetBindingsRequireClassesWithImplicitConstructors(), m)) - // Phase2A: let-bindings - pass through let innerState = (incrCtorInfoOpt, envForTycon, tpenv, recBindIdx, uncheckedBindsRev) [Phase2AIncrClassBindings (tcref, letBinds, isStatic, isRec, m)], innerState diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index f3b1e9ca645..67d1ecfc8eb 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -280,10 +280,10 @@ let noArgOrRetAttribs = ArgAndRetAttribs ([], []) type DeclKind = | ModuleOrMemberBinding - /// Extensions to a type within the same assembly + /// Extensions to a type within the same module or namespace fragment | IntrinsicExtensionBinding - /// Extensions to a type in a different assembly + /// Extensions to a type not within the same module or namespace fragment | ExtrinsicExtensionBinding | ClassLetBinding of isStatic: bool From 4c6386d2f1b5ec83c4620acad76026f8fdd1d371 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Wed, 19 Oct 2022 13:41:07 +0100 Subject: [PATCH 03/45] fix generation of .cctor for unions --- src/Compiler/AbstractIL/il.fs | 63 +++++++++++++++++---- src/Compiler/AbstractIL/il.fsi | 58 +++++++++++++++++++- src/Compiler/AbstractIL/ilwrite.fs | 4 ++ src/Compiler/AbstractIL/ilx.fs | 36 ++++++++++-- src/Compiler/Checking/CheckDeclarations.fs | 41 +++++++++----- src/Compiler/Checking/InfoReader.fs | 2 +- src/Compiler/CodeGen/IlxGen.fs | 64 +++++++++++----------- src/Compiler/TypedTree/TypedTree.fs | 30 +++++++--- src/Compiler/TypedTree/TypedTree.fsi | 18 +++--- src/Compiler/TypedTree/TypedTreePickle.fs | 15 ++++- 10 files changed, 250 insertions(+), 81 deletions(-) diff --git a/src/Compiler/AbstractIL/il.fs b/src/Compiler/AbstractIL/il.fs index e0a5bb576aa..c477c6d2b98 100644 --- a/src/Compiler/AbstractIL/il.fs +++ b/src/Compiler/AbstractIL/il.fs @@ -193,20 +193,22 @@ type LazyOrderedMultiMap<'Key, 'Data when 'Key: equality>(keyf: 'Data -> 'Key, l t) - member self.Entries() = lazyItems.Force() + member _.Entries() = lazyItems.Force() - member self.Add y = + member _.Add y = new LazyOrderedMultiMap<'Key, 'Data>(keyf, lazyItems |> lazyMap (fun x -> y :: x)) - member self.Filter f = + member _.Filter f = new LazyOrderedMultiMap<'Key, 'Data>(keyf, lazyItems |> lazyMap (List.filter f)) - member self.Item + member _.Item with get x = match quickMap.Force().TryGetValue x with | true, v -> v | _ -> [] + override _.ToString() = "" + //--------------------------------------------------------------------- // SHA1 hash-signing algorithm. Used to get the public key token from // the public key. @@ -430,6 +432,7 @@ type AssemblyRefData = assemRefVersion: ILVersionInfo option assemRefLocale: Locale option } + override x.ToString() = x.assemRefName /// Global state: table of all assembly references keyed by AssemblyRefData. let AssemblyRefUniqueStampGenerator = UniqueStampGenerator() @@ -589,6 +592,8 @@ type ILModuleRef = member x.Hash = x.hash + override x.ToString() = x.Name + [] [] type ILScopeRef = @@ -678,6 +683,8 @@ type ILCallingConv = static member Static = ILCallingConvStatics.Static + override x.ToString() = if x.IsStatic then "static" else "instance" + /// Static storage to amortize the allocation of ILCallingConv.Instance and ILCallingConv.Static. and ILCallingConvStatics() = @@ -997,7 +1004,7 @@ type ILMethodRef = member x.ReturnType = x.mrefReturn - member x.CallingSignature = mkILCallSig (x.CallingConv, x.ArgTypes, x.ReturnType) + member x.GetCallingSignature() = mkILCallSig (x.CallingConv, x.ArgTypes, x.ReturnType) static member Create(enclosingTypeRef, callingConv, name, genericArity, argTypes, returnType) = { @@ -1126,6 +1133,8 @@ type ILSourceDocument = member x.File = x.sourceFile + override x.ToString() = x.File + [] type ILDebugPoint = { @@ -1461,6 +1470,7 @@ type ILLocalDebugInfo = Range: ILCodeLabel * ILCodeLabel DebugMappings: ILLocalDebugMapping list } + override x.ToString() = (fst x.Range).ToString() + "-" + (snd x.Range).ToString() [] type ILCode = @@ -1470,6 +1480,7 @@ type ILCode = Exceptions: ILExceptionSpec list Locals: ILLocalDebugInfo list } + override x.ToString() = "" [] type ILLocal = @@ -1478,6 +1489,7 @@ type ILLocal = IsPinned: bool DebugInfo: (string * int * int) option } + override x.ToString() = "" type ILLocals = ILLocal list @@ -1494,6 +1506,7 @@ type ILDebugImports = Parent: ILDebugImports option Imports: ILDebugImport[] } + override x.ToString() = "" [] type ILMethodBody = @@ -1507,6 +1520,7 @@ type ILMethodBody = DebugRange: ILDebugPoint option DebugImports: ILDebugImports option } + override x.ToString() = "" [] type ILMemberAccess = @@ -1747,6 +1761,7 @@ type PInvokeMethod = ThrowOnUnmappableChar: PInvokeThrowOnUnmappableChar CharBestFit: PInvokeCharBestFit } + override x.ToString() = x.Name [] type ILParameter = @@ -1764,6 +1779,8 @@ type ILParameter = member x.CustomAttrs = x.CustomAttrsStored.GetCustomAttrs x.MetadataIndex + override x.ToString() = x.Name |> Option.defaultValue "" + type ILParameters = ILParameter list [] @@ -1775,6 +1792,8 @@ type ILReturn = MetadataIndex: int32 } + override x.ToString() = "" + member x.CustomAttrs = x.CustomAttrsStored.GetCustomAttrs x.MetadataIndex member x.WithCustomAttrs(customAttrs) = @@ -1789,6 +1808,8 @@ type ILOverridesSpec = member x.DeclaringType = let (OverridesSpec (_mr, ty)) = x in ty + override x.ToString() = "overrides " + x.DeclaringType.ToString() + "::" + x.MethodRef.ToString() + type ILMethodVirtualInfo = { IsFinal: bool @@ -1811,7 +1832,7 @@ type MethodCodeKind = | Native | Runtime -let typesOfILParams (ps: ILParameters) : ILTypes = ps |> List.map (fun p -> p.Type) +let typesOfILParams (ps: ILParameters) = ps |> List.map (fun p -> p.Type) [] type ILGenericVariance = @@ -1996,7 +2017,7 @@ type ILMethodDef member x.IsZeroInit = x.MethodBody.IsZeroInit - member md.CallingSignature = + member md.GetCallingSignature() = mkILCallSig (md.CallingConv, md.ParameterTypes, md.Return.Type) member x.IsClassInitializer = x.Name = ".cctor" @@ -2107,6 +2128,8 @@ type ILMethodDef member x.WithRuntime(condition) = x.With(implAttributes = (x.ImplAttributes |> conditionalAdd condition MethodImplAttributes.Runtime)) + override x.ToString() = x.Name + /// Index table by name and arity. type MethodDefMap = Map @@ -2152,7 +2175,7 @@ type ILMethodDefs(f: unit -> ILMethodDef[]) = member x.TryFindInstanceByNameAndCallingSignature(nm, callingSig) = x.FindByName nm - |> List.tryFind (fun x -> not x.IsStatic && x.CallingSignature = callingSig) + |> List.tryFind (fun x -> not x.IsStatic && x.GetCallingSignature() = callingSig) [] type ILEventDef @@ -2235,6 +2258,8 @@ type ILEventDefs = member x.LookupByName s = let (ILEvents t) = x in t[s] + override x.ToString() = "" + [] type ILPropertyDef ( @@ -2313,6 +2338,8 @@ type ILPropertyDefs = member x.LookupByName s = let (ILProperties t) = x in t[s] + override x.ToString() = "" + let convertFieldAccess (ilMemberAccess: ILMemberAccess) = match ilMemberAccess with | ILMemberAccess.Assembly -> FieldAttributes.Assembly @@ -2414,6 +2441,8 @@ type ILFieldDef member x.WithFieldMarshal(marshal) = x.With(marshal = marshal, attributes = (x.Attributes |> conditionalAdd marshal.IsSome FieldAttributes.HasFieldMarshal)) + override x.ToString() = "field " + x.Name + // Index table by name. Keep a canonical list to make sure field order is not disturbed for binary manipulation. type ILFieldDefs = | ILFields of LazyOrderedMultiMap @@ -2422,6 +2451,8 @@ type ILFieldDefs = member x.LookupByName s = let (ILFields t) = x in t[s] + override x.ToString() = "" + type ILMethodImplDef = { Overrides: ILOverridesSpec @@ -2782,6 +2813,8 @@ type ILTypeDef member x.WithInitSemantics(init) = x.With(attributes = (x.Attributes ||| convertInitSemantics init)) + override x.ToString() = x.Name + and [] ILTypeDefs(f: unit -> ILPreTypeDef[]) = let mutable array = InlineDelayInit<_>(f) @@ -2797,10 +2830,10 @@ and [] ILTypeDefs(f: unit -> ILPreTypeDef[]) = ReadOnlyDictionary t) - member x.AsArray() = + member _.AsArray() = [| for pre in array.Value -> pre.GetTypeDef() |] - member x.AsList() = + member _.AsList() = [ for pre in array.Value -> pre.GetTypeDef() ] interface IEnumerable with @@ -2863,6 +2896,8 @@ type ILNestedExportedType = member x.CustomAttrs = x.CustomAttrsStored.GetCustomAttrs x.MetadataIndex + override x.ToString() = "exported type " + x.Name + and ILNestedExportedTypes = | ILNestedExportedTypes of Lazy> @@ -2885,6 +2920,8 @@ and [] ILExportedTypeOrForwarder = member x.CustomAttrs = x.CustomAttrsStored.GetCustomAttrs x.MetadataIndex + override x.ToString() = "exported type " + x.Name + and ILExportedTypesAndForwarders = | ILExportedTypesAndForwarders of Lazy> @@ -2923,6 +2960,8 @@ type ILResource = member x.CustomAttrs = x.CustomAttrsStored.GetCustomAttrs x.MetadataIndex + override x.ToString() = "resource " + x.Name + type ILResources = | ILResources of ILResource list @@ -2970,6 +3009,8 @@ type ILAssemblyManifest = member x.SecurityDecls = x.SecurityDeclsStored.GetSecurityDecls x.MetadataIndex + override x.ToString() = "assembly manifest " + x.Name + [] type ILNativeResource = | In of fileName: string * linkedResourceBase: int * linkedResourceStart: int * linkedResourceLength: int @@ -3013,6 +3054,8 @@ type ILModuleDef = member x.CustomAttrs = x.CustomAttrsStored.GetCustomAttrs x.MetadataIndex + override x.ToString() = "assembly " + x.Name + // -------------------------------------------------------------------- // Add fields and types to tables, with decent error messages // when clashes occur... diff --git a/src/Compiler/AbstractIL/il.fsi b/src/Compiler/AbstractIL/il.fsi index 3ea66ef5bf2..acef6bfd83a 100644 --- a/src/Compiler/AbstractIL/il.fsi +++ b/src/Compiler/AbstractIL/il.fsi @@ -354,7 +354,7 @@ type ILMethodRef = member ReturnType: ILType - member CallingSignature: ILCallingSignature + member GetCallingSignature: unit -> ILCallingSignature interface System.IComparable @@ -1089,27 +1089,43 @@ type ILMethodDef = member IsVirtual: bool member IsFinal: bool + member IsNewSlot: bool + member IsCheckAccessOnOverride: bool + member IsAbstract: bool + member MethodBody: ILMethodBody - member CallingSignature: ILCallingSignature + + member GetCallingSignature: unit -> ILCallingSignature + member Access: ILMemberAccess + member IsHideBySig: bool + member IsSpecialName: bool /// The method is exported to unmanaged code using COM interop. member IsUnmanagedExport: bool + member IsReqSecObj: bool /// Some methods are marked "HasSecurity" even if there are no permissions attached, e.g. if they use SuppressUnmanagedCodeSecurityAttribute member HasSecurity: bool + member IsManaged: bool + member IsForwardRef: bool + member IsInternalCall: bool + member IsPreserveSig: bool + member IsSynchronized: bool + member IsNoInline: bool + member IsAggressiveInline: bool /// SafeHandle finalizer must be run. @@ -1129,19 +1145,33 @@ type ILMethodDef = ?genericParams: ILGenericParameterDefs * ?customAttrs: ILAttributes -> ILMethodDef + member internal WithSpecialName: ILMethodDef + member internal WithHideBySig: unit -> ILMethodDef + member internal WithHideBySig: bool -> ILMethodDef + member internal WithFinal: bool -> ILMethodDef + member internal WithAbstract: bool -> ILMethodDef + member internal WithAccess: ILMemberAccess -> ILMethodDef + member internal WithNewSlot: ILMethodDef + member internal WithSecurity: bool -> ILMethodDef + member internal WithPInvoke: bool -> ILMethodDef + member internal WithPreserveSig: bool -> ILMethodDef + member internal WithSynchronized: bool -> ILMethodDef + member internal WithNoInlining: bool -> ILMethodDef + member internal WithAggressiveInlining: bool -> ILMethodDef + member internal WithRuntime: bool -> ILMethodDef /// Tables of methods. Logically equivalent to a list of methods but @@ -1149,10 +1179,15 @@ type ILMethodDef = /// name and arity. [] type ILMethodDefs = + interface IEnumerable + member AsArray: unit -> ILMethodDef[] + member AsList: unit -> ILMethodDef list + member FindByName: string -> ILMethodDef list + member TryFindInstanceByNameAndCallingSignature: string * ILCallingSignature -> ILMethodDef option /// Field definitions. @@ -1185,20 +1220,32 @@ type ILFieldDef = ILFieldDef member Name: string + member FieldType: ILType + member Attributes: FieldAttributes + member Data: byte[] option + member LiteralValue: ILFieldInit option /// The explicit offset in bytes when explicit layout is used. member Offset: int32 option + member Marshal: ILNativeType option + member CustomAttrs: ILAttributes + member IsStatic: bool + member IsSpecialName: bool + member IsLiteral: bool + member NotSerialized: bool + member IsInitOnly: bool + member Access: ILMemberAccess /// Functional update of the value @@ -1212,12 +1259,19 @@ type ILFieldDef = ?marshal: ILNativeType option * ?customAttrs: ILAttributes -> ILFieldDef + member internal WithAccess: ILMemberAccess -> ILFieldDef + member internal WithInitOnly: bool -> ILFieldDef + member internal WithStatic: bool -> ILFieldDef + member internal WithSpecialName: bool -> ILFieldDef + member internal WithNotSerialized: bool -> ILFieldDef + member internal WithLiteralDefaultValue: ILFieldInit option -> ILFieldDef + member internal WithFieldMarshal: ILNativeType option -> ILFieldDef /// Tables of fields. Logically equivalent to a list of fields but the table is kept in diff --git a/src/Compiler/AbstractIL/ilwrite.fs b/src/Compiler/AbstractIL/ilwrite.fs index 80bb791c25f..847ebf2bb08 100644 --- a/src/Compiler/AbstractIL/ilwrite.fs +++ b/src/Compiler/AbstractIL/ilwrite.fs @@ -407,6 +407,8 @@ type MetadataTable<'T> = member tbl.GetTableEntry x = tbl.dict[x] + override x.ToString() = "table " + x.name + //--------------------------------------------------------------------- // Keys into some of the tables //--------------------------------------------------------------------- @@ -453,6 +455,8 @@ type MethodDefKey(ilg:ILGlobals, tidx: int, garity: int, nm: string, retTy: ILTy isStatic = y.IsStatic | _ -> false + override x.ToString() = nm + /// We use this key type to help find ILFieldDefs for FieldRefs type FieldDefKey(tidx: int, nm: string, ty: ILType) = // precompute the hash. hash doesn't include the type diff --git a/src/Compiler/AbstractIL/ilx.fs b/src/Compiler/AbstractIL/ilx.fs index e91ad50d712..971d5bf3dd8 100644 --- a/src/Compiler/AbstractIL/ilx.fs +++ b/src/Compiler/AbstractIL/ilx.fs @@ -15,10 +15,16 @@ let mkLowerName (nm: string) = [] type IlxUnionCaseField(fd: ILFieldDef) = let lowerName = mkLowerName fd.Name - member x.ILField = fd + + member _.ILField = fd + member x.Type = x.ILField.FieldType + member x.Name = x.ILField.Name - member x.LowerName = lowerName + + member _.LowerName = lowerName + + override x.ToString() = x.Name type IlxUnionCase = { @@ -28,11 +34,17 @@ type IlxUnionCase = } member x.FieldDefs = x.altFields + member x.FieldDef n = x.altFields[n] + member x.Name = x.altName + member x.IsNullary = (x.FieldDefs.Length = 0) + member x.FieldTypes = x.FieldDefs |> Array.map (fun fd -> fd.Type) + override x.ToString() = x.Name + type IlxUnionHasHelpers = | NoHelpers | AllHelpers @@ -48,7 +60,9 @@ type IlxUnionSpec = let (IlxUnionSpec (IlxUnionRef (bx, tref, _, _, _), inst)) = x in mkILNamedTy bx tref inst member x.Boxity = let (IlxUnionSpec (IlxUnionRef (bx, _, _, _, _), _)) = x in bx + member x.TypeRef = let (IlxUnionSpec (IlxUnionRef (_, tref, _, _, _), _)) = x in tref + member x.GenericArgs = let (IlxUnionSpec (_, inst)) = x in inst member x.AlternativesArray = @@ -58,10 +72,15 @@ type IlxUnionSpec = let (IlxUnionSpec (IlxUnionRef (_, _, _, np, _), _)) = x in np member x.HasHelpers = let (IlxUnionSpec (IlxUnionRef (_, _, _, _, b), _)) = x in b + member x.Alternatives = Array.toList x.AlternativesArray + member x.Alternative idx = x.AlternativesArray[idx] + member x.FieldDef idx fidx = x.Alternative(idx).FieldDef(fidx) + override x.ToString() = x.TypeRef.Name + type IlxClosureLambdas = | Lambdas_forall of ILGenericParameterDef * IlxClosureLambdas | Lambdas_lambda of ILParameter * IlxClosureLambdas @@ -99,6 +118,8 @@ type IlxClosureFreeVar = fvType: ILType } + override x.ToString() = x.fvName + let mkILFreeVar (name, compgen, ty) = { fvName = name @@ -106,7 +127,8 @@ let mkILFreeVar (name, compgen, ty) = fvType = ty } -type IlxClosureRef = IlxClosureRef of ILTypeRef * IlxClosureLambdas * IlxClosureFreeVar[] +type IlxClosureRef = + | IlxClosureRef of ILTypeRef * IlxClosureLambdas * IlxClosureFreeVar[] type IlxClosureSpec = | IlxClosureSpec of IlxClosureRef * ILGenericArgs * ILType * useStaticField: bool @@ -141,6 +163,8 @@ type IlxClosureSpec = let formalCloTy = mkILFormalBoxedTy x.TypeRef (mkILFormalTypars x.GenericArgs) mkILFieldSpecInTy (x.ILType, "@_instance", formalCloTy) + override x.ToString() = x.TypeRef.ToString() + // Define an extension of the IL algebra of type definitions type IlxClosureInfo = { @@ -171,12 +195,14 @@ type IlxUnionInfo = DebugImports: ILDebugImports option } + override _.ToString() = "" + // -------------------------------------------------------------------- // Define these as extensions of the IL types // -------------------------------------------------------------------- -let destTyFuncApp = - function +let destTyFuncApp input = + match input with | Apps_tyapp (b, c) -> b, c | _ -> failwith "destTyFuncApp" diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index 389d96e2236..ee81eb41171 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -1203,7 +1203,7 @@ module MutRecBindingChecking = // envStatic contains class typars and the (ungeneralized) members on the class(es). // envStatic has no instance-variables (local let-bindings or ctor args). - let v = rbind.RecBindingInfo .Val + let v = rbind.RecBindingInfo.Val let envForBinding = if v.IsInstanceMember then envInstance else envStatic // Type variables derived from the type definition (or implicit constructor) are always generalizable (we check their generalizability later). @@ -3320,7 +3320,15 @@ module EstablishTypeDefinitionCores = let recdFields = TcRecdUnionAndEnumDeclarations.TcNamedFieldDecls cenv envinner innerParent false tpenv fields recdFields |> CheckDuplicates (fun f -> f.Id) "field" |> ignore writeFakeRecordFieldsToSink recdFields - let repr = TFSharpTyconRepr (Construct.NewEmptyFSharpTyconData TFSharpRecord) + let data = + { + fsobjmodel_cases = Construct.MakeUnionCases [] + fsobjmodel_kind = TFSharpRecord + fsobjmodel_vslots = [] + fsobjmodel_rfields = Construct.MakeRecdFieldsTable recdFields + } + + let repr = TFSharpTyconRepr data repr, None, NoSafeInitInfo | SynTypeDefnSimpleRepr.LibraryOnlyILAssembly (s, _) -> @@ -3451,13 +3459,14 @@ module EstablishTypeDefinitionCores = let baseValOpt = MakeAndPublishBaseVal cenv envinner baseIdOpt (superOfTycon g tycon) let safeInitInfo = ComputeInstanceSafeInitInfo cenv envinner thisTyconRef.Range thisTy let safeInitFields = match safeInitInfo with SafeInitField (_, fld) -> [fld] | NoSafeInitInfo -> [] - - let repr = - TFSharpTyconRepr - { fsobjmodel_cases = Construct.MakeUnionCases [] - fsobjmodel_kind = kind - fsobjmodel_vslots = abstractSlots - fsobjmodel_rfields = Construct.MakeRecdFieldsTable (userFields @ implicitStructFields @ safeInitFields) } + let data = + { + fsobjmodel_cases = Construct.MakeUnionCases [] + fsobjmodel_kind = kind + fsobjmodel_vslots = abstractSlots + fsobjmodel_rfields = Construct.MakeRecdFieldsTable (userFields @ implicitStructFields @ safeInitFields) + } + let repr = TFSharpTyconRepr data repr, baseValOpt, safeInitInfo | SynTypeDefnSimpleRepr.Enum (decls, m) -> @@ -3475,12 +3484,14 @@ module EstablishTypeDefinitionCores = errorR(Error(FSComp.SR.tcInvalidTypeForLiteralEnumeration(), m)) writeFakeRecordFieldsToSink fields' - let repr = - TFSharpTyconRepr - { fsobjmodel_cases = Construct.MakeUnionCases [] - fsobjmodel_kind=kind - fsobjmodel_vslots=[] - fsobjmodel_rfields= Construct.MakeRecdFieldsTable (vfld :: fields') } + let data = + { + fsobjmodel_cases = Construct.MakeUnionCases [] + fsobjmodel_kind = kind + fsobjmodel_vslots = [] + fsobjmodel_rfields = Construct.MakeRecdFieldsTable (vfld :: fields') + } + let repr = TFSharpTyconRepr data repr, None, NoSafeInitInfo tycon.entity_tycon_repr <- typeRepr diff --git a/src/Compiler/Checking/InfoReader.fs b/src/Compiler/Checking/InfoReader.fs index 27eb5c2547e..24db327dc7e 100644 --- a/src/Compiler/Checking/InfoReader.fs +++ b/src/Compiler/Checking/InfoReader.fs @@ -487,7 +487,7 @@ type InfoReader(g: TcGlobals, amap: Import.ImportMap) as this = | Some name when name = overridesName -> true | _ -> false if canAccumulate then - match mdefs.TryFindInstanceByNameAndCallingSignature (overrideBy.Name, overrideBy.MethodRef.CallingSignature) with + match mdefs.TryFindInstanceByNameAndCallingSignature (overrideBy.Name, overrideBy.MethodRef.GetCallingSignature()) with | Some mdef -> let overridesILTy = ilMethImpl.Overrides.DeclaringType let overridesTyFullName = overridesILTy.TypeRef.FullName diff --git a/src/Compiler/CodeGen/IlxGen.fs b/src/Compiler/CodeGen/IlxGen.fs index 66f7483f523..5d0eca2fc38 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/src/Compiler/CodeGen/IlxGen.fs @@ -1902,29 +1902,29 @@ let MergePropertyDefs m ilPropertyDefs = /// Information collected imperatively for each type definition type TypeDefBuilder(tdef: ILTypeDef, tdefDiscards) = - let gmethods = ResizeArray(0) - let gfields = ResizeArray(0) + let gmethods = ResizeArray(tdef.Methods.AsList()) + let gfields = ResizeArray(tdef.Fields.AsList()) let gproperties: Dictionary = Dictionary<_, _>(3, HashIdentity.Structural) - let gevents = ResizeArray(0) + let gevents = ResizeArray(tdef.Events.AsList()) let gnested = TypeDefsBuilder() - member b.Close() = + member _.Close() = tdef.With( - methods = mkILMethods (tdef.Methods.AsList() @ ResizeArray.toList gmethods), - fields = mkILFields (tdef.Fields.AsList() @ ResizeArray.toList gfields), + methods = mkILMethods (ResizeArray.toList gmethods), + fields = mkILFields (ResizeArray.toList gfields), properties = mkILProperties (tdef.Properties.AsList() @ HashRangeSorted gproperties), - events = mkILEvents (tdef.Events.AsList() @ ResizeArray.toList gevents), + events = mkILEvents (ResizeArray.toList gevents), nestedTypes = mkILTypeDefs (tdef.NestedTypes.AsList() @ gnested.Close()) ) - member b.AddEventDef edef = gevents.Add edef + member _.AddEventDef edef = gevents.Add edef - member b.AddFieldDef ilFieldDef = gfields.Add ilFieldDef + member _.AddFieldDef ilFieldDef = gfields.Add ilFieldDef - member b.AddMethodDef ilMethodDef = + member _.AddMethodDef ilMethodDef = let discard = match tdefDiscards with | Some (mdefDiscard, _) -> mdefDiscard ilMethodDef @@ -11082,6 +11082,23 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) = let ilEvents = mkILEvents abstractEventDefs let ilFields = mkILFields ilFieldDefs + // For now, generic types always use ILTypeInit.BeforeField. This is because + // there appear to be some cases where ILTypeInit.OnAny causes problems for + // the .NET CLR when used in conjunction with generic classes in cross-DLL + // and NGEN scenarios. + // + // We don't apply this rule to the final file. This is because ALL classes with .cctors in + // the final file (which may in turn trigger the .cctor for the .EXE itself, which + // in turn calls the main() method) must have deterministic initialization + // that is not triggered prior to execution of the main() method. + // If this property doesn't hold then the .cctor can end up running + // before the main method even starts. + let typeDefTrigger = + if eenv.isFinalFile || tycon.TyparsNoRange.IsEmpty then + ILTypeInit.OnAny + else + ILTypeInit.BeforeField + let tdef, tdefDiscards = let isSerializable = (TryFindFSharpBoolAttribute g g.attrib_AutoSerializableAttribute tycon.Attribs @@ -11102,9 +11119,9 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) = // Build a basic type definition let isObjectType = - (match tyconRepr with - | TFSharpTyconRepr _ -> true - | _ -> false) + match k with + | TFSharpRecord _ -> false + | _ -> true let ilAttrs = ilCustomAttrs @@ -11121,23 +11138,6 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) = )) ] - // For now, generic types always use ILTypeInit.BeforeField. This is because - // there appear to be some cases where ILTypeInit.OnAny causes problems for - // the .NET CLR when used in conjunction with generic classes in cross-DLL - // and NGEN scenarios. - // - // We don't apply this rule to the final file. This is because ALL classes with .cctors in - // the final file (which may in turn trigger the .cctor for the .EXE itself, which - // in turn calls the main() method) must have deterministic initialization - // that is not triggered prior to execution of the main() method. - // If this property doesn't hold then the .cctor can end up running - // before the main method even starts. - let typeDefTrigger = - if eenv.isFinalFile || tycon.TyparsNoRange.IsEmpty then - ILTypeInit.OnAny - else - ILTypeInit.BeforeField - let isKnownToBeAttribute = ExistsSameHeadTypeInHierarchy g cenv.amap m super g.mk_Attribute_ty @@ -11338,7 +11338,9 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) = .WithSealed(true) .WithEncoding(ILDefaultPInvokeEncoding.Auto) .WithAccess(access) - .WithInitSemantics(ILTypeInit.BeforeField) + // If there are static fields in the union, use the same kind of trigger as + // for class types + .WithInitSemantics(if ilFields.AsList().IsEmpty then ILTypeInit.BeforeField else typeDefTrigger) let tdef2 = EraseUnions.mkClassUnionDef diff --git a/src/Compiler/TypedTree/TypedTree.fs b/src/Compiler/TypedTree/TypedTree.fs index 767258fd3a9..ae19e714839 100644 --- a/src/Compiler/TypedTree/TypedTree.fs +++ b/src/Compiler/TypedTree/TypedTree.fs @@ -1106,8 +1106,21 @@ type Entity = /// Set the on-demand analysis about whether the entity is assumed to be a readonly struct member x.SetIsAssumedReadOnly b = x.entity_flags <- x.entity_flags.WithIsAssumedReadOnly b - /// Indicates if this is an F# type definition whose r.h.s. is known to be some kind of F# object model definition - member x.IsFSharpObjectModelTycon = match x.TypeReprInfo with | TFSharpTyconRepr _ -> true | _ -> false + /// Indicates if this is an F# type definition known to be an F# class, interface, struct, + /// delegate or enum. This isn't generally a particularly useful thing to know, + /// it is better to use more specific predicates. + member x.IsFSharpObjectModelTycon = + match x.TypeReprInfo with + | TFSharpTyconRepr { fsobjmodel_kind = kind } -> + match kind with + | TFSharpRecord + | TFSharpUnion -> false + | TFSharpClass + | TFSharpInterface + | TFSharpDelegate _ + | TFSharpStruct + | TFSharpEnum -> true + | _ -> false /// Indicates if this is an F# type definition which is one of the special types in FSharp.Core.dll which uses /// an assembly-code representation for the type, e.g. the primitive array type constructor. @@ -1146,8 +1159,7 @@ type Entity = #endif x.IsILEnumTycon || x.IsFSharpEnumTycon - - /// Indicates if this is an F#-defined struct or enum type definition, i.e. a value type definition + /// Indicates if this is an F#-defined value type definition, including struct records and unions member x.IsFSharpStructOrEnumTycon = match x.TypeReprInfo with | TFSharpTyconRepr info -> @@ -1162,7 +1174,7 @@ type Entity = x.IsILTycon && x.ILTyconRawMetadata.IsStructOrEnum - /// Indicates if this is a struct or enum type definition, i.e. a value type definition + /// Indicates if this is a struct or enum type definition, i.e. a value type definition, including struct records and unions member x.IsStructOrEnumTycon = #if !NO_TYPEPROVIDERS match x.TypeReprInfo with @@ -3627,7 +3639,7 @@ type EntityRef = /// Note: result is a indexed table, and for each name the results are in reverse declaration order member x.MembersOfFSharpTyconByName = x.Deref.MembersOfFSharpTyconByName - /// Indicates if this is a struct or enum type definition, i.e. a value type definition + /// Indicates if this is a struct or enum type definition, i.e. a value type definition, including struct records and unions member x.IsStructOrEnumTycon = x.Deref.IsStructOrEnumTycon /// Indicates if this is an F# type definition which is one of the special types in FSharp.Core.dll which uses @@ -3669,7 +3681,9 @@ type EntityRef = /// Indicates if this is an F# type definition whose r.h.s. is known to be a record type definition. member x.IsRecordTycon = x.Deref.IsRecordTycon - /// Indicates if this is an F# type definition whose r.h.s. is known to be some kind of F# object model definition + /// Indicates if this is an F# type definition known to be an F# class, interface, struct, + /// delegate or enum. This isn't generally a particularly useful thing to know, + /// it is better to use more specific predicates. member x.IsFSharpObjectModelTycon = x.Deref.IsFSharpObjectModelTycon /// The on-demand analysis about whether the entity has the IsByRefLike attribute @@ -3709,7 +3723,7 @@ type EntityRef = /// Indicates if this is an enum type definition member x.IsEnumTycon = x.Deref.IsEnumTycon - /// Indicates if this is an F#-defined struct or enum type definition, i.e. a value type definition + /// Indicates if this is an F#-defined value type definition, including struct records and unions member x.IsFSharpStructOrEnumTycon = x.Deref.IsFSharpStructOrEnumTycon /// Indicates if this is a .NET-defined struct or enum type definition, i.e. a value type definition diff --git a/src/Compiler/TypedTree/TypedTree.fsi b/src/Compiler/TypedTree/TypedTree.fsi index 55f31ccd284..951bee082fc 100644 --- a/src/Compiler/TypedTree/TypedTree.fsi +++ b/src/Compiler/TypedTree/TypedTree.fsi @@ -612,10 +612,12 @@ type Entity = /// Indicates if this is an F#-defined interface type definition member IsFSharpInterfaceTycon: bool - /// Indicates if this is an F# type definition whose r.h.s. is known to be some kind of F# object model definition + /// Indicates if this is an F# type definition known to be an F# class, interface, struct, + /// delegate or enum. This isn't generally a particularly useful thing to know, + /// it is better to use more specific predicates. member IsFSharpObjectModelTycon: bool - /// Indicates if this is an F#-defined struct or enum type definition, i.e. a value type definition + /// Indicates if this is an F#-defined value type definition, including struct records and unions member IsFSharpStructOrEnumTycon: bool /// Indicates if this is an F# type definition whose r.h.s. definition is unknown (i.e. a traditional ML 'abstract' type in a signature, @@ -625,7 +627,7 @@ type Entity = /// Indicates if this is a .NET-defined enum type definition member IsILEnumTycon: bool - /// Indicates if this is a .NET-defined struct or enum type definition, i.e. a value type definition + /// Indicates if this is a .NET-defined struct or enum type definition member IsILStructOrEnumTycon: bool /// Indicate if this is a type definition backed by Abstract IL metadata. @@ -674,7 +676,7 @@ type Entity = member IsStaticInstantiationTycon: bool #endif - /// Indicates if this is a struct or enum type definition, i.e. a value type definition + /// Indicates if this is a struct or enum type definition, i.e. a value type definition, including struct records and unions member IsStructOrEnumTycon: bool /// Indicates if this is an F# type definition whose r.h.s. is known to be a record type definition that is a value type. @@ -2464,10 +2466,12 @@ type EntityRef = /// Indicates if this is an F#-defined interface type definition member IsFSharpInterfaceTycon: bool - /// Indicates if this is an F# type definition whose r.h.s. is known to be some kind of F# object model definition + /// Indicates if this is an F# type definition known to be an F# class, interface, struct, + /// delegate or enum. This isn't generally a particularly useful thing to know, + /// it is better to use more specific predicates. member IsFSharpObjectModelTycon: bool - /// Indicates if this is an F#-defined struct or enum type definition, i.e. a value type definition + /// Indicates if this is an F#-defined value type definition, including struct records and unions member IsFSharpStructOrEnumTycon: bool /// Indicates if this is an F# type definition whose r.h.s. definition is unknown (i.e. a traditional ML 'abstract' type in a signature, @@ -2527,7 +2531,7 @@ type EntityRef = member IsStaticInstantiationTycon: bool #endif - /// Indicates if this is a struct or enum type definition, i.e. a value type definition + /// Indicates if this is a struct or enum type definition, i.e. a value type definition, including struct records and unions member IsStructOrEnumTycon: bool /// Indicates if this entity is an F# type abbreviation definition diff --git a/src/Compiler/TypedTree/TypedTreePickle.fs b/src/Compiler/TypedTree/TypedTreePickle.fs index c53928401be..37f3cfb6075 100644 --- a/src/Compiler/TypedTree/TypedTreePickle.fs +++ b/src/Compiler/TypedTree/TypedTreePickle.fs @@ -2077,13 +2077,13 @@ and p_member_info (x: ValMemberInfo) st = and p_tycon_objmodel_kind x st = match x with - | TFSharpUnion -> failwith "unreachable, see p_tycon_repr" - | TFSharpRecord -> failwith "unreachable, see p_tycon_repr" | TFSharpClass -> p_byte 0 st | TFSharpInterface -> p_byte 1 st | TFSharpStruct -> p_byte 2 st | TFSharpDelegate ss -> p_byte 3 st; p_slotsig ss st | TFSharpEnum -> p_byte 4 st + | TFSharpUnion -> p_byte 5 st + | TFSharpRecord -> p_byte 6 st and p_vrefFlags x st = match x with @@ -2133,6 +2133,7 @@ and u_tycon_repr st = | 1 -> let tag2 = u_byte st match tag2 with + // Records historically use a different format to other FSharpTyconRepr | 0 -> let v = u_rfield_table st (fun _flagBit -> @@ -2143,9 +2144,12 @@ and u_tycon_repr st = fsobjmodel_vslots=[] fsobjmodel_rfields=v }) + + // Unions without static fields historically use a different format to other FSharpTyconRepr | 1 -> let v = u_list u_unioncase_spec st (fun _flagBit -> Construct.MakeUnionRepr v) + | 2 -> let v = u_ILType st // This is the F# 3.0 extension to the format used for F# provider-generated types, which record an ILTypeRef in the format @@ -2171,13 +2175,18 @@ and u_tycon_repr st = TNoRepr else TAsmRepr v) + | 3 -> let v = u_tycon_objmodel_data st (fun _flagBit -> TFSharpTyconRepr v) + | 4 -> let v = u_ty st (fun _flagBit -> TMeasureableRepr v) + | _ -> ufailwith st "u_tycon_repr" + + // Unions with static fields use a different format to other FSharpTyconRepr | 2 -> let cases = u_array u_unioncase_spec st let data = u_tycon_objmodel_data st @@ -2385,6 +2394,8 @@ and u_tycon_objmodel_kind st = | 2 -> TFSharpStruct | 3 -> u_slotsig st |> TFSharpDelegate | 4 -> TFSharpEnum + | 5 -> TFSharpUnion + | 6 -> TFSharpRecord | _ -> ufailwith st "u_tycon_objmodel_kind" and u_vrefFlags st = From 509f16d6987eda7696b05662736e34a0303a95b3 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Wed, 19 Oct 2022 14:45:53 +0100 Subject: [PATCH 04/45] fix build --- .../Checking/CheckIncrementalClasses.fs | 17 ++++++++++++----- 1 file changed, 12 insertions(+), 5 deletions(-) diff --git a/src/Compiler/Checking/CheckIncrementalClasses.fs b/src/Compiler/Checking/CheckIncrementalClasses.fs index 1befa8ec6ba..3e3e2fe1cd6 100644 --- a/src/Compiler/Checking/CheckIncrementalClasses.fs +++ b/src/Compiler/Checking/CheckIncrementalClasses.fs @@ -489,11 +489,18 @@ type IncrClassReprInfo = | SafeInitField (_, fld) -> yield fld | NoSafeInitInfo -> () ] - let recdFields = Construct.MakeRecdFieldsTable (rfspecs @ tcref.AllFieldsAsList) - - // Mutate the entity_tycon_repr to publish the fields - tcref.Deref.entity_tycon_repr <- TFSharpTyconRepr { tcref.FSharpTyconRepresentationData with fsobjmodel_rfields = recdFields} - + let allFields = rfspecs @ tcref.AllFieldsAsList + match allFields with + | [] -> () + | _ -> + match tcref.TypeReprInfo with + | TFSharpTyconRepr info -> + let recdFields = Construct.MakeRecdFieldsTable (rfspecs @ tcref.AllFieldsAsList) + + // Mutate the entity_tycon_repr to publish the fields + tcref.Deref.entity_tycon_repr <- TFSharpTyconRepr { info with fsobjmodel_rfields = recdFields} + | _ -> + errorR(InternalError("unreachable, anything that can have fields should be a TFSharpTyconRepr", tcref.Range)) /// Given localRep saying how locals have been represented, e.g. as fields. /// Given an expr under a given thisVal context. From 3ba36c3a287052745a958eeb5e4d51a0d092308f Mon Sep 17 00:00:00 2001 From: Don Syme Date: Wed, 19 Oct 2022 15:09:53 +0100 Subject: [PATCH 05/45] fix formatting --- src/Compiler/AbstractIL/il.fs | 22 +++++++++++---- src/Compiler/AbstractIL/ilx.fs | 3 +- .../Checking/CheckIncrementalClasses.fsi | 7 +---- src/Compiler/CodeGen/IlxGen.fs | 28 +++++++++++++++---- 4 files changed, 42 insertions(+), 18 deletions(-) diff --git a/src/Compiler/AbstractIL/il.fs b/src/Compiler/AbstractIL/il.fs index c477c6d2b98..e3d0cd28f20 100644 --- a/src/Compiler/AbstractIL/il.fs +++ b/src/Compiler/AbstractIL/il.fs @@ -432,6 +432,7 @@ type AssemblyRefData = assemRefVersion: ILVersionInfo option assemRefLocale: Locale option } + override x.ToString() = x.assemRefName /// Global state: table of all assembly references keyed by AssemblyRefData. @@ -683,7 +684,8 @@ type ILCallingConv = static member Static = ILCallingConvStatics.Static - override x.ToString() = if x.IsStatic then "static" else "instance" + override x.ToString() = + if x.IsStatic then "static" else "instance" /// Static storage to amortize the allocation of ILCallingConv.Instance and ILCallingConv.Static. and ILCallingConvStatics() = @@ -1004,7 +1006,8 @@ type ILMethodRef = member x.ReturnType = x.mrefReturn - member x.GetCallingSignature() = mkILCallSig (x.CallingConv, x.ArgTypes, x.ReturnType) + member x.GetCallingSignature() = + mkILCallSig (x.CallingConv, x.ArgTypes, x.ReturnType) static member Create(enclosingTypeRef, callingConv, name, genericArity, argTypes, returnType) = { @@ -1470,7 +1473,9 @@ type ILLocalDebugInfo = Range: ILCodeLabel * ILCodeLabel DebugMappings: ILLocalDebugMapping list } - override x.ToString() = (fst x.Range).ToString() + "-" + (snd x.Range).ToString() + + override x.ToString() = + (fst x.Range).ToString() + "-" + (snd x.Range).ToString() [] type ILCode = @@ -1480,6 +1485,7 @@ type ILCode = Exceptions: ILExceptionSpec list Locals: ILLocalDebugInfo list } + override x.ToString() = "" [] @@ -1489,6 +1495,7 @@ type ILLocal = IsPinned: bool DebugInfo: (string * int * int) option } + override x.ToString() = "" type ILLocals = ILLocal list @@ -1506,6 +1513,7 @@ type ILDebugImports = Parent: ILDebugImports option Imports: ILDebugImport[] } + override x.ToString() = "" [] @@ -1520,6 +1528,7 @@ type ILMethodBody = DebugRange: ILDebugPoint option DebugImports: ILDebugImports option } + override x.ToString() = "" [] @@ -1761,6 +1770,7 @@ type PInvokeMethod = ThrowOnUnmappableChar: PInvokeThrowOnUnmappableChar CharBestFit: PInvokeCharBestFit } + override x.ToString() = x.Name [] @@ -1779,7 +1789,8 @@ type ILParameter = member x.CustomAttrs = x.CustomAttrsStored.GetCustomAttrs x.MetadataIndex - override x.ToString() = x.Name |> Option.defaultValue "" + override x.ToString() = + x.Name |> Option.defaultValue "" type ILParameters = ILParameter list @@ -1808,7 +1819,8 @@ type ILOverridesSpec = member x.DeclaringType = let (OverridesSpec (_mr, ty)) = x in ty - override x.ToString() = "overrides " + x.DeclaringType.ToString() + "::" + x.MethodRef.ToString() + override x.ToString() = + "overrides " + x.DeclaringType.ToString() + "::" + x.MethodRef.ToString() type ILMethodVirtualInfo = { diff --git a/src/Compiler/AbstractIL/ilx.fs b/src/Compiler/AbstractIL/ilx.fs index 971d5bf3dd8..8b167ce778e 100644 --- a/src/Compiler/AbstractIL/ilx.fs +++ b/src/Compiler/AbstractIL/ilx.fs @@ -127,8 +127,7 @@ let mkILFreeVar (name, compgen, ty) = fvType = ty } -type IlxClosureRef = - | IlxClosureRef of ILTypeRef * IlxClosureLambdas * IlxClosureFreeVar[] +type IlxClosureRef = IlxClosureRef of ILTypeRef * IlxClosureLambdas * IlxClosureFreeVar[] type IlxClosureSpec = | IlxClosureSpec of IlxClosureRef * ILGenericArgs * ILType * useStaticField: bool diff --git a/src/Compiler/Checking/CheckIncrementalClasses.fsi b/src/Compiler/Checking/CheckIncrementalClasses.fsi index 2ed5c559d80..0de56111ff9 100644 --- a/src/Compiler/Checking/CheckIncrementalClasses.fsi +++ b/src/Compiler/Checking/CheckIncrementalClasses.fsi @@ -119,12 +119,7 @@ type IncrClassConstructionBindingsPhase2C = /// Check and elaborate the "left hand side" of the implicit class construction /// syntax. val TcStaticImplicitCtorInfo_Phase2A: - cenv: TcFileState * - env: TcEnv * - tcref: TyconRef * - m: range * - copyOfTyconTypars: Typar list -> - StaticCtorInfo + cenv: TcFileState * env: TcEnv * tcref: TyconRef * m: range * copyOfTyconTypars: Typar list -> StaticCtorInfo /// Check and elaborate the "left hand side" of the implicit class construction /// syntax. diff --git a/src/Compiler/CodeGen/IlxGen.fs b/src/Compiler/CodeGen/IlxGen.fs index 5d0eca2fc38..60546a54cd7 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/src/Compiler/CodeGen/IlxGen.fs @@ -2165,6 +2165,7 @@ type AssemblyBuilder(cenv: cenv, anonTypeTable: AnonTypeGenerationTable) as mgbu if isStruct then tycon.SetIsStructRecordOrUnion true + let rfields = (tps, flds) ||> List.map2 (fun tp (propName, _fldName, _fldTy) -> @@ -2181,6 +2182,7 @@ type AssemblyBuilder(cenv: cenv, anonTypeTable: AnonTypeGenerationTable) as mgbu XmlDoc.Empty taccessPublic false) + let data = { fsobjmodel_cases = Construct.MakeUnionCases [] @@ -2188,6 +2190,7 @@ type AssemblyBuilder(cenv: cenv, anonTypeTable: AnonTypeGenerationTable) as mgbu fsobjmodel_kind = TFSharpRecord fsobjmodel_vslots = [] } + tycon.entity_tycon_repr <- TFSharpTyconRepr data let tcref = mkLocalTyconRef tycon let ty = generalizedTyconRef g tcref @@ -10694,8 +10697,10 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) = match o.fsobjmodel_kind with | TFSharpUnion | TFSharpRecord -> - if tycon.IsStructOrEnumTycon then ILTypeDefKind.ValueType - else ILTypeDefKind.Class + if tycon.IsStructOrEnumTycon then + ILTypeDefKind.ValueType + else + ILTypeDefKind.Class | TFSharpClass -> ILTypeDefKind.Class | TFSharpStruct -> ILTypeDefKind.ValueType | TFSharpInterface -> ILTypeDefKind.Interface @@ -11113,7 +11118,11 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) = tdef, None - | TFSharpTyconRepr { fsobjmodel_kind = k } when (match k with TFSharpUnion -> false | _ -> true) -> + | TFSharpTyconRepr { fsobjmodel_kind = k } when + (match k with + | TFSharpUnion -> false + | _ -> true) + -> let super = superOfTycon g tycon let ilBaseTy = GenType cenv m eenvinner.tyenv super @@ -11253,7 +11262,11 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) = tdef, None - | TFSharpTyconRepr { fsobjmodel_kind = k } when (match k with TFSharpUnion -> true | _ -> false) -> + | TFSharpTyconRepr { fsobjmodel_kind = k } when + (match k with + | TFSharpUnion -> true + | _ -> false) + -> let alternatives = tycon.UnionCasesArray |> Array.mapi (fun i ucspec -> @@ -11340,7 +11353,12 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) = .WithAccess(access) // If there are static fields in the union, use the same kind of trigger as // for class types - .WithInitSemantics(if ilFields.AsList().IsEmpty then ILTypeInit.BeforeField else typeDefTrigger) + .WithInitSemantics( + if ilFields.AsList().IsEmpty then + ILTypeInit.BeforeField + else + typeDefTrigger + ) let tdef2 = EraseUnions.mkClassUnionDef From 4f0a31013b00fde9080095ccdc19f9bd74990730 Mon Sep 17 00:00:00 2001 From: "github-actions[bot]" <41898282+github-actions[bot]@users.noreply.github.com> Date: Thu, 8 Jun 2023 10:18:30 +0000 Subject: [PATCH 06/45] Automated command ran: fantomas Co-authored-by: T-Gro <46543583+T-Gro@users.noreply.github.com> --- src/Compiler/AbstractIL/il.fs | 1 - 1 file changed, 1 deletion(-) diff --git a/src/Compiler/AbstractIL/il.fs b/src/Compiler/AbstractIL/il.fs index 3e819b6429a..b438cc1d79d 100644 --- a/src/Compiler/AbstractIL/il.fs +++ b/src/Compiler/AbstractIL/il.fs @@ -2448,7 +2448,6 @@ type ILFieldDef member x.WithFieldMarshal(marshal) = x.With(marshal = marshal, attributes = (x.Attributes |> conditionalAdd marshal.IsSome FieldAttributes.HasFieldMarshal)) - [] member x.DebugText = x.ToString() From 1c37ab01cb22eef4ae376209138750184c58ff47 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Thu, 8 Jun 2023 13:17:29 +0200 Subject: [PATCH 07/45] Build issues resolved --- src/Compiler/Checking/CheckDeclarations.fs | 10 +++++----- src/Compiler/Checking/CheckIncrementalClasses.fs | 4 ++-- 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index 57f13fa8efb..07d4b3b6b4a 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -898,7 +898,7 @@ module MutRecBindingChecking = let innerState = (None, envForTycon, tpenv, recBindIdx, uncheckedBindsRev) [Phase2AIncrClassCtor (staticCtorInfo, None)], innerState - | Some (SynMemberDefn.ImplicitCtor (vis, Attributes attrs, SynSimplePats.SimplePats(spats, _), thisIdOpt, xmlDoc, m)), ContainerInfo(_, Some memberContainerInfo) -> + | Some (SynMemberDefn.ImplicitCtor (vis, Attributes attrs, SynSimplePats.SimplePats(pats=spats), thisIdOpt, xmlDoc, m,_)), ContainerInfo(_, Some memberContainerInfo) -> let (MemberOrValContainerInfo(tcref, _, baseValOpt, safeInitInfo, _)) = memberContainerInfo @@ -1860,7 +1860,7 @@ let TcMutRecDefns_Phase2 (cenv: cenv) envInitial mBinds scopem mutRecNSInfo (env ReportErrorOnStaticClass synMembers match tyconOpt with | Some tycon -> - for slot in tycon.FSharpObjectModelTypeInfo.fsobjmodel_vslots do + for slot in tycon.FSharpTyconRepresentationData.fsobjmodel_vslots do warning(Error(FSComp.SR.chkAbstractMembersDeclarationsOnStaticClasses(), slot.Range)) for fld in tycon.AllFieldsArray do @@ -4211,7 +4211,7 @@ module TcDeclarations = // Convert auto properties to member bindings in the post-list let rec postAutoProps memb = match memb with - | SynMemberDefn.AutoProperty(attributes=Attributes attribs; isStatic=isStatic; ident=id; typeOpt=tyOpt; propKind=propKind; memberFlags=memberFlags; memberFlagsForSet=memberFlagsForSet; xmlDoc=xmlDoc; accessibility=access; trivia = { GetSetKeyword = mGetSetOpt }) -> + | SynMemberDefn.AutoProperty(attributes=Attributes attribs; isStatic=isStatic; ident=id; typeOpt=tyOpt; propKind=propKind; memberFlags=memberFlags; memberFlagsForSet=memberFlagsForSet; xmlDoc=xmlDoc; accessibility=access; trivia = { GetSetKeywords = mGetSetOpt }) -> let mMemberPortion = id.idRange // Only the keep the non-field-targeted attributes let attribs = attribs |> List.filter (fun a -> match a.Target with Some t when t.idText = "field" -> false | _ -> true) @@ -4222,7 +4222,7 @@ module TcDeclarations = let memberFlagsForSet = { memberFlagsForSet with GetterOrSetterIsCompilerGenerated = true } match propKind, mGetSetOpt with - | SynMemberKind.PropertySet, Some m -> errorR(Error(FSComp.SR.parsMutableOnAutoPropertyShouldBeGetSetNotJustSet(), m)) + | SynMemberKind.PropertySet, Some getSetKeywords -> errorR(Error(FSComp.SR.parsMutableOnAutoPropertyShouldBeGetSetNotJustSet(), getSetKeywords.Range)) | _ -> () [ @@ -4291,7 +4291,7 @@ module TcDeclarations = //let nestedTycons = cspec |> List.choose (function SynMemberDefn.NestedType (x, _, _) -> Some x | _ -> None) - let slotsigs = members |> List.choose (function SynMemberDefn.AbstractSlot (x, y, _) -> Some(x, y) | _ -> None) + let slotsigs = members |> List.choose (function SynMemberDefn.AbstractSlot (slotSig = x; flags = y) -> Some(x, y) | _ -> None) let members = SplitAutoProps members diff --git a/src/Compiler/Checking/CheckIncrementalClasses.fs b/src/Compiler/Checking/CheckIncrementalClasses.fs index 8e9f8927f9f..d7c487b3af5 100644 --- a/src/Compiler/Checking/CheckIncrementalClasses.fs +++ b/src/Compiler/Checking/CheckIncrementalClasses.fs @@ -105,9 +105,9 @@ let TcStaticImplicitCtorInfo_Phase2A(cenv: cenv, env, tcref: TyconRef, m, copyOf let cctorTy = mkFunTy g g.unit_ty g.unit_ty let valSynData = SynValInfo([[]], SynInfo.unnamedRetVal) let id = ident ("cctor", m) - CheckForNonAbstractInterface ModuleOrMemberBinding tcref ClassCtorMemberFlags id.idRange + CheckForNonAbstractInterface g ModuleOrMemberBinding tcref ClassCtorMemberFlags false id.idRange let memberInfo = MakeMemberDataAndMangledNameForMemberVal(g, tcref, false, [], [], ClassCtorMemberFlags, valSynData, id, false) - let prelimValReprInfo = TranslateSynValInfo m (TcAttributes cenv env) valSynData + let prelimValReprInfo = TranslateSynValInfo cenv m (TcAttributes cenv env) valSynData let prelimTyschemeG = GeneralizedType(copyOfTyconTypars, cctorTy) let valReprInfo = InferGenericArityFromTyScheme prelimTyschemeG prelimValReprInfo let cctorValScheme = ValScheme(id, prelimTyschemeG, Some valReprInfo, None, Some memberInfo, false, ValInline.Never, NormalVal, Some (SynAccess.Private Range.Zero), false, true, false, false) From 6adc132f4811b4ec4526829184934ddb6bad5b5b Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Thu, 8 Jun 2023 15:09:26 +0200 Subject: [PATCH 08/45] surface area changed --- ...arp.Compiler.Service.SurfaceArea.netstandard20.debug.bsl | 6 ++---- ...p.Compiler.Service.SurfaceArea.netstandard20.release.bsl | 6 ++---- .../FSharp.Core.SurfaceArea.netstandard21.debug.bsl | 2 +- 3 files changed, 5 insertions(+), 9 deletions(-) diff --git a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.debug.bsl b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.debug.bsl index ffc2dba9d44..50b9df52a58 100644 --- a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.debug.bsl +++ b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.debug.bsl @@ -764,8 +764,7 @@ FSharp.Compiler.AbstractIL.IL+ILMethodDef: ILAttributes CustomAttrs FSharp.Compiler.AbstractIL.IL+ILMethodDef: ILAttributes get_CustomAttrs() FSharp.Compiler.AbstractIL.IL+ILMethodDef: ILCallingConv CallingConv FSharp.Compiler.AbstractIL.IL+ILMethodDef: ILCallingConv get_CallingConv() -FSharp.Compiler.AbstractIL.IL+ILMethodDef: ILCallingSignature CallingSignature -FSharp.Compiler.AbstractIL.IL+ILMethodDef: ILCallingSignature get_CallingSignature() +FSharp.Compiler.AbstractIL.IL+ILMethodDef: ILCallingSignature GetCallingSignature() FSharp.Compiler.AbstractIL.IL+ILMethodDef: ILMemberAccess Access FSharp.Compiler.AbstractIL.IL+ILMethodDef: ILMemberAccess get_Access() FSharp.Compiler.AbstractIL.IL+ILMethodDef: ILMethodBody MethodBody @@ -825,8 +824,7 @@ FSharp.Compiler.AbstractIL.IL+ILMethodRef: Boolean Equals(System.Object) FSharp.Compiler.AbstractIL.IL+ILMethodRef: Boolean Equals(System.Object, System.Collections.IEqualityComparer) FSharp.Compiler.AbstractIL.IL+ILMethodRef: ILCallingConv CallingConv FSharp.Compiler.AbstractIL.IL+ILMethodRef: ILCallingConv get_CallingConv() -FSharp.Compiler.AbstractIL.IL+ILMethodRef: ILCallingSignature CallingSignature -FSharp.Compiler.AbstractIL.IL+ILMethodRef: ILCallingSignature get_CallingSignature() +FSharp.Compiler.AbstractIL.IL+ILMethodRef: ILCallingSignature GetCallingSignature() FSharp.Compiler.AbstractIL.IL+ILMethodRef: ILMethodRef Create(ILTypeRef, ILCallingConv, System.String, Int32, Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.AbstractIL.IL+ILType], ILType) FSharp.Compiler.AbstractIL.IL+ILMethodRef: ILType ReturnType FSharp.Compiler.AbstractIL.IL+ILMethodRef: ILType get_ReturnType() diff --git a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.release.bsl b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.release.bsl index 98811959ee7..862c5408206 100644 --- a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.release.bsl +++ b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.release.bsl @@ -764,8 +764,7 @@ FSharp.Compiler.AbstractIL.IL+ILMethodDef: ILAttributes CustomAttrs FSharp.Compiler.AbstractIL.IL+ILMethodDef: ILAttributes get_CustomAttrs() FSharp.Compiler.AbstractIL.IL+ILMethodDef: ILCallingConv CallingConv FSharp.Compiler.AbstractIL.IL+ILMethodDef: ILCallingConv get_CallingConv() -FSharp.Compiler.AbstractIL.IL+ILMethodDef: ILCallingSignature CallingSignature -FSharp.Compiler.AbstractIL.IL+ILMethodDef: ILCallingSignature get_CallingSignature() +FSharp.Compiler.AbstractIL.IL+ILMethodDef: ILCallingSignature GetCallingSignature() FSharp.Compiler.AbstractIL.IL+ILMethodDef: ILMemberAccess Access FSharp.Compiler.AbstractIL.IL+ILMethodDef: ILMemberAccess get_Access() FSharp.Compiler.AbstractIL.IL+ILMethodDef: ILMethodBody MethodBody @@ -825,8 +824,7 @@ FSharp.Compiler.AbstractIL.IL+ILMethodRef: Boolean Equals(System.Object) FSharp.Compiler.AbstractIL.IL+ILMethodRef: Boolean Equals(System.Object, System.Collections.IEqualityComparer) FSharp.Compiler.AbstractIL.IL+ILMethodRef: ILCallingConv CallingConv FSharp.Compiler.AbstractIL.IL+ILMethodRef: ILCallingConv get_CallingConv() -FSharp.Compiler.AbstractIL.IL+ILMethodRef: ILCallingSignature CallingSignature -FSharp.Compiler.AbstractIL.IL+ILMethodRef: ILCallingSignature get_CallingSignature() +FSharp.Compiler.AbstractIL.IL+ILMethodRef: ILCallingSignature GetCallingSignature() FSharp.Compiler.AbstractIL.IL+ILMethodRef: ILMethodRef Create(ILTypeRef, ILCallingConv, System.String, Int32, Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.AbstractIL.IL+ILType], ILType) FSharp.Compiler.AbstractIL.IL+ILMethodRef: ILType ReturnType FSharp.Compiler.AbstractIL.IL+ILMethodRef: ILType get_ReturnType() diff --git a/tests/FSharp.Core.UnitTests/FSharp.Core.SurfaceArea.netstandard21.debug.bsl b/tests/FSharp.Core.UnitTests/FSharp.Core.SurfaceArea.netstandard21.debug.bsl index 29f826a24ba..1b2f3a0e052 100644 --- a/tests/FSharp.Core.UnitTests/FSharp.Core.SurfaceArea.netstandard21.debug.bsl +++ b/tests/FSharp.Core.UnitTests/FSharp.Core.SurfaceArea.netstandard21.debug.bsl @@ -1002,7 +1002,7 @@ Microsoft.FSharp.Core.ExtraTopLevelOperators: T PrintFormatToTextWriter[T](Syste Microsoft.FSharp.Core.ExtraTopLevelOperators: T PrintFormat[T](Microsoft.FSharp.Core.PrintfFormat`4[T,System.IO.TextWriter,Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit]) Microsoft.FSharp.Core.ExtraTopLevelOperators: T SpliceExpression[T](Microsoft.FSharp.Quotations.FSharpExpr`1[T]) Microsoft.FSharp.Core.ExtraTopLevelOperators: T SpliceUntypedExpression[T](Microsoft.FSharp.Quotations.FSharpExpr) -Microsoft.FSharp.Core.ExtraTopLevelOperators: T[,] CreateArray2D[?,T](System.Collections.Generic.IEnumerable`1[?]) +Microsoft.FSharp.Core.ExtraTopLevelOperators: T[,] CreateArray2D[a,T](System.Collections.Generic.IEnumerable`1[a]) Microsoft.FSharp.Core.FSharpChoice`2+Choice1Of2[T1,T2]: T1 Item Microsoft.FSharp.Core.FSharpChoice`2+Choice1Of2[T1,T2]: T1 get_Item() Microsoft.FSharp.Core.FSharpChoice`2+Choice2Of2[T1,T2]: T2 Item From a28c57ed03ba949466d2ad989a36d2a773608585 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Fri, 9 Jun 2023 14:22:11 +0200 Subject: [PATCH 09/45] Test ideas for static let --- .../StaticLet/ActivePatternForUnion.fs | 0 .../StaticLet/CreateUnionCases.fs | 0 .../StaticLet/PlainEnum.fs | 0 .../QuotationsForStaticLetRecords.fs | 0 .../StaticLet/QuotationsForStaticLetUnions.fs | 0 .../StaticLet/RecordOrderOfExecution.fs | 0 .../StaticLet/RecordShowCase.fs | 20 +++ .../StaticLet/RecordStaticMember.fs | 0 .../StaticLet/RecursiveDUs.fs | 0 .../StaticLet/RecursiveRecords.fs | 0 .../StaticLet/SimpleEmptyGenericType.fs | 0 .../StaticLet/SimpleEmptyType.fs | 0 .../StaticLet/SimpleRecord.fs | 0 .../StaticLet/SimpleUnion.fs | 0 .../StaticLet/StaticLetInGenericRecords.fs | 0 .../StaticLet/StaticLetInGenericUnion.fs | 0 .../StaticLet/StaticLetInUnionsAndRecords.fs | 163 ++++++++++++++++++ .../StaticLet/StructRecord.fs | 0 .../StaticLet/StructUnion.fs | 0 .../StaticLet/UnionOrderOfExecution.fs | 0 .../StaticLet/UnionShowCase.fs | 18 ++ .../StaticLet/UnionStaticMember.fs | 0 .../FSharp.Compiler.ComponentTests.fsproj | 1 + 23 files changed, 202 insertions(+) create mode 100644 tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/ActivePatternForUnion.fs create mode 100644 tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/CreateUnionCases.fs create mode 100644 tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/PlainEnum.fs create mode 100644 tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/QuotationsForStaticLetRecords.fs create mode 100644 tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/QuotationsForStaticLetUnions.fs create mode 100644 tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/RecordOrderOfExecution.fs create mode 100644 tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/RecordShowCase.fs create mode 100644 tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/RecordStaticMember.fs create mode 100644 tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/RecursiveDUs.fs create mode 100644 tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/RecursiveRecords.fs create mode 100644 tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/SimpleEmptyGenericType.fs create mode 100644 tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/SimpleEmptyType.fs create mode 100644 tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/SimpleRecord.fs create mode 100644 tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/SimpleUnion.fs create mode 100644 tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/StaticLetInGenericRecords.fs create mode 100644 tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/StaticLetInGenericUnion.fs create mode 100644 tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/StaticLetInUnionsAndRecords.fs create mode 100644 tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/StructRecord.fs create mode 100644 tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/StructUnion.fs create mode 100644 tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/UnionOrderOfExecution.fs create mode 100644 tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/UnionShowCase.fs create mode 100644 tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/UnionStaticMember.fs diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/ActivePatternForUnion.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/ActivePatternForUnion.fs new file mode 100644 index 00000000000..e69de29bb2d diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/CreateUnionCases.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/CreateUnionCases.fs new file mode 100644 index 00000000000..e69de29bb2d diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/PlainEnum.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/PlainEnum.fs new file mode 100644 index 00000000000..e69de29bb2d diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/QuotationsForStaticLetRecords.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/QuotationsForStaticLetRecords.fs new file mode 100644 index 00000000000..e69de29bb2d diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/QuotationsForStaticLetUnions.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/QuotationsForStaticLetUnions.fs new file mode 100644 index 00000000000..e69de29bb2d diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/RecordOrderOfExecution.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/RecordOrderOfExecution.fs new file mode 100644 index 00000000000..e69de29bb2d diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/RecordShowCase.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/RecordShowCase.fs new file mode 100644 index 00000000000..5c692769042 --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/RecordShowCase.fs @@ -0,0 +1,20 @@ +module Test + +type R = + { + F1: int + F2: int + } + + static do printfn "init R 1" + static let r1 = { F1 = 1; F2 = 1 } + static member R1 = r1 + + static do printfn "init R 2" + static let r2 = { F1 = 1; F2 = 2 } + static member val R2 = r2 + + + +printfn "%i" R.R1.F2 +printfn "%i" R.R2.F2 \ No newline at end of file diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/RecordStaticMember.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/RecordStaticMember.fs new file mode 100644 index 00000000000..e69de29bb2d diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/RecursiveDUs.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/RecursiveDUs.fs new file mode 100644 index 00000000000..e69de29bb2d diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/RecursiveRecords.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/RecursiveRecords.fs new file mode 100644 index 00000000000..e69de29bb2d diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/SimpleEmptyGenericType.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/SimpleEmptyGenericType.fs new file mode 100644 index 00000000000..e69de29bb2d diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/SimpleEmptyType.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/SimpleEmptyType.fs new file mode 100644 index 00000000000..e69de29bb2d diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/SimpleRecord.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/SimpleRecord.fs new file mode 100644 index 00000000000..e69de29bb2d diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/SimpleUnion.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/SimpleUnion.fs new file mode 100644 index 00000000000..e69de29bb2d diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/StaticLetInGenericRecords.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/StaticLetInGenericRecords.fs new file mode 100644 index 00000000000..e69de29bb2d diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/StaticLetInGenericUnion.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/StaticLetInGenericUnion.fs new file mode 100644 index 00000000000..e69de29bb2d diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/StaticLetInUnionsAndRecords.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/StaticLetInUnionsAndRecords.fs new file mode 100644 index 00000000000..cf9aed64d66 --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/StaticLetInUnionsAndRecords.fs @@ -0,0 +1,163 @@ +module FSharp.Compiler.ComponentTests.Conformance.BasicTypeAndModuleDefinitions.StaticLet + +open System.IO +open Xunit +open FSharp.Test +open FSharp.Test.Compiler + +let verifyCompileAndRun compilation = + compilation + |> asExe + |> compileAndRun + + +[] +let ``Static let - union showcase`` compilation = + compilation + |> verifyCompileAndRun + |> shouldSucceed + |> withStdOutContains """init U 1 +init U 2 +init end +Case2 1 +Case2 2""" + +[] +let ``Static let - record showcase`` compilation = + compilation + |> verifyCompileAndRun + |> shouldSucceed + |> withStdOutContains """init R 1 +init R 2 +1 +2""" + +[] +let ``Static let in empty type`` compilation = + compilation + |> typecheck + |> shouldSucceed + +[] +let ``Static let in empty generic type`` compilation = + compilation + |> typecheck + |> shouldSucceed + +[] +let ``Static let in simple union`` compilation = + compilation + |> typecheck + |> shouldSucceed + +[] +let ``What about plain enums?`` compilation = + compilation + |> typecheck + |> shouldSucceed + +[] +let ``Static active pattern in union`` compilation = + compilation + |> typecheck + |> shouldSucceed + +[] +let ``Static let in struct union`` compilation = + compilation + |> typecheck + |> shouldSucceed + +[] +let ``Static let in simple record`` compilation = + compilation + |> typecheck + |> shouldSucceed + + +[] +let ``Static let in struct record`` compilation = + compilation + |> typecheck + |> shouldSucceed + +[] +let ``Static let with static member in union`` compilation = + compilation + |> typecheck + |> shouldSucceed + +[] +let ``Static let with static member in record`` compilation = + compilation + |> typecheck + |> shouldSucceed + + +[] +let ``Static let creating DU cases`` compilation = + compilation + |> verifyCompileAndRun + |> shouldSucceed + |> withStdOutContains "TODO put anything meaningful here" + + +[] +let ``Static let union - order of execution`` compilation = + compilation + |> verifyCompileAndRun + |> shouldSucceed + |> withStdOutContains "TODO put anything meaningful here" + +[] +let ``Static let record - order of execution`` compilation = + compilation + |> verifyCompileAndRun + |> shouldSucceed + |> withStdOutContains "TODO put anything meaningful here" + + +[] +let ``Static let - recursive DU definitions calling each other`` compilation = + compilation + |> verifyCompileAndRun + |> shouldSucceed + |> withStdOutContains "TODO put anything meaningful here" + +[] +let ``Static let - recursive record definitions calling each other`` compilation = + compilation + |> verifyCompileAndRun + |> shouldSucceed + |> withStdOutContains "TODO put anything meaningful here" + + +[] +let ``Static let - quotations support for unions`` compilation = + compilation + |> verifyCompileAndRun + |> shouldSucceed + |> withStdOutContains "TODO put anything meaningful here" + +[] +let ``Static let - quotations support for records`` compilation = + compilation + |> verifyCompileAndRun + |> shouldSucceed + |> withStdOutContains "TODO put anything meaningful here" + + +[] +let ``Static let union - executes per generic struct typar`` compilation = + compilation + |> verifyCompileAndRun + |> shouldSucceed + |> withStdOutContains "TODO put anything meaningful here" + + +[] +let ``Static let record - executes per generic struct typar`` compilation = + compilation + |> verifyCompileAndRun + |> shouldSucceed + |> withStdOutContains "TODO put anything meaningful here" \ No newline at end of file diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/StructRecord.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/StructRecord.fs new file mode 100644 index 00000000000..e69de29bb2d diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/StructUnion.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/StructUnion.fs new file mode 100644 index 00000000000..e69de29bb2d diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/UnionOrderOfExecution.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/UnionOrderOfExecution.fs new file mode 100644 index 00000000000..e69de29bb2d diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/UnionShowCase.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/UnionShowCase.fs new file mode 100644 index 00000000000..7b6cb870ff2 --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/UnionShowCase.fs @@ -0,0 +1,18 @@ +module Test + +type U = + | Case1 + | Case2 of int + + static do printfn "init U 1" + static let u1 = Case2 1 + static member U1 = u1 + + static do printfn "init U 2" + static let u2 = Case2 2 + static member val U2 = u2 + + static do printfn "init end" + +printfn "%A" U.U1 +printfn "%A" U.U2 \ No newline at end of file diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/UnionStaticMember.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/UnionStaticMember.fs new file mode 100644 index 00000000000..e69de29bb2d diff --git a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj index 85aec6c485e..4d9b720c2ce 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj +++ b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj @@ -33,6 +33,7 @@ + From 23c43f3f2aa8088845077d20468be4787f1057f7 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Fri, 9 Jun 2023 18:48:55 +0200 Subject: [PATCH 10/45] tests --- .../StaticLet/ActivePatternForUnion.fs | 14 ++++++++++ .../StaticLet/CreateUnionCases.fs | 14 ++++++++++ .../StaticLet/PlainEnum.fs | 9 +++++++ .../StaticLet/QuotationsForStaticLetUnions.fs | 12 +++++++++ .../StaticLet/RecordStaticMember.fs | 0 .../StaticLet/StaticLetInUnionsAndRecords.fs | 26 ++++++------------- .../StaticLet/UnionStaticMember.fs | 0 7 files changed, 57 insertions(+), 18 deletions(-) delete mode 100644 tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/RecordStaticMember.fs delete mode 100644 tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/UnionStaticMember.fs diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/ActivePatternForUnion.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/ActivePatternForUnion.fs index e69de29bb2d..613e6a52b2b 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/ActivePatternForUnion.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/ActivePatternForUnion.fs @@ -0,0 +1,14 @@ +module Test + +type AB = + | A + | B of int + static let (|B0Pat|_|) value = if value = 0 then Some (B 999) else None + static let b1 = B 1 + static member ParseUsingActivePattern x = match x with | B0Pat x -> x | _ -> A + static member B1 = b1 + + +let testThis = AB.ParseUsingActivePattern 0 + +printfn "%A" testThis \ No newline at end of file diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/CreateUnionCases.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/CreateUnionCases.fs index e69de29bb2d..aedd420b581 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/CreateUnionCases.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/CreateUnionCases.fs @@ -0,0 +1,14 @@ +module Test + +type MyDu = + | A + | Other + + static let ofString s = match s with | "A" -> A | _ -> Other + static member OfString = ofString + static let toString x = match x with | A -> "A" | Other -> "..." + static member PrintToString = toString + +let myVal = MyDu.OfString "brmbrm" + +printfn "%s" (myVal |> MyDu.PrintToString) \ No newline at end of file diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/PlainEnum.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/PlainEnum.fs index e69de29bb2d..df08d5384b0 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/PlainEnum.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/PlainEnum.fs @@ -0,0 +1,9 @@ +module Test + +type MyPlainEnum = + | A = 0 + | B = 1 + static let isThisPossible = A + static member IsIt = isThisPossible + +printfn "%i" (MyPlainEnum.IsIt) \ No newline at end of file diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/QuotationsForStaticLetUnions.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/QuotationsForStaticLetUnions.fs index e69de29bb2d..fa6257770f5 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/QuotationsForStaticLetUnions.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/QuotationsForStaticLetUnions.fs @@ -0,0 +1,12 @@ +module Test + +type MyDu = + | A + | Other + + static let ofString s = match s with | "A" -> A | _ -> Other + static member Q = <@ ofString "A" @> + +let myQ = MyDu.Q + +printfn "%A" myQ \ No newline at end of file diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/RecordStaticMember.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/RecordStaticMember.fs deleted file mode 100644 index e69de29bb2d..00000000000 diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/StaticLetInUnionsAndRecords.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/StaticLetInUnionsAndRecords.fs index cf9aed64d66..01efc1f558c 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/StaticLetInUnionsAndRecords.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/StaticLetInUnionsAndRecords.fs @@ -22,6 +22,7 @@ init end Case2 1 Case2 2""" + [] let ``Static let - record showcase`` compilation = compilation @@ -51,16 +52,18 @@ let ``Static let in simple union`` compilation = |> shouldSucceed [] -let ``What about plain enums?`` compilation = +let ``Support in plain enums - typecheck should fail`` compilation = compilation |> typecheck - |> shouldSucceed + |> shouldFail + |> withDiagnosticMessage "Enumerations cannot have members" [] let ``Static active pattern in union`` compilation = compilation - |> typecheck + |> verifyCompileAndRun |> shouldSucceed + |> withStdOutContains """B 999""" [] let ``Static let in struct union`` compilation = @@ -80,26 +83,13 @@ let ``Static let in struct record`` compilation = compilation |> typecheck |> shouldSucceed - -[] -let ``Static let with static member in union`` compilation = - compilation - |> typecheck - |> shouldSucceed - -[] -let ``Static let with static member in record`` compilation = - compilation - |> typecheck - |> shouldSucceed - [] let ``Static let creating DU cases`` compilation = compilation |> verifyCompileAndRun |> shouldSucceed - |> withStdOutContains "TODO put anything meaningful here" + |> withStdOutContains "..." [] @@ -137,7 +127,7 @@ let ``Static let - quotations support for unions`` compilation = compilation |> verifyCompileAndRun |> shouldSucceed - |> withStdOutContains "TODO put anything meaningful here" + |> withStdOutContains """Let (s, Value ("A"), Call (None, ofString, [s]))""" [] let ``Static let - quotations support for records`` compilation = diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/UnionStaticMember.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/UnionStaticMember.fs deleted file mode 100644 index e69de29bb2d..00000000000 From 801b5c1406dfdda796d184e24b835253bc8e8520 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Mon, 12 Jun 2023 10:00:50 +0200 Subject: [PATCH 11/45] More tests --- .../StaticLet/QuotationsForStaticLetRecords.fs | 13 +++++++++++++ .../StaticLet/SimpleEmptyType.fs | 9 +++++++++ .../StaticLet/StaticLetInUnionsAndRecords.fs | 6 ++++-- 3 files changed, 26 insertions(+), 2 deletions(-) diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/QuotationsForStaticLetRecords.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/QuotationsForStaticLetRecords.fs index e69de29bb2d..bee4bcb9653 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/QuotationsForStaticLetRecords.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/QuotationsForStaticLetRecords.fs @@ -0,0 +1,13 @@ +module Test + +type R = + { + F1: int + F2: int + } + + static let createRecord v1 r = { F1 = v1; F2 = v1 } + static member Q = <@ createRecord 42 @> + + +printfn "%A" R.Q \ No newline at end of file diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/SimpleEmptyType.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/SimpleEmptyType.fs index e69de29bb2d..6175218306c 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/SimpleEmptyType.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/SimpleEmptyType.fs @@ -0,0 +1,9 @@ +module Test + +type EmptyT = + static let x = 5 + static do printfn "init" + static member PrintIt() = printfn "%i" x + + +EmptyT.PrintIt() \ No newline at end of file diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/StaticLetInUnionsAndRecords.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/StaticLetInUnionsAndRecords.fs index 01efc1f558c..c4d344fba30 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/StaticLetInUnionsAndRecords.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/StaticLetInUnionsAndRecords.fs @@ -36,8 +36,10 @@ init R 2 [] let ``Static let in empty type`` compilation = compilation - |> typecheck + |> verifyCompileAndRun |> shouldSucceed + |> withStdOutContains """init +5""" [] let ``Static let in empty generic type`` compilation = @@ -134,7 +136,7 @@ let ``Static let - quotations support for records`` compilation = compilation |> verifyCompileAndRun |> shouldSucceed - |> withStdOutContains "TODO put anything meaningful here" + |> withStdOutContains "Let (v1, Value (42), Lambda (r, Call (None, createRecord, [v1, r])))" [] From 30981021f381572c775d08f16b3e6bf505e44d8a Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Mon, 12 Jun 2023 14:43:55 +0200 Subject: [PATCH 12/45] file reorg after @KevinRansom restructuring of component tests --- .../StaticLet/ActivePatternForUnion.fs | 0 .../StaticLet/CreateUnionCases.fs | 0 .../StaticLet/PlainEnum.fs | 13 ++++ .../QuotationsForStaticLetRecords.fs | 0 .../StaticLet/QuotationsForStaticLetUnions.fs | 0 .../StaticLet/RecordOrderOfExecution.fs | 0 .../StaticLet/RecordShowCase.fs | 0 .../StaticLet/RecursiveDUs.fs | 0 .../StaticLet/RecursiveRecords.fs | 0 .../StaticLet/SimpleEmptyGenericType.fs | 0 .../StaticLet/SimpleEmptyType.fs | 0 .../StaticLet/SimpleRecord.fs | 0 .../StaticLet/SimpleUnion.fs | 0 .../StaticLet/StaticLetInGenericRecords.fs | 0 .../StaticLet/StaticLetInGenericUnion.fs | 0 .../StaticLet/StaticLetInUnionsAndRecords.fs | 0 .../StaticLet/StructRecord.fs | 0 .../StaticLet/StructUnion.fs | 0 .../StaticLet/UnionOrderOfExecution.fs | 0 .../StaticLet/UnionShowCase.fs | 0 .../StaticLet/PlainEnum.fs | 9 --- .../FSharp.Compiler.ComponentTests.fsproj | 67 ++++++------------- 22 files changed, 34 insertions(+), 55 deletions(-) rename tests/FSharp.Compiler.ComponentTests/Conformance/{BasicTypeAndModuleDefinitions => BasicGrammarElements}/StaticLet/ActivePatternForUnion.fs (100%) rename tests/FSharp.Compiler.ComponentTests/Conformance/{BasicTypeAndModuleDefinitions => BasicGrammarElements}/StaticLet/CreateUnionCases.fs (100%) create mode 100644 tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/PlainEnum.fs rename tests/FSharp.Compiler.ComponentTests/Conformance/{BasicTypeAndModuleDefinitions => BasicGrammarElements}/StaticLet/QuotationsForStaticLetRecords.fs (100%) rename tests/FSharp.Compiler.ComponentTests/Conformance/{BasicTypeAndModuleDefinitions => BasicGrammarElements}/StaticLet/QuotationsForStaticLetUnions.fs (100%) rename tests/FSharp.Compiler.ComponentTests/Conformance/{BasicTypeAndModuleDefinitions => BasicGrammarElements}/StaticLet/RecordOrderOfExecution.fs (100%) rename tests/FSharp.Compiler.ComponentTests/Conformance/{BasicTypeAndModuleDefinitions => BasicGrammarElements}/StaticLet/RecordShowCase.fs (100%) rename tests/FSharp.Compiler.ComponentTests/Conformance/{BasicTypeAndModuleDefinitions => BasicGrammarElements}/StaticLet/RecursiveDUs.fs (100%) rename tests/FSharp.Compiler.ComponentTests/Conformance/{BasicTypeAndModuleDefinitions => BasicGrammarElements}/StaticLet/RecursiveRecords.fs (100%) rename tests/FSharp.Compiler.ComponentTests/Conformance/{BasicTypeAndModuleDefinitions => BasicGrammarElements}/StaticLet/SimpleEmptyGenericType.fs (100%) rename tests/FSharp.Compiler.ComponentTests/Conformance/{BasicTypeAndModuleDefinitions => BasicGrammarElements}/StaticLet/SimpleEmptyType.fs (100%) rename tests/FSharp.Compiler.ComponentTests/Conformance/{BasicTypeAndModuleDefinitions => BasicGrammarElements}/StaticLet/SimpleRecord.fs (100%) rename tests/FSharp.Compiler.ComponentTests/Conformance/{BasicTypeAndModuleDefinitions => BasicGrammarElements}/StaticLet/SimpleUnion.fs (100%) rename tests/FSharp.Compiler.ComponentTests/Conformance/{BasicTypeAndModuleDefinitions => BasicGrammarElements}/StaticLet/StaticLetInGenericRecords.fs (100%) rename tests/FSharp.Compiler.ComponentTests/Conformance/{BasicTypeAndModuleDefinitions => BasicGrammarElements}/StaticLet/StaticLetInGenericUnion.fs (100%) rename tests/FSharp.Compiler.ComponentTests/Conformance/{BasicTypeAndModuleDefinitions => BasicGrammarElements}/StaticLet/StaticLetInUnionsAndRecords.fs (100%) rename tests/FSharp.Compiler.ComponentTests/Conformance/{BasicTypeAndModuleDefinitions => BasicGrammarElements}/StaticLet/StructRecord.fs (100%) rename tests/FSharp.Compiler.ComponentTests/Conformance/{BasicTypeAndModuleDefinitions => BasicGrammarElements}/StaticLet/StructUnion.fs (100%) rename tests/FSharp.Compiler.ComponentTests/Conformance/{BasicTypeAndModuleDefinitions => BasicGrammarElements}/StaticLet/UnionOrderOfExecution.fs (100%) rename tests/FSharp.Compiler.ComponentTests/Conformance/{BasicTypeAndModuleDefinitions => BasicGrammarElements}/StaticLet/UnionShowCase.fs (100%) delete mode 100644 tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/PlainEnum.fs diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/ActivePatternForUnion.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/ActivePatternForUnion.fs similarity index 100% rename from tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/ActivePatternForUnion.fs rename to tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/ActivePatternForUnion.fs diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/CreateUnionCases.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/CreateUnionCases.fs similarity index 100% rename from tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/CreateUnionCases.fs rename to tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/CreateUnionCases.fs diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/PlainEnum.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/PlainEnum.fs new file mode 100644 index 00000000000..4662d040123 --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/PlainEnum.fs @@ -0,0 +1,13 @@ +module Test + +type MyPlainEnum = + | A = 0 + | B = 1 + static let isThisPossible = A + static let myFavNumber = 42 + static let myFavFunc a b = a + b + + +let methods = typeof.GetMethods(System.Reflection.BindingFlags.Static) + +printfn "%i" (methods.Length) \ No newline at end of file diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/QuotationsForStaticLetRecords.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/QuotationsForStaticLetRecords.fs similarity index 100% rename from tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/QuotationsForStaticLetRecords.fs rename to tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/QuotationsForStaticLetRecords.fs diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/QuotationsForStaticLetUnions.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/QuotationsForStaticLetUnions.fs similarity index 100% rename from tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/QuotationsForStaticLetUnions.fs rename to tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/QuotationsForStaticLetUnions.fs diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/RecordOrderOfExecution.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/RecordOrderOfExecution.fs similarity index 100% rename from tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/RecordOrderOfExecution.fs rename to tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/RecordOrderOfExecution.fs diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/RecordShowCase.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/RecordShowCase.fs similarity index 100% rename from tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/RecordShowCase.fs rename to tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/RecordShowCase.fs diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/RecursiveDUs.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/RecursiveDUs.fs similarity index 100% rename from tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/RecursiveDUs.fs rename to tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/RecursiveDUs.fs diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/RecursiveRecords.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/RecursiveRecords.fs similarity index 100% rename from tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/RecursiveRecords.fs rename to tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/RecursiveRecords.fs diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/SimpleEmptyGenericType.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/SimpleEmptyGenericType.fs similarity index 100% rename from tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/SimpleEmptyGenericType.fs rename to tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/SimpleEmptyGenericType.fs diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/SimpleEmptyType.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/SimpleEmptyType.fs similarity index 100% rename from tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/SimpleEmptyType.fs rename to tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/SimpleEmptyType.fs diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/SimpleRecord.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/SimpleRecord.fs similarity index 100% rename from tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/SimpleRecord.fs rename to tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/SimpleRecord.fs diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/SimpleUnion.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/SimpleUnion.fs similarity index 100% rename from tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/SimpleUnion.fs rename to tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/SimpleUnion.fs diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/StaticLetInGenericRecords.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StaticLetInGenericRecords.fs similarity index 100% rename from tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/StaticLetInGenericRecords.fs rename to tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StaticLetInGenericRecords.fs diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/StaticLetInGenericUnion.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StaticLetInGenericUnion.fs similarity index 100% rename from tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/StaticLetInGenericUnion.fs rename to tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StaticLetInGenericUnion.fs diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/StaticLetInUnionsAndRecords.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StaticLetInUnionsAndRecords.fs similarity index 100% rename from tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/StaticLetInUnionsAndRecords.fs rename to tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StaticLetInUnionsAndRecords.fs diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/StructRecord.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StructRecord.fs similarity index 100% rename from tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/StructRecord.fs rename to tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StructRecord.fs diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/StructUnion.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StructUnion.fs similarity index 100% rename from tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/StructUnion.fs rename to tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StructUnion.fs diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/UnionOrderOfExecution.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/UnionOrderOfExecution.fs similarity index 100% rename from tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/UnionOrderOfExecution.fs rename to tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/UnionOrderOfExecution.fs diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/UnionShowCase.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/UnionShowCase.fs similarity index 100% rename from tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/UnionShowCase.fs rename to tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/UnionShowCase.fs diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/PlainEnum.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/PlainEnum.fs deleted file mode 100644 index df08d5384b0..00000000000 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicTypeAndModuleDefinitions/StaticLet/PlainEnum.fs +++ /dev/null @@ -1,9 +0,0 @@ -module Test - -type MyPlainEnum = - | A = 0 - | B = 1 - static let isThisPossible = A - static member IsIt = isThisPossible - -printfn "%i" (MyPlainEnum.IsIt) \ No newline at end of file diff --git a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj index 9015010988a..05bd80f576e 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj +++ b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj @@ -61,48 +61,7 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + @@ -313,7 +272,27 @@ + + + + + + + + + + + + + + + + + + + + @@ -331,8 +310,4 @@ - - - - From 58a7eec97382228fafaee18d26b0cb0f6f2fbfd3 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Mon, 12 Jun 2023 16:19:56 +0200 Subject: [PATCH 13/45] records, generic records, plain enums --- .../StaticLet/ActivePatternForUnion.fs | 8 +- .../StaticLet/RecordOrderOfExecution.fs | 26 ++++++ .../StaticLet/SimpleEmptyType.fs | 10 ++- .../StaticLet/SimpleRecord.fs | 24 ++++++ .../StaticLet/SimpleUnion.fs | 26 ++++++ .../StaticLet/StaticLetInGenericRecords.fs | 41 +++++++++ .../StaticLetInGenericRecordsILtest.fs | 21 +++++ .../StaticLet/StaticLetInUnionsAndRecords.fs | 84 ++++++++++++++++--- .../StaticLet/StructRecord.fs | 25 ++++++ .../StaticLet/StructUnion.fs | 27 ++++++ .../StaticLet/UnionOrderOfExecution.fs | 22 +++++ 11 files changed, 299 insertions(+), 15 deletions(-) create mode 100644 tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StaticLetInGenericRecordsILtest.fs diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/ActivePatternForUnion.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/ActivePatternForUnion.fs index 613e6a52b2b..11a3f9323d2 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/ActivePatternForUnion.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/ActivePatternForUnion.fs @@ -3,10 +3,10 @@ module Test type AB = | A | B of int - static let (|B0Pat|_|) value = if value = 0 then Some (B 999) else None - static let b1 = B 1 - static member ParseUsingActivePattern x = match x with | B0Pat x -> x | _ -> A - static member B1 = b1 + + static let (|B0PatPrivate|_|) value = if value = 0 then Some (B 999) else None + static member ParseUsingActivePattern x = match x with | B0PatPrivate x -> x | _ -> A + let testThis = AB.ParseUsingActivePattern 0 diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/RecordOrderOfExecution.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/RecordOrderOfExecution.fs index e69de29bb2d..132514142b1 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/RecordOrderOfExecution.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/RecordOrderOfExecution.fs @@ -0,0 +1,26 @@ +module Test + +type R = + { + F1: int + F2: int + } + + static do printfn "init R 1" + static let r1 = + do printfn "side effect in let binding R1" + { F1 = 1; F2 = 1 } + static member R1 = + do printfn "side effect in member R1" + r1 + + +module InnerModule = + let print() = printfn "calling print %i" R.R1.F2 + + +printfn "Before accessing type" +InnerModule.print() +InnerModule.print() + + diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/SimpleEmptyType.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/SimpleEmptyType.fs index 6175218306c..5ea94f81299 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/SimpleEmptyType.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/SimpleEmptyType.fs @@ -3,7 +3,15 @@ module Test type EmptyT = static let x = 5 static do printfn "init" + static let mutable counter = 0 + static member Incr() = + counter <- counter + 1 + counter static member PrintIt() = printfn "%i" x -EmptyT.PrintIt() \ No newline at end of file +EmptyT.PrintIt() +ignore (EmptyT.Incr()) +ignore (EmptyT.Incr()) + +printfn "%i" (EmptyT.Incr()) \ No newline at end of file diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/SimpleRecord.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/SimpleRecord.fs index e69de29bb2d..31c42801dc8 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/SimpleRecord.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/SimpleRecord.fs @@ -0,0 +1,24 @@ +module Test + +type R = + { + F1: int + F2: int + } + + static let cachedval = { F1 = 1; F2 = 1 } + static let factoryFunc x = { F1 = x; F2 = x } + static let mutable mutableVal = 0 + static let incrementor() = mutableVal <- mutableVal + 1 + + static member IncrementAndReturn() = + do incrementor() + let freshVal = factoryFunc mutableVal + freshVal.F1 + cachedval.F1 + + +let mutable lastVal = 0 +for i=0 to 5 do + lastVal <- R.IncrementAndReturn() + +printfn "%i" lastVal \ No newline at end of file diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/SimpleUnion.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/SimpleUnion.fs index e69de29bb2d..9f56fa63146 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/SimpleUnion.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/SimpleUnion.fs @@ -0,0 +1,26 @@ +module Test + +type MyDu = + | A of int + | B of string + | C + + static let factoryFunc x = A x + static let mutable mutableVal = factoryFunc 11 + static let circularIncrement() = + mutableVal <- + match mutableVal with + | A i -> B (string i) + | B _ -> C + | C -> A 42 + + static member IncrementAndReturn() = + do circularIncrement() + mutableVal + + +let mutable lastVal = C +for i=0 to 5 do + lastVal <- MyDu.IncrementAndReturn() + +printfn "%A" lastVal \ No newline at end of file diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StaticLetInGenericRecords.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StaticLetInGenericRecords.fs index e69de29bb2d..32e090ebdbf 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StaticLetInGenericRecords.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StaticLetInGenericRecords.fs @@ -0,0 +1,41 @@ +module Test + +type MyRecord<'T> = + { + X: 'T + Y: int + } + + static let sizeOfT = sizeof<'T> + static let cachedVal = + printfn "Creating cached val for %s" (typeof<'T>.Name) + { X = Unchecked.defaultof<'T> ; Y = 15} + static let mutable perTyparInstMutableCounter = 0 + + static member IncBySize() = + perTyparInstMutableCounter <- perTyparInstMutableCounter + sizeOfT + + static member GetCounter() = perTyparInstMutableCounter + + + +MyRecord.IncBySize() +MyRecord.IncBySize() + +printfn "2x sizeof = %i" (MyRecord.GetCounter()) + +MyRecord.IncBySize() +MyRecord.IncBySize() + +printfn "2x sizeof = %i" (MyRecord.GetCounter()) + +MyRecord.IncBySize() +MyRecord.IncBySize() + +printfn "2x sizeof = %i" (MyRecord.GetCounter()) + +MyRecord.IncBySize() +MyRecord.IncBySize() + +printfn "2x sizeof = %i" (MyRecord.GetCounter()) + diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StaticLetInGenericRecordsILtest.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StaticLetInGenericRecordsILtest.fs new file mode 100644 index 00000000000..738bd09f0fd --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StaticLetInGenericRecordsILtest.fs @@ -0,0 +1,21 @@ +module Test + +open System + +[] +[] +type MyRecord<'T> = + { + X: 'T + } + // Init per typar + static let cachedVal = + Console.WriteLine(typeof<'T>.Name) + typeof<'T>.Name + + static member GetMyName() = cachedVal + + + +Console.WriteLine(MyRecord.GetMyName()) +Console.WriteLine(MyRecord.GetMyName()) \ No newline at end of file diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StaticLetInUnionsAndRecords.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StaticLetInUnionsAndRecords.fs index c4d344fba30..b95f5508765 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StaticLetInUnionsAndRecords.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StaticLetInUnionsAndRecords.fs @@ -1,6 +1,5 @@ module FSharp.Compiler.ComponentTests.Conformance.BasicTypeAndModuleDefinitions.StaticLet -open System.IO open Xunit open FSharp.Test open FSharp.Test.Compiler @@ -39,7 +38,8 @@ let ``Static let in empty type`` compilation = |> verifyCompileAndRun |> shouldSucceed |> withStdOutContains """init -5""" +5 +3""" [] let ``Static let in empty generic type`` compilation = @@ -50,8 +50,9 @@ let ``Static let in empty generic type`` compilation = [] let ``Static let in simple union`` compilation = compilation - |> typecheck + |> verifyCompileAndRun |> shouldSucceed + |> withStdOutContains "A 42" [] let ``Support in plain enums - typecheck should fail`` compilation = @@ -70,21 +71,24 @@ let ``Static active pattern in union`` compilation = [] let ``Static let in struct union`` compilation = compilation - |> typecheck + |> verifyCompileAndRun |> shouldSucceed + |> withStdOutContains "A 42" [] let ``Static let in simple record`` compilation = compilation - |> typecheck + |> verifyCompileAndRun |> shouldSucceed + |> withStdOutContains "7" [] let ``Static let in struct record`` compilation = compilation - |> typecheck + |> verifyCompileAndRun |> shouldSucceed + |> withStdOutContains "7" [] let ``Static let creating DU cases`` compilation = @@ -99,14 +103,26 @@ let ``Static let union - order of execution`` compilation = compilation |> verifyCompileAndRun |> shouldSucceed - |> withStdOutContains "TODO put anything meaningful here" + |> withStdOutContains """init type U +side effect in let binding case2cachedVal +Before accessing type +side effect in member Singleton +calling print Case2 42 +side effect in member Singleton +calling print Case2 42""" [] let ``Static let record - order of execution`` compilation = compilation |> verifyCompileAndRun |> shouldSucceed - |> withStdOutContains "TODO put anything meaningful here" + |> withStdOutContains """init R 1 +side effect in let binding R1 +Before accessing type +side effect in member R1 +calling print 1 +side effect in member R1 +calling print 1""" [] @@ -148,8 +164,56 @@ let ``Static let union - executes per generic struct typar`` compilation = [] -let ``Static let record - executes per generic struct typar`` compilation = +let ``Static let record - executes per generic typar`` compilation = compilation |> verifyCompileAndRun |> shouldSucceed - |> withStdOutContains "TODO put anything meaningful here" \ No newline at end of file + // Does it HAVE TO execute also for 'Object' ? Why does it do that? + |> withStdOutContains """Creating cached val for Int32 +2x sizeof = 8 +Creating cached val for String +2x sizeof = 16 +Creating cached val for DateTime +2x sizeof = 16 +Creating cached val for Uri +2x sizeof = 16""" + +[] +let ``Static let record - generics - IL test`` compilation = + compilation + |> compile + |> verifyIL [""" .method private specialname rtspecialname static + void .cctor() cil managed + { + + .maxstack 8 + IL_0000: ldtoken !T + IL_0005: call class [netstandard]System.Type [netstandard]System.Type::GetTypeFromHandle(valuetype [netstandard]System.RuntimeTypeHandle) + IL_000a: callvirt instance string [runtime]System.Reflection.MemberInfo::get_Name() + IL_000f: call void [runtime]System.Console::WriteLine(string) + IL_0014: ldtoken !T + IL_0019: call class [netstandard]System.Type [netstandard]System.Type::GetTypeFromHandle(valuetype [netstandard]System.RuntimeTypeHandle) + IL_001e: callvirt instance string [runtime]System.Reflection.MemberInfo::get_Name() + IL_0023: stsfld string class Test/MyRecord`1::cachedVal + IL_0028: ldc.i4.0 + IL_0029: volatile. + IL_002b: stsfld int32 class Test/MyRecord`1::init@7 + IL_0030: ret + } + + .method public static string GetMyName() cil managed + { + + .maxstack 8 + IL_0000: volatile. + IL_0002: ldsfld int32 class Test/MyRecord`1::init@7 + IL_0007: ldc.i4.0 + IL_0008: bge.s IL_0011 + + IL_000a: call void [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/IntrinsicFunctions::FailStaticInit() + IL_000f: br.s IL_0011 + + IL_0011: ldsfld string class Test/MyRecord`1::cachedVal + IL_0016: ret + } """] + \ No newline at end of file diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StructRecord.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StructRecord.fs index e69de29bb2d..f9308d5e73d 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StructRecord.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StructRecord.fs @@ -0,0 +1,25 @@ +module Test + +[] +type R = + { + F1: int + F2: int + } + + static let cachedval = { F1 = 1; F2 = 1 } + static let factoryFunc x = { F1 = x; F2 = x } + static let mutable mutableVal = 0 + static let incrementor() = mutableVal <- mutableVal + 1 + + static member IncrementAndReturn() = + do incrementor() + let freshVal = factoryFunc mutableVal + freshVal.F1 + cachedval.F1 + + +let mutable lastVal = 0 +for i=0 to 5 do + lastVal <- R.IncrementAndReturn() + +printfn "%i" lastVal \ No newline at end of file diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StructUnion.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StructUnion.fs index e69de29bb2d..26466c8e67e 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StructUnion.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StructUnion.fs @@ -0,0 +1,27 @@ +module Test + +[] +type MyDu = + | A of intVal:int + | B of stringVal:string + | C + + static let factoryFunc x = A x + static let mutable mutableVal = factoryFunc 11 + static let circularIncrement() = + mutableVal <- + match mutableVal with + | A i -> B (string i) + | B _ -> C + | C -> A 42 + + static member IncrementAndReturn() = + do circularIncrement() + mutableVal + + +let mutable lastVal = C +for i=0 to 5 do + lastVal <- MyDu.IncrementAndReturn() + +printfn "%A" lastVal \ No newline at end of file diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/UnionOrderOfExecution.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/UnionOrderOfExecution.fs index e69de29bb2d..d627dbd1a99 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/UnionOrderOfExecution.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/UnionOrderOfExecution.fs @@ -0,0 +1,22 @@ +module Test + +type U = + | Case1 + | Case2 of int + + static do printfn "init type U" + static let case2cachedVal = + do printfn "side effect in let binding case2cachedVal" + Case2 42 + static member GetSingleton = + do printfn "side effect in member Singleton" + case2cachedVal + + +module InnerModule = + let print() = printfn "calling print %A" (U.GetSingleton) + + +printfn "Before accessing type" +InnerModule.print() +InnerModule.print() \ No newline at end of file From 98050b11317e2afe6768b41bf9c40df3061c7678 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Mon, 12 Jun 2023 19:44:24 +0200 Subject: [PATCH 14/45] Static let in generic union --- .../StaticLet/StaticLetInGenericUnion.fs | 31 +++++++++++++++++++ .../StaticLet/StaticLetInUnionsAndRecords.fs | 7 ++++- 2 files changed, 37 insertions(+), 1 deletion(-) diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StaticLetInGenericUnion.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StaticLetInGenericUnion.fs index e69de29bb2d..d05297cc25c 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StaticLetInGenericUnion.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StaticLetInGenericUnion.fs @@ -0,0 +1,31 @@ +module Test + +[] +type MyUnion<'A,'B> = + | A of aval:'A + | B of bval:'B + | C + + static let sizeOfTCached = + printfn "Creating cached val for %s * %s" (typeof<'A>.Name) (typeof<'B>.Name) + sizeof> + + + static let mutable perTyparInstMutableCounter = 0 + + static member IncBySize() = + perTyparInstMutableCounter <- perTyparInstMutableCounter + sizeOfTCached + + static member GetCounter() = perTyparInstMutableCounter + + + +MyUnion.IncBySize() +printfn "sizeof MyUnion = %i" (MyUnion.GetCounter()) + +MyUnion.IncBySize() +printfn "sizeof MyUnion = %i" (MyUnion.GetCounter()) + +MyUnion.IncBySize() +printfn "sizeof MyUnion = %i" (MyUnion.GetCounter()) + diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StaticLetInUnionsAndRecords.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StaticLetInUnionsAndRecords.fs index b95f5508765..b1a1b18cd00 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StaticLetInUnionsAndRecords.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StaticLetInUnionsAndRecords.fs @@ -160,7 +160,12 @@ let ``Static let union - executes per generic struct typar`` compilation = compilation |> verifyCompileAndRun |> shouldSucceed - |> withStdOutContains "TODO put anything meaningful here" + |> withStdOutContains """Creating cached val for Int32 * Int32 +sizeof MyUnion = 12 +Creating cached val for Int32 * String +sizeof MyUnion = 16 +Creating cached val for String * String +sizeof MyUnion = 24""" [] From c7e451521c334168a43184825b2c09b3dfac77e2 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Mon, 12 Jun 2023 19:55:42 +0200 Subject: [PATCH 15/45] recursive records with static let --- .../StaticLet/RecursiveDUs.fs | 4 +++ .../StaticLet/RecursiveRecords.fs | 26 +++++++++++++++++++ .../StaticLet/StaticLetInUnionsAndRecords.fs | 6 ++++- 3 files changed, 35 insertions(+), 1 deletion(-) diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/RecursiveDUs.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/RecursiveDUs.fs index e69de29bb2d..7ad9035a20f 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/RecursiveDUs.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/RecursiveDUs.fs @@ -0,0 +1,4 @@ +module rec Test + + +type Chicken \ No newline at end of file diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/RecursiveRecords.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/RecursiveRecords.fs index e69de29bb2d..b58e7b6d6ed 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/RecursiveRecords.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/RecursiveRecords.fs @@ -0,0 +1,26 @@ +module rec Test + +type Chicken = + {Eggs : Egg list} + static do printfn "Chicken init" + static let firstEggEver = + printfn "creating firstEggEver" + {Mother = {Eggs = []}} + + static member FirstEgg = firstEggEver + +type Egg = + {Mother : Chicken} + static do printfn "Egg init" + +type Omelette = + {Egg : Egg} + static do printfn "Omelette init" + + + +let o = {Egg = {Mother = {Eggs = [{Mother = {Eggs = [Chicken.FirstEgg]}}]}}} + +printfn "%i" (o.Egg.Mother.Eggs |> List.length) + + diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StaticLetInUnionsAndRecords.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StaticLetInUnionsAndRecords.fs index b1a1b18cd00..749b9c84118 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StaticLetInUnionsAndRecords.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StaticLetInUnionsAndRecords.fs @@ -137,7 +137,11 @@ let ``Static let - recursive record definitions calling each other`` compilation compilation |> verifyCompileAndRun |> shouldSucceed - |> withStdOutContains "TODO put anything meaningful here" + |> withStdOutContains """Chicken init +creating firstEggEver +Egg init +Omelette init +1""" [] From 65f5745c76910e388110c325fc97685c849af32a Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Tue, 13 Jun 2023 13:51:55 +0200 Subject: [PATCH 16/45] recursive DU --- .../StaticLet/RecursiveDUs.fs | 42 ++++++++++++++++++- .../StaticLet/StaticLetInUnionsAndRecords.fs | 11 ++++- 2 files changed, 50 insertions(+), 3 deletions(-) diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/RecursiveDUs.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/RecursiveDUs.fs index 7ad9035a20f..556f331d5e0 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/RecursiveDUs.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/RecursiveDUs.fs @@ -1,4 +1,44 @@ module rec Test -type Chicken \ No newline at end of file +[] +type DuA = + | A1 + | B of DuB + | C of DuC + + static do printfn "DuA init" + static let allVals = + printfn "DuA allVals access" + seq {yield DuA.A1.ToString();yield! DuB.AllValues; yield! DuC.AllValues} + static member AllValues = allVals + +[] +type DuB = + | B1 + | A of DuA + | C of DuC + + static do printfn "DuB init" + static let allVals = + printfn "DuB allVals access" + seq {yield DuB.B1.ToString();yield! DuA.AllValues; yield! DuC.AllValues} + static member AllValues = allVals + +[] +type DuC = + | C1 + | A of DuA + | B of DuB + + static do printfn "DuC init" + static let allVals = + printfn "DuC allVals access" + seq {yield DuC.C1.ToString();yield! DuA.AllValues; yield! DuB.AllValues} + static member AllValues = allVals + + +let all = Seq.concat [ DuA.AllValues; DuB.AllValues; DuC.AllValues] |> Seq.truncate 999 |> List.ofSeq + +printfn "total = %i" (all |> List.length) +printfn "uniq = %i" (all |> List.distinct |> List.length) \ No newline at end of file diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StaticLetInUnionsAndRecords.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StaticLetInUnionsAndRecords.fs index 749b9c84118..6d34f86e766 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StaticLetInUnionsAndRecords.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StaticLetInUnionsAndRecords.fs @@ -1,4 +1,4 @@ -module FSharp.Compiler.ComponentTests.Conformance.BasicTypeAndModuleDefinitions.StaticLet +module Conformance.BasicGrammarElements.StaticLet open Xunit open FSharp.Test @@ -130,7 +130,14 @@ let ``Static let - recursive DU definitions calling each other`` compilation = compilation |> verifyCompileAndRun |> shouldSucceed - |> withStdOutContains "TODO put anything meaningful here" + |> withStdOutContains """DuA init +DuA allVals access +DuB init +DuB allVals access +DuC init +DuC allVals access +total = 999 +uniq = 2""" [] let ``Static let - recursive record definitions calling each other`` compilation = From d4f3cfa0004e0f7370350259003a1989442afb21 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Tue, 13 Jun 2023 14:30:56 +0200 Subject: [PATCH 17/45] Negative tests for F# below 7 --- src/Compiler/Checking/CheckDeclarations.fs | 3 ++ src/Compiler/FSComp.txt | 1 + src/Compiler/Facilities/LanguageFeatures.fs | 3 ++ src/Compiler/Facilities/LanguageFeatures.fsi | 1 + src/Compiler/xlf/FSComp.txt.cs.xlf | 5 +++ src/Compiler/xlf/FSComp.txt.de.xlf | 5 +++ src/Compiler/xlf/FSComp.txt.es.xlf | 5 +++ src/Compiler/xlf/FSComp.txt.fr.xlf | 5 +++ src/Compiler/xlf/FSComp.txt.it.xlf | 5 +++ src/Compiler/xlf/FSComp.txt.ja.xlf | 5 +++ src/Compiler/xlf/FSComp.txt.ko.xlf | 5 +++ src/Compiler/xlf/FSComp.txt.pl.xlf | 5 +++ src/Compiler/xlf/FSComp.txt.pt-BR.xlf | 5 +++ src/Compiler/xlf/FSComp.txt.ru.xlf | 5 +++ src/Compiler/xlf/FSComp.txt.tr.xlf | 5 +++ src/Compiler/xlf/FSComp.txt.zh-Hans.xlf | 5 +++ src/Compiler/xlf/FSComp.txt.zh-Hant.xlf | 5 +++ .../StaticLet/SimpleEmptyGenericType.fs | 14 +++++++++ .../StaticLet/StaticLetInUnionsAndRecords.fs | 31 +++++++++++++++++-- 19 files changed, 115 insertions(+), 3 deletions(-) diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index 07d4b3b6b4a..7b211427594 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -941,6 +941,9 @@ module MutRecBindingChecking = // Code for potential future design change to allow functions-compiled-as-members in structs errorR(Error(FSComp.SR.tcStructsMayNotContainLetBindings(), (trimRangeToLine m))) + if isStatic && incrCtorInfoOpt.IsNone && not (g.langVersion.SupportsFeature(LanguageFeature.StaticLetInRecordsDusEmptyTypes)) then + errorR(Error(FSComp.SR.tcStaticLetBindingsRequireClassesWithImplicitConstructors(), m)) + // Phase2A: let-bindings - pass through let innerState = (incrCtorInfoOpt, envForTycon, tpenv, recBindIdx, uncheckedBindsRev) [Phase2AIncrClassBindings (tcref, letBinds, isStatic, isRec, m)], innerState diff --git a/src/Compiler/FSComp.txt b/src/Compiler/FSComp.txt index 479e11ad05a..1f9353aaff2 100644 --- a/src/Compiler/FSComp.txt +++ b/src/Compiler/FSComp.txt @@ -1695,4 +1695,5 @@ featureEscapeBracesInFormattableString,"Escapes curly braces before calling Form 3564,parsMissingUnionCaseName,"Missing union case name" 3565,parsExpectingType,"Expecting type" featureInformationalObjInferenceDiagnostic,"Diagnostic 3559 (warn when obj inferred) at informational level, off by default" +featureStaticLetInRecordsDusEmptyTypes,"Allow static let bindings in union, record, struct, non-incremental-class types" 3566,tcMultipleRecdTypeChoice,"Multiple type matches were found:\n%s\nThe type '%s' was used. Due to the overlapping field names\n%s\nconsider using type annotations or change the order of open statements." diff --git a/src/Compiler/Facilities/LanguageFeatures.fs b/src/Compiler/Facilities/LanguageFeatures.fs index 45af383237b..682f608e67d 100644 --- a/src/Compiler/Facilities/LanguageFeatures.fs +++ b/src/Compiler/Facilities/LanguageFeatures.fs @@ -70,6 +70,7 @@ type LanguageFeature = | WarningWhenMultipleRecdTypeChoice | ImprovedImpliedArgumentNames | DiagnosticForObjInference + | StaticLetInRecordsDusEmptyTypes /// LanguageVersion management type LanguageVersion(versionText) = @@ -163,6 +164,7 @@ type LanguageVersion(versionText) = LanguageFeature.WarningWhenMultipleRecdTypeChoice, previewVersion LanguageFeature.ImprovedImpliedArgumentNames, previewVersion LanguageFeature.DiagnosticForObjInference, previewVersion + LanguageFeature.StaticLetInRecordsDusEmptyTypes, previewVersion ] @@ -288,6 +290,7 @@ type LanguageVersion(versionText) = | LanguageFeature.WarningWhenMultipleRecdTypeChoice -> FSComp.SR.featureWarningWhenMultipleRecdTypeChoice () | LanguageFeature.ImprovedImpliedArgumentNames -> FSComp.SR.featureImprovedImpliedArgumentNames () | LanguageFeature.DiagnosticForObjInference -> FSComp.SR.featureInformationalObjInferenceDiagnostic () + | LanguageFeature.StaticLetInRecordsDusEmptyTypes -> FSComp.SR.featureStaticLetInRecordsDusEmptyTypes () /// Get a version string associated with the given feature. static member GetFeatureVersionString feature = diff --git a/src/Compiler/Facilities/LanguageFeatures.fsi b/src/Compiler/Facilities/LanguageFeatures.fsi index cef7a43a325..649d232ac43 100644 --- a/src/Compiler/Facilities/LanguageFeatures.fsi +++ b/src/Compiler/Facilities/LanguageFeatures.fsi @@ -60,6 +60,7 @@ type LanguageFeature = | WarningWhenMultipleRecdTypeChoice | ImprovedImpliedArgumentNames | DiagnosticForObjInference + | StaticLetInRecordsDusEmptyTypes /// LanguageVersion management type LanguageVersion = diff --git a/src/Compiler/xlf/FSComp.txt.cs.xlf b/src/Compiler/xlf/FSComp.txt.cs.xlf index 13c9dd9295f..4fc4be0acc2 100644 --- a/src/Compiler/xlf/FSComp.txt.cs.xlf +++ b/src/Compiler/xlf/FSComp.txt.cs.xlf @@ -402,6 +402,11 @@ vzor s jedním podtržítkem + + Allow static let bindings in union, record, struct, non-incremental-class types + Allow static let bindings in union, record, struct, non-incremental-class types + + Static members in interfaces Statické členy v rozhraních diff --git a/src/Compiler/xlf/FSComp.txt.de.xlf b/src/Compiler/xlf/FSComp.txt.de.xlf index 743c472a650..a28af5b5d6e 100644 --- a/src/Compiler/xlf/FSComp.txt.de.xlf +++ b/src/Compiler/xlf/FSComp.txt.de.xlf @@ -402,6 +402,11 @@ Muster mit einzelnem Unterstrich + + Allow static let bindings in union, record, struct, non-incremental-class types + Allow static let bindings in union, record, struct, non-incremental-class types + + Static members in interfaces Statische Member in Schnittstellen diff --git a/src/Compiler/xlf/FSComp.txt.es.xlf b/src/Compiler/xlf/FSComp.txt.es.xlf index d61df64ef38..538a25d4194 100644 --- a/src/Compiler/xlf/FSComp.txt.es.xlf +++ b/src/Compiler/xlf/FSComp.txt.es.xlf @@ -402,6 +402,11 @@ patrón de subrayado simple + + Allow static let bindings in union, record, struct, non-incremental-class types + Allow static let bindings in union, record, struct, non-incremental-class types + + Static members in interfaces Miembros estáticos en interfaces diff --git a/src/Compiler/xlf/FSComp.txt.fr.xlf b/src/Compiler/xlf/FSComp.txt.fr.xlf index d576058a3e1..2d2d19b2ccd 100644 --- a/src/Compiler/xlf/FSComp.txt.fr.xlf +++ b/src/Compiler/xlf/FSComp.txt.fr.xlf @@ -402,6 +402,11 @@ modèle de trait de soulignement unique + + Allow static let bindings in union, record, struct, non-incremental-class types + Allow static let bindings in union, record, struct, non-incremental-class types + + Static members in interfaces Membres statiques dans les interfaces diff --git a/src/Compiler/xlf/FSComp.txt.it.xlf b/src/Compiler/xlf/FSComp.txt.it.xlf index 67ddd7e0fdc..4e98baca425 100644 --- a/src/Compiler/xlf/FSComp.txt.it.xlf +++ b/src/Compiler/xlf/FSComp.txt.it.xlf @@ -402,6 +402,11 @@ criterio per carattere di sottolineatura singolo + + Allow static let bindings in union, record, struct, non-incremental-class types + Allow static let bindings in union, record, struct, non-incremental-class types + + Static members in interfaces Membri statici nelle interfacce diff --git a/src/Compiler/xlf/FSComp.txt.ja.xlf b/src/Compiler/xlf/FSComp.txt.ja.xlf index 3f8ad74f8a7..2e5448cca29 100644 --- a/src/Compiler/xlf/FSComp.txt.ja.xlf +++ b/src/Compiler/xlf/FSComp.txt.ja.xlf @@ -402,6 +402,11 @@ 単一のアンダースコア パターン + + Allow static let bindings in union, record, struct, non-incremental-class types + Allow static let bindings in union, record, struct, non-incremental-class types + + Static members in interfaces インターフェイス内の静的メンバー diff --git a/src/Compiler/xlf/FSComp.txt.ko.xlf b/src/Compiler/xlf/FSComp.txt.ko.xlf index 6a17a61364a..841206fe103 100644 --- a/src/Compiler/xlf/FSComp.txt.ko.xlf +++ b/src/Compiler/xlf/FSComp.txt.ko.xlf @@ -402,6 +402,11 @@ 단일 밑줄 패턴 + + Allow static let bindings in union, record, struct, non-incremental-class types + Allow static let bindings in union, record, struct, non-incremental-class types + + Static members in interfaces 인터페이스의 정적 멤버 diff --git a/src/Compiler/xlf/FSComp.txt.pl.xlf b/src/Compiler/xlf/FSComp.txt.pl.xlf index dd3877c8a43..248eac7e52f 100644 --- a/src/Compiler/xlf/FSComp.txt.pl.xlf +++ b/src/Compiler/xlf/FSComp.txt.pl.xlf @@ -402,6 +402,11 @@ wzorzec z pojedynczym podkreśleniem + + Allow static let bindings in union, record, struct, non-incremental-class types + Allow static let bindings in union, record, struct, non-incremental-class types + + Static members in interfaces Statyczne składowe w interfejsach diff --git a/src/Compiler/xlf/FSComp.txt.pt-BR.xlf b/src/Compiler/xlf/FSComp.txt.pt-BR.xlf index a282f140ab2..4b44fe76fe3 100644 --- a/src/Compiler/xlf/FSComp.txt.pt-BR.xlf +++ b/src/Compiler/xlf/FSComp.txt.pt-BR.xlf @@ -402,6 +402,11 @@ padrão de sublinhado simples + + Allow static let bindings in union, record, struct, non-incremental-class types + Allow static let bindings in union, record, struct, non-incremental-class types + + Static members in interfaces Membros estáticos em interfaces diff --git a/src/Compiler/xlf/FSComp.txt.ru.xlf b/src/Compiler/xlf/FSComp.txt.ru.xlf index 426b61eaeb1..ddc1204fa27 100644 --- a/src/Compiler/xlf/FSComp.txt.ru.xlf +++ b/src/Compiler/xlf/FSComp.txt.ru.xlf @@ -402,6 +402,11 @@ шаблон с одним подчеркиванием + + Allow static let bindings in union, record, struct, non-incremental-class types + Allow static let bindings in union, record, struct, non-incremental-class types + + Static members in interfaces Статические элементы в интерфейсах diff --git a/src/Compiler/xlf/FSComp.txt.tr.xlf b/src/Compiler/xlf/FSComp.txt.tr.xlf index 67e127a9055..b47a689b562 100644 --- a/src/Compiler/xlf/FSComp.txt.tr.xlf +++ b/src/Compiler/xlf/FSComp.txt.tr.xlf @@ -402,6 +402,11 @@ tek alt çizgi deseni + + Allow static let bindings in union, record, struct, non-incremental-class types + Allow static let bindings in union, record, struct, non-incremental-class types + + Static members in interfaces Arabirimlerdeki statik üyeler diff --git a/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf b/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf index 7660508a935..c251f64350b 100644 --- a/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf +++ b/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf @@ -402,6 +402,11 @@ 单下划线模式 + + Allow static let bindings in union, record, struct, non-incremental-class types + Allow static let bindings in union, record, struct, non-incremental-class types + + Static members in interfaces 接口中的静态成员 diff --git a/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf b/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf index 3a1c92ff8f1..da4e89a7dd3 100644 --- a/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf +++ b/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf @@ -402,6 +402,11 @@ 單一底線模式 + + Allow static let bindings in union, record, struct, non-incremental-class types + Allow static let bindings in union, record, struct, non-incremental-class types + + Static members in interfaces 介面中的靜態成員 diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/SimpleEmptyGenericType.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/SimpleEmptyGenericType.fs index e69de29bb2d..00e36ff836f 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/SimpleEmptyGenericType.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/SimpleEmptyGenericType.fs @@ -0,0 +1,14 @@ +module Test + +type EmptyT<'T> = + static let cachedName = + let name = typeof<'T>.Name + printfn "Accessing name for %s" name + name + static member Name = cachedName + + +for i=0 to 10 do + EmptyT.Name |> ignore + EmptyT.Name |> ignore + EmptyT.Name |> ignore \ No newline at end of file diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StaticLetInUnionsAndRecords.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StaticLetInUnionsAndRecords.fs index 6d34f86e766..cd508e8e633 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StaticLetInUnionsAndRecords.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StaticLetInUnionsAndRecords.fs @@ -3,9 +3,30 @@ module Conformance.BasicGrammarElements.StaticLet open Xunit open FSharp.Test open FSharp.Test.Compiler +open System.IO + +let allTestCases = + Directory.EnumerateFiles(__SOURCE_DIRECTORY__) + |> Seq.toArray + |> Array.map Path.GetFileName + |> Array.except [__SOURCE_FILE__;"PlainEnum.fs"] // ALl files in the folder except this one with the tests + |> Array.map (fun f -> [|f :> obj|]) + + +[] +[] +let ``Should fail in F# 7 and lower`` (implFileName:string) = + let fileContents = File.ReadAllText (Path.Combine(__SOURCE_DIRECTORY__,implFileName)) + + Fs fileContents + |> withLangVersion70 + |> typecheck + |> shouldFail + |> withDiagnosticMessageMatches "Static value definitions may only be used in types with a primary constructor." let verifyCompileAndRun compilation = compilation + |> withLangVersionPreview |> asExe |> compileAndRun @@ -44,8 +65,11 @@ let ``Static let in empty type`` compilation = [] let ``Static let in empty generic type`` compilation = compilation - |> typecheck + |> verifyCompileAndRun |> shouldSucceed + |> withStdOutContains """Accessing name for Int32 +Accessing name for String +Accessing name for Byte""" [] let ``Static let in simple union`` compilation = @@ -57,7 +81,8 @@ let ``Static let in simple union`` compilation = [] let ``Support in plain enums - typecheck should fail`` compilation = compilation - |> typecheck + |> withLangVersionPreview + |> typecheck |> shouldFail |> withDiagnosticMessage "Enumerations cannot have members" @@ -184,7 +209,6 @@ let ``Static let record - executes per generic typar`` compilation = compilation |> verifyCompileAndRun |> shouldSucceed - // Does it HAVE TO execute also for 'Object' ? Why does it do that? |> withStdOutContains """Creating cached val for Int32 2x sizeof = 8 Creating cached val for String @@ -197,6 +221,7 @@ Creating cached val for Uri [] let ``Static let record - generics - IL test`` compilation = compilation + |> withLangVersionPreview |> compile |> verifyIL [""" .method private specialname rtspecialname static void .cctor() cil managed From 1fcfa1e6403758eb7abc66201475bcd5c76ff46a Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Wed, 14 Jun 2023 18:00:33 +0200 Subject: [PATCH 18/45] augmentation regressions --- src/Compiler/Checking/CheckDeclarations.fs | 32 +++++++++----- .../Checking/CheckIncrementalClasses.fs | 3 +- src/Compiler/FSComp.txt | 3 +- src/Compiler/xlf/FSComp.txt.cs.xlf | 9 +++- src/Compiler/xlf/FSComp.txt.de.xlf | 9 +++- src/Compiler/xlf/FSComp.txt.es.xlf | 9 +++- src/Compiler/xlf/FSComp.txt.fr.xlf | 9 +++- src/Compiler/xlf/FSComp.txt.it.xlf | 9 +++- src/Compiler/xlf/FSComp.txt.ja.xlf | 9 +++- src/Compiler/xlf/FSComp.txt.ko.xlf | 9 +++- src/Compiler/xlf/FSComp.txt.pl.xlf | 9 +++- src/Compiler/xlf/FSComp.txt.pt-BR.xlf | 9 +++- src/Compiler/xlf/FSComp.txt.ru.xlf | 9 +++- src/Compiler/xlf/FSComp.txt.tr.xlf | 9 +++- src/Compiler/xlf/FSComp.txt.zh-Hans.xlf | 9 +++- src/Compiler/xlf/FSComp.txt.zh-Hant.xlf | 9 +++- .../StaticLetExtensionToBuiltinType.fs | 7 +++ .../StaticLet/StaticLetInUnionsAndRecords.fs | 44 ++++++++++++++++--- tests/fsharp/typecheck/sigs/neg46.bsl | 8 ++-- tests/fsharp/typecheck/sigs/neg46.fs | 2 +- tests/fsharp/typecheck/sigs/neg62.bsl | 6 +-- 21 files changed, 169 insertions(+), 53 deletions(-) create mode 100644 tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StaticLetExtensionToBuiltinType.fs diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index 7b211427594..825dfa7ee83 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -941,8 +941,11 @@ module MutRecBindingChecking = // Code for potential future design change to allow functions-compiled-as-members in structs errorR(Error(FSComp.SR.tcStructsMayNotContainLetBindings(), (trimRangeToLine m))) - if isStatic && incrCtorInfoOpt.IsNone && not (g.langVersion.SupportsFeature(LanguageFeature.StaticLetInRecordsDusEmptyTypes)) then - errorR(Error(FSComp.SR.tcStaticLetBindingsRequireClassesWithImplicitConstructors(), m)) + if isStatic && isExtrinsic then + errorR(Error(FSComp.SR.tcStaticBindingInExtrinsicAugmentation(), m)) + + elif isStatic && incrCtorInfoOpt.IsNone && not (g.langVersion.SupportsFeature(LanguageFeature.StaticLetInRecordsDusEmptyTypes)) then + errorR(Error(FSComp.SR.tcStaticLetBindingsRequireClassesWithImplicitConstructors(), m)) // Phase2A: let-bindings - pass through let innerState = (incrCtorInfoOpt, envForTycon, tpenv, recBindIdx, uncheckedBindsRev) @@ -1833,6 +1836,7 @@ let TcMutRecDefns_Phase2 (cenv: cenv) envInitial mBinds scopem mutRecNSInfo (env let tpenv = emptyUnscopedTyparEnv try + // Some preliminary checks mutRecDefns |> MutRecShapes.iterTycons (fun tyconData -> let (MutRecDefnsPhase2DataForTycon(_, _, declKind, tcref, _, _, _, members, m, newslotsOK, _)) = tyconData @@ -1841,12 +1845,14 @@ let TcMutRecDefns_Phase2 (cenv: cenv) envInitial mBinds scopem mutRecNSInfo (env error(InternalError("Intrinsic augmentations of types are only permitted in the same file as the definition of the type", m)) for mem in members do match mem with + | SynMemberDefn.AutoProperty (isStatic=isStatic) + | SynMemberDefn.LetBindings (isStatic=isStatic) when isStatic -> () | SynMemberDefn.Member _ | SynMemberDefn.GetSetMember _ - | SynMemberDefn.AutoProperty _ - | SynMemberDefn.LetBindings _ // accept local definitions | SynMemberDefn.Interface _ -> () | SynMemberDefn.Open _ + | SynMemberDefn.AutoProperty _ + | SynMemberDefn.LetBindings _ | SynMemberDefn.ImplicitCtor _ // accept implicit ctor pattern, should be first! | SynMemberDefn.ImplicitInherit _ when newslotsOK = NewSlotsOK -> () // accept implicit ctor pattern, should be first! // The rest should have been removed by splitting, they belong to "core" (they are "shape" of type, not implementation) @@ -1858,8 +1864,8 @@ let TcMutRecDefns_Phase2 (cenv: cenv) envInitial mBinds scopem mutRecNSInfo (env let (MutRecDefnsPhase2DataForTycon(tyconOpt, _x, declKind, tcref, _, _, declaredTyconTypars, synMembers, _, _, fixupFinalAttrs)) = tyconData // If a tye uses both [] and [] attributes it means it is a static class. - let isStaticClass = HasFSharpAttribute cenv.g cenv.g.attrib_SealedAttribute tcref.Attribs && HasFSharpAttribute cenv.g cenv.g.attrib_AbstractClassAttribute tcref.Attribs - if isStaticClass && cenv.g.langVersion.SupportsFeature(LanguageFeature.ErrorReportingOnStaticClasses) then + let isStaticClass = HasFSharpAttribute g g.attrib_SealedAttribute tcref.Attribs && HasFSharpAttribute g g.attrib_AbstractClassAttribute tcref.Attribs + if isStaticClass && g.langVersion.SupportsFeature(LanguageFeature.ErrorReportingOnStaticClasses) then ReportErrorOnStaticClass synMembers match tyconOpt with | Some tycon -> @@ -4165,10 +4171,12 @@ module TcDeclarations = | _ -> () + + /// Split auto-properties into 'let' and 'member' bindings let private SplitAutoProps members = - let membersIncludingAutoProps = - members |> List.filter (fun memb -> + let membersIncludingAutoProps, vals_Inherits_Abstractslots = + members |> List.partition (fun memb -> match memb with | SynMemberDefn.Interface _ | SynMemberDefn.Member _ @@ -4265,7 +4273,7 @@ module TcDeclarations = let preMembers = membersIncludingAutoProps |> List.collect preAutoProps let postMembers = membersIncludingAutoProps |> List.collect postAutoProps - preMembers @ postMembers + preMembers @ postMembers, vals_Inherits_Abstractslots /// Separates the definition into core (shape) and body. /// @@ -4275,7 +4283,7 @@ module TcDeclarations = /// where members contain methods/overrides, also implicit ctor, inheritCall and local definitions. let rec private SplitTyconDefn (SynTypeDefn(typeInfo=synTyconInfo;typeRepr=trepr; members=extraMembers)) = let extraMembers = desugarGetSetMembers extraMembers - let extraMembers = SplitAutoProps extraMembers + let extraMembers, vals_Inherits_Abstractslots = SplitAutoProps extraMembers let implements1 = extraMembers |> List.choose (function SynMemberDefn.Interface (interfaceType=ty) -> Some(ty, ty.Range) | _ -> None) match trepr with @@ -4296,7 +4304,7 @@ module TcDeclarations = let slotsigs = members |> List.choose (function SynMemberDefn.AbstractSlot (slotSig = x; flags = y) -> Some(x, y) | _ -> None) - let members = SplitAutoProps members + let members,_vals_Inherits_Abstractslots = SplitAutoProps members let isConcrete = members |> List.exists (function @@ -4335,7 +4343,7 @@ module TcDeclarations = let isAtOriginalTyconDefn = not (isAugmentationTyconDefnRepr repr) let core = MutRecDefnsPhase1DataForTycon(synTyconInfo, repr, implements2@implements1, preEstablishedHasDefaultCtor, hasSelfReferentialCtor, isAtOriginalTyconDefn) - core, members @ extraMembers + core, members @ vals_Inherits_Abstractslots @ extraMembers | SynTypeDefnRepr.Simple(repr, _) -> diff --git a/src/Compiler/Checking/CheckIncrementalClasses.fs b/src/Compiler/Checking/CheckIncrementalClasses.fs index d7c487b3af5..47d1680bd62 100644 --- a/src/Compiler/Checking/CheckIncrementalClasses.fs +++ b/src/Compiler/Checking/CheckIncrementalClasses.fs @@ -497,12 +497,13 @@ type IncrClassReprInfo = | [] -> () | _ -> match tcref.TypeReprInfo with + | TILObjectRepr _ -> () | TFSharpTyconRepr info -> let recdFields = Construct.MakeRecdFieldsTable (rfspecs @ tcref.AllFieldsAsList) // Mutate the entity_tycon_repr to publish the fields tcref.Deref.entity_tycon_repr <- TFSharpTyconRepr { info with fsobjmodel_rfields = recdFields} - | _ -> + | _ -> errorR(InternalError("unreachable, anything that can have fields should be a TFSharpTyconRepr", tcref.Range)) /// Given localRep saying how locals have been represented, e.g. as fields. diff --git a/src/Compiler/FSComp.txt b/src/Compiler/FSComp.txt index 1f9353aaff2..f33d5611ff2 100644 --- a/src/Compiler/FSComp.txt +++ b/src/Compiler/FSComp.txt @@ -749,7 +749,7 @@ tcTypeAbbreviationsCheckedAtCompileTime,"As of F# 4.1, the accessibility of type 897,tcMeasureDeclarationsRequireStaticMembers,"Measure declarations may have only static members" tcStructsMayNotContainDoBindings,"Structs cannot contain 'do' bindings because the default constructor for structs would not execute these bindings" 901,tcStructsMayNotContainLetBindings,"Structs cannot contain value definitions because the default constructor for structs will not execute these bindings. Consider adding additional arguments to the primary constructor for the type." -902,tcStaticLetBindingsRequireClassesWithImplicitConstructors,"Static value definitions may only be used in types with a primary constructor. Consider adding arguments to the type definition, e.g. 'type X(args) = ...'." +902,tcStaticLetBindingsRequireClassesWithImplicitConstructors,"For F#7 and lower, static value definitions may only be used in types with a primary constructor ('type X(args) = ...'). To enable them in all other types, use language version 'preview'." 904,tcMeasureDeclarationsRequireStaticMembersNotConstructors,"Measure declarations may have only static members: constructors are not available" 905,tcMemberAndLocalClassBindingHaveSameName,"A member and a local class binding both have the name '%s'" 906,tcTypeAbbreviationsCannotHaveInterfaceDeclaration,"Type abbreviations cannot have interface declarations" @@ -1697,3 +1697,4 @@ featureEscapeBracesInFormattableString,"Escapes curly braces before calling Form featureInformationalObjInferenceDiagnostic,"Diagnostic 3559 (warn when obj inferred) at informational level, off by default" featureStaticLetInRecordsDusEmptyTypes,"Allow static let bindings in union, record, struct, non-incremental-class types" 3566,tcMultipleRecdTypeChoice,"Multiple type matches were found:\n%s\nThe type '%s' was used. Due to the overlapping field names\n%s\nconsider using type annotations or change the order of open statements." +3567,tcStaticBindingInExtrinsicAugmentation,"Static bindings cannot be added to extrinsic augmentations. Consider using a 'static member' instead." \ No newline at end of file diff --git a/src/Compiler/xlf/FSComp.txt.cs.xlf b/src/Compiler/xlf/FSComp.txt.cs.xlf index 4fc4be0acc2..26b3726607b 100644 --- a/src/Compiler/xlf/FSComp.txt.cs.xlf +++ b/src/Compiler/xlf/FSComp.txt.cs.xlf @@ -1187,6 +1187,11 @@ Nelze volat „{0}“ - metodu setter pro vlastnost pouze init. Použijte místo toho inicializaci objektu. Viz https://aka.ms/fsharp-assigning-values-to-properties-at-initialization + + Static bindings cannot be added to extrinsic augmentations. Consider using a 'static member' instead. + Static bindings cannot be added to extrinsic augmentations. Consider using a 'static member' instead. + + This expression implicitly converts type '{0}' to type '{1}'. See https://aka.ms/fsharp-implicit-convs. Tento výraz implicitně převede typ {0} na typ {1}. Přečtěte si téma https://aka.ms/fsharp-implicit-convs. @@ -4883,8 +4888,8 @@ - Static value definitions may only be used in types with a primary constructor. Consider adding arguments to the type definition, e.g. 'type X(args) = ...'. - Statické definice hodnot se dají použít jenom u typů s primárním konstruktorem. Zvažte přidání argumentů do definice typu, třeba type X(args) = ... + For F#7 and lower, static value definitions may only be used in types with a primary constructor ('type X(args) = ...'). To enable them in all other types, use language version 'preview'. + Statické definice hodnot se dají použít jenom u typů s primárním konstruktorem. Zvažte přidání argumentů do definice typu, třeba type X(args) = ... diff --git a/src/Compiler/xlf/FSComp.txt.de.xlf b/src/Compiler/xlf/FSComp.txt.de.xlf index a28af5b5d6e..0812754ad3e 100644 --- a/src/Compiler/xlf/FSComp.txt.de.xlf +++ b/src/Compiler/xlf/FSComp.txt.de.xlf @@ -1187,6 +1187,11 @@ „{0}“ kann nicht aufgerufen werden – ein Setter für die Eigenschaft nur für die Initialisierung. Bitte verwenden Sie stattdessen die Objektinitialisierung. Siehe https://aka.ms/fsharp-assigning-values-to-properties-at-initialization + + Static bindings cannot be added to extrinsic augmentations. Consider using a 'static member' instead. + Static bindings cannot be added to extrinsic augmentations. Consider using a 'static member' instead. + + This expression implicitly converts type '{0}' to type '{1}'. See https://aka.ms/fsharp-implicit-convs. Dieser Ausdruck konvertiert den Typ "{0}" implizit in den Typ "{1}". Siehe https://aka.ms/fsharp-implicit-convs. @@ -4883,8 +4888,8 @@ - Static value definitions may only be used in types with a primary constructor. Consider adding arguments to the type definition, e.g. 'type X(args) = ...'. - Statische Wertdefinitionen dürfen nur in Typen mit einem primären Konstruktor verwendet werden. Ziehen Sie in Betracht, Argumente zur Typdefinition hinzuzufügen, z. B. "type X(args) = ...". + For F#7 and lower, static value definitions may only be used in types with a primary constructor ('type X(args) = ...'). To enable them in all other types, use language version 'preview'. + Statische Wertdefinitionen dürfen nur in Typen mit einem primären Konstruktor verwendet werden. Ziehen Sie in Betracht, Argumente zur Typdefinition hinzuzufügen, z. B. "type X(args) = ...". diff --git a/src/Compiler/xlf/FSComp.txt.es.xlf b/src/Compiler/xlf/FSComp.txt.es.xlf index 538a25d4194..1aa3353f231 100644 --- a/src/Compiler/xlf/FSComp.txt.es.xlf +++ b/src/Compiler/xlf/FSComp.txt.es.xlf @@ -1187,6 +1187,11 @@ No se puede llamar a '{0}': un establecedor para una propiedad de solo inicialización. Use la inicialización del objeto en su lugar. Ver https://aka.ms/fsharp-assigning-values-to-properties-at-initialization + + Static bindings cannot be added to extrinsic augmentations. Consider using a 'static member' instead. + Static bindings cannot be added to extrinsic augmentations. Consider using a 'static member' instead. + + This expression implicitly converts type '{0}' to type '{1}'. See https://aka.ms/fsharp-implicit-convs. Esta expresión convierte implícitamente el tipo '{0}' al tipo '{1}'. Consulte https://aka.ms/fsharp-implicit-convs. @@ -4883,8 +4888,8 @@ - Static value definitions may only be used in types with a primary constructor. Consider adding arguments to the type definition, e.g. 'type X(args) = ...'. - Las definiciones de valores estáticos se pueden usar solo en tipos con un constructor principal. Considere agregar argumentos a la definición de tipo, por ejemplo, 'type X(args) = ...'. + For F#7 and lower, static value definitions may only be used in types with a primary constructor ('type X(args) = ...'). To enable them in all other types, use language version 'preview'. + Las definiciones de valores estáticos se pueden usar solo en tipos con un constructor principal. Considere agregar argumentos a la definición de tipo, por ejemplo, 'type X(args) = ...'. diff --git a/src/Compiler/xlf/FSComp.txt.fr.xlf b/src/Compiler/xlf/FSComp.txt.fr.xlf index 2d2d19b2ccd..dce502b0438 100644 --- a/src/Compiler/xlf/FSComp.txt.fr.xlf +++ b/src/Compiler/xlf/FSComp.txt.fr.xlf @@ -1187,6 +1187,11 @@ Nous n’avons pas pu appeler '{0}' - méthode setter pour la propriété init-only. Utilisez plutôt l’initialisation d’objet. Consultez https://aka.ms/fsharp-assigning-values-to-properties-at-initialization. + + Static bindings cannot be added to extrinsic augmentations. Consider using a 'static member' instead. + Static bindings cannot be added to extrinsic augmentations. Consider using a 'static member' instead. + + This expression implicitly converts type '{0}' to type '{1}'. See https://aka.ms/fsharp-implicit-convs. Cette expression convertit implicitement le type « {0} » en type « {1} ». Voir https://aka.ms/fsharp-implicit-convs. @@ -4883,8 +4888,8 @@ - Static value definitions may only be used in types with a primary constructor. Consider adding arguments to the type definition, e.g. 'type X(args) = ...'. - Les définitions de valeur statiques peuvent uniquement être utilisées dans les types comportant un constructeur principal. Ajoutez des arguments à la définition de type, par exemple 'type X(args) = …'. + For F#7 and lower, static value definitions may only be used in types with a primary constructor ('type X(args) = ...'). To enable them in all other types, use language version 'preview'. + Les définitions de valeur statiques peuvent uniquement être utilisées dans les types comportant un constructeur principal. Ajoutez des arguments à la définition de type, par exemple 'type X(args) = …'. diff --git a/src/Compiler/xlf/FSComp.txt.it.xlf b/src/Compiler/xlf/FSComp.txt.it.xlf index 4e98baca425..76e537af10c 100644 --- a/src/Compiler/xlf/FSComp.txt.it.xlf +++ b/src/Compiler/xlf/FSComp.txt.it.xlf @@ -1187,6 +1187,11 @@ Non è possibile chiamare '{0}', un setter per la proprietà init-only. Usare invece l'inizializzazione dell'oggetto. Vedere https://aka.ms/fsharp-assigning-values-to-properties-at-initialization + + Static bindings cannot be added to extrinsic augmentations. Consider using a 'static member' instead. + Static bindings cannot be added to extrinsic augmentations. Consider using a 'static member' instead. + + This expression implicitly converts type '{0}' to type '{1}'. See https://aka.ms/fsharp-implicit-convs. Questa espressione converte in modo implicito il tipo '{0}' nel tipo '{1}'. Vedere https://aka.ms/fsharp-implicit-convs. @@ -4883,8 +4888,8 @@ - Static value definitions may only be used in types with a primary constructor. Consider adding arguments to the type definition, e.g. 'type X(args) = ...'. - Le definizioni di valore statiche possono essere utilizzate solo nei tipi con un costruttore primario. Provare ad aggiungere argomenti alla definizione di tipo, ad esempio 'type X(args) = ...'. + For F#7 and lower, static value definitions may only be used in types with a primary constructor ('type X(args) = ...'). To enable them in all other types, use language version 'preview'. + Le definizioni di valore statiche possono essere utilizzate solo nei tipi con un costruttore primario. Provare ad aggiungere argomenti alla definizione di tipo, ad esempio 'type X(args) = ...'. diff --git a/src/Compiler/xlf/FSComp.txt.ja.xlf b/src/Compiler/xlf/FSComp.txt.ja.xlf index 2e5448cca29..bdcc53f6b08 100644 --- a/src/Compiler/xlf/FSComp.txt.ja.xlf +++ b/src/Compiler/xlf/FSComp.txt.ja.xlf @@ -1187,6 +1187,11 @@ '{0}' を呼び出すことはできません。これは init のみのプロパティのセッターなので、代わりにオブジェクトの初期化を使用してください。https://aka.ms/fsharp-assigning-values-to-properties-at-initialization を参照してください。 + + Static bindings cannot be added to extrinsic augmentations. Consider using a 'static member' instead. + Static bindings cannot be added to extrinsic augmentations. Consider using a 'static member' instead. + + This expression implicitly converts type '{0}' to type '{1}'. See https://aka.ms/fsharp-implicit-convs. この式は、型 '{0}' を型 '{1}' に暗黙的に変換します。https://aka.ms/fsharp-implicit-convs を参照してください。 @@ -4883,8 +4888,8 @@ - Static value definitions may only be used in types with a primary constructor. Consider adding arguments to the type definition, e.g. 'type X(args) = ...'. - 静的な値の定義は、プライマリ コンストラクターを含む型でのみ使用できます。型定義に引数を追加してください ( たとえば、'type X(args) = ...')。 + For F#7 and lower, static value definitions may only be used in types with a primary constructor ('type X(args) = ...'). To enable them in all other types, use language version 'preview'. + 静的な値の定義は、プライマリ コンストラクターを含む型でのみ使用できます。型定義に引数を追加してください ( たとえば、'type X(args) = ...')。 diff --git a/src/Compiler/xlf/FSComp.txt.ko.xlf b/src/Compiler/xlf/FSComp.txt.ko.xlf index 841206fe103..64965d741dc 100644 --- a/src/Compiler/xlf/FSComp.txt.ko.xlf +++ b/src/Compiler/xlf/FSComp.txt.ko.xlf @@ -1187,6 +1187,11 @@ init 전용 속성의 setter인 '{0}'을(를) 호출할 수 없습니다. 개체 초기화를 대신 사용하세요. https://aka.ms/fsharp-assigning-values-to-properties-at-initialization를 참조하세요. + + Static bindings cannot be added to extrinsic augmentations. Consider using a 'static member' instead. + Static bindings cannot be added to extrinsic augmentations. Consider using a 'static member' instead. + + This expression implicitly converts type '{0}' to type '{1}'. See https://aka.ms/fsharp-implicit-convs. 이 식은 암시적으로 '{0}' 형식을 '{1}' 형식으로 변환 합니다. https://aka.ms/fsharp-implicit-convs 참조 @@ -4883,8 +4888,8 @@ - Static value definitions may only be used in types with a primary constructor. Consider adding arguments to the type definition, e.g. 'type X(args) = ...'. - 정적 값 정의는 기본 생성자가 포함된 형식에서만 사용할 수 있습니다. 'type X(args) = ...'와 같이 형식 정의에 인수를 추가해 보세요. + For F#7 and lower, static value definitions may only be used in types with a primary constructor ('type X(args) = ...'). To enable them in all other types, use language version 'preview'. + 정적 값 정의는 기본 생성자가 포함된 형식에서만 사용할 수 있습니다. 'type X(args) = ...'와 같이 형식 정의에 인수를 추가해 보세요. diff --git a/src/Compiler/xlf/FSComp.txt.pl.xlf b/src/Compiler/xlf/FSComp.txt.pl.xlf index 248eac7e52f..44d7c160da7 100644 --- a/src/Compiler/xlf/FSComp.txt.pl.xlf +++ b/src/Compiler/xlf/FSComp.txt.pl.xlf @@ -1187,6 +1187,11 @@ Nie można wywołać „{0}” — metody ustawiającej dla właściwości tylko do inicjowania. Zamiast tego użyj inicjowania obiektu. Zobacz https://aka.ms/fsharp-assigning-values-to-properties-at-initialization + + Static bindings cannot be added to extrinsic augmentations. Consider using a 'static member' instead. + Static bindings cannot be added to extrinsic augmentations. Consider using a 'static member' instead. + + This expression implicitly converts type '{0}' to type '{1}'. See https://aka.ms/fsharp-implicit-convs. To wyrażenie bezwzględnie konwertuje typ "{0}" na typ "{1}". Zobacz https://aka.ms/fsharp-implicit-convs. @@ -4883,8 +4888,8 @@ - Static value definitions may only be used in types with a primary constructor. Consider adding arguments to the type definition, e.g. 'type X(args) = ...'. - Definicje wartości statycznych mogą być używane tylko w przypadku typów z konstruktorem podstawowym. Rozważ dodanie argumentów do definicji typu, na przykład „type X(argumenty) = ...”. + For F#7 and lower, static value definitions may only be used in types with a primary constructor ('type X(args) = ...'). To enable them in all other types, use language version 'preview'. + Definicje wartości statycznych mogą być używane tylko w przypadku typów z konstruktorem podstawowym. Rozważ dodanie argumentów do definicji typu, na przykład „type X(argumenty) = ...”. diff --git a/src/Compiler/xlf/FSComp.txt.pt-BR.xlf b/src/Compiler/xlf/FSComp.txt.pt-BR.xlf index 4b44fe76fe3..88eb3d3df99 100644 --- a/src/Compiler/xlf/FSComp.txt.pt-BR.xlf +++ b/src/Compiler/xlf/FSComp.txt.pt-BR.xlf @@ -1187,6 +1187,11 @@ Não é possível chamar '{0}' – um setter da propriedade somente inicialização, use a inicialização de objeto. Confira https://aka.ms/fsharp-assigning-values-to-properties-at-initialization + + Static bindings cannot be added to extrinsic augmentations. Consider using a 'static member' instead. + Static bindings cannot be added to extrinsic augmentations. Consider using a 'static member' instead. + + This expression implicitly converts type '{0}' to type '{1}'. See https://aka.ms/fsharp-implicit-convs. Essa expressão converte implicitamente o tipo '{0}' ao tipo '{1}'. Consulte https://aka.ms/fsharp-implicit-convs. @@ -4883,8 +4888,8 @@ - Static value definitions may only be used in types with a primary constructor. Consider adding arguments to the type definition, e.g. 'type X(args) = ...'. - Definições de valores estáticos só podem ser usadas em tipos com um construtor primário. Considere adicionar argumentos à definição de tipo, por exemplo, 'type X(args) = ...'. + For F#7 and lower, static value definitions may only be used in types with a primary constructor ('type X(args) = ...'). To enable them in all other types, use language version 'preview'. + Definições de valores estáticos só podem ser usadas em tipos com um construtor primário. Considere adicionar argumentos à definição de tipo, por exemplo, 'type X(args) = ...'. diff --git a/src/Compiler/xlf/FSComp.txt.ru.xlf b/src/Compiler/xlf/FSComp.txt.ru.xlf index ddc1204fa27..4349684b336 100644 --- a/src/Compiler/xlf/FSComp.txt.ru.xlf +++ b/src/Compiler/xlf/FSComp.txt.ru.xlf @@ -1187,6 +1187,11 @@ Не удается вызвать '{0}' — установщик для свойства только для инициализации, вместо этого используйте инициализацию объекта. См. https://aka.ms/fsharp-assigning-values-to-properties-at-initialization. + + Static bindings cannot be added to extrinsic augmentations. Consider using a 'static member' instead. + Static bindings cannot be added to extrinsic augmentations. Consider using a 'static member' instead. + + This expression implicitly converts type '{0}' to type '{1}'. See https://aka.ms/fsharp-implicit-convs. Это выражение неявно преобразует тип "{0}" в тип "{1}". См. сведения на странице https://aka.ms/fsharp-implicit-convs. @@ -4883,8 +4888,8 @@ - Static value definitions may only be used in types with a primary constructor. Consider adding arguments to the type definition, e.g. 'type X(args) = ...'. - Статические определения значений можно использовать только в типах с первичными конструкторами. Попробуйте добавить в определение типа аргументы, напр. "type X(args) = ...". + For F#7 and lower, static value definitions may only be used in types with a primary constructor ('type X(args) = ...'). To enable them in all other types, use language version 'preview'. + Статические определения значений можно использовать только в типах с первичными конструкторами. Попробуйте добавить в определение типа аргументы, напр. "type X(args) = ...". diff --git a/src/Compiler/xlf/FSComp.txt.tr.xlf b/src/Compiler/xlf/FSComp.txt.tr.xlf index b47a689b562..0efe3a1dc4a 100644 --- a/src/Compiler/xlf/FSComp.txt.tr.xlf +++ b/src/Compiler/xlf/FSComp.txt.tr.xlf @@ -1187,6 +1187,11 @@ Yalnızca başlatma özelliği için ayarlayıcı olan '{0}' çağrılamaz, lütfen bunun yerine nesne başlatmayı kullanın. bkz. https://aka.ms/fsharp-assigning-values-to-properties-at-initialization + + Static bindings cannot be added to extrinsic augmentations. Consider using a 'static member' instead. + Static bindings cannot be added to extrinsic augmentations. Consider using a 'static member' instead. + + This expression implicitly converts type '{0}' to type '{1}'. See https://aka.ms/fsharp-implicit-convs. Bu ifade '{0}' türünü örtülü olarak '{1}' türüne dönüştürür. https://aka.ms/fsharp-implicit-convs adresine bakın. @@ -4883,8 +4888,8 @@ - Static value definitions may only be used in types with a primary constructor. Consider adding arguments to the type definition, e.g. 'type X(args) = ...'. - Statik değer tanımları yalnızca birincil oluşturucusu olan türlerde kullanılabilir. Tür tanımına bağımsız değişkenler eklemeyi düşünün, örn. 'type X(args) = ...'. + For F#7 and lower, static value definitions may only be used in types with a primary constructor ('type X(args) = ...'). To enable them in all other types, use language version 'preview'. + Statik değer tanımları yalnızca birincil oluşturucusu olan türlerde kullanılabilir. Tür tanımına bağımsız değişkenler eklemeyi düşünün, örn. 'type X(args) = ...'. diff --git a/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf b/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf index c251f64350b..ae7f1c63404 100644 --- a/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf +++ b/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf @@ -1187,6 +1187,11 @@ 无法调用 "{0}"，它是仅限 init 属性的资源库，请改用对象初始化。请参阅 https://aka.ms/fsharp-assigning-values-to-properties-at-initialization + + Static bindings cannot be added to extrinsic augmentations. Consider using a 'static member' instead. + Static bindings cannot be added to extrinsic augmentations. Consider using a 'static member' instead. + + This expression implicitly converts type '{0}' to type '{1}'. See https://aka.ms/fsharp-implicit-convs. 此表达式将类型“{0}”隐式转换为类型“{1}”。请参阅 https://aka.ms/fsharp-implicit-convs。 @@ -4883,8 +4888,8 @@ - Static value definitions may only be used in types with a primary constructor. Consider adding arguments to the type definition, e.g. 'type X(args) = ...'. - 静态值定义只能在具有主构造函数的类型中使用。请考虑向类型定义添加参数，例如“type X(args) = ...”。 + For F#7 and lower, static value definitions may only be used in types with a primary constructor ('type X(args) = ...'). To enable them in all other types, use language version 'preview'. + 静态值定义只能在具有主构造函数的类型中使用。请考虑向类型定义添加参数，例如“type X(args) = ...”。 diff --git a/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf b/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf index da4e89a7dd3..27cec76e5f2 100644 --- a/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf +++ b/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf @@ -1187,6 +1187,11 @@ 無法呼叫 '{0}' - 僅初始化屬性的 setter，請改為使用物件初始化。請參閱 https://aka.ms/fsharp-assigning-values-to-properties-at-initialization + + Static bindings cannot be added to extrinsic augmentations. Consider using a 'static member' instead. + Static bindings cannot be added to extrinsic augmentations. Consider using a 'static member' instead. + + This expression implicitly converts type '{0}' to type '{1}'. See https://aka.ms/fsharp-implicit-convs. 此運算式將類型 '{0}' 隱含轉換為類型 '{1}'。請參閱 https://aka.ms/fsharp-implicit-convs。 @@ -4883,8 +4888,8 @@ - Static value definitions may only be used in types with a primary constructor. Consider adding arguments to the type definition, e.g. 'type X(args) = ...'. - 靜態值定義只能用於含有主要建構函式的類型中。請考慮在類型定義加入引數，例如 'type X(args) = ...'。 + For F#7 and lower, static value definitions may only be used in types with a primary constructor ('type X(args) = ...'). To enable them in all other types, use language version 'preview'. + 靜態值定義只能用於含有主要建構函式的類型中。請考慮在類型定義加入引數，例如 'type X(args) = ...'。 diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StaticLetExtensionToBuiltinType.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StaticLetExtensionToBuiltinType.fs new file mode 100644 index 00000000000..f8aefccd642 --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StaticLetExtensionToBuiltinType.fs @@ -0,0 +1,7 @@ +module Test + +type System.Random with + static let getcached() = new System.Random(42) + static member NextInt() = (getcached()).Next() + +printfn "%i" (System.Random.NextInt()) \ No newline at end of file diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StaticLetInUnionsAndRecords.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StaticLetInUnionsAndRecords.fs index cd508e8e633..f3446f973f4 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StaticLetInUnionsAndRecords.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StaticLetInUnionsAndRecords.fs @@ -5,16 +5,16 @@ open FSharp.Test open FSharp.Test.Compiler open System.IO -let allTestCases = +let testCasesForFSharp7ErrorMessage = Directory.EnumerateFiles(__SOURCE_DIRECTORY__) |> Seq.toArray |> Array.map Path.GetFileName - |> Array.except [__SOURCE_FILE__;"PlainEnum.fs"] // ALl files in the folder except this one with the tests + |> Array.except [__SOURCE_FILE__;"PlainEnum.fs";"StaticLetExtensionToBuiltinType.fs"] // ALl files in the folder except this one with the tests |> Array.map (fun f -> [|f :> obj|]) [] -[] +[] let ``Should fail in F# 7 and lower`` (implFileName:string) = let fileContents = File.ReadAllText (Path.Combine(__SOURCE_DIRECTORY__,implFileName)) @@ -22,7 +22,34 @@ let ``Should fail in F# 7 and lower`` (implFileName:string) = |> withLangVersion70 |> typecheck |> shouldFail - |> withDiagnosticMessageMatches "Static value definitions may only be used in types with a primary constructor." + |> withErrorCode 902 + |> withDiagnosticMessageMatches "static value definitions may only be used in types with a primary constructor" + +[] +[] +[] +let ``Member val regression - not allowed without primary constructor`` (langVersion:string) = + Fs """module Test +type Bad3 = + member val X = 1 + 1 """ + |> withLangVersion langVersion + |> typecheck + |> shouldFail + |> withDiagnostics [] + + +[] +[] +[] +let ``Type augmentation with abstract slot not allowed`` (langVersion:string) = + Fs """module Test +type System.Random with + abstract M : int -> int + static member Factory() = 1 """ + |> withLangVersion langVersion + |> typecheck + |> shouldFail + |> withDiagnostics [Error 912, Line 3, Col 8, Line 3, Col 31, "This declaration element is not permitted in an augmentation"] let verifyCompileAndRun compilation = compilation @@ -175,13 +202,20 @@ Egg init Omelette init 1""" - [] let ``Static let - quotations support for unions`` compilation = compilation |> verifyCompileAndRun |> shouldSucceed |> withStdOutContains """Let (s, Value ("A"), Call (None, ofString, [s]))""" + + +[] +let ``Static let extension to builtin type`` compilation = + compilation + |> typecheck + |> shouldFail + |> withDiagnostics [Error 3567, Line 4, Col 5, Line 4, Col 51, "Static bindings cannot be added to extrinsic augmentations. Consider using a 'static member' instead."] [] let ``Static let - quotations support for records`` compilation = diff --git a/tests/fsharp/typecheck/sigs/neg46.bsl b/tests/fsharp/typecheck/sigs/neg46.bsl index bb3cafeccb3..aa8968e4ea0 100644 --- a/tests/fsharp/typecheck/sigs/neg46.bsl +++ b/tests/fsharp/typecheck/sigs/neg46.bsl @@ -1,13 +1,13 @@ neg46.fs(6,8,6,26): typecheck error FS0912: This declaration element is not permitted in an augmentation -neg46.fs(10,8,10,33): typecheck error FS0912: This declaration element is not permitted in an augmentation +neg46.fs(10,8,10,40): typecheck error FS3567: Static bindings cannot be added to extrinsic augmentations. Consider using a 'static member' instead. -neg46.fs(14,8,14,26): typecheck error FS0912: This declaration element is not permitted in an augmentation +neg46.fs(14,8,14,26): typecheck error FS3567: Static bindings cannot be added to extrinsic augmentations. Consider using a 'static member' instead. -neg46.fs(18,8,19,21): typecheck error FS0912: This declaration element is not permitted in an augmentation +neg46.fs(18,8,19,21): typecheck error FS3567: Static bindings cannot be added to extrinsic augmentations. Consider using a 'static member' instead. -neg46.fs(23,8,23,32): typecheck error FS0912: This declaration element is not permitted in an augmentation +neg46.fs(23,8,23,32): typecheck error FS3567: Static bindings cannot be added to extrinsic augmentations. Consider using a 'static member' instead. neg46.fs(27,8,27,25): typecheck error FS0912: This declaration element is not permitted in an augmentation diff --git a/tests/fsharp/typecheck/sigs/neg46.fs b/tests/fsharp/typecheck/sigs/neg46.fs index ec75b835a43..bd38d1de60a 100644 --- a/tests/fsharp/typecheck/sigs/neg46.fs +++ b/tests/fsharp/typecheck/sigs/neg46.fs @@ -7,7 +7,7 @@ type System.Random with static member Factory() = 1 type System.Random with - static let gen = Random() + static let gen = System.Random() static member Factory() = 1 type System.Random with diff --git a/tests/fsharp/typecheck/sigs/neg62.bsl b/tests/fsharp/typecheck/sigs/neg62.bsl index 8205597f550..a0f2b8cef29 100644 --- a/tests/fsharp/typecheck/sigs/neg62.bsl +++ b/tests/fsharp/typecheck/sigs/neg62.bsl @@ -1,7 +1,7 @@ -neg62.fs(5,3,5,28): typecheck error FS0902: Static value definitions may only be used in types with a primary constructor. Consider adding arguments to the type definition, e.g. 'type X(args) = ...'. +neg62.fs(5,3,5,28): typecheck error FS0902: For F#7 and lower, static value definitions may only be used in types with a primary constructor ('type X(args) = ...'). To enable them in all other types, use language version 'preview'. -neg62.fs(8,3,8,19): typecheck error FS0902: Static value definitions may only be used in types with a primary constructor. Consider adding arguments to the type definition, e.g. 'type X(args) = ...'. +neg62.fs(8,3,8,19): typecheck error FS0902: For F#7 and lower, static value definitions may only be used in types with a primary constructor ('type X(args) = ...'). To enable them in all other types, use language version 'preview'. neg62.fs(11,3,11,12): typecheck error FS0963: This definition may only be used in a type with a primary constructor. Consider adding arguments to your type definition, e.g. 'type X(args) = ...'. @@ -17,7 +17,7 @@ neg62.fs(28,5,28,18): typecheck error FS0960: 'let' and 'do' bindings must come neg62.fs(31,5,31,32): typecheck error FS3133: 'member val' definitions are only permitted in types with a primary constructor. Consider adding arguments to your type definition, e.g. 'type X(args) = ...'. -neg62.fs(31,5,31,32): typecheck error FS0902: Static value definitions may only be used in types with a primary constructor. Consider adding arguments to the type definition, e.g. 'type X(args) = ...'. +neg62.fs(31,5,31,32): typecheck error FS0902: For F#7 and lower, static value definitions may only be used in types with a primary constructor ('type X(args) = ...'). To enable them in all other types, use language version 'preview'. neg62.fs(34,5,34,25): typecheck error FS3133: 'member val' definitions are only permitted in types with a primary constructor. Consider adding arguments to your type definition, e.g. 'type X(args) = ...'. From 0b51dbef184460bf68848f00fa8d3e929dff34a7 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Wed, 14 Jun 2023 18:46:55 +0200 Subject: [PATCH 19/45] Update CheckDeclarations.fs --- src/Compiler/Checking/CheckDeclarations.fs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index 825dfa7ee83..528fefba855 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -4283,7 +4283,7 @@ module TcDeclarations = /// where members contain methods/overrides, also implicit ctor, inheritCall and local definitions. let rec private SplitTyconDefn (SynTypeDefn(typeInfo=synTyconInfo;typeRepr=trepr; members=extraMembers)) = let extraMembers = desugarGetSetMembers extraMembers - let extraMembers, vals_Inherits_Abstractslots = SplitAutoProps extraMembers + let extraMembers, extra_vals_Inherits_Abstractslots = SplitAutoProps extraMembers let implements1 = extraMembers |> List.choose (function SynMemberDefn.Interface (interfaceType=ty) -> Some(ty, ty.Range) | _ -> None) match trepr with @@ -4343,7 +4343,7 @@ module TcDeclarations = let isAtOriginalTyconDefn = not (isAugmentationTyconDefnRepr repr) let core = MutRecDefnsPhase1DataForTycon(synTyconInfo, repr, implements2@implements1, preEstablishedHasDefaultCtor, hasSelfReferentialCtor, isAtOriginalTyconDefn) - core, members @ vals_Inherits_Abstractslots @ extraMembers + core, members @ extra_vals_Inherits_Abstractslots @ extraMembers | SynTypeDefnRepr.Simple(repr, _) -> From 7b77db3e4b58e3e599b8ec478b9aae174696d4af Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Fri, 16 Jun 2023 20:50:11 +0200 Subject: [PATCH 20/45] internalerror with MakeValueAssign fixed? --- .../Checking/CheckIncrementalClasses.fs | 46 ++++++++++--------- .../StaticLet/StaticLetInUnionsAndRecords.fs | 2 +- 2 files changed, 26 insertions(+), 22 deletions(-) diff --git a/src/Compiler/Checking/CheckIncrementalClasses.fs b/src/Compiler/Checking/CheckIncrementalClasses.fs index 47d1680bd62..6452c7b224c 100644 --- a/src/Compiler/Checking/CheckIncrementalClasses.fs +++ b/src/Compiler/Checking/CheckIncrementalClasses.fs @@ -722,37 +722,41 @@ let MakeCtorForIncrClassConstructionPhase2C( | DebugPointAtBinding.Yes m, _ -> m | _ -> v.Range - let assignExpr = reps.MakeValueAssign thisValOpt thisTyInst NoSafeInitInfo v rhsExpr m + if isStatic = false && thisValOpt.IsNone then + (isPriorToSuperInit, id), [] + else + let assignExpr = reps.MakeValueAssign thisValOpt thisTyInst NoSafeInitInfo v rhsExpr m - let adjustSafeInitFieldExprOpt = - if isStatic then - match safeStaticInitInfo with - | SafeInitField (rfref, _) -> - let setExpr = mkStaticRecdFieldSet (rfref, thisTyInst, mkInt g m idx, m) - let setExpr = reps.FixupIncrClassExprPhase2C cenv thisValOpt NoSafeInitInfo thisTyInst setExpr - Some setExpr - | NoSafeInitInfo -> + let adjustSafeInitFieldExprOpt = + if isStatic then + match safeStaticInitInfo with + | SafeInitField (rfref, _) -> + let setExpr = mkStaticRecdFieldSet (rfref, thisTyInst, mkInt g m idx, m) + let setExpr = reps.FixupIncrClassExprPhase2C cenv thisValOpt NoSafeInitInfo thisTyInst setExpr + Some setExpr + | NoSafeInitInfo -> + None + else None - else - None - (isPriorToSuperInit, (fun e -> - let e = - match adjustSafeInitFieldExprOpt with - | None -> e - | Some adjustExpr -> mkCompGenSequential m adjustExpr e + (isPriorToSuperInit, (fun e -> + let e = + match adjustSafeInitFieldExprOpt with + | None -> e + | Some adjustExpr -> mkCompGenSequential m adjustExpr e - let assignExpr = - match spBind with - | DebugPointAtBinding.Yes _ -> mkDebugPoint m assignExpr - | _ -> assignExpr + let assignExpr = + match spBind with + | DebugPointAtBinding.Yes _ -> mkDebugPoint m assignExpr + | _ -> assignExpr - mkSequential m assignExpr e)), [] + mkSequential m assignExpr e)), [] /// Work out the implicit construction side effects of a 'let', 'let rec' or 'do' /// binding in the implicit class construction sequence let TransTrueDec isCtorArg (reps: IncrClassReprInfo) dec = match dec with + // Pokud to neni staticke, a zaroven to nema construktor info, tak zkusit vyhnout se TransBind mozna? | IncrClassBindingGroup(binds, isStatic, isRec) -> let actions, reps, methodBinds = let reps = (reps, binds) ||> List.fold (fun rep bind -> rep.ChooseAndAddRepresentation(cenv, env, isStatic, isCtorArg, staticCtorInfo, ctorInfoOpt, staticForcedFieldVars, instanceForcedFieldVars, bind)) // extend diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StaticLetInUnionsAndRecords.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StaticLetInUnionsAndRecords.fs index f3446f973f4..b1549e882c4 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StaticLetInUnionsAndRecords.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StaticLetInUnionsAndRecords.fs @@ -35,7 +35,7 @@ type Bad3 = |> withLangVersion langVersion |> typecheck |> shouldFail - |> withDiagnostics [] + |> withDiagnostics [Error 3133, Line 3, Col 5, Line 3, Col 25, "'member val' definitions are only permitted in types with a primary constructor. Consider adding arguments to your type definition, e.g. 'type X(args) = ...'."] [] From dc2d520401bb57935042ae9803a4fd00ff335c71 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Fri, 16 Jun 2023 21:59:00 +0200 Subject: [PATCH 21/45] IL baselines changed (just reordered) --- .../Inlining/Match01.fs.il.net472.debug.bsl | 72 ++++----- .../Inlining/Match01.fs.il.net472.release.bsl | 72 ++++----- .../Inlining/Match01.fs.il.netcore.debug.bsl | 72 ++++----- .../Match01.fs.il.netcore.release.bsl | 72 ++++----- .../TestFunctions/Verify13043.fs.il.debug.bsl | 152 +++++++++--------- .../Verify13043.fs.il.release.bsl | 152 +++++++++--------- 6 files changed, 296 insertions(+), 296 deletions(-) diff --git a/tests/FSharp.Compiler.ComponentTests/EmittedIL/Inlining/Match01.fs.il.net472.debug.bsl b/tests/FSharp.Compiler.ComponentTests/EmittedIL/Inlining/Match01.fs.il.net472.debug.bsl index 06514590ac1..45ba3be6216 100644 --- a/tests/FSharp.Compiler.ComponentTests/EmittedIL/Inlining/Match01.fs.il.net472.debug.bsl +++ b/tests/FSharp.Compiler.ComponentTests/EmittedIL/Inlining/Match01.fs.il.net472.debug.bsl @@ -1125,6 +1125,42 @@ } } + .method public static int32 select1(class assembly/Test1 x) cil managed + { + + .maxstack 8 + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: call instance int32 assembly/Test1::get_Tag() + IL_0007: switch ( + IL_001c, + IL_0028, + IL_002a, + IL_002c) + IL_001c: ldarg.0 + IL_001d: castclass assembly/Test1/X11 + IL_0022: ldfld int32 assembly/Test1/X11::item + IL_0027: ret + + IL_0028: ldc.i4.2 + IL_0029: ret + + IL_002a: ldc.i4.3 + IL_002b: ret + + IL_002c: ldc.i4.4 + IL_002d: ret + } + + .method public static int32 fm(class assembly/Test1 y) cil managed + { + + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: call int32 assembly::select1(class assembly/Test1) + IL_0006: ret + } + .method assembly static int32 CompareTo$cont@4(class assembly/Test1 this, class assembly/Test1 obj, class [FSharp.Core]Microsoft.FSharp.Core.Unit unitVar) cil managed @@ -1386,42 +1422,6 @@ IL_00ef: ret } - .method public static int32 select1(class assembly/Test1 x) cil managed - { - - .maxstack 8 - IL_0000: nop - IL_0001: ldarg.0 - IL_0002: call instance int32 assembly/Test1::get_Tag() - IL_0007: switch ( - IL_001c, - IL_0028, - IL_002a, - IL_002c) - IL_001c: ldarg.0 - IL_001d: castclass assembly/Test1/X11 - IL_0022: ldfld int32 assembly/Test1/X11::item - IL_0027: ret - - IL_0028: ldc.i4.2 - IL_0029: ret - - IL_002a: ldc.i4.3 - IL_002b: ret - - IL_002c: ldc.i4.4 - IL_002d: ret - } - - .method public static int32 fm(class assembly/Test1 y) cil managed - { - - .maxstack 8 - IL_0000: ldarg.0 - IL_0001: call int32 assembly::select1(class assembly/Test1) - IL_0006: ret - } - } .class private abstract auto ansi sealed ''.$assembly diff --git a/tests/FSharp.Compiler.ComponentTests/EmittedIL/Inlining/Match01.fs.il.net472.release.bsl b/tests/FSharp.Compiler.ComponentTests/EmittedIL/Inlining/Match01.fs.il.net472.release.bsl index 6b5629b9317..13e4c61843e 100644 --- a/tests/FSharp.Compiler.ComponentTests/EmittedIL/Inlining/Match01.fs.il.net472.release.bsl +++ b/tests/FSharp.Compiler.ComponentTests/EmittedIL/Inlining/Match01.fs.il.net472.release.bsl @@ -1120,6 +1120,42 @@ } } + .method public static int32 select1(class assembly/Test1 x) cil managed + { + + .maxstack 8 + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: call instance int32 assembly/Test1::get_Tag() + IL_0007: switch ( + IL_001c, + IL_0028, + IL_002a, + IL_002c) + IL_001c: ldarg.0 + IL_001d: castclass assembly/Test1/X11 + IL_0022: ldfld int32 assembly/Test1/X11::item + IL_0027: ret + + IL_0028: ldc.i4.2 + IL_0029: ret + + IL_002a: ldc.i4.3 + IL_002b: ret + + IL_002c: ldc.i4.4 + IL_002d: ret + } + + .method public static int32 fm(class assembly/Test1 y) cil managed + { + + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: call int32 assembly::select1(class assembly/Test1) + IL_0006: ret + } + .method assembly static int32 CompareTo$cont@4(class assembly/Test1 this, class assembly/Test1 obj, class [FSharp.Core]Microsoft.FSharp.Core.Unit unitVar) cil managed @@ -1389,42 +1425,6 @@ IL_00fc: ret } - .method public static int32 select1(class assembly/Test1 x) cil managed - { - - .maxstack 8 - IL_0000: nop - IL_0001: ldarg.0 - IL_0002: call instance int32 assembly/Test1::get_Tag() - IL_0007: switch ( - IL_001c, - IL_0028, - IL_002a, - IL_002c) - IL_001c: ldarg.0 - IL_001d: castclass assembly/Test1/X11 - IL_0022: ldfld int32 assembly/Test1/X11::item - IL_0027: ret - - IL_0028: ldc.i4.2 - IL_0029: ret - - IL_002a: ldc.i4.3 - IL_002b: ret - - IL_002c: ldc.i4.4 - IL_002d: ret - } - - .method public static int32 fm(class assembly/Test1 y) cil managed - { - - .maxstack 8 - IL_0000: ldarg.0 - IL_0001: call int32 assembly::select1(class assembly/Test1) - IL_0006: ret - } - } .class private abstract auto ansi sealed ''.$assembly diff --git a/tests/FSharp.Compiler.ComponentTests/EmittedIL/Inlining/Match01.fs.il.netcore.debug.bsl b/tests/FSharp.Compiler.ComponentTests/EmittedIL/Inlining/Match01.fs.il.netcore.debug.bsl index a26af5e534a..9f7c89bc0ad 100644 --- a/tests/FSharp.Compiler.ComponentTests/EmittedIL/Inlining/Match01.fs.il.netcore.debug.bsl +++ b/tests/FSharp.Compiler.ComponentTests/EmittedIL/Inlining/Match01.fs.il.netcore.debug.bsl @@ -1125,6 +1125,42 @@ } } + .method public static int32 select1(class assembly/Test1 x) cil managed + { + + .maxstack 8 + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: call instance int32 assembly/Test1::get_Tag() + IL_0007: switch ( + IL_001c, + IL_0028, + IL_002a, + IL_002c) + IL_001c: ldarg.0 + IL_001d: castclass assembly/Test1/X11 + IL_0022: ldfld int32 assembly/Test1/X11::item + IL_0027: ret + + IL_0028: ldc.i4.2 + IL_0029: ret + + IL_002a: ldc.i4.3 + IL_002b: ret + + IL_002c: ldc.i4.4 + IL_002d: ret + } + + .method public static int32 fm(class assembly/Test1 y) cil managed + { + + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: call int32 assembly::select1(class assembly/Test1) + IL_0006: ret + } + .method assembly static int32 CompareTo$cont@4(class assembly/Test1 this, class assembly/Test1 obj, class [FSharp.Core]Microsoft.FSharp.Core.Unit unitVar) cil managed @@ -1386,42 +1422,6 @@ IL_00ef: ret } - .method public static int32 select1(class assembly/Test1 x) cil managed - { - - .maxstack 8 - IL_0000: nop - IL_0001: ldarg.0 - IL_0002: call instance int32 assembly/Test1::get_Tag() - IL_0007: switch ( - IL_001c, - IL_0028, - IL_002a, - IL_002c) - IL_001c: ldarg.0 - IL_001d: castclass assembly/Test1/X11 - IL_0022: ldfld int32 assembly/Test1/X11::item - IL_0027: ret - - IL_0028: ldc.i4.2 - IL_0029: ret - - IL_002a: ldc.i4.3 - IL_002b: ret - - IL_002c: ldc.i4.4 - IL_002d: ret - } - - .method public static int32 fm(class assembly/Test1 y) cil managed - { - - .maxstack 8 - IL_0000: ldarg.0 - IL_0001: call int32 assembly::select1(class assembly/Test1) - IL_0006: ret - } - } .class private abstract auto ansi sealed ''.$assembly diff --git a/tests/FSharp.Compiler.ComponentTests/EmittedIL/Inlining/Match01.fs.il.netcore.release.bsl b/tests/FSharp.Compiler.ComponentTests/EmittedIL/Inlining/Match01.fs.il.netcore.release.bsl index c6444083260..986841f2ee8 100644 --- a/tests/FSharp.Compiler.ComponentTests/EmittedIL/Inlining/Match01.fs.il.netcore.release.bsl +++ b/tests/FSharp.Compiler.ComponentTests/EmittedIL/Inlining/Match01.fs.il.netcore.release.bsl @@ -1120,6 +1120,42 @@ } } + .method public static int32 select1(class assembly/Test1 x) cil managed + { + + .maxstack 8 + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: call instance int32 assembly/Test1::get_Tag() + IL_0007: switch ( + IL_001c, + IL_0028, + IL_002a, + IL_002c) + IL_001c: ldarg.0 + IL_001d: castclass assembly/Test1/X11 + IL_0022: ldfld int32 assembly/Test1/X11::item + IL_0027: ret + + IL_0028: ldc.i4.2 + IL_0029: ret + + IL_002a: ldc.i4.3 + IL_002b: ret + + IL_002c: ldc.i4.4 + IL_002d: ret + } + + .method public static int32 fm(class assembly/Test1 y) cil managed + { + + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: call int32 assembly::select1(class assembly/Test1) + IL_0006: ret + } + .method assembly static int32 CompareTo$cont@4(class assembly/Test1 this, class assembly/Test1 obj, class [FSharp.Core]Microsoft.FSharp.Core.Unit unitVar) cil managed @@ -1389,42 +1425,6 @@ IL_00fc: ret } - .method public static int32 select1(class assembly/Test1 x) cil managed - { - - .maxstack 8 - IL_0000: nop - IL_0001: ldarg.0 - IL_0002: call instance int32 assembly/Test1::get_Tag() - IL_0007: switch ( - IL_001c, - IL_0028, - IL_002a, - IL_002c) - IL_001c: ldarg.0 - IL_001d: castclass assembly/Test1/X11 - IL_0022: ldfld int32 assembly/Test1/X11::item - IL_0027: ret - - IL_0028: ldc.i4.2 - IL_0029: ret - - IL_002a: ldc.i4.3 - IL_002b: ret - - IL_002c: ldc.i4.4 - IL_002d: ret - } - - .method public static int32 fm(class assembly/Test1 y) cil managed - { - - .maxstack 8 - IL_0000: ldarg.0 - IL_0001: call int32 assembly::select1(class assembly/Test1) - IL_0006: ret - } - } .class private abstract auto ansi sealed ''.$assembly diff --git a/tests/FSharp.Compiler.ComponentTests/EmittedIL/TestFunctions/Verify13043.fs.il.debug.bsl b/tests/FSharp.Compiler.ComponentTests/EmittedIL/TestFunctions/Verify13043.fs.il.debug.bsl index db118790e53..a8adc2b9f6a 100644 --- a/tests/FSharp.Compiler.ComponentTests/EmittedIL/TestFunctions/Verify13043.fs.il.debug.bsl +++ b/tests/FSharp.Compiler.ComponentTests/EmittedIL/TestFunctions/Verify13043.fs.il.debug.bsl @@ -43,6 +43,82 @@ extends [runtime]System.Object { .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 07 00 00 00 00 00 ) + .class auto ansi serializable sealed nested assembly beforefieldinit matchResult@38 + extends class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2 + { + .field static assembly initonly class assembly/matchResult@38 @_instance + .method assembly specialname rtspecialname + instance void .ctor() cil managed + { + .custom instance void [runtime]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [runtime]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: call instance void class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2::.ctor() + IL_0006: ret + } + + .method public strict virtual instance bool + Invoke(int32 n) cil managed + { + + .maxstack 8 + IL_0000: ldarg.1 + IL_0001: call bool assembly::condition(int32) + IL_0006: ret + } + + .method private specialname rtspecialname static + void .cctor() cil managed + { + + .maxstack 10 + IL_0000: newobj instance void assembly/matchResult@38::.ctor() + IL_0005: stsfld class assembly/matchResult@38 assembly/matchResult@38::@_instance + IL_000a: ret + } + + } + + .class auto ansi serializable sealed nested assembly beforefieldinit functionResult@43 + extends class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2 + { + .field static assembly initonly class assembly/functionResult@43 @_instance + .method assembly specialname rtspecialname + instance void .ctor() cil managed + { + .custom instance void [runtime]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [runtime]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: call instance void class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2::.ctor() + IL_0006: ret + } + + .method public strict virtual instance bool + Invoke(int32 n) cil managed + { + + .maxstack 8 + IL_0000: ldarg.1 + IL_0001: call bool assembly::condition(int32) + IL_0006: ret + } + + .method private specialname rtspecialname static + void .cctor() cil managed + { + + .maxstack 10 + IL_0000: newobj instance void assembly/functionResult@43::.ctor() + IL_0005: stsfld class assembly/functionResult@43 assembly/functionResult@43::@_instance + IL_000a: ret + } + + } + .class auto ansi serializable sealed nested assembly beforefieldinit f@8 extends class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Collections.FSharpList`1> { @@ -177,82 +253,6 @@ } - .class auto ansi serializable sealed nested assembly beforefieldinit matchResult@38 - extends class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2 - { - .field static assembly initonly class assembly/matchResult@38 @_instance - .method assembly specialname rtspecialname - instance void .ctor() cil managed - { - .custom instance void [runtime]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - .custom instance void [runtime]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) - - .maxstack 8 - IL_0000: ldarg.0 - IL_0001: call instance void class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2::.ctor() - IL_0006: ret - } - - .method public strict virtual instance bool - Invoke(int32 n) cil managed - { - - .maxstack 8 - IL_0000: ldarg.1 - IL_0001: call bool assembly::condition(int32) - IL_0006: ret - } - - .method private specialname rtspecialname static - void .cctor() cil managed - { - - .maxstack 10 - IL_0000: newobj instance void assembly/matchResult@38::.ctor() - IL_0005: stsfld class assembly/matchResult@38 assembly/matchResult@38::@_instance - IL_000a: ret - } - - } - - .class auto ansi serializable sealed nested assembly beforefieldinit functionResult@43 - extends class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2 - { - .field static assembly initonly class assembly/functionResult@43 @_instance - .method assembly specialname rtspecialname - instance void .ctor() cil managed - { - .custom instance void [runtime]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - .custom instance void [runtime]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) - - .maxstack 8 - IL_0000: ldarg.0 - IL_0001: call instance void class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2::.ctor() - IL_0006: ret - } - - .method public strict virtual instance bool - Invoke(int32 n) cil managed - { - - .maxstack 8 - IL_0000: ldarg.1 - IL_0001: call bool assembly::condition(int32) - IL_0006: ret - } - - .method private specialname rtspecialname static - void .cctor() cil managed - { - - .maxstack 10 - IL_0000: newobj instance void assembly/functionResult@43::.ctor() - IL_0005: stsfld class assembly/functionResult@43 assembly/functionResult@43::@_instance - IL_000a: ret - } - - } - .method public specialname static class [FSharp.Core]Microsoft.FSharp.Collections.FSharpList`1 get_list() cil managed { diff --git a/tests/FSharp.Compiler.ComponentTests/EmittedIL/TestFunctions/Verify13043.fs.il.release.bsl b/tests/FSharp.Compiler.ComponentTests/EmittedIL/TestFunctions/Verify13043.fs.il.release.bsl index db118790e53..a8adc2b9f6a 100644 --- a/tests/FSharp.Compiler.ComponentTests/EmittedIL/TestFunctions/Verify13043.fs.il.release.bsl +++ b/tests/FSharp.Compiler.ComponentTests/EmittedIL/TestFunctions/Verify13043.fs.il.release.bsl @@ -43,6 +43,82 @@ extends [runtime]System.Object { .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 07 00 00 00 00 00 ) + .class auto ansi serializable sealed nested assembly beforefieldinit matchResult@38 + extends class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2 + { + .field static assembly initonly class assembly/matchResult@38 @_instance + .method assembly specialname rtspecialname + instance void .ctor() cil managed + { + .custom instance void [runtime]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [runtime]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: call instance void class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2::.ctor() + IL_0006: ret + } + + .method public strict virtual instance bool + Invoke(int32 n) cil managed + { + + .maxstack 8 + IL_0000: ldarg.1 + IL_0001: call bool assembly::condition(int32) + IL_0006: ret + } + + .method private specialname rtspecialname static + void .cctor() cil managed + { + + .maxstack 10 + IL_0000: newobj instance void assembly/matchResult@38::.ctor() + IL_0005: stsfld class assembly/matchResult@38 assembly/matchResult@38::@_instance + IL_000a: ret + } + + } + + .class auto ansi serializable sealed nested assembly beforefieldinit functionResult@43 + extends class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2 + { + .field static assembly initonly class assembly/functionResult@43 @_instance + .method assembly specialname rtspecialname + instance void .ctor() cil managed + { + .custom instance void [runtime]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [runtime]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: call instance void class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2::.ctor() + IL_0006: ret + } + + .method public strict virtual instance bool + Invoke(int32 n) cil managed + { + + .maxstack 8 + IL_0000: ldarg.1 + IL_0001: call bool assembly::condition(int32) + IL_0006: ret + } + + .method private specialname rtspecialname static + void .cctor() cil managed + { + + .maxstack 10 + IL_0000: newobj instance void assembly/functionResult@43::.ctor() + IL_0005: stsfld class assembly/functionResult@43 assembly/functionResult@43::@_instance + IL_000a: ret + } + + } + .class auto ansi serializable sealed nested assembly beforefieldinit f@8 extends class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Collections.FSharpList`1> { @@ -177,82 +253,6 @@ } - .class auto ansi serializable sealed nested assembly beforefieldinit matchResult@38 - extends class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2 - { - .field static assembly initonly class assembly/matchResult@38 @_instance - .method assembly specialname rtspecialname - instance void .ctor() cil managed - { - .custom instance void [runtime]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - .custom instance void [runtime]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) - - .maxstack 8 - IL_0000: ldarg.0 - IL_0001: call instance void class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2::.ctor() - IL_0006: ret - } - - .method public strict virtual instance bool - Invoke(int32 n) cil managed - { - - .maxstack 8 - IL_0000: ldarg.1 - IL_0001: call bool assembly::condition(int32) - IL_0006: ret - } - - .method private specialname rtspecialname static - void .cctor() cil managed - { - - .maxstack 10 - IL_0000: newobj instance void assembly/matchResult@38::.ctor() - IL_0005: stsfld class assembly/matchResult@38 assembly/matchResult@38::@_instance - IL_000a: ret - } - - } - - .class auto ansi serializable sealed nested assembly beforefieldinit functionResult@43 - extends class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2 - { - .field static assembly initonly class assembly/functionResult@43 @_instance - .method assembly specialname rtspecialname - instance void .ctor() cil managed - { - .custom instance void [runtime]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - .custom instance void [runtime]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) - - .maxstack 8 - IL_0000: ldarg.0 - IL_0001: call instance void class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2::.ctor() - IL_0006: ret - } - - .method public strict virtual instance bool - Invoke(int32 n) cil managed - { - - .maxstack 8 - IL_0000: ldarg.1 - IL_0001: call bool assembly::condition(int32) - IL_0006: ret - } - - .method private specialname rtspecialname static - void .cctor() cil managed - { - - .maxstack 10 - IL_0000: newobj instance void assembly/functionResult@43::.ctor() - IL_0005: stsfld class assembly/functionResult@43 assembly/functionResult@43::@_instance - IL_000a: ret - } - - } - .method public specialname static class [FSharp.Core]Microsoft.FSharp.Collections.FSharpList`1 get_list() cil managed { From 3915139251679825217913d7ca8d3cf16919e266 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Fri, 16 Jun 2023 22:29:00 +0200 Subject: [PATCH 22/45] making AbstractMemberNotAllowedInAugmentation for records an error --- src/Compiler/Checking/CheckDeclarations.fs | 4 ++-- .../StaticLet/StaticLetInUnionsAndRecords.fs | 16 ++++++++++++++-- 2 files changed, 16 insertions(+), 4 deletions(-) diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index 528fefba855..eb7bac2c956 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -4350,12 +4350,12 @@ module TcDeclarations = let members = [] let isAtOriginalTyconDefn = true let core = MutRecDefnsPhase1DataForTycon(synTyconInfo, repr, implements1, false, false, isAtOriginalTyconDefn) - core, members @ extraMembers + core, members @ extra_vals_Inherits_Abstractslots @ extraMembers | SynTypeDefnRepr.Exception r -> let isAtOriginalTyconDefn = true let core = MutRecDefnsPhase1DataForTycon(synTyconInfo, SynTypeDefnSimpleRepr.Exception r, implements1, false, false, isAtOriginalTyconDefn) - core, extraMembers + core, extra_vals_Inherits_Abstractslots @ extraMembers //------------------------------------------------------------------------- diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StaticLetInUnionsAndRecords.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StaticLetInUnionsAndRecords.fs index b1549e882c4..ebe5c177f18 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StaticLetInUnionsAndRecords.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StaticLetInUnionsAndRecords.fs @@ -28,7 +28,7 @@ let ``Should fail in F# 7 and lower`` (implFileName:string) = [] [] [] -let ``Member val regression - not allowed without primary constructor`` (langVersion:string) = +let ``Regression in Member val - not allowed without primary constructor`` (langVersion:string) = Fs """module Test type Bad3 = member val X = 1 + 1 """ @@ -41,7 +41,7 @@ type Bad3 = [] [] [] -let ``Type augmentation with abstract slot not allowed`` (langVersion:string) = +let ``Regression - Type augmentation with abstract slot not allowed`` (langVersion:string) = Fs """module Test type System.Random with abstract M : int -> int @@ -51,6 +51,18 @@ type System.Random with |> shouldFail |> withDiagnostics [Error 912, Line 3, Col 8, Line 3, Col 31, "This declaration element is not permitted in an augmentation"] +[] +[] +[] +let ``Regression - record with abstract slot not allowed`` (langVersion:string) = + Fs """module Test +type myRecord2 = { field1: int; field2: string } + with abstract member AbstractMemberNotAllowedInAugmentation : string -> string end """ + |> withLangVersion langVersion + |> typecheck + |> shouldFail + |> withDiagnostics [Error 912, Line 3, Col 8, Line 3, Col 81, "This declaration element is not permitted in an augmentation"] + let verifyCompileAndRun compilation = compilation |> withLangVersionPreview From 935d81193ef4f113286b9de92a5cb5c637d1927e Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Fri, 16 Jun 2023 22:39:02 +0200 Subject: [PATCH 23/45] handle errors from both .fs and .fsi in a single test --- .../Conformance/BasicGrammarElements/LetBindings/Basic/Basic.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/LetBindings/Basic/Basic.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/LetBindings/Basic/Basic.fs index a639d2dfa3f..33eff4235d1 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/LetBindings/Basic/Basic.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/LetBindings/Basic/Basic.fs @@ -118,7 +118,7 @@ module LetBindings_Basic = let ``E_Literals02_fsi`` compilation = compilation |> withAdditionalSourceFile (SourceFromPath (__SOURCE_DIRECTORY__ ++"E_Literals02.fs")) - |> verifyCompile + |> typecheck |> shouldFail |> withDiagnostics [ (Error 876, Line 12, Col 1, Line 13, Col 18, "A declaration may only be the [] attribute if a constant value is also given, e.g. 'val x: int = 1'") From 097a7421b7e9a55163a4afe2a40c19c7fbdbbad8 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Fri, 16 Jun 2023 22:53:53 +0200 Subject: [PATCH 24/45] remove empty line --- src/Compiler/FSComp.txt | 1 - 1 file changed, 1 deletion(-) diff --git a/src/Compiler/FSComp.txt b/src/Compiler/FSComp.txt index f79c48b16f9..2e0b6caac81 100644 --- a/src/Compiler/FSComp.txt +++ b/src/Compiler/FSComp.txt @@ -1700,4 +1700,3 @@ featureStaticLetInRecordsDusEmptyTypes,"Allow static let bindings in union, reco 3566,tcMultipleRecdTypeChoice,"Multiple type matches were found:\n%s\nThe type '%s' was used. Due to the overlapping field names\n%s\nconsider using type annotations or change the order of open statements." 3567,parsMissingMemberBody,"Expecting member body" 3568,tcStaticBindingInExtrinsicAugmentation,"Static bindings cannot be added to extrinsic augmentations. Consider using a 'static member' instead." - From 235f9051487042911043043689181f564a6104bc Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Fri, 16 Jun 2023 22:58:17 +0200 Subject: [PATCH 25/45] .fsproj clean (no idea how it came to be) --- .../FSharp.Compiler.ComponentTests.fsproj | 23 +------------------ 1 file changed, 1 insertion(+), 22 deletions(-) diff --git a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj index baa27eba2fb..a1c2866d660 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj +++ b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj @@ -273,28 +273,7 @@ - - - - - - - - - - - - - - - - - - - - - @@ -310,5 +289,5 @@ - + From c8987add2d9b08c7c86158411ee86fe9bafba36f Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Mon, 19 Jun 2023 13:25:08 +0200 Subject: [PATCH 26/45] IL test fixup --- src/Compiler/Facilities/LanguageFeatures.fs | 1 - .../TestFunctions/Verify13043.fs.il.debug.bsl | 152 +++++++++--------- 2 files changed, 76 insertions(+), 77 deletions(-) diff --git a/src/Compiler/Facilities/LanguageFeatures.fs b/src/Compiler/Facilities/LanguageFeatures.fs index f76701f985f..632d58fb764 100644 --- a/src/Compiler/Facilities/LanguageFeatures.fs +++ b/src/Compiler/Facilities/LanguageFeatures.fs @@ -296,7 +296,6 @@ type LanguageVersion(versionText) = | LanguageFeature.StaticLetInRecordsDusEmptyTypes -> FSComp.SR.featureStaticLetInRecordsDusEmptyTypes () | LanguageFeature.StrictIndentation -> FSComp.SR.featureStrictIndentation () - /// Get a version string associated with the given feature. static member GetFeatureVersionString feature = match features.TryGetValue feature with diff --git a/tests/FSharp.Compiler.ComponentTests/EmittedIL/TestFunctions/Verify13043.fs.il.debug.bsl b/tests/FSharp.Compiler.ComponentTests/EmittedIL/TestFunctions/Verify13043.fs.il.debug.bsl index a8adc2b9f6a..db118790e53 100644 --- a/tests/FSharp.Compiler.ComponentTests/EmittedIL/TestFunctions/Verify13043.fs.il.debug.bsl +++ b/tests/FSharp.Compiler.ComponentTests/EmittedIL/TestFunctions/Verify13043.fs.il.debug.bsl @@ -43,82 +43,6 @@ extends [runtime]System.Object { .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 07 00 00 00 00 00 ) - .class auto ansi serializable sealed nested assembly beforefieldinit matchResult@38 - extends class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2 - { - .field static assembly initonly class assembly/matchResult@38 @_instance - .method assembly specialname rtspecialname - instance void .ctor() cil managed - { - .custom instance void [runtime]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - .custom instance void [runtime]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) - - .maxstack 8 - IL_0000: ldarg.0 - IL_0001: call instance void class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2::.ctor() - IL_0006: ret - } - - .method public strict virtual instance bool - Invoke(int32 n) cil managed - { - - .maxstack 8 - IL_0000: ldarg.1 - IL_0001: call bool assembly::condition(int32) - IL_0006: ret - } - - .method private specialname rtspecialname static - void .cctor() cil managed - { - - .maxstack 10 - IL_0000: newobj instance void assembly/matchResult@38::.ctor() - IL_0005: stsfld class assembly/matchResult@38 assembly/matchResult@38::@_instance - IL_000a: ret - } - - } - - .class auto ansi serializable sealed nested assembly beforefieldinit functionResult@43 - extends class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2 - { - .field static assembly initonly class assembly/functionResult@43 @_instance - .method assembly specialname rtspecialname - instance void .ctor() cil managed - { - .custom instance void [runtime]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - .custom instance void [runtime]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) - - .maxstack 8 - IL_0000: ldarg.0 - IL_0001: call instance void class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2::.ctor() - IL_0006: ret - } - - .method public strict virtual instance bool - Invoke(int32 n) cil managed - { - - .maxstack 8 - IL_0000: ldarg.1 - IL_0001: call bool assembly::condition(int32) - IL_0006: ret - } - - .method private specialname rtspecialname static - void .cctor() cil managed - { - - .maxstack 10 - IL_0000: newobj instance void assembly/functionResult@43::.ctor() - IL_0005: stsfld class assembly/functionResult@43 assembly/functionResult@43::@_instance - IL_000a: ret - } - - } - .class auto ansi serializable sealed nested assembly beforefieldinit f@8 extends class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Collections.FSharpList`1> { @@ -253,6 +177,82 @@ } + .class auto ansi serializable sealed nested assembly beforefieldinit matchResult@38 + extends class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2 + { + .field static assembly initonly class assembly/matchResult@38 @_instance + .method assembly specialname rtspecialname + instance void .ctor() cil managed + { + .custom instance void [runtime]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [runtime]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: call instance void class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2::.ctor() + IL_0006: ret + } + + .method public strict virtual instance bool + Invoke(int32 n) cil managed + { + + .maxstack 8 + IL_0000: ldarg.1 + IL_0001: call bool assembly::condition(int32) + IL_0006: ret + } + + .method private specialname rtspecialname static + void .cctor() cil managed + { + + .maxstack 10 + IL_0000: newobj instance void assembly/matchResult@38::.ctor() + IL_0005: stsfld class assembly/matchResult@38 assembly/matchResult@38::@_instance + IL_000a: ret + } + + } + + .class auto ansi serializable sealed nested assembly beforefieldinit functionResult@43 + extends class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2 + { + .field static assembly initonly class assembly/functionResult@43 @_instance + .method assembly specialname rtspecialname + instance void .ctor() cil managed + { + .custom instance void [runtime]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [runtime]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: call instance void class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2::.ctor() + IL_0006: ret + } + + .method public strict virtual instance bool + Invoke(int32 n) cil managed + { + + .maxstack 8 + IL_0000: ldarg.1 + IL_0001: call bool assembly::condition(int32) + IL_0006: ret + } + + .method private specialname rtspecialname static + void .cctor() cil managed + { + + .maxstack 10 + IL_0000: newobj instance void assembly/functionResult@43::.ctor() + IL_0005: stsfld class assembly/functionResult@43 assembly/functionResult@43::@_instance + IL_000a: ret + } + + } + .method public specialname static class [FSharp.Core]Microsoft.FSharp.Collections.FSharpList`1 get_list() cil managed { From 26d6316cee665d8aa9b3c691a989290f9c728bfe Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Mon, 19 Jun 2023 13:25:23 +0200 Subject: [PATCH 27/45] IL test fixup --- .../Inlining/Match01.fs.il.net472.debug.bsl | 72 +++++++++---------- 1 file changed, 36 insertions(+), 36 deletions(-) diff --git a/tests/FSharp.Compiler.ComponentTests/EmittedIL/Inlining/Match01.fs.il.net472.debug.bsl b/tests/FSharp.Compiler.ComponentTests/EmittedIL/Inlining/Match01.fs.il.net472.debug.bsl index 45ba3be6216..06514590ac1 100644 --- a/tests/FSharp.Compiler.ComponentTests/EmittedIL/Inlining/Match01.fs.il.net472.debug.bsl +++ b/tests/FSharp.Compiler.ComponentTests/EmittedIL/Inlining/Match01.fs.il.net472.debug.bsl @@ -1125,42 +1125,6 @@ } } - .method public static int32 select1(class assembly/Test1 x) cil managed - { - - .maxstack 8 - IL_0000: nop - IL_0001: ldarg.0 - IL_0002: call instance int32 assembly/Test1::get_Tag() - IL_0007: switch ( - IL_001c, - IL_0028, - IL_002a, - IL_002c) - IL_001c: ldarg.0 - IL_001d: castclass assembly/Test1/X11 - IL_0022: ldfld int32 assembly/Test1/X11::item - IL_0027: ret - - IL_0028: ldc.i4.2 - IL_0029: ret - - IL_002a: ldc.i4.3 - IL_002b: ret - - IL_002c: ldc.i4.4 - IL_002d: ret - } - - .method public static int32 fm(class assembly/Test1 y) cil managed - { - - .maxstack 8 - IL_0000: ldarg.0 - IL_0001: call int32 assembly::select1(class assembly/Test1) - IL_0006: ret - } - .method assembly static int32 CompareTo$cont@4(class assembly/Test1 this, class assembly/Test1 obj, class [FSharp.Core]Microsoft.FSharp.Core.Unit unitVar) cil managed @@ -1422,6 +1386,42 @@ IL_00ef: ret } + .method public static int32 select1(class assembly/Test1 x) cil managed + { + + .maxstack 8 + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: call instance int32 assembly/Test1::get_Tag() + IL_0007: switch ( + IL_001c, + IL_0028, + IL_002a, + IL_002c) + IL_001c: ldarg.0 + IL_001d: castclass assembly/Test1/X11 + IL_0022: ldfld int32 assembly/Test1/X11::item + IL_0027: ret + + IL_0028: ldc.i4.2 + IL_0029: ret + + IL_002a: ldc.i4.3 + IL_002b: ret + + IL_002c: ldc.i4.4 + IL_002d: ret + } + + .method public static int32 fm(class assembly/Test1 y) cil managed + { + + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: call int32 assembly::select1(class assembly/Test1) + IL_0006: ret + } + } .class private abstract auto ansi sealed ''.$assembly From d3a109b2647fff0fa814143cf265b53394465895 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Mon, 19 Jun 2023 13:25:36 +0200 Subject: [PATCH 28/45] xx --- .../Inlining/Match01.fs.il.netcore.debug.bsl | 72 +++++++++---------- 1 file changed, 36 insertions(+), 36 deletions(-) diff --git a/tests/FSharp.Compiler.ComponentTests/EmittedIL/Inlining/Match01.fs.il.netcore.debug.bsl b/tests/FSharp.Compiler.ComponentTests/EmittedIL/Inlining/Match01.fs.il.netcore.debug.bsl index 9f7c89bc0ad..a26af5e534a 100644 --- a/tests/FSharp.Compiler.ComponentTests/EmittedIL/Inlining/Match01.fs.il.netcore.debug.bsl +++ b/tests/FSharp.Compiler.ComponentTests/EmittedIL/Inlining/Match01.fs.il.netcore.debug.bsl @@ -1125,42 +1125,6 @@ } } - .method public static int32 select1(class assembly/Test1 x) cil managed - { - - .maxstack 8 - IL_0000: nop - IL_0001: ldarg.0 - IL_0002: call instance int32 assembly/Test1::get_Tag() - IL_0007: switch ( - IL_001c, - IL_0028, - IL_002a, - IL_002c) - IL_001c: ldarg.0 - IL_001d: castclass assembly/Test1/X11 - IL_0022: ldfld int32 assembly/Test1/X11::item - IL_0027: ret - - IL_0028: ldc.i4.2 - IL_0029: ret - - IL_002a: ldc.i4.3 - IL_002b: ret - - IL_002c: ldc.i4.4 - IL_002d: ret - } - - .method public static int32 fm(class assembly/Test1 y) cil managed - { - - .maxstack 8 - IL_0000: ldarg.0 - IL_0001: call int32 assembly::select1(class assembly/Test1) - IL_0006: ret - } - .method assembly static int32 CompareTo$cont@4(class assembly/Test1 this, class assembly/Test1 obj, class [FSharp.Core]Microsoft.FSharp.Core.Unit unitVar) cil managed @@ -1422,6 +1386,42 @@ IL_00ef: ret } + .method public static int32 select1(class assembly/Test1 x) cil managed + { + + .maxstack 8 + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: call instance int32 assembly/Test1::get_Tag() + IL_0007: switch ( + IL_001c, + IL_0028, + IL_002a, + IL_002c) + IL_001c: ldarg.0 + IL_001d: castclass assembly/Test1/X11 + IL_0022: ldfld int32 assembly/Test1/X11::item + IL_0027: ret + + IL_0028: ldc.i4.2 + IL_0029: ret + + IL_002a: ldc.i4.3 + IL_002b: ret + + IL_002c: ldc.i4.4 + IL_002d: ret + } + + .method public static int32 fm(class assembly/Test1 y) cil managed + { + + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: call int32 assembly::select1(class assembly/Test1) + IL_0006: ret + } + } .class private abstract auto ansi sealed ''.$assembly From 5b4d5b85088bfcc59700d15b9a1d55225c2aaa27 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Mon, 19 Jun 2023 13:32:32 +0200 Subject: [PATCH 29/45] Release IL fixup --- .../Inlining/Match01.fs.il.net472.release.bsl | 72 ++++----- .../Verify13043.fs.il.release.bsl | 152 +++++++++--------- 2 files changed, 112 insertions(+), 112 deletions(-) diff --git a/tests/FSharp.Compiler.ComponentTests/EmittedIL/Inlining/Match01.fs.il.net472.release.bsl b/tests/FSharp.Compiler.ComponentTests/EmittedIL/Inlining/Match01.fs.il.net472.release.bsl index 13e4c61843e..6b5629b9317 100644 --- a/tests/FSharp.Compiler.ComponentTests/EmittedIL/Inlining/Match01.fs.il.net472.release.bsl +++ b/tests/FSharp.Compiler.ComponentTests/EmittedIL/Inlining/Match01.fs.il.net472.release.bsl @@ -1120,42 +1120,6 @@ } } - .method public static int32 select1(class assembly/Test1 x) cil managed - { - - .maxstack 8 - IL_0000: nop - IL_0001: ldarg.0 - IL_0002: call instance int32 assembly/Test1::get_Tag() - IL_0007: switch ( - IL_001c, - IL_0028, - IL_002a, - IL_002c) - IL_001c: ldarg.0 - IL_001d: castclass assembly/Test1/X11 - IL_0022: ldfld int32 assembly/Test1/X11::item - IL_0027: ret - - IL_0028: ldc.i4.2 - IL_0029: ret - - IL_002a: ldc.i4.3 - IL_002b: ret - - IL_002c: ldc.i4.4 - IL_002d: ret - } - - .method public static int32 fm(class assembly/Test1 y) cil managed - { - - .maxstack 8 - IL_0000: ldarg.0 - IL_0001: call int32 assembly::select1(class assembly/Test1) - IL_0006: ret - } - .method assembly static int32 CompareTo$cont@4(class assembly/Test1 this, class assembly/Test1 obj, class [FSharp.Core]Microsoft.FSharp.Core.Unit unitVar) cil managed @@ -1425,6 +1389,42 @@ IL_00fc: ret } + .method public static int32 select1(class assembly/Test1 x) cil managed + { + + .maxstack 8 + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: call instance int32 assembly/Test1::get_Tag() + IL_0007: switch ( + IL_001c, + IL_0028, + IL_002a, + IL_002c) + IL_001c: ldarg.0 + IL_001d: castclass assembly/Test1/X11 + IL_0022: ldfld int32 assembly/Test1/X11::item + IL_0027: ret + + IL_0028: ldc.i4.2 + IL_0029: ret + + IL_002a: ldc.i4.3 + IL_002b: ret + + IL_002c: ldc.i4.4 + IL_002d: ret + } + + .method public static int32 fm(class assembly/Test1 y) cil managed + { + + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: call int32 assembly::select1(class assembly/Test1) + IL_0006: ret + } + } .class private abstract auto ansi sealed ''.$assembly diff --git a/tests/FSharp.Compiler.ComponentTests/EmittedIL/TestFunctions/Verify13043.fs.il.release.bsl b/tests/FSharp.Compiler.ComponentTests/EmittedIL/TestFunctions/Verify13043.fs.il.release.bsl index a8adc2b9f6a..db118790e53 100644 --- a/tests/FSharp.Compiler.ComponentTests/EmittedIL/TestFunctions/Verify13043.fs.il.release.bsl +++ b/tests/FSharp.Compiler.ComponentTests/EmittedIL/TestFunctions/Verify13043.fs.il.release.bsl @@ -43,82 +43,6 @@ extends [runtime]System.Object { .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 07 00 00 00 00 00 ) - .class auto ansi serializable sealed nested assembly beforefieldinit matchResult@38 - extends class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2 - { - .field static assembly initonly class assembly/matchResult@38 @_instance - .method assembly specialname rtspecialname - instance void .ctor() cil managed - { - .custom instance void [runtime]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - .custom instance void [runtime]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) - - .maxstack 8 - IL_0000: ldarg.0 - IL_0001: call instance void class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2::.ctor() - IL_0006: ret - } - - .method public strict virtual instance bool - Invoke(int32 n) cil managed - { - - .maxstack 8 - IL_0000: ldarg.1 - IL_0001: call bool assembly::condition(int32) - IL_0006: ret - } - - .method private specialname rtspecialname static - void .cctor() cil managed - { - - .maxstack 10 - IL_0000: newobj instance void assembly/matchResult@38::.ctor() - IL_0005: stsfld class assembly/matchResult@38 assembly/matchResult@38::@_instance - IL_000a: ret - } - - } - - .class auto ansi serializable sealed nested assembly beforefieldinit functionResult@43 - extends class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2 - { - .field static assembly initonly class assembly/functionResult@43 @_instance - .method assembly specialname rtspecialname - instance void .ctor() cil managed - { - .custom instance void [runtime]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) - .custom instance void [runtime]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) - - .maxstack 8 - IL_0000: ldarg.0 - IL_0001: call instance void class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2::.ctor() - IL_0006: ret - } - - .method public strict virtual instance bool - Invoke(int32 n) cil managed - { - - .maxstack 8 - IL_0000: ldarg.1 - IL_0001: call bool assembly::condition(int32) - IL_0006: ret - } - - .method private specialname rtspecialname static - void .cctor() cil managed - { - - .maxstack 10 - IL_0000: newobj instance void assembly/functionResult@43::.ctor() - IL_0005: stsfld class assembly/functionResult@43 assembly/functionResult@43::@_instance - IL_000a: ret - } - - } - .class auto ansi serializable sealed nested assembly beforefieldinit f@8 extends class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2,class [FSharp.Core]Microsoft.FSharp.Collections.FSharpList`1> { @@ -253,6 +177,82 @@ } + .class auto ansi serializable sealed nested assembly beforefieldinit matchResult@38 + extends class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2 + { + .field static assembly initonly class assembly/matchResult@38 @_instance + .method assembly specialname rtspecialname + instance void .ctor() cil managed + { + .custom instance void [runtime]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [runtime]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: call instance void class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2::.ctor() + IL_0006: ret + } + + .method public strict virtual instance bool + Invoke(int32 n) cil managed + { + + .maxstack 8 + IL_0000: ldarg.1 + IL_0001: call bool assembly::condition(int32) + IL_0006: ret + } + + .method private specialname rtspecialname static + void .cctor() cil managed + { + + .maxstack 10 + IL_0000: newobj instance void assembly/matchResult@38::.ctor() + IL_0005: stsfld class assembly/matchResult@38 assembly/matchResult@38::@_instance + IL_000a: ret + } + + } + + .class auto ansi serializable sealed nested assembly beforefieldinit functionResult@43 + extends class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2 + { + .field static assembly initonly class assembly/functionResult@43 @_instance + .method assembly specialname rtspecialname + instance void .ctor() cil managed + { + .custom instance void [runtime]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [runtime]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: call instance void class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2::.ctor() + IL_0006: ret + } + + .method public strict virtual instance bool + Invoke(int32 n) cil managed + { + + .maxstack 8 + IL_0000: ldarg.1 + IL_0001: call bool assembly::condition(int32) + IL_0006: ret + } + + .method private specialname rtspecialname static + void .cctor() cil managed + { + + .maxstack 10 + IL_0000: newobj instance void assembly/functionResult@43::.ctor() + IL_0005: stsfld class assembly/functionResult@43 assembly/functionResult@43::@_instance + IL_000a: ret + } + + } + .method public specialname static class [FSharp.Core]Microsoft.FSharp.Collections.FSharpList`1 get_list() cil managed { From add7eaef4b6aa8a1d9a56779edde993bec6090e9 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Mon, 19 Jun 2023 13:33:58 +0200 Subject: [PATCH 30/45] error code update --- .../StaticLet/StaticLetInUnionsAndRecords.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StaticLetInUnionsAndRecords.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StaticLetInUnionsAndRecords.fs index ebe5c177f18..5f39ed74e98 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StaticLetInUnionsAndRecords.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StaticLetInUnionsAndRecords.fs @@ -227,7 +227,7 @@ let ``Static let extension to builtin type`` compilation = compilation |> typecheck |> shouldFail - |> withDiagnostics [Error 3567, Line 4, Col 5, Line 4, Col 51, "Static bindings cannot be added to extrinsic augmentations. Consider using a 'static member' instead."] + |> withDiagnostics [Error 3568, Line 4, Col 5, Line 4, Col 51, "Static bindings cannot be added to extrinsic augmentations. Consider using a 'static member' instead."] [] let ``Static let - quotations support for records`` compilation = From 6573da6d147d685bd134a6c74ba816934344c6c8 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Mon, 19 Jun 2023 13:35:32 +0200 Subject: [PATCH 31/45] error code fix --- .../Match01.fs.il.netcore.release.bsl | 72 +++++++++---------- tests/fsharp/typecheck/sigs/neg46.bsl | 8 +-- 2 files changed, 40 insertions(+), 40 deletions(-) diff --git a/tests/FSharp.Compiler.ComponentTests/EmittedIL/Inlining/Match01.fs.il.netcore.release.bsl b/tests/FSharp.Compiler.ComponentTests/EmittedIL/Inlining/Match01.fs.il.netcore.release.bsl index 986841f2ee8..c6444083260 100644 --- a/tests/FSharp.Compiler.ComponentTests/EmittedIL/Inlining/Match01.fs.il.netcore.release.bsl +++ b/tests/FSharp.Compiler.ComponentTests/EmittedIL/Inlining/Match01.fs.il.netcore.release.bsl @@ -1120,42 +1120,6 @@ } } - .method public static int32 select1(class assembly/Test1 x) cil managed - { - - .maxstack 8 - IL_0000: nop - IL_0001: ldarg.0 - IL_0002: call instance int32 assembly/Test1::get_Tag() - IL_0007: switch ( - IL_001c, - IL_0028, - IL_002a, - IL_002c) - IL_001c: ldarg.0 - IL_001d: castclass assembly/Test1/X11 - IL_0022: ldfld int32 assembly/Test1/X11::item - IL_0027: ret - - IL_0028: ldc.i4.2 - IL_0029: ret - - IL_002a: ldc.i4.3 - IL_002b: ret - - IL_002c: ldc.i4.4 - IL_002d: ret - } - - .method public static int32 fm(class assembly/Test1 y) cil managed - { - - .maxstack 8 - IL_0000: ldarg.0 - IL_0001: call int32 assembly::select1(class assembly/Test1) - IL_0006: ret - } - .method assembly static int32 CompareTo$cont@4(class assembly/Test1 this, class assembly/Test1 obj, class [FSharp.Core]Microsoft.FSharp.Core.Unit unitVar) cil managed @@ -1425,6 +1389,42 @@ IL_00fc: ret } + .method public static int32 select1(class assembly/Test1 x) cil managed + { + + .maxstack 8 + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: call instance int32 assembly/Test1::get_Tag() + IL_0007: switch ( + IL_001c, + IL_0028, + IL_002a, + IL_002c) + IL_001c: ldarg.0 + IL_001d: castclass assembly/Test1/X11 + IL_0022: ldfld int32 assembly/Test1/X11::item + IL_0027: ret + + IL_0028: ldc.i4.2 + IL_0029: ret + + IL_002a: ldc.i4.3 + IL_002b: ret + + IL_002c: ldc.i4.4 + IL_002d: ret + } + + .method public static int32 fm(class assembly/Test1 y) cil managed + { + + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: call int32 assembly::select1(class assembly/Test1) + IL_0006: ret + } + } .class private abstract auto ansi sealed ''.$assembly diff --git a/tests/fsharp/typecheck/sigs/neg46.bsl b/tests/fsharp/typecheck/sigs/neg46.bsl index aa8968e4ea0..403fbc6dcf1 100644 --- a/tests/fsharp/typecheck/sigs/neg46.bsl +++ b/tests/fsharp/typecheck/sigs/neg46.bsl @@ -1,13 +1,13 @@ neg46.fs(6,8,6,26): typecheck error FS0912: This declaration element is not permitted in an augmentation -neg46.fs(10,8,10,40): typecheck error FS3567: Static bindings cannot be added to extrinsic augmentations. Consider using a 'static member' instead. +neg46.fs(10,8,10,40): typecheck error FS3568: Static bindings cannot be added to extrinsic augmentations. Consider using a 'static member' instead. -neg46.fs(14,8,14,26): typecheck error FS3567: Static bindings cannot be added to extrinsic augmentations. Consider using a 'static member' instead. +neg46.fs(14,8,14,26): typecheck error FS3568: Static bindings cannot be added to extrinsic augmentations. Consider using a 'static member' instead. -neg46.fs(18,8,19,21): typecheck error FS3567: Static bindings cannot be added to extrinsic augmentations. Consider using a 'static member' instead. +neg46.fs(18,8,19,21): typecheck error FS3568: Static bindings cannot be added to extrinsic augmentations. Consider using a 'static member' instead. -neg46.fs(23,8,23,32): typecheck error FS3567: Static bindings cannot be added to extrinsic augmentations. Consider using a 'static member' instead. +neg46.fs(23,8,23,32): typecheck error FS3568: Static bindings cannot be added to extrinsic augmentations. Consider using a 'static member' instead. neg46.fs(27,8,27,25): typecheck error FS0912: This declaration element is not permitted in an augmentation From 4ccd656be0e5d0a3e5167f72f8c5c904909f579a Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Mon, 19 Jun 2023 13:52:08 +0200 Subject: [PATCH 32/45] baseline - typar generalization. Notice how the previous baseline was having the same duplicate message two times. --- tests/fsharp/typecheck/sigs/neg04.bsl | 10 ++-------- 1 file changed, 2 insertions(+), 8 deletions(-) diff --git a/tests/fsharp/typecheck/sigs/neg04.bsl b/tests/fsharp/typecheck/sigs/neg04.bsl index 3630185c4ba..88ae776c8ca 100644 --- a/tests/fsharp/typecheck/sigs/neg04.bsl +++ b/tests/fsharp/typecheck/sigs/neg04.bsl @@ -34,12 +34,6 @@ The type ''a seq' does not match the type ''n list' neg04.fs(47,49,47,51): typecheck error FS0784: This numeric literal requires that a module 'NumericLiteralN' defining functions FromZero, FromOne, FromInt32, FromInt64 and FromString be in scope -neg04.fs(47,30,47,51): typecheck error FS0001: Type mismatch. Expecting a - ''a seq -> 'n' -but given a - ''o list -> 'p' -The type ''a seq' does not match the type ''n list' - neg04.fs(61,25,61,40): typecheck error FS0001: This expression was expected to have type 'ClassType1' but here has type @@ -51,7 +45,7 @@ neg04.fs(70,21,70,36): typecheck error FS0064: This construct causes code to be neg04.fs(70,12,70,14): typecheck error FS0663: This type parameter has been used in a way that constrains it to always be 'c' -neg04.fs(70,21,70,36): typecheck error FS0698: Invalid constraint: the type used for the constraint is sealed, which means the constraint could only be satisfied by at most one solution +neg04.fs(70,12,70,14): typecheck error FS0660: This code is less generic than required by its annotations because the explicit type variable 'a' could not be generalized. It was constrained to be 'c'. neg04.fs(76,19,76,26): typecheck error FS0698: Invalid constraint: the type used for the constraint is sealed, which means the constraint could only be satisfied by at most one solution @@ -59,7 +53,7 @@ neg04.fs(76,19,76,26): typecheck error FS0064: This construct causes code to be neg04.fs(76,10,76,12): typecheck error FS0663: This type parameter has been used in a way that constrains it to always be 'd' -neg04.fs(76,19,76,26): typecheck error FS0698: Invalid constraint: the type used for the constraint is sealed, which means the constraint could only be satisfied by at most one solution +neg04.fs(76,10,76,12): typecheck error FS0660: This code is less generic than required by its annotations because the explicit type variable 'a' could not be generalized. It was constrained to be 'd'. neg04.fs(81,58,81,61): typecheck error FS0001: This expression was expected to have type 'int' From b4968fcbde95b1069cff8e2e8f82992f7edeecbf Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Mon, 19 Jun 2023 17:34:28 +0200 Subject: [PATCH 33/45] Fixing typeprovider tests --- src/Compiler/Checking/CheckDeclarations.fs | 2 +- tests/fsharp/FSharpSuite.Tests.fsproj | 2 ++ 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index eb7bac2c956..e5a80f03b0a 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -884,7 +884,7 @@ module MutRecBindingChecking = // ideally we'd have the 'm' of the type declaration stored here, to avoid needing to trim to line to approx error(Error(FSComp.SR.tcTypeAbbreviationsMayNotHaveMembers(), (trimRangeToLine m))) - if tcref.IsEnumTycon && (declKind <> ExtrinsicExtensionBinding) then + if tcref.IsEnumTycon && (declKind <> ExtrinsicExtensionBinding) && classMemberDef.IsSome then // ideally we'd have the 'm' of the type declaration stored here, to avoid needing to trim to line to approx error(Error(FSComp.SR.tcEnumerationsMayNotHaveMembers(), (trimRangeToLine m))) diff --git a/tests/fsharp/FSharpSuite.Tests.fsproj b/tests/fsharp/FSharpSuite.Tests.fsproj index cc369a10b0b..f42e5b0de45 100644 --- a/tests/fsharp/FSharpSuite.Tests.fsproj +++ b/tests/fsharp/FSharpSuite.Tests.fsproj @@ -108,6 +108,8 @@ false + + From bf7be00de866093e56fc7de9129002a6a1aae71b Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Mon, 19 Jun 2023 18:57:39 +0200 Subject: [PATCH 34/45] Trying to resolve 'here was a mismatch between the processor architecture of the project being built "MSIL"' --- tests/fsharp/FSharpSuite.Tests.fsproj | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/fsharp/FSharpSuite.Tests.fsproj b/tests/fsharp/FSharpSuite.Tests.fsproj index f42e5b0de45..8dd86c95e40 100644 --- a/tests/fsharp/FSharpSuite.Tests.fsproj +++ b/tests/fsharp/FSharpSuite.Tests.fsproj @@ -108,8 +108,8 @@ false - - + + From bdeb26f247c75ad5a682d438109df7b5364e611f Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Mon, 19 Jun 2023 19:23:25 +0200 Subject: [PATCH 35/45] one more atempt --- tests/fsharp/FSharpSuite.Tests.fsproj | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/fsharp/FSharpSuite.Tests.fsproj b/tests/fsharp/FSharpSuite.Tests.fsproj index 8dd86c95e40..ff2f82ae49e 100644 --- a/tests/fsharp/FSharpSuite.Tests.fsproj +++ b/tests/fsharp/FSharpSuite.Tests.fsproj @@ -108,8 +108,8 @@ false - - + + From 11c1cb1804bfb8f6ace378c089b5c1d7c6ff1f51 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Tue, 20 Jun 2023 10:31:15 +0200 Subject: [PATCH 36/45] PR feedback --- src/Compiler/AbstractIL/il.fs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/Compiler/AbstractIL/il.fs b/src/Compiler/AbstractIL/il.fs index b438cc1d79d..adb892d7cb4 100644 --- a/src/Compiler/AbstractIL/il.fs +++ b/src/Compiler/AbstractIL/il.fs @@ -1464,7 +1464,8 @@ type ILLocalDebugInfo = } override x.ToString() = - (fst x.Range).ToString() + "-" + (snd x.Range).ToString() + let firstLabel,secondLabel = x.Range + sprintf "%i-%i" firstLabel secondLabel [] type ILCode = From ccae157dda89713ca65fc04a08121a298bcbd87c Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Tue, 20 Jun 2023 11:22:45 +0200 Subject: [PATCH 37/45] fantomas whitespace --- src/Compiler/AbstractIL/il.fs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Compiler/AbstractIL/il.fs b/src/Compiler/AbstractIL/il.fs index adb892d7cb4..2c96d10f528 100644 --- a/src/Compiler/AbstractIL/il.fs +++ b/src/Compiler/AbstractIL/il.fs @@ -1464,8 +1464,8 @@ type ILLocalDebugInfo = } override x.ToString() = - let firstLabel,secondLabel = x.Range - sprintf "%i-%i" firstLabel secondLabel + let firstLabel, secondLabel = x.Range + sprintf "%i-%i" firstLabel secondLabel [] type ILCode = From d66f1a7b77f1cf0e740abad1cd9a8089f4733288 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Tue, 20 Jun 2023 11:45:20 +0200 Subject: [PATCH 38/45] multi-file static init test added --- .../StaticLet/LowercaseDuTest.fs | 16 +++++ .../StaticLet/StaticLetInUnionsAndRecords.fs | 72 +++++++++++++++++++ 2 files changed, 88 insertions(+) create mode 100644 tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/LowercaseDuTest.fs diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/LowercaseDuTest.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/LowercaseDuTest.fs new file mode 100644 index 00000000000..bd726a9d60b --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/LowercaseDuTest.fs @@ -0,0 +1,16 @@ +module Test + +[] +type DU = + | an of int + | B of string + | C + | ``D`` of bool + | ``d`` + + + static do printfn "I am here" + + static let cachedVals = [| DU.an 42; DU.``d`` |] + + static member GetValsAsString() = sprintf "%A" cachedVals \ No newline at end of file diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StaticLetInUnionsAndRecords.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StaticLetInUnionsAndRecords.fs index 5f39ed74e98..c7aa6c676a9 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StaticLetInUnionsAndRecords.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StaticLetInUnionsAndRecords.fs @@ -92,6 +92,13 @@ init R 2 1 2""" +[] +let ``Static let - lowercase DU`` compilation = + compilation + |> withLangVersionPreview + |> typecheck + |> shouldSucceed + [] let ``Static let in empty type`` compilation = compilation @@ -303,4 +310,69 @@ let ``Static let record - generics - IL test`` compilation = IL_0011: ldsfld string class Test/MyRecord`1::cachedVal IL_0016: ret } """] + + +[] +let ``Static let in DU in penultimate file`` () = + // This file is included in the compilation, but its types are not access => statics are not executed + let firstFile = """ +module TypesWhichAreNotAccessed + +do printfn "TypesWhichAreNotAccessed module 'do'" + +type NotAccessedType = + | Case19 + | Case40 of int + + static do printfn "NotAccessedType 'do'" + + +""" + + let types = + """ +module MyTypes + +do printfn "MyTypes module 'do'" + +type U = + | Case1 + | Case2 of int + + static do printfn "MyTypes.U 'do'" + static let u1 = + do printfn "creating MyTypes.U.u1 now" + Case2 1 + static member U1 = u1 + + +do printfn "MyTypes module 'do' no. 2" + +module InnerModuleNotAccess = + do printfn "InnerModuleNotAccess 'do'" + let someVal = "" + """ + + let program = + """ +module Test + +[] +let main _ = + do printfn "Before static access" + let u1 = MyTypes.U.U1 + printfn "%A" u1 + 0 + """ + + FSharp firstFile + |> withAdditionalSourceFiles [SourceCodeFileKind.Create("types.fs", types);SourceCodeFileKind.Create("program.fs", program)] + |> verifyCompileAndRun + |> withStdOutContains """Before static access +MyTypes module 'do' +MyTypes.U 'do' +creating MyTypes.U.u1 now +MyTypes module 'do' no. 2 +InnerModuleNotAccess 'do' +Case2 1""" \ No newline at end of file From d51ca8b9b5a3465ac1bdc66b81002f4bc2f2f747 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Tue, 20 Jun 2023 11:56:46 +0200 Subject: [PATCH 39/45] PR feedback --- src/Compiler/Checking/CheckDeclarations.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index 3bf419f341b..ab2c8a2a8ba 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -745,7 +745,7 @@ module MutRecBindingChecking = /// Represents one element in a type definition, after the first phase type TyconBindingPhase2A = - /// An entry corresponding to the definition of the implicit constructor for a class + /// An entry corresponding to the definition of the static constructor of a class and optional of the incremental constructor (if one exists) | Phase2AIncrClassCtor of StaticCtorInfo * IncrClassCtorInfo option /// An 'inherit' declaration in an incremental class From 64a7e41fef601f91e291fb3cb19acba657078669 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Tue, 20 Jun 2023 15:39:46 +0200 Subject: [PATCH 40/45] Raise error if Fsharp.Core is compiled with features that need new pickle state (establish a new precedenc for that) --- src/Compiler/FSComp.txt | 1 + src/Compiler/TypedTree/TypedTreePickle.fs | 20 ++++++++++++++++---- src/Compiler/xlf/FSComp.txt.cs.xlf | 5 +++++ src/Compiler/xlf/FSComp.txt.de.xlf | 5 +++++ src/Compiler/xlf/FSComp.txt.es.xlf | 5 +++++ src/Compiler/xlf/FSComp.txt.fr.xlf | 5 +++++ src/Compiler/xlf/FSComp.txt.it.xlf | 5 +++++ src/Compiler/xlf/FSComp.txt.ja.xlf | 5 +++++ src/Compiler/xlf/FSComp.txt.ko.xlf | 5 +++++ src/Compiler/xlf/FSComp.txt.pl.xlf | 5 +++++ src/Compiler/xlf/FSComp.txt.pt-BR.xlf | 5 +++++ src/Compiler/xlf/FSComp.txt.ru.xlf | 5 +++++ src/Compiler/xlf/FSComp.txt.tr.xlf | 5 +++++ src/Compiler/xlf/FSComp.txt.zh-Hans.xlf | 5 +++++ src/Compiler/xlf/FSComp.txt.zh-Hant.xlf | 5 +++++ 15 files changed, 82 insertions(+), 4 deletions(-) diff --git a/src/Compiler/FSComp.txt b/src/Compiler/FSComp.txt index ea95fe71b66..5fd5685a134 100644 --- a/src/Compiler/FSComp.txt +++ b/src/Compiler/FSComp.txt @@ -1700,3 +1700,4 @@ featureStaticLetInRecordsDusEmptyTypes,"Allow static let bindings in union, reco 3566,tcMultipleRecdTypeChoice,"Multiple type matches were found:\n%s\nThe type '%s' was used. Due to the overlapping field names\n%s\nconsider using type annotations or change the order of open statements." 3567,parsMissingMemberBody,"Expecting member body" 3568,tcStaticBindingInExtrinsicAugmentation,"Static bindings cannot be added to extrinsic augmentations. Consider using a 'static member' instead." +3569,pickleFsharpCoreBackwardsCompatible,"Newly added pickle state cannot be used in FSharp.Core, since it must be working in older compilers+tooling as well. The time window is at least 3 years after feature introduction. Violation: %s . Context: \n %s " diff --git a/src/Compiler/TypedTree/TypedTreePickle.fs b/src/Compiler/TypedTree/TypedTreePickle.fs index 42bdb90c394..ef32a880016 100644 --- a/src/Compiler/TypedTree/TypedTreePickle.fs +++ b/src/Compiler/TypedTree/TypedTreePickle.fs @@ -1812,9 +1812,15 @@ let rec p_tycon_repr x st = false // Unions with static fields, added to format - | TFSharpTyconRepr ({ fsobjmodel_cases = x; fsobjmodel_kind = TFSharpUnion } as r) -> + | TFSharpTyconRepr ({ fsobjmodel_cases = cases; fsobjmodel_kind = TFSharpUnion } as r) -> + if st.oglobals.compilingFSharpCore then + let fields = r.fsobjmodel_rfields.FieldsByIndex + let firstFieldRange = fields[0].DefinitionRange + let allFieldsText = fields |> Array.map (fun f -> f.LogicalName) |> String.concat System.Environment.NewLine + errorR(Error(FSComp.SR.pickleFsharpCoreBackwardsCompatible("fields in union",allFieldsText), firstFieldRange)) + p_byte 2 st - p_array p_unioncase_spec x.CasesTable.CasesByIndex st + p_array p_unioncase_spec cases.CasesTable.CasesByIndex st p_tycon_objmodel_data r st false @@ -1989,8 +1995,14 @@ and p_tycon_objmodel_kind x st = | TFSharpStruct -> p_byte 2 st | TFSharpDelegate ss -> p_byte 3 st; p_slotsig ss st | TFSharpEnum -> p_byte 4 st - | TFSharpUnion -> p_byte 5 st - | TFSharpRecord -> p_byte 6 st + | TFSharpUnion -> + if st.oglobals.compilingFSharpCore then + errorR(Error(FSComp.SR.pickleFsharpCoreBackwardsCompatible("union as FSharpTyconKind ",st.ofile), range.Zero)) + p_byte 5 st + | TFSharpRecord -> + if st.oglobals.compilingFSharpCore then + errorR(Error(FSComp.SR.pickleFsharpCoreBackwardsCompatible("record as FSharpTyconKind ",st.ofile), range.Zero)) + p_byte 6 st and p_vrefFlags x st = match x with diff --git a/src/Compiler/xlf/FSComp.txt.cs.xlf b/src/Compiler/xlf/FSComp.txt.cs.xlf index d1da9102177..048cbd1da75 100644 --- a/src/Compiler/xlf/FSComp.txt.cs.xlf +++ b/src/Compiler/xlf/FSComp.txt.cs.xlf @@ -862,6 +862,11 @@ Algoritmus {0} není podporovaný. + + Newly added pickle state cannot be used in FSharp.Core, since it must be working in older compilers+tooling as well. The time window is at least 3 years after feature introduction. Violation: {0} . Context: \n {1} + Newly added pickle state cannot be used in FSharp.Core, since it must be working in older compilers+tooling as well. The time window is at least 3 years after feature introduction. Violation: {0} . Context: \n {1} + + A constrained generic construct occured in the resumable code specification Ve specifikaci obnovitelného kódu došlo k omezené obecné konstrukci. diff --git a/src/Compiler/xlf/FSComp.txt.de.xlf b/src/Compiler/xlf/FSComp.txt.de.xlf index 92d6b058bd0..7ee079bd8f6 100644 --- a/src/Compiler/xlf/FSComp.txt.de.xlf +++ b/src/Compiler/xlf/FSComp.txt.de.xlf @@ -862,6 +862,11 @@ Algorithmus "{0}" wird nicht unterstützt + + Newly added pickle state cannot be used in FSharp.Core, since it must be working in older compilers+tooling as well. The time window is at least 3 years after feature introduction. Violation: {0} . Context: \n {1} + Newly added pickle state cannot be used in FSharp.Core, since it must be working in older compilers+tooling as well. The time window is at least 3 years after feature introduction. Violation: {0} . Context: \n {1} + + A constrained generic construct occured in the resumable code specification In der fortsetzbaren Codespezifikation ist ein eingeschränktes generisches Konstrukt aufgetreten. diff --git a/src/Compiler/xlf/FSComp.txt.es.xlf b/src/Compiler/xlf/FSComp.txt.es.xlf index 410bc4bbcbf..9335c05b8bb 100644 --- a/src/Compiler/xlf/FSComp.txt.es.xlf +++ b/src/Compiler/xlf/FSComp.txt.es.xlf @@ -862,6 +862,11 @@ No se admite el algoritmo '{0}' + + Newly added pickle state cannot be used in FSharp.Core, since it must be working in older compilers+tooling as well. The time window is at least 3 years after feature introduction. Violation: {0} . Context: \n {1} + Newly added pickle state cannot be used in FSharp.Core, since it must be working in older compilers+tooling as well. The time window is at least 3 years after feature introduction. Violation: {0} . Context: \n {1} + + A constrained generic construct occured in the resumable code specification En la especificación del código resumible aparecía una construcción genérica restringida diff --git a/src/Compiler/xlf/FSComp.txt.fr.xlf b/src/Compiler/xlf/FSComp.txt.fr.xlf index 8d10c4f026d..7cfea11f7db 100644 --- a/src/Compiler/xlf/FSComp.txt.fr.xlf +++ b/src/Compiler/xlf/FSComp.txt.fr.xlf @@ -862,6 +862,11 @@ Algorithme '{0}' non pris en charge + + Newly added pickle state cannot be used in FSharp.Core, since it must be working in older compilers+tooling as well. The time window is at least 3 years after feature introduction. Violation: {0} . Context: \n {1} + Newly added pickle state cannot be used in FSharp.Core, since it must be working in older compilers+tooling as well. The time window is at least 3 years after feature introduction. Violation: {0} . Context: \n {1} + + A constrained generic construct occured in the resumable code specification Une construction générique contrainte s'est produite dans la spécification de code de reprise diff --git a/src/Compiler/xlf/FSComp.txt.it.xlf b/src/Compiler/xlf/FSComp.txt.it.xlf index 9a3b79c36c3..1212ef66921 100644 --- a/src/Compiler/xlf/FSComp.txt.it.xlf +++ b/src/Compiler/xlf/FSComp.txt.it.xlf @@ -862,6 +862,11 @@ L'algoritmo '{0}' non è supportato + + Newly added pickle state cannot be used in FSharp.Core, since it must be working in older compilers+tooling as well. The time window is at least 3 years after feature introduction. Violation: {0} . Context: \n {1} + Newly added pickle state cannot be used in FSharp.Core, since it must be working in older compilers+tooling as well. The time window is at least 3 years after feature introduction. Violation: {0} . Context: \n {1} + + A constrained generic construct occured in the resumable code specification Costrutto generico vincolato nella specifica del codice ripristinabile diff --git a/src/Compiler/xlf/FSComp.txt.ja.xlf b/src/Compiler/xlf/FSComp.txt.ja.xlf index d2ebb9095fb..08ffe93c5b0 100644 --- a/src/Compiler/xlf/FSComp.txt.ja.xlf +++ b/src/Compiler/xlf/FSComp.txt.ja.xlf @@ -862,6 +862,11 @@ アルゴリズム '{0}' はサポートされていません + + Newly added pickle state cannot be used in FSharp.Core, since it must be working in older compilers+tooling as well. The time window is at least 3 years after feature introduction. Violation: {0} . Context: \n {1} + Newly added pickle state cannot be used in FSharp.Core, since it must be working in older compilers+tooling as well. The time window is at least 3 years after feature introduction. Violation: {0} . Context: \n {1} + + A constrained generic construct occured in the resumable code specification 再開可能なコード指定で制約付きジェネリック コンストラクトが発生しました diff --git a/src/Compiler/xlf/FSComp.txt.ko.xlf b/src/Compiler/xlf/FSComp.txt.ko.xlf index 070070798b8..c0f046e3076 100644 --- a/src/Compiler/xlf/FSComp.txt.ko.xlf +++ b/src/Compiler/xlf/FSComp.txt.ko.xlf @@ -862,6 +862,11 @@ {0}' 알고리즘은 지원되지 않습니다. + + Newly added pickle state cannot be used in FSharp.Core, since it must be working in older compilers+tooling as well. The time window is at least 3 years after feature introduction. Violation: {0} . Context: \n {1} + Newly added pickle state cannot be used in FSharp.Core, since it must be working in older compilers+tooling as well. The time window is at least 3 years after feature introduction. Violation: {0} . Context: \n {1} + + A constrained generic construct occured in the resumable code specification 다시 시작 가능한 코드 사양에서 제약이 있는 제네릭 구문이 발생했습니다. diff --git a/src/Compiler/xlf/FSComp.txt.pl.xlf b/src/Compiler/xlf/FSComp.txt.pl.xlf index acaaf888a54..04e6d9beb64 100644 --- a/src/Compiler/xlf/FSComp.txt.pl.xlf +++ b/src/Compiler/xlf/FSComp.txt.pl.xlf @@ -862,6 +862,11 @@ Algorytm „{0}” nie jest obsługiwany + + Newly added pickle state cannot be used in FSharp.Core, since it must be working in older compilers+tooling as well. The time window is at least 3 years after feature introduction. Violation: {0} . Context: \n {1} + Newly added pickle state cannot be used in FSharp.Core, since it must be working in older compilers+tooling as well. The time window is at least 3 years after feature introduction. Violation: {0} . Context: \n {1} + + A constrained generic construct occured in the resumable code specification W specyfikacji kodu z możliwością wznowienia wystąpiła ograniczona konstrukcja ogólna diff --git a/src/Compiler/xlf/FSComp.txt.pt-BR.xlf b/src/Compiler/xlf/FSComp.txt.pt-BR.xlf index 50eb80cd7ee..b70321fdca0 100644 --- a/src/Compiler/xlf/FSComp.txt.pt-BR.xlf +++ b/src/Compiler/xlf/FSComp.txt.pt-BR.xlf @@ -862,6 +862,11 @@ Algoritmo '{0}' sem suporte + + Newly added pickle state cannot be used in FSharp.Core, since it must be working in older compilers+tooling as well. The time window is at least 3 years after feature introduction. Violation: {0} . Context: \n {1} + Newly added pickle state cannot be used in FSharp.Core, since it must be working in older compilers+tooling as well. The time window is at least 3 years after feature introduction. Violation: {0} . Context: \n {1} + + A constrained generic construct occured in the resumable code specification Um constructo genérico restrito ocorreu na especificação de código retomável diff --git a/src/Compiler/xlf/FSComp.txt.ru.xlf b/src/Compiler/xlf/FSComp.txt.ru.xlf index 809b1d53439..29f3cac0716 100644 --- a/src/Compiler/xlf/FSComp.txt.ru.xlf +++ b/src/Compiler/xlf/FSComp.txt.ru.xlf @@ -862,6 +862,11 @@ Алгоритм "{0}" не поддерживается + + Newly added pickle state cannot be used in FSharp.Core, since it must be working in older compilers+tooling as well. The time window is at least 3 years after feature introduction. Violation: {0} . Context: \n {1} + Newly added pickle state cannot be used in FSharp.Core, since it must be working in older compilers+tooling as well. The time window is at least 3 years after feature introduction. Violation: {0} . Context: \n {1} + + A constrained generic construct occured in the resumable code specification В спецификации возобновляемого кода возникла ограниченная универсальная конструкция diff --git a/src/Compiler/xlf/FSComp.txt.tr.xlf b/src/Compiler/xlf/FSComp.txt.tr.xlf index a4861271224..3f33aa66381 100644 --- a/src/Compiler/xlf/FSComp.txt.tr.xlf +++ b/src/Compiler/xlf/FSComp.txt.tr.xlf @@ -862,6 +862,11 @@ {0}' algoritması desteklenmiyor + + Newly added pickle state cannot be used in FSharp.Core, since it must be working in older compilers+tooling as well. The time window is at least 3 years after feature introduction. Violation: {0} . Context: \n {1} + Newly added pickle state cannot be used in FSharp.Core, since it must be working in older compilers+tooling as well. The time window is at least 3 years after feature introduction. Violation: {0} . Context: \n {1} + + A constrained generic construct occured in the resumable code specification Sürdürülebilir kod belirtiminde kısıtlanmış bir genel yapı oluştu diff --git a/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf b/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf index 13b531dfc2f..ca6cfa002d9 100644 --- a/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf +++ b/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf @@ -862,6 +862,11 @@ 不支持算法“{0}” + + Newly added pickle state cannot be used in FSharp.Core, since it must be working in older compilers+tooling as well. The time window is at least 3 years after feature introduction. Violation: {0} . Context: \n {1} + Newly added pickle state cannot be used in FSharp.Core, since it must be working in older compilers+tooling as well. The time window is at least 3 years after feature introduction. Violation: {0} . Context: \n {1} + + A constrained generic construct occured in the resumable code specification 可恢复代码规范中发生受约束的泛型构造 diff --git a/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf b/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf index ab9a1c67317..5af20cd322c 100644 --- a/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf +++ b/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf @@ -862,6 +862,11 @@ 不支援演算法 '{0}' + + Newly added pickle state cannot be used in FSharp.Core, since it must be working in older compilers+tooling as well. The time window is at least 3 years after feature introduction. Violation: {0} . Context: \n {1} + Newly added pickle state cannot be used in FSharp.Core, since it must be working in older compilers+tooling as well. The time window is at least 3 years after feature introduction. Violation: {0} . Context: \n {1} + + A constrained generic construct occured in the resumable code specification 可繼續的程式碼規格中出現了限制式泛型建構 From 7a7b83a9484629c3fb4fe3b73a09160dbad81bb8 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Wed, 21 Jun 2023 13:19:12 +0200 Subject: [PATCH 41/45] Hard fail pickling when fsharp.core uses new constructs --- src/Compiler/TypedTree/TypedTreePickle.fs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/Compiler/TypedTree/TypedTreePickle.fs b/src/Compiler/TypedTree/TypedTreePickle.fs index ef32a880016..c99beeb9f2d 100644 --- a/src/Compiler/TypedTree/TypedTreePickle.fs +++ b/src/Compiler/TypedTree/TypedTreePickle.fs @@ -1796,6 +1796,7 @@ let u_cpath st = let rec p_tycon_repr x st = // The leading "p_byte 1" and "p_byte 0" come from the F# 2.0 format, which used an option value at this point. + match x with // Records | TFSharpTyconRepr { fsobjmodel_rfields = fs; fsobjmodel_kind = TFSharpRecord } -> @@ -1817,7 +1818,7 @@ let rec p_tycon_repr x st = let fields = r.fsobjmodel_rfields.FieldsByIndex let firstFieldRange = fields[0].DefinitionRange let allFieldsText = fields |> Array.map (fun f -> f.LogicalName) |> String.concat System.Environment.NewLine - errorR(Error(FSComp.SR.pickleFsharpCoreBackwardsCompatible("fields in union",allFieldsText), firstFieldRange)) + raise (Error(FSComp.SR.pickleFsharpCoreBackwardsCompatible("fields in union",allFieldsText), firstFieldRange)) p_byte 2 st p_array p_unioncase_spec cases.CasesTable.CasesByIndex st @@ -1997,11 +1998,11 @@ and p_tycon_objmodel_kind x st = | TFSharpEnum -> p_byte 4 st | TFSharpUnion -> if st.oglobals.compilingFSharpCore then - errorR(Error(FSComp.SR.pickleFsharpCoreBackwardsCompatible("union as FSharpTyconKind ",st.ofile), range.Zero)) + raise (Error(FSComp.SR.pickleFsharpCoreBackwardsCompatible("union as FSharpTyconKind ",st.ofile), range.Zero)) p_byte 5 st | TFSharpRecord -> if st.oglobals.compilingFSharpCore then - errorR(Error(FSComp.SR.pickleFsharpCoreBackwardsCompatible("record as FSharpTyconKind ",st.ofile), range.Zero)) + raise (Error(FSComp.SR.pickleFsharpCoreBackwardsCompatible("record as FSharpTyconKind ",st.ofile), range.Zero)) p_byte 6 st and p_vrefFlags x st = From 80071cecf5da798386135a02559cfbfab1812181 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Mon, 26 Jun 2023 11:12:08 +0200 Subject: [PATCH 42/45] IL tests for static let init --- .../StaticLet/StaticLetInUnionsAndRecords.fs | 185 +++++++++++++++++- 1 file changed, 184 insertions(+), 1 deletion(-) diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StaticLetInUnionsAndRecords.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StaticLetInUnionsAndRecords.fs index c7aa6c676a9..6c8db9e7b72 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StaticLetInUnionsAndRecords.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StaticLetInUnionsAndRecords.fs @@ -375,4 +375,187 @@ creating MyTypes.U.u1 now MyTypes module 'do' no. 2 InnerModuleNotAccess 'do' Case2 1""" - \ No newline at end of file + + +[] +let ``Static let IL init single file test`` () = + FSharp """ +module Test +open System + +do Console.WriteLine("module before type") +[] +type X = + static do Console.WriteLine("from type") +do Console.WriteLine("module after type") +""" + |> withLangVersionPreview + |> compile + |> shouldSucceed + |> verifyIL [""" +.class public abstract auto ansi sealed Test + extends [runtime]System.Object +{ + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 07 00 00 00 00 00 ) + .class auto ansi serializable nested public X + extends [runtime]System.Object + { + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.NoEqualityAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.NoComparisonAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 03 00 00 00 00 00 ) + .method private specialname rtspecialname static + void .cctor() cil managed + { + + .maxstack 8 + IL_0000: ldc.i4.0 + IL_0001: stsfld int32 ''.$Test::init@ + IL_0006: ldsfld int32 ''.$Test::init@ + IL_000b: pop + IL_000c: ret + } + + } + +} + +.class private abstract auto ansi sealed ''.$Test + extends [runtime]System.Object +{ + .field static assembly int32 init@ + .custom instance void [runtime]System.Diagnostics.DebuggerBrowsableAttribute::.ctor(valuetype [runtime]System.Diagnostics.DebuggerBrowsableState) = ( 01 00 00 00 00 00 00 00 ) + .custom instance void [runtime]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [runtime]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + .method private specialname rtspecialname static + void .cctor() cil managed + { + + .maxstack 8 + IL_0000: ldstr "module before type" + IL_0005: call void [runtime]System.Console::WriteLine(string) + IL_000a: ldstr "from type" + IL_000f: call void [runtime]System.Console::WriteLine(string) + IL_0014: ldstr "module after type" + IL_0019: call void [runtime]System.Console::WriteLine(string) + IL_001e: ret + } + +}"""] + +[] +let ``Static let in penultimate file IL test`` () = + let types = """ +namespace MyTypes +open System + +[] +type X = + static do Console.WriteLine("from type") + static let mutable x_value = 42 + static member GetX = x_value + +""" + + let program = """ +module ProgramMain +open System +Console.Write(MyTypes.X.GetX) +""" + + FSharp types + |> withAdditionalSourceFiles [SourceCodeFileKind.Create("program.fs", program)] + |> withLangVersionPreview + |> compile + |> shouldSucceed + |> verifyIL [""" +.class public auto ansi serializable MyTypes.X + extends [runtime]System.Object +{ + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.NoEqualityAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.NoComparisonAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 03 00 00 00 00 00 ) + .field static assembly int32 x_value + .field static assembly int32 init@6 + .method public specialname static int32 + get_GetX() cil managed + { + + .maxstack 8 + IL_0000: volatile. + IL_0002: ldsfld int32 MyTypes.X::init@6 + IL_0007: ldc.i4.0 + IL_0008: bge.s IL_0011 + + IL_000a: call void [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/IntrinsicFunctions::FailStaticInit() + IL_000f: br.s IL_0011 + + IL_0011: ldsfld int32 MyTypes.X::x_value + IL_0016: ret + } + + .method private specialname rtspecialname static + void .cctor() cil managed + { + + .maxstack 8 + IL_0000: ldc.i4.0 + IL_0001: stsfld int32 ''.$Test::init@ + IL_0006: ldsfld int32 ''.$Test::init@ + IL_000b: pop + IL_000c: ret + } + + .property int32 GetX() + { + .get int32 MyTypes.X::get_GetX() + } +} + +.class public abstract auto ansi sealed ProgramMain + extends [runtime]System.Object +{ + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 07 00 00 00 00 00 ) +} + +.class private abstract auto ansi sealed ''.$ProgramMain + extends [runtime]System.Object +{ + .field static assembly int32 init@ + .custom instance void [runtime]System.Diagnostics.DebuggerBrowsableAttribute::.ctor(valuetype [runtime]System.Diagnostics.DebuggerBrowsableState) = ( 01 00 00 00 00 00 00 00 ) + .custom instance void [runtime]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [runtime]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + .method private specialname rtspecialname static + void .cctor() cil managed + { + + .maxstack 8 + IL_0000: call int32 MyTypes.X::get_GetX() + IL_0005: call void [runtime]System.Console::Write(int32) + IL_000a: ret + } + +} + +.class private abstract auto ansi sealed ''.$Test + extends [runtime]System.Object +{ + .field static assembly int32 init@ + .custom instance void [runtime]System.Diagnostics.DebuggerBrowsableAttribute::.ctor(valuetype [runtime]System.Diagnostics.DebuggerBrowsableState) = ( 01 00 00 00 00 00 00 00 ) + .custom instance void [runtime]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [runtime]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + .method private specialname rtspecialname static + void .cctor() cil managed + { + + .maxstack 8 + IL_0000: ldstr "from type" + IL_0005: call void [runtime]System.Console::WriteLine(string) + IL_000a: ldc.i4.s 42 + IL_000c: stsfld int32 MyTypes.X::x_value + IL_0011: ldc.i4.0 + IL_0012: volatile. + IL_0014: stsfld int32 MyTypes.X::init@6 + IL_0019: ret + } + +}"""] \ No newline at end of file From aaff4ba24b1c8cf4d988ecb5c90f7c59bb23e378 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Mon, 26 Jun 2023 11:19:33 +0200 Subject: [PATCH 43/45] change error code --- .../StaticLet/StaticLetInUnionsAndRecords.fs | 2 +- tests/fsharp/typecheck/sigs/neg46.bsl | 8 ++++---- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StaticLetInUnionsAndRecords.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StaticLetInUnionsAndRecords.fs index 6c8db9e7b72..1a40189bb9e 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StaticLetInUnionsAndRecords.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/StaticLet/StaticLetInUnionsAndRecords.fs @@ -234,7 +234,7 @@ let ``Static let extension to builtin type`` compilation = compilation |> typecheck |> shouldFail - |> withDiagnostics [Error 3568, Line 4, Col 5, Line 4, Col 51, "Static bindings cannot be added to extrinsic augmentations. Consider using a 'static member' instead."] + |> withDiagnostics [Error 3570, Line 4, Col 5, Line 4, Col 51, "Static bindings cannot be added to extrinsic augmentations. Consider using a 'static member' instead."] [] let ``Static let - quotations support for records`` compilation = diff --git a/tests/fsharp/typecheck/sigs/neg46.bsl b/tests/fsharp/typecheck/sigs/neg46.bsl index 403fbc6dcf1..fbe970a68a5 100644 --- a/tests/fsharp/typecheck/sigs/neg46.bsl +++ b/tests/fsharp/typecheck/sigs/neg46.bsl @@ -1,13 +1,13 @@ neg46.fs(6,8,6,26): typecheck error FS0912: This declaration element is not permitted in an augmentation -neg46.fs(10,8,10,40): typecheck error FS3568: Static bindings cannot be added to extrinsic augmentations. Consider using a 'static member' instead. +neg46.fs(10,8,10,40): typecheck error FS3570: Static bindings cannot be added to extrinsic augmentations. Consider using a 'static member' instead. -neg46.fs(14,8,14,26): typecheck error FS3568: Static bindings cannot be added to extrinsic augmentations. Consider using a 'static member' instead. +neg46.fs(14,8,14,26): typecheck error FS3570: Static bindings cannot be added to extrinsic augmentations. Consider using a 'static member' instead. -neg46.fs(18,8,19,21): typecheck error FS3568: Static bindings cannot be added to extrinsic augmentations. Consider using a 'static member' instead. +neg46.fs(18,8,19,21): typecheck error FS3570: Static bindings cannot be added to extrinsic augmentations. Consider using a 'static member' instead. -neg46.fs(23,8,23,32): typecheck error FS3568: Static bindings cannot be added to extrinsic augmentations. Consider using a 'static member' instead. +neg46.fs(23,8,23,32): typecheck error FS3570: Static bindings cannot be added to extrinsic augmentations. Consider using a 'static member' instead. neg46.fs(27,8,27,25): typecheck error FS0912: This declaration element is not permitted in an augmentation From a730ec0ce5c610159893c6b307252de2f09f17da Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Wed, 19 Jul 2023 17:19:44 +0200 Subject: [PATCH 44/45] whitespace formatting --- src/Compiler/Facilities/LanguageFeatures.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Compiler/Facilities/LanguageFeatures.fs b/src/Compiler/Facilities/LanguageFeatures.fs index 7b4bf617452..b925a00c686 100644 --- a/src/Compiler/Facilities/LanguageFeatures.fs +++ b/src/Compiler/Facilities/LanguageFeatures.fs @@ -165,7 +165,7 @@ type LanguageVersion(versionText) = LanguageFeature.ExtendedStringInterpolation, previewVersion LanguageFeature.WarningWhenMultipleRecdTypeChoice, previewVersion LanguageFeature.ImprovedImpliedArgumentNames, previewVersion - LanguageFeature.DiagnosticForObjInference, previewVersion + LanguageFeature.DiagnosticForObjInference, previewVersion LanguageFeature.WarningWhenTailRecAttributeButNonTailRecUsage, previewVersion LanguageFeature.StaticLetInRecordsDusEmptyTypes, previewVersion LanguageFeature.StrictIndentation, previewVersion From c68b86d447e4c21babd114e7d0af340af7640e07 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Wed, 19 Jul 2023 18:00:48 +0200 Subject: [PATCH 45/45] fixing build --- src/Compiler/Checking/CheckDeclarations.fs | 2 +- src/Compiler/Checking/SignatureHash.fs | 18 +++++++++--------- 2 files changed, 10 insertions(+), 10 deletions(-) diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index 470c8259127..c9ce1584086 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -951,7 +951,7 @@ module MutRecBindingChecking = let innerState = (incrCtorInfoOpt, envForTycon, tpenv, recBindIdx, uncheckedBindsRev) [Phase2AIncrClassBindings (tcref, letBinds, isStatic, isRec, m)], innerState - | Some (SynMemberDefn.Member(SynBinding(headPat = SynPat.Wild _; expr = SynExpr.ArbitraryAfterError _), _)), _ -> + | Some (SynMemberDefn.Member(SynBinding(headPat = SynPat.Wild _; expr = SynExpr.ArbitraryAfterError _), _)), _ | Some (SynMemberDefn.Member(SynBinding(headPat = SynPat.FromParseError(SynPat.Wild _, _)), _)), _ -> [], innerState diff --git a/src/Compiler/Checking/SignatureHash.fs b/src/Compiler/Checking/SignatureHash.fs index 351e2f7a14a..2193f4325b5 100644 --- a/src/Compiler/Checking/SignatureHash.fs +++ b/src/Compiler/Checking/SignatureHash.fs @@ -413,15 +413,15 @@ module TyconDefinitionHash = let specializedHash = match repr with - | TFSharpRecdRepr _ -> fieldsHash () - | TFSharpUnionRepr _ -> hashUnionCases (g, observer) tycon.UnionCasesArray - | TFSharpObjectRepr { - fsobjmodel_kind = TFSharpDelegate slotSig - } -> hashFsharpDelegate g slotSig - | TFSharpObjectRepr { fsobjmodel_kind = TFSharpEnum } -> hashFsharpEnum tycon - | TFSharpObjectRepr { - fsobjmodel_kind = TFSharpClass | TFSharpInterface | TFSharpStruct as tfor - } -> + | TFSharpTyconRepr { fsobjmodel_kind = TFSharpRecord } -> fieldsHash () + | TFSharpTyconRepr { fsobjmodel_kind = TFSharpUnion } -> hashUnionCases (g, observer) tycon.UnionCasesArray + | TFSharpTyconRepr { + fsobjmodel_kind = TFSharpDelegate slotSig + } -> hashFsharpDelegate g slotSig + | TFSharpTyconRepr { fsobjmodel_kind = TFSharpEnum } -> hashFsharpEnum tycon + | TFSharpTyconRepr { + fsobjmodel_kind = TFSharpClass | TFSharpInterface | TFSharpStruct as tfor + } -> iimplsHash () @@ fieldsHash () @@ membersHash () @@ inheritsHash () |> pipeToHash ( match tfor with