diff --git a/src/fsharp/IlxGen.fs b/src/fsharp/IlxGen.fs index 3c8ac06ee1f..09750c4f32d 100644 --- a/src/fsharp/IlxGen.fs +++ b/src/fsharp/IlxGen.fs @@ -1356,57 +1356,65 @@ type AssemblyBuilder(cenv: cenv, anonTypeTable: AnonTypeGenerationTable) as mgbu let generateAnonType genToStringMethod (isStruct, ilTypeRef, nms) = - let flds = [ for (i, nm) in Array.indexed nms -> (nm, nm + "@", ILType.TypeVar (uint16 i)) ] + let propTys = [ for (i, nm) in Array.indexed nms -> nm, ILType.TypeVar (uint16 i) ] + // Note that this alternative below would give the same names as C#, but the generated // comparison/equality doesn't know about these names. //let flds = [ for (i, nm) in Array.indexed nms -> (nm, "<" + nm + ">" + "i__Field", ILType.TypeVar (uint16 i)) ] + let ilCtorRef = mkILMethRef(ilTypeRef, ILCallingConv.Instance, ".ctor", 0, List.map snd propTys, ILType.Void) - let ilGenericParams = - [ for nm in nms -> - { Name = sprintf "<%s>j__TPar" nm - Constraints = [] - Variance=NonVariant - CustomAttrsStored = storeILCustomAttrs emptyILCustomAttrs - HasReferenceTypeConstraint=false - HasNotNullableValueTypeConstraint=false - HasDefaultConstructorConstraint= false - MetadataIndex = NoMetadataIdx } ] + let ilMethodRefs = + [| for (propName, propTy) in propTys -> + mkILMethRef (ilTypeRef, ILCallingConv.Instance, "get_" + propName, 0, [], propTy) |] - let ilTy = mkILFormalNamedTy (if isStruct then ILBoxity.AsValue else ILBoxity.AsObject) ilTypeRef ilGenericParams + let ilTy = mkILNamedTy (if isStruct then ILBoxity.AsValue else ILBoxity.AsObject) ilTypeRef (List.map snd propTys) - // Generate the IL fields - let ilFieldDefs = - mkILFields - [ for (_, fldName, fldTy) in flds -> - let fdef = mkILInstanceField (fldName, fldTy, None, ILMemberAccess.Private) - fdef.With(customAttrs = mkILCustomAttrs [ g.DebuggerBrowsableNeverAttribute ]) ] + if ilTypeRef.Scope.IsLocalRef then + + let flds = [ for (i, nm) in Array.indexed nms -> (nm, nm + "@", ILType.TypeVar (uint16 i)) ] + + let ilGenericParams = + [ for nm in nms -> + { Name = sprintf "<%s>j__TPar" nm + Constraints = [] + Variance=NonVariant + CustomAttrsStored = storeILCustomAttrs emptyILCustomAttrs + HasReferenceTypeConstraint=false + HasNotNullableValueTypeConstraint=false + HasDefaultConstructorConstraint= false + MetadataIndex = NoMetadataIdx } ] + + let ilTy = mkILFormalNamedTy (if isStruct then ILBoxity.AsValue else ILBoxity.AsObject) ilTypeRef ilGenericParams + + // Generate the IL fields + let ilFieldDefs = + mkILFields + [ for (_, fldName, fldTy) in flds -> + let fdef = mkILInstanceField (fldName, fldTy, None, ILMemberAccess.Private) + fdef.With(customAttrs = mkILCustomAttrs [ g.DebuggerBrowsableNeverAttribute ]) ] - // Generate property definitions for the fields compiled as properties - let ilProperties = - mkILProperties - [ for (i, (propName, _fldName, fldTy)) in List.indexed flds -> - ILPropertyDef(name=propName, - attributes=PropertyAttributes.None, - setMethod=None, - getMethod=Some(mkILMethRef(ilTypeRef, ILCallingConv.Instance, "get_" + propName, 0, [], fldTy )), - callingConv=ILCallingConv.Instance.ThisConv, - propertyType=fldTy, - init= None, - args=[], - customAttrs=mkILCustomAttrs [ mkCompilationMappingAttrWithSeqNum g (int SourceConstructFlags.Field) i ]) ] + // Generate property definitions for the fields compiled as properties + let ilProperties = + mkILProperties + [ for (i, (propName, _fldName, fldTy)) in List.indexed flds -> + ILPropertyDef(name=propName, + attributes=PropertyAttributes.None, + setMethod=None, + getMethod=Some(mkILMethRef(ilTypeRef, ILCallingConv.Instance, "get_" + propName, 0, [], fldTy )), + callingConv=ILCallingConv.Instance.ThisConv, + propertyType=fldTy, + init= None, + args=[], + customAttrs=mkILCustomAttrs [ mkCompilationMappingAttrWithSeqNum g (int SourceConstructFlags.Field) i ]) ] - let ilMethods = - [ for (propName, fldName, fldTy) in flds -> - mkLdfldMethodDef ("get_" + propName, ILMemberAccess.Public, false, ilTy, fldName, fldTy) - yield! genToStringMethod ilTy ] + let ilMethods = + [ for (propName, fldName, fldTy) in flds -> + mkLdfldMethodDef ("get_" + propName, ILMemberAccess.Public, false, ilTy, fldName, fldTy) + yield! genToStringMethod ilTy ] - let ilBaseTy = (if isStruct then g.iltyp_ValueType else g.ilg.typ_Object) + let ilBaseTy = (if isStruct then g.iltyp_ValueType else g.ilg.typ_Object) - let ilCtorDef = mkILSimpleStorageCtorWithParamNames(None, (if isStruct then None else Some ilBaseTy.TypeSpec), ilTy, [], flds, ILMemberAccess.Public) - let ilCtorRef = mkRefToILMethod(ilTypeRef, ilCtorDef) - let ilMethodRefs = [| for mdef in ilMethods -> mkRefToILMethod(ilTypeRef, mdef) |] - - if ilTypeRef.Scope.IsLocalRef then + let ilCtorDef = mkILSimpleStorageCtorWithParamNames(None, (if isStruct then None else Some ilBaseTy.TypeSpec), ilTy, [], flds, ILMemberAccess.Public) // Create a tycon that looks exactly like a record definition, to help drive the generation of equality/comparison code let m = range0 @@ -1482,12 +1490,12 @@ type AssemblyBuilder(cenv: cenv, anonTypeTable: AnonTypeGenerationTable) as mgbu /// static init fields on script modules. let mutable scriptInitFspecs: (ILFieldSpec * range) list = [] - member mgbuf.AddScriptInitFieldSpec(fieldSpec, range) = + member __.AddScriptInitFieldSpec (fieldSpec, range) = scriptInitFspecs <- (fieldSpec, range) :: scriptInitFspecs /// This initializes the script in #load and fsc command-line order causing their /// sideeffects to be executed. - member mgbuf.AddInitializeScriptsInOrderToEntryPoint() = + member mgbuf.AddInitializeScriptsInOrderToEntryPoint () = // Get the entry point and initialized any scripts in order. match explicitEntryPointInfo with | Some tref -> @@ -1496,57 +1504,54 @@ type AssemblyBuilder(cenv: cenv, anonTypeTable: AnonTypeGenerationTable) as mgbu scriptInitFspecs |> List.iter IntializeCompiledScript | None -> () - member mgbuf.GenerateRawDataValueType(cloc, size) = + member __.GenerateRawDataValueType (cloc, size) = // Byte array literals require a ValueType of size the required number of bytes. // With fsi.exe, S.R.Emit TypeBuilder CreateType has restrictions when a ValueType VT is nested inside a type T, and T has a field of type VT. // To avoid this situation, these ValueTypes are generated under the private implementation rather than in the current cloc. [was bug 1532]. let cloc = CompLocForPrivateImplementationDetails cloc rawDataValueTypeGenerator.Apply((cloc, size)) - member mgbuf.GenerateAnonType(genToStringMethod, anonInfo: AnonRecdTypeInfo) = + member __.GenerateAnonType (genToStringMethod, anonInfo: AnonRecdTypeInfo) = let isStruct = evalAnonInfoIsStruct anonInfo let key = anonInfo.Stamp - match anonTypeTable.Table.TryGetValue key with - | true, res -> res - | _ -> + if not (anonTypeTable.Table.ContainsKey key) then let info = generateAnonType genToStringMethod (isStruct, anonInfo.ILTypeRef, anonInfo.SortedNames) anonTypeTable.Table.[key] <- info - info - member mgbuf.LookupAnonType(anonInfo: AnonRecdTypeInfo) = + member __.LookupAnonType (anonInfo: AnonRecdTypeInfo) = match anonTypeTable.Table.TryGetValue anonInfo.Stamp with | true, res -> res | _ -> failwithf "the anonymous record %A has not been generated in the pre-phase of generating this module" anonInfo.ILTypeRef - member mgbuf.GrabExtraBindingsToGenerate() = + member __.GrabExtraBindingsToGenerate () = let result = extraBindingsToGenerate extraBindingsToGenerate <- [] result - member mgbuf.AddTypeDef(tref: ILTypeRef, tdef, eliminateIfEmpty, addAtEnd, tdefDiscards) = + member __.AddTypeDef (tref: ILTypeRef, tdef, eliminateIfEmpty, addAtEnd, tdefDiscards) = gtdefs.FindNestedTypeDefsBuilder(tref.Enclosing).AddTypeDef(tdef, eliminateIfEmpty, addAtEnd, tdefDiscards) - member mgbuf.GetCurrentFields(tref: ILTypeRef) = + member __.GetCurrentFields (tref: ILTypeRef) = gtdefs.FindNestedTypeDefBuilder(tref).GetCurrentFields() - member mgbuf.AddReflectedDefinition(vspec: Tast.Val, expr) = + member __.AddReflectedDefinition (vspec: Tast.Val, expr) = // preserve order by storing index of item let n = reflectedDefinitions.Count reflectedDefinitions.Add(vspec, (vspec.CompiledName, n, expr)) - member mgbuf.ReplaceNameOfReflectedDefinition(vspec, newName) = + member __.ReplaceNameOfReflectedDefinition (vspec, newName) = match reflectedDefinitions.TryGetValue vspec with | true, (name, n, expr) when name <> newName -> reflectedDefinitions.[vspec] <- (newName, n, expr) | _ -> () - member mgbuf.AddMethodDef(tref: ILTypeRef, ilMethodDef) = + member __.AddMethodDef (tref: ILTypeRef, ilMethodDef) = gtdefs.FindNestedTypeDefBuilder(tref).AddMethodDef(ilMethodDef) if ilMethodDef.IsEntryPoint then explicitEntryPointInfo <- Some tref - member mgbuf.AddExplicitInitToSpecificMethodDef(cond, tref, fspec, sourceOpt, feefee, seqpt) = - // Authoring a .cctor with effects forces the cctor for the 'initialization' module by doing a dummy store & load of a field - // Doing both a store and load keeps FxCop happier because it thinks the field is useful + member __.AddExplicitInitToSpecificMethodDef (cond, tref, fspec, sourceOpt, feefee, seqpt) = + // Authoring a .cctor with effects forces the cctor for the 'initialization' module by doing a dummy store & load of a field + // Doing both a store and load keeps FxCop happier because it thinks the field is useful let instrs = [ yield! (if condition "NO_ADD_FEEFEE_TO_CCTORS" then [] elif condition "ADD_SEQPT_TO_CCTORS" then seqpt else feefee) // mark start of hidden code yield mkLdcInt32 0 @@ -1555,25 +1560,26 @@ type AssemblyBuilder(cenv: cenv, anonTypeTable: AnonTypeGenerationTable) as mgbu yield AI_pop] gtdefs.FindNestedTypeDefBuilder(tref).PrependInstructionsToSpecificMethodDef(cond, instrs, sourceOpt) - member mgbuf.AddEventDef(tref, edef) = + member __.AddEventDef (tref, edef) = gtdefs.FindNestedTypeDefBuilder(tref).AddEventDef(edef) - member mgbuf.AddFieldDef(tref, ilFieldDef) = + member __.AddFieldDef (tref, ilFieldDef) = gtdefs.FindNestedTypeDefBuilder(tref).AddFieldDef(ilFieldDef) - member mgbuf.AddOrMergePropertyDef(tref, pdef, m) = + member __.AddOrMergePropertyDef (tref, pdef, m) = gtdefs.FindNestedTypeDefBuilder(tref).AddOrMergePropertyDef(pdef, m) - member mgbuf.Close() = + member __.Close() = // old implementation adds new element to the head of list so result was accumulated in reversed order let orderedReflectedDefinitions = [for (KeyValue(vspec, (name, n, expr))) in reflectedDefinitions -> n, ((name, vspec), expr)] |> List.sortBy (fst >> (~-)) // invert the result to get 'order-by-descending' behavior (items in list are 0..* so we don't need to worry about int.MinValue) |> List.map snd gtdefs.Close(), orderedReflectedDefinitions - member mgbuf.cenv = cenv - member mgbuf.GetExplicitEntryPointInfo() = explicitEntryPointInfo + member __.cenv = cenv + + member __.GetExplicitEntryPointInfo() = explicitEntryPointInfo /// Record the types of the things on the evaluation stack. /// Used for the few times we have to flush the IL evaluation stack and to compute maxStack. @@ -6408,7 +6414,7 @@ and GenTopImpl cenv (mgbuf: AssemblyBuilder) mainInfoOpt eenv (TImplFile (qname, // Generate all the anonymous record types mentioned anywhere in this module for anonInfo in anonRecdTypes.Values do - mgbuf.GenerateAnonType((fun ilThisTy -> GenToStringMethod cenv eenv ilThisTy m), anonInfo) |> ignore + mgbuf.GenerateAnonType((fun ilThisTy -> GenToStringMethod cenv eenv ilThisTy m), anonInfo) let eenv = {eenv with cloc = { eenv.cloc with TopImplQualifiedName = qname.Text } } @@ -7615,7 +7621,6 @@ let ClearGeneratedValue (ctxt: ExecutionContext) (_g: TcGlobals) eenv (v: Val) = #endif () - /// The published API from the ILX code generator type IlxAssemblyGenerator(amap: ImportMap, tcGlobals: TcGlobals, tcVal: ConstraintSolver.TcValF, ccu: Tast.CcuThunk) = diff --git a/src/fsharp/PostInferenceChecks.fs b/src/fsharp/PostInferenceChecks.fs index 6ca98745cec..ddbad8f09eb 100644 --- a/src/fsharp/PostInferenceChecks.fs +++ b/src/fsharp/PostInferenceChecks.fs @@ -285,6 +285,10 @@ let BindVal cenv env (v: Val) = let BindVals cenv env vs = List.iter (BindVal cenv env) vs +let RecordAnonRecdInfo cenv (anonInfo: AnonRecdTypeInfo) = + if not (cenv.anonRecdTypes.ContainsKey anonInfo.Stamp) then + cenv.anonRecdTypes <- cenv.anonRecdTypes.Add(anonInfo.Stamp, anonInfo) + //-------------------------------------------------------------------------- // approx walk of type //-------------------------------------------------------------------------- @@ -334,8 +338,7 @@ let rec CheckTypeDeep (cenv: cenv) ((visitTy, visitTyconRefOpt, visitAppTyOpt, v | Some visitAppTy -> visitAppTy (tcref, tinst) | None -> () | TType_anon (anonInfo, tys) -> - if not (cenv.anonRecdTypes.ContainsKey anonInfo.Stamp) then - cenv.anonRecdTypes <- cenv.anonRecdTypes.Add(anonInfo.Stamp, anonInfo) + RecordAnonRecdInfo cenv anonInfo CheckTypesDeep cenv f g env tys | TType_ucase (_, tinst) -> CheckTypesDeep cenv f g env tinst @@ -1011,8 +1014,8 @@ and CheckExpr (cenv: cenv) (env: env) origExpr (context: PermitByRefExpr) : Limi CheckValRef cenv env baseVal m PermitByRefExpr.No CheckExprsPermitByRefLike cenv env rest - | Expr.Op (c, tyargs, args, m) -> - CheckExprOp cenv env (c, tyargs, args, m) context expr + | Expr.Op (op, tyargs, args, m) -> + CheckExprOp cenv env (op, tyargs, args, m) context expr // Allow 'typeof' calls as a special case, the only accepted use of System.Void! | TypeOfExpr g ty when isVoidTy g ty -> @@ -1115,7 +1118,14 @@ and CheckExprOp cenv env (op, tyargs, args, m) context expr = let ctorLimitedZoneCheck() = if env.ctorLimitedZone then errorR(Error(FSComp.SR.chkObjCtorsCantUseExceptionHandling(), m)) - (* Special cases *) + // Ensure anonynous record type requirements are recorded + match op with + | TOp.AnonRecdGet (anonInfo, _) + | TOp.AnonRecd anonInfo -> + RecordAnonRecdInfo cenv anonInfo + | _ -> () + + // Special cases match op, tyargs, args with // Handle these as special cases since mutables are allowed inside their bodies | TOp.While _, _, [Expr.Lambda (_, _, _, [_], e1, _, _);Expr.Lambda (_, _, _, [_], e2, _, _)] -> diff --git a/src/fsharp/TypeRelations.fs b/src/fsharp/TypeRelations.fs index 2169bf295cb..6eae6fcf4f6 100755 --- a/src/fsharp/TypeRelations.fs +++ b/src/fsharp/TypeRelations.fs @@ -66,18 +66,28 @@ let rec TypesFeasiblyEquiv ndeep g amap m ty1 ty2 = let ty1 = stripTyEqns g ty1 let ty2 = stripTyEqns g ty2 match ty1, ty2 with - // QUERY: should these be false for non-equal rigid typars? warn-if-not-rigid typars? | TType_var _, _ | _, TType_var _ -> true + | TType_app (tc1, l1), TType_app (tc2, l2) when tyconRefEq g tc1 tc2 -> List.lengthsEqAndForall2 (TypesFeasiblyEquiv ndeep g amap m) l1 l2 + + | TType_anon (anonInfo1, l1),TType_anon (anonInfo2, l2) -> + (evalTupInfoIsStruct anonInfo1.TupInfo = evalTupInfoIsStruct anonInfo2.TupInfo) && + (match anonInfo1.Assembly, anonInfo2.Assembly with ccu1, ccu2 -> ccuEq ccu1 ccu2) && + (anonInfo1.SortedNames = anonInfo2.SortedNames) && + List.lengthsEqAndForall2 (TypesFeasiblyEquiv ndeep g amap m) l1 l2 + | TType_tuple (tupInfo1, l1), TType_tuple (tupInfo2, l2) -> evalTupInfoIsStruct tupInfo1 = evalTupInfoIsStruct tupInfo2 && List.lengthsEqAndForall2 (TypesFeasiblyEquiv ndeep g amap m) l1 l2 + | TType_fun (d1, r1), TType_fun (d2, r2) -> (TypesFeasiblyEquiv ndeep g amap m) d1 d2 && (TypesFeasiblyEquiv ndeep g amap m) r1 r2 + | TType_measure _, TType_measure _ -> true + | _ -> false @@ -88,18 +98,18 @@ let rec TypeFeasiblySubsumesType ndeep g amap m ty1 canCoerce ty2 = let ty1 = stripTyEqns g ty1 let ty2 = stripTyEqns g ty2 match ty1, ty2 with - // QUERY: should these be false for non-equal rigid typars? warn-if-not-rigid typars? | TType_var _, _ | _, TType_var _ -> true | TType_app (tc1, l1), TType_app (tc2, l2) when tyconRefEq g tc1 tc2 -> List.lengthsEqAndForall2 (TypesFeasiblyEquiv ndeep g amap m) l1 l2 - | TType_tuple (tupInfo1, l1), TType_tuple (tupInfo2, l2) -> - evalTupInfoIsStruct tupInfo1 = evalTupInfoIsStruct tupInfo2 && - List.lengthsEqAndForall2 (TypesFeasiblyEquiv ndeep g amap m) l1 l2 - | TType_fun (d1, r1), TType_fun (d2, r2) -> - (TypesFeasiblyEquiv ndeep g amap m) d1 d2 && (TypesFeasiblyEquiv ndeep g amap m) r1 r2 + + | TType_tuple _, TType_tuple _ + | TType_anon _, TType_anon _ + | TType_fun _, TType_fun _ -> TypesFeasiblyEquiv ndeep g amap m ty1 ty2 + | TType_measure _, TType_measure _ -> true + | _ -> // F# reference types are subtypes of type 'obj' (isObjTy g ty1 && (canCoerce = CanCoerce || isRefTy g ty2)) diff --git a/tests/fsharp/core/anon/test.fsx b/tests/fsharp/core/anon/test.fsx index 331d522f071..092a8977143 100644 --- a/tests/fsharp/core/anon/test.fsx +++ b/tests/fsharp/core/anon/test.fsx @@ -67,6 +67,18 @@ module CrossAssemblyTestTupleStruct = check "svrknvio4" (let res = SampleAPITupleStruct.SampleFunctionReturningStructTuple() in match res with (x,y) -> x + y.Length) 4 tests() +module TypeNotGeneratedBug = + + let foo (_: obj) = () + + let bar() = foo {| ThisIsUniqueToThisTest6353 = 1 |} + +module FeasibleEqualityNotImplemented = + type R = {| number: int |} + let e = Event< R>() + e.Trigger {|number = 3|} + e.Publish.Add (printfn "%A") // error + #if TESTS_AS_APP let RUN() = !failures #else