From 7763fa07c1e28da5b150a861e91b9e047d0403ff Mon Sep 17 00:00:00 2001 From: Eugene Auduchinok Date: Wed, 20 Dec 2023 19:24:32 +0100 Subject: [PATCH 01/13] Keep typars produced in name resolution --- src/Compiler/Checking/CheckDeclarations.fs | 28 +++++----- src/Compiler/Checking/CheckExpressions.fs | 28 +++++----- src/Compiler/Checking/NameResolution.fs | 59 +++++++++++++++++----- src/Compiler/Checking/NameResolution.fsi | 5 +- 4 files changed, 79 insertions(+), 41 deletions(-) diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index ef9a56204a0..fa683b63493 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -2935,7 +2935,7 @@ module EstablishTypeDefinitionCores = | Some (tc, args, m) -> let ad = envinner.AccessRights match ResolveTypeLongIdent cenv.tcSink cenv.nameResolver ItemOccurence.UseInType OpenQualified envinner.NameEnv ad tc TypeNameResolutionStaticArgsInfo.DefiniteEmpty PermitDirectReferenceToGeneratedType.Yes with - | Result (_, tcrefBeforeStaticArguments) when + | Result (_, tcrefBeforeStaticArguments, _) when tcrefBeforeStaticArguments.IsProvided && not tcrefBeforeStaticArguments.IsErased -> @@ -4099,7 +4099,7 @@ module TcDeclarations = let g = cenv.g let ad = envForDecls.AccessRights - let tcref = + let tcref, reqTypars = match tyconOpt with | Some tycon when isAtOriginalTyconDefn -> @@ -4108,15 +4108,17 @@ module TcDeclarations = ResolveTypeLongIdent cenv.tcSink cenv.nameResolver ItemOccurence.Binding OpenQualified envForDecls.NameEnv ad longPath resInfo PermitDirectReferenceToGeneratedType.No |> ignore - mkLocalTyconRef tycon + let tcref = mkLocalTyconRef tycon + let reqTypars = tcref.Typars m + tcref, reqTypars | _ -> let resInfo = TypeNameResolutionStaticArgsInfo.FromTyArgs synTypars.Length - let _, tcref = + let _, tcref, reqTypars = match ResolveTypeLongIdent cenv.tcSink cenv.nameResolver ItemOccurence.Binding OpenQualified envForDecls.NameEnv ad longPath resInfo PermitDirectReferenceToGeneratedType.No with | Result res -> // Update resolved type parameters with the names from the source. - let _, tcref = res + let types, tcref, ttypes = res if tcref.TyparsNoRange.Length = synTypars.Length then (tcref.TyparsNoRange, synTypars) ||> List.zip @@ -4126,12 +4128,14 @@ module TcDeclarations = typar.SetIdent(untypedIdent) ) - res - | res when inSig && List.isSingleton longPath -> - errorR(Deprecated(FSComp.SR.tcReservedSyntaxForAugmentation(), m)) - ForceRaise res - | res -> ForceRaise res - tcref + let tps = ttypes |> List.map (function TType_var(typar, _) -> typar | _ -> failwith "123") + types, tcref, tps + + | Exception exn -> + if inSig && List.isSingleton longPath then + errorR(Deprecated(FSComp.SR.tcReservedSyntaxForAugmentation(), m)) + ForceRaise (Exception exn) + tcref, reqTypars let isInterfaceOrDelegateOrEnum = tcref.Deref.IsFSharpInterfaceTycon || @@ -4142,8 +4146,6 @@ module TcDeclarations = tcref.Deref.IsFSharpDelegateTycon || tcref.Deref.IsFSharpEnumTycon - let reqTypars = tcref.Typars m - // Member definitions are intrinsic (added directly to the type) if: // a) For interfaces, only if it is in the original defn. // Augmentations to interfaces via partial type defns will always be extensions, e.g. extension members on interfaces. diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index f182c98ac85..a4da4ff9652 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -767,7 +767,7 @@ let TcConst (cenv: cenv) (overallTy: TType) m env synConst = | SynMeasure.One _ -> Measure.One | SynMeasure.Named(tc, m) -> let ad = env.eAccessRights - let _, tcref = ForceRaise(ResolveTypeLongIdent cenv.tcSink cenv.nameResolver ItemOccurence.Use OpenQualified env.eNameResEnv ad tc TypeNameResolutionStaticArgsInfo.DefiniteEmpty PermitDirectReferenceToGeneratedType.No) + let _, tcref, _ = ForceRaise(ResolveTypeLongIdent cenv.tcSink cenv.nameResolver ItemOccurence.Use OpenQualified env.eNameResEnv ad tc TypeNameResolutionStaticArgsInfo.DefiniteEmpty PermitDirectReferenceToGeneratedType.No) match tcref.TypeOrMeasureKind with | TyparKind.Type -> error(Error(FSComp.SR.tcExpectedUnitOfMeasureNotType(), m)) | TyparKind.Measure -> Measure.Const tcref @@ -4458,7 +4458,7 @@ and TcLongIdentType kindOpt (cenv: cenv) newOk checkConstraints occ iwsam env tp let m = synLongId.Range let ad = env.eAccessRights - let tinstEnclosing, tcref = ForceRaise(ResolveTypeLongIdent cenv.tcSink cenv.nameResolver occ OpenQualified env.NameEnv ad tc TypeNameResolutionStaticArgsInfo.DefiniteEmpty PermitDirectReferenceToGeneratedType.No) + let tinstEnclosing, tcref, inst = ForceRaise(ResolveTypeLongIdent cenv.tcSink cenv.nameResolver occ OpenQualified env.NameEnv ad tc TypeNameResolutionStaticArgsInfo.DefiniteEmpty PermitDirectReferenceToGeneratedType.No) CheckIWSAM cenv env checkConstraints iwsam m tcref @@ -4472,7 +4472,7 @@ and TcLongIdentType kindOpt (cenv: cenv) newOk checkConstraints occ iwsam env tp | _, TyparKind.Measure -> TType_measure (Measure.Const tcref), tpenv | _, TyparKind.Type -> - TcTypeApp cenv newOk checkConstraints occ env tpenv m tcref tinstEnclosing [] + TcTypeApp cenv newOk checkConstraints occ env tpenv m tcref tinstEnclosing [] inst /// Some.Long.TypeName /// ty1 SomeLongTypeName @@ -4480,7 +4480,7 @@ and TcLongIdentAppType kindOpt (cenv: cenv) newOk checkConstraints occ iwsam env let (SynLongIdent(tc, _, _)) = longId let ad = env.eAccessRights - let tinstEnclosing, tcref = + let tinstEnclosing, tcref, inst = let tyResInfo = TypeNameResolutionStaticArgsInfo.FromTyArgs args.Length ResolveTypeLongIdent cenv.tcSink cenv.nameResolver ItemOccurence.UseInType OpenQualified env.eNameResEnv ad tc tyResInfo PermitDirectReferenceToGeneratedType.No |> ForceRaise @@ -4499,7 +4499,7 @@ and TcLongIdentAppType kindOpt (cenv: cenv) newOk checkConstraints occ iwsam env | _, TyparKind.Type -> if postfix && tcref.Typars m |> List.exists (fun tp -> match tp.Kind with TyparKind.Measure -> true | _ -> false) then error(Error(FSComp.SR.tcInvalidUnitsOfMeasurePrefix(), m)) - TcTypeApp cenv newOk checkConstraints occ env tpenv m tcref tinstEnclosing args + TcTypeApp cenv newOk checkConstraints occ env tpenv m tcref tinstEnclosing args inst | _, TyparKind.Measure -> match args, postfix with @@ -4518,8 +4518,8 @@ and TcNestedAppType (cenv: cenv) newOk checkConstraints occ iwsam env tpenv synL let leftTy, tpenv = TcType cenv newOk checkConstraints occ iwsam env tpenv synLeftTy match leftTy with | AppTy g (tcref, tinst) -> - let tcref = ResolveTypeLongIdentInTyconRef cenv.tcSink cenv.nameResolver env.eNameResEnv (TypeNameResolutionInfo.ResolveToTypeRefs (TypeNameResolutionStaticArgsInfo.FromTyArgs args.Length)) ad m tcref longId - TcTypeApp cenv newOk checkConstraints occ env tpenv m tcref tinst args + let tcref, inst = ResolveTypeLongIdentInTyconRef cenv.tcSink cenv.nameResolver occ env.eNameResEnv (TypeNameResolutionInfo.ResolveToTypeRefs (TypeNameResolutionStaticArgsInfo.FromTyArgs args.Length)) ad m tcref longId + TcTypeApp cenv newOk checkConstraints occ env tpenv m tcref tinst args inst | _ -> error(Error(FSComp.SR.tcTypeHasNoNestedTypes(), m)) @@ -4943,7 +4943,7 @@ and TcProvidedTypeApp (cenv: cenv) env tpenv tcref args m = /// Note that the generic type may be a nested generic type List.ListEnumerator. /// In this case, 'argsR is only the instantiation of the suffix type arguments, and pathTypeArgs gives /// the prefix of type arguments. -and TcTypeApp (cenv: cenv) newOk checkConstraints occ env tpenv m tcref pathTypeArgs (synArgTys: SynType list) = +and TcTypeApp (cenv: cenv) newOk checkConstraints occ env tpenv m tcref pathTypeArgs (synArgTys: SynType list) (tinst: TypeInst) = let g = cenv.g CheckTyconAccessible cenv.amap m env.AccessRights tcref |> ignore CheckEntityAttributes g tcref m |> CommitOperationResult @@ -4954,7 +4954,7 @@ and TcTypeApp (cenv: cenv) newOk checkConstraints occ env tpenv m tcref pathType if tcref.Deref.IsProvided then TcProvidedTypeApp cenv env tpenv tcref synArgTys m else #endif - let tps, _, tinst, _ = FreshenTyconRef2 g m tcref + let tps = tinst |> List.map (function TType_var(typar, _) -> typar | _ -> failwith "123") // If we're not checking constraints, i.e. when we first assert the super/interfaces of a type definition, then just // clear the constraint lists of the freshly generated type variables. A little ugly but fairly localized. @@ -5009,9 +5009,9 @@ and TcNestedTypeApplication (cenv: cenv) newOk checkConstraints occ iwsam env tp error(Error(FSComp.SR.tcTypeHasNoNestedTypes(), mWholeTypeApp)) match ty with - | TType_app(tcref, _, _) -> + | TType_app(tcref, inst, _) -> CheckIWSAM cenv env checkConstraints iwsam mWholeTypeApp tcref - TcTypeApp cenv newOk checkConstraints occ env tpenv mWholeTypeApp tcref pathTypeArgs tyargs + TcTypeApp cenv newOk checkConstraints occ env tpenv mWholeTypeApp tcref pathTypeArgs tyargs inst | _ -> error(InternalError("TcNestedTypeApplication: expected type application", mWholeTypeApp)) @@ -8163,10 +8163,10 @@ and TcNameOfExpr (cenv: cenv) env tpenv (synArg: SynExpr) = if (match delayed with [DelayedTypeApp _] | [] -> true | _ -> false) then let (TypeNameResolutionInfo(_, staticArgsInfo)) = GetLongIdentTypeNameInfo delayed match ResolveTypeLongIdent cenv.tcSink cenv.nameResolver ItemOccurence.UseInAttribute OpenQualified env.eNameResEnv ad longId staticArgsInfo PermitDirectReferenceToGeneratedType.No with - | Result (tinstEnclosing, tcref) when IsEntityAccessible cenv.amap m ad tcref -> + | Result (tinstEnclosing, tcref, inst) when IsEntityAccessible cenv.amap m ad tcref -> match delayed with | [DelayedTypeApp (tyargs, _, mExprAndTypeArgs)] -> - TcTypeApp cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs tcref tinstEnclosing tyargs |> ignore + TcTypeApp cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs tcref tinstEnclosing tyargs inst |> ignore | _ -> () true // resolved to a type name, done with checks | _ -> @@ -10858,7 +10858,7 @@ and TcAttributeEx canFail (cenv: cenv) (env: TcEnv) attrTgt attrEx (synAttr: Syn match ResolveTypeLongIdent cenv.tcSink cenv.nameResolver ItemOccurence.UseInAttribute OpenQualified env.eNameResEnv ad tycon TypeNameResolutionStaticArgsInfo.DefiniteEmpty PermitDirectReferenceToGeneratedType.No with | Exception err -> raze err - | Result(tinstEnclosing, tcref) -> success(TcTypeApp cenv NoNewTypars CheckCxs ItemOccurence.UseInAttribute env tpenv mAttr tcref tinstEnclosing []) + | Result(tinstEnclosing, tcref, inst) -> success(TcTypeApp cenv NoNewTypars CheckCxs ItemOccurence.UseInAttribute env tpenv mAttr tcref tinstEnclosing [] inst) ForceRaise ((try1 (tyid.idText + "Attribute")) |> otherwise (fun () -> (try1 tyid.idText))) diff --git a/src/Compiler/Checking/NameResolution.fs b/src/Compiler/Checking/NameResolution.fs index 5afdada9b05..9b06e283b79 100644 --- a/src/Compiler/Checking/NameResolution.fs +++ b/src/Compiler/Checking/NameResolution.fs @@ -2978,6 +2978,31 @@ let ResolveUnqualifiedTyconRefs nenv tcrefs = | Some tinst -> (resInfo.WithEnclosingTypeInst tinst, tcref)) +let compgenId = mkSynId range0 unassignedTyparName + +let NewCompGenTypar (kind, rigid, staticReq, dynamicReq, error) = + Construct.NewTypar(kind, rigid, SynTypar(compgenId, staticReq, true), error, dynamicReq, [], false, false) + +let FreshenTypar (g: TcGlobals) rigid (tp: Typar) = + let clearStaticReq = g.langVersion.SupportsFeature LanguageFeature.InterfacesWithAbstractStaticMembers + let staticReq = if clearStaticReq then TyparStaticReq.None else tp.StaticReq + let dynamicReq = if rigid = TyparRigidity.Rigid then TyparDynamicReq.Yes else TyparDynamicReq.No + NewCompGenTypar (tp.Kind, rigid, staticReq, dynamicReq, false) + +// QUERY: should 'rigid' ever really be 'true'? We set this when we know +// we are going to have to generalize a typar, e.g. when implementing a +// abstract generic method slot. But we later check the generalization +// condition anyway, so we could get away with a non-rigid typar. This +// would sort of be cleaner, though give errors later. +let FreshenAndFixupTypars g m rigid fctps tinst tpsorig = + let tps = tpsorig |> List.map (FreshenTypar g rigid) + let renaming, tinst = FixupNewTypars m fctps tinst tpsorig tps + tps, renaming, tinst + +let FreshenTypeInst g m tpsorig = + FreshenAndFixupTypars g m TyparRigidity.Flexible [] [] tpsorig + + /// Resolve F# "A.B.C" syntax in expressions /// Not all of the sequence will necessarily be swallowed, i.e. we return some identifiers /// that may represent further actions, e.g. further lookups. @@ -3082,8 +3107,11 @@ let rec ResolveExprLongIdentPrim sink (ncenv: NameResolver) first fullyQualified |> CollectResults success match tyconSearch () with - | Result ((resInfo, tcref) :: _) -> - let item = Item.Types(id.idText, [ generalizedTyconRef ncenv.g tcref ]) + | Result((resInfo, tcref) :: _) -> + let inst = FreshenTypeInst ncenv.g m (tcref.Typars m) + let _, _, tTypes = inst + let tType = TType_app(tcref, tTypes, ncenv.g.knownWithoutNull) + let item = Item.Types(id.idText, [ tType ]) success (resInfo, item) | _ -> @@ -3439,7 +3467,7 @@ let rec ResolveTypeLongIdentInTyconRefPrim (ncenv: NameResolver) (typeNameResInf AtMostOneResult m tyconSearch /// Resolve a long identifier representing a type name and report the result -let ResolveTypeLongIdentInTyconRef sink (ncenv: NameResolver) nenv typeNameResInfo ad m tcref (lid: Ident list) = +let ResolveTypeLongIdentInTyconRef sink (ncenv: NameResolver) occurrence nenv typeNameResInfo ad m tcref (lid: Ident list) = let resInfo, tcref = match lid with | [] -> @@ -3447,9 +3475,12 @@ let ResolveTypeLongIdentInTyconRef sink (ncenv: NameResolver) nenv typeNameResIn | id :: rest -> ForceRaise (ResolveTypeLongIdentInTyconRefPrim ncenv typeNameResInfo ad ResolutionInfo.Empty PermitDirectReferenceToGeneratedType.No 0 m tcref id rest) ResolutionInfo.SendEntityPathToSink(sink, ncenv, nenv, ItemOccurence.Use, ad, resInfo, ResultTyparChecker(fun () -> true)) - let item = Item.Types(tcref.DisplayName, [FreshenTycon ncenv m tcref]) - CallNameResolutionSink sink (rangeOfLid lid, nenv, item, emptyTyparInst, ItemOccurence.UseInType, ad) - tcref + + let _, tinst, args = FreshenTypeInst ncenv.g m (tcref.Typars m) + let ttype = TType_app(tcref, args, ncenv.g.knownWithoutNull) + let item = Item.Types(tcref.DisplayName, [ttype]) + CallNameResolutionSink sink (m, nenv, item, tinst, occurrence, ad) + tcref, args /// Create an UndefinedName error with details let SuggestTypeLongIdentInModuleOrNamespace depth (modref: ModuleOrNamespaceRef) amap ad m (id: Ident) = @@ -3593,7 +3624,6 @@ let rec ResolveTypeLongIdentPrim sink (ncenv: NameResolver) occurence first full let r = AddResults searchSoFar (modulSearchFailed()) AtMostOneResult m2 (r |?> (fun tcrefs -> CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities (tcrefs, typeNameResInfo, genOk, m))) - /// Resolve a long identifier representing a type and report it let ResolveTypeLongIdentAux sink (ncenv: NameResolver) occurence fullyQualified nenv ad (lid: Ident list) staticResInfo genOk = let m = rangeOfLid lid @@ -3608,15 +3638,20 @@ let ResolveTypeLongIdentAux sink (ncenv: NameResolver) occurence fullyQualified match res with | Result (resInfo, tcref) -> ResolutionInfo.SendEntityPathToSink(sink, ncenv, nenv, ItemOccurence.UseInType, ad, resInfo, ResultTyparChecker(fun () -> true)) - let item = Item.Types(tcref.DisplayName, [FreshenTycon ncenv m tcref]) - CallNameResolutionSink sink (m, nenv, item, emptyTyparInst, occurence, ad) - | _ -> () - res + let inst = FreshenTypeInst ncenv.g m (tcref.Typars m) + let _, inst2, tTypes = inst + let ttype = TType_app(tcref, tTypes, ncenv.g.knownWithoutNull) + let item = Item.Types(tcref.DisplayName, [ttype]) + CallNameResolutionSink sink (m, nenv, item, inst2, occurence, ad) + Result(resInfo, tcref, tTypes) + + | Exception exn -> + Exception exn /// Resolve a long identifier representing a type and report it let ResolveTypeLongIdent sink ncenv occurence fullyQualified nenv ad lid staticResInfo genOk = let res = ResolveTypeLongIdentAux sink ncenv occurence fullyQualified nenv ad lid staticResInfo genOk - (res |?> fun (resInfo, tcref) -> (resInfo.EnclosingTypeInst, tcref)) + res |?> fun (resInfo, tcref, ttypes) -> (resInfo.EnclosingTypeInst, tcref, ttypes) //------------------------------------------------------------------------- // Resolve F#/IL "." syntax in records etc. diff --git a/src/Compiler/Checking/NameResolution.fsi b/src/Compiler/Checking/NameResolution.fsi index 43cfdd12d5c..b42094cf33c 100755 --- a/src/Compiler/Checking/NameResolution.fsi +++ b/src/Compiler/Checking/NameResolution.fsi @@ -727,13 +727,14 @@ val internal ResolvePatternLongIdent: val internal ResolveTypeLongIdentInTyconRef: sink: TcResultsSink -> ncenv: NameResolver -> + occurrence: ItemOccurence -> nenv: NameResolutionEnv -> typeNameResInfo: TypeNameResolutionInfo -> ad: AccessorDomain -> m: range -> tcref: TyconRef -> lid: Ident list -> - TyconRef + TyconRef * TypeInst /// Resolve a long identifier to a type definition val internal ResolveTypeLongIdent: @@ -746,7 +747,7 @@ val internal ResolveTypeLongIdent: lid: Ident list -> staticResInfo: TypeNameResolutionStaticArgsInfo -> genOk: PermitDirectReferenceToGeneratedType -> - ResultOrException + ResultOrException /// Resolve a long identifier to a field val internal ResolveField: From 0b9c0ad0e9efdc6adbd387c5f848804d29f9a4f1 Mon Sep 17 00:00:00 2001 From: Eugene Auduchinok Date: Wed, 20 Dec 2023 20:01:51 +0100 Subject: [PATCH 02/13] Better debug errors --- src/Compiler/Checking/CheckDeclarations.fs | 2 +- src/Compiler/Checking/CheckExpressions.fs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index fa683b63493..d18edd3e895 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -4128,7 +4128,7 @@ module TcDeclarations = typar.SetIdent(untypedIdent) ) - let tps = ttypes |> List.map (function TType_var(typar, _) -> typar | _ -> failwith "123") + let tps = ttypes |> List.map (function TType_var(typar, _) -> typar | t -> failwith $"ComputeTyconDeclKind: {t}") types, tcref, tps | Exception exn -> diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index a4da4ff9652..e51611da3be 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -4954,7 +4954,7 @@ and TcTypeApp (cenv: cenv) newOk checkConstraints occ env tpenv m tcref pathType if tcref.Deref.IsProvided then TcProvidedTypeApp cenv env tpenv tcref synArgTys m else #endif - let tps = tinst |> List.map (function TType_var(typar, _) -> typar | _ -> failwith "123") + let tps = tinst |> List.map (function TType_var(typar, _) -> typar | t -> failwith $"TcTypeApp: {t}") // If we're not checking constraints, i.e. when we first assert the super/interfaces of a type definition, then just // clear the constraint lists of the freshly generated type variables. A little ugly but fairly localized. From b3a8ec05c1b030c8059312e0b48008e7cc27accf Mon Sep 17 00:00:00 2001 From: Eugene Auduchinok Date: Thu, 21 Dec 2023 17:50:52 +0100 Subject: [PATCH 03/13] Unwrap measure type vars --- src/Compiler/Checking/CheckExpressions.fs | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index e51611da3be..93c08e2a80f 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -4954,7 +4954,12 @@ and TcTypeApp (cenv: cenv) newOk checkConstraints occ env tpenv m tcref pathType if tcref.Deref.IsProvided then TcProvidedTypeApp cenv env tpenv tcref synArgTys m else #endif - let tps = tinst |> List.map (function TType_var(typar, _) -> typar | t -> failwith $"TcTypeApp: {t}") + let tps = tinst |> List.map (fun t -> + match t with + | TType_var(typar, _) + | TType_measure(Measure.Var typar) -> typar + | t -> failwith $"TcTypeApp: {t}" + ) // If we're not checking constraints, i.e. when we first assert the super/interfaces of a type definition, then just // clear the constraint lists of the freshly generated type variables. A little ugly but fairly localized. From 0ad6b154f47ef18c36f8cb44d69edaea54d06e9e Mon Sep 17 00:00:00 2001 From: Eugene Auduchinok Date: Mon, 25 Dec 2023 18:29:30 +0100 Subject: [PATCH 04/13] Undo check declarations change --- src/Compiler/Checking/CheckDeclarations.fs | 17 ++++++++--------- 1 file changed, 8 insertions(+), 9 deletions(-) diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index d18edd3e895..a451b415435 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -4099,7 +4099,7 @@ module TcDeclarations = let g = cenv.g let ad = envForDecls.AccessRights - let tcref, reqTypars = + let tcref = match tyconOpt with | Some tycon when isAtOriginalTyconDefn -> @@ -4108,17 +4108,15 @@ module TcDeclarations = ResolveTypeLongIdent cenv.tcSink cenv.nameResolver ItemOccurence.Binding OpenQualified envForDecls.NameEnv ad longPath resInfo PermitDirectReferenceToGeneratedType.No |> ignore - let tcref = mkLocalTyconRef tycon - let reqTypars = tcref.Typars m - tcref, reqTypars + mkLocalTyconRef tycon | _ -> let resInfo = TypeNameResolutionStaticArgsInfo.FromTyArgs synTypars.Length - let _, tcref, reqTypars = + let tcref = match ResolveTypeLongIdent cenv.tcSink cenv.nameResolver ItemOccurence.Binding OpenQualified envForDecls.NameEnv ad longPath resInfo PermitDirectReferenceToGeneratedType.No with | Result res -> // Update resolved type parameters with the names from the source. - let types, tcref, ttypes = res + let _, tcref, _ = res if tcref.TyparsNoRange.Length = synTypars.Length then (tcref.TyparsNoRange, synTypars) ||> List.zip @@ -4128,14 +4126,13 @@ module TcDeclarations = typar.SetIdent(untypedIdent) ) - let tps = ttypes |> List.map (function TType_var(typar, _) -> typar | t -> failwith $"ComputeTyconDeclKind: {t}") - types, tcref, tps + tcref | Exception exn -> if inSig && List.isSingleton longPath then errorR(Deprecated(FSComp.SR.tcReservedSyntaxForAugmentation(), m)) ForceRaise (Exception exn) - tcref, reqTypars + tcref let isInterfaceOrDelegateOrEnum = tcref.Deref.IsFSharpInterfaceTycon || @@ -4146,6 +4143,8 @@ module TcDeclarations = tcref.Deref.IsFSharpDelegateTycon || tcref.Deref.IsFSharpEnumTycon + let reqTypars = tcref.Typars m + // Member definitions are intrinsic (added directly to the type) if: // a) For interfaces, only if it is in the original defn. // Augmentations to interfaces via partial type defns will always be extensions, e.g. extension members on interfaces. From b0f023551a78dfc3a5585fed73bbaa7b241fc9e2 Mon Sep 17 00:00:00 2001 From: Eugene Auduchinok Date: Mon, 25 Dec 2023 18:56:44 +0100 Subject: [PATCH 05/13] Fix reported range --- src/Compiler/Checking/NameResolution.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Compiler/Checking/NameResolution.fs b/src/Compiler/Checking/NameResolution.fs index 9b06e283b79..3423170611c 100644 --- a/src/Compiler/Checking/NameResolution.fs +++ b/src/Compiler/Checking/NameResolution.fs @@ -3479,7 +3479,7 @@ let ResolveTypeLongIdentInTyconRef sink (ncenv: NameResolver) occurrence nenv ty let _, tinst, args = FreshenTypeInst ncenv.g m (tcref.Typars m) let ttype = TType_app(tcref, args, ncenv.g.knownWithoutNull) let item = Item.Types(tcref.DisplayName, [ttype]) - CallNameResolutionSink sink (m, nenv, item, tinst, occurrence, ad) + CallNameResolutionSink sink (rangeOfLid lid, nenv, item, tinst, occurrence, ad) tcref, args /// Create an UndefinedName error with details From 12d3d9a378bcfa903c75e351a72b36d3bd21cc0d Mon Sep 17 00:00:00 2001 From: Eugene Auduchinok Date: Mon, 25 Dec 2023 20:04:46 +0100 Subject: [PATCH 06/13] Undo occurrence change --- src/Compiler/Checking/CheckExpressions.fs | 2 +- src/Compiler/Checking/NameResolution.fs | 4 ++-- src/Compiler/Checking/NameResolution.fsi | 1 - 3 files changed, 3 insertions(+), 4 deletions(-) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index 93c08e2a80f..78fbe30ecef 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -4518,7 +4518,7 @@ and TcNestedAppType (cenv: cenv) newOk checkConstraints occ iwsam env tpenv synL let leftTy, tpenv = TcType cenv newOk checkConstraints occ iwsam env tpenv synLeftTy match leftTy with | AppTy g (tcref, tinst) -> - let tcref, inst = ResolveTypeLongIdentInTyconRef cenv.tcSink cenv.nameResolver occ env.eNameResEnv (TypeNameResolutionInfo.ResolveToTypeRefs (TypeNameResolutionStaticArgsInfo.FromTyArgs args.Length)) ad m tcref longId + let tcref, inst = ResolveTypeLongIdentInTyconRef cenv.tcSink cenv.nameResolver env.eNameResEnv (TypeNameResolutionInfo.ResolveToTypeRefs (TypeNameResolutionStaticArgsInfo.FromTyArgs args.Length)) ad m tcref longId TcTypeApp cenv newOk checkConstraints occ env tpenv m tcref tinst args inst | _ -> error(Error(FSComp.SR.tcTypeHasNoNestedTypes(), m)) diff --git a/src/Compiler/Checking/NameResolution.fs b/src/Compiler/Checking/NameResolution.fs index 3423170611c..521c5993179 100644 --- a/src/Compiler/Checking/NameResolution.fs +++ b/src/Compiler/Checking/NameResolution.fs @@ -3467,7 +3467,7 @@ let rec ResolveTypeLongIdentInTyconRefPrim (ncenv: NameResolver) (typeNameResInf AtMostOneResult m tyconSearch /// Resolve a long identifier representing a type name and report the result -let ResolveTypeLongIdentInTyconRef sink (ncenv: NameResolver) occurrence nenv typeNameResInfo ad m tcref (lid: Ident list) = +let ResolveTypeLongIdentInTyconRef sink (ncenv: NameResolver) nenv typeNameResInfo ad m tcref (lid: Ident list) = let resInfo, tcref = match lid with | [] -> @@ -3479,7 +3479,7 @@ let ResolveTypeLongIdentInTyconRef sink (ncenv: NameResolver) occurrence nenv ty let _, tinst, args = FreshenTypeInst ncenv.g m (tcref.Typars m) let ttype = TType_app(tcref, args, ncenv.g.knownWithoutNull) let item = Item.Types(tcref.DisplayName, [ttype]) - CallNameResolutionSink sink (rangeOfLid lid, nenv, item, tinst, occurrence, ad) + CallNameResolutionSink sink (rangeOfLid lid, nenv, item, tinst, ItemOccurence.UseInType, ad) tcref, args /// Create an UndefinedName error with details diff --git a/src/Compiler/Checking/NameResolution.fsi b/src/Compiler/Checking/NameResolution.fsi index b42094cf33c..fe40c88b546 100755 --- a/src/Compiler/Checking/NameResolution.fsi +++ b/src/Compiler/Checking/NameResolution.fsi @@ -727,7 +727,6 @@ val internal ResolvePatternLongIdent: val internal ResolveTypeLongIdentInTyconRef: sink: TcResultsSink -> ncenv: NameResolver -> - occurrence: ItemOccurence -> nenv: NameResolutionEnv -> typeNameResInfo: TypeNameResolutionInfo -> ad: AccessorDomain -> From 064980567a86052f5da4a89e412effd96d0564ec Mon Sep 17 00:00:00 2001 From: Eugene Auduchinok Date: Tue, 26 Dec 2023 18:43:04 +0100 Subject: [PATCH 07/13] Skip path typars --- src/Compiler/Checking/CheckExpressions.fs | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index 78fbe30ecef..e405ca29ae2 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -4954,7 +4954,12 @@ and TcTypeApp (cenv: cenv) newOk checkConstraints occ env tpenv m tcref pathType if tcref.Deref.IsProvided then TcProvidedTypeApp cenv env tpenv tcref synArgTys m else #endif - let tps = tinst |> List.map (fun t -> + let synArgTysLength = synArgTys.Length + let pathTypeArgsLength = pathTypeArgs.Length + if tinst.Length <> pathTypeArgsLength + synArgTysLength then + error (TyconBadArgs(env.DisplayEnv, tcref, pathTypeArgsLength + synArgTysLength, m)) + + let tps = tinst |> List.skip pathTypeArgsLength |> List.map (fun t -> match t with | TType_var(typar, _) | TType_measure(Measure.Var typar) -> typar @@ -4964,10 +4969,6 @@ and TcTypeApp (cenv: cenv) newOk checkConstraints occ env tpenv m tcref pathType // If we're not checking constraints, i.e. when we first assert the super/interfaces of a type definition, then just // clear the constraint lists of the freshly generated type variables. A little ugly but fairly localized. if checkConstraints = NoCheckCxs then tps |> List.iter (fun tp -> tp.SetConstraints []) - let synArgTysLength = synArgTys.Length - let pathTypeArgsLength = pathTypeArgs.Length - if tinst.Length <> pathTypeArgsLength + synArgTysLength then - error (TyconBadArgs(env.DisplayEnv, tcref, pathTypeArgsLength + synArgTysLength, m)) let argTys, tpenv = // Get the suffix of typars From a2a73414f6748db55b11784aa92ce2f96942eb6b Mon Sep 17 00:00:00 2001 From: Eugene Auduchinok Date: Tue, 26 Dec 2023 20:13:11 +0100 Subject: [PATCH 08/13] Add test --- tests/service/Symbols.fs | 43 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 43 insertions(+) diff --git a/tests/service/Symbols.fs b/tests/service/Symbols.fs index acbc02f6c98..b3d6261d60a 100644 --- a/tests/service/Symbols.fs +++ b/tests/service/Symbols.fs @@ -326,6 +326,49 @@ open System """ findSymbolUseByName "IDisposable" checkResults |> ignore + + [] + let ``Interface 04 - Type arg`` () = + let _, checkResults = getParseAndCheckResults """ +open System.Collections.Generic + +IList +""" + let symbolUse = findSymbolUseByName "IList`1" checkResults + let _, typeArg = symbolUse.GenericArguments[0] + typeArg.Format(symbolUse.DisplayContext) |> shouldEqual "int" + + [] + let ``Interface 05 - Type arg`` () = + let _, checkResults = getParseAndCheckResults """ +type I<'T> = + abstract M: 'T -> unit + +{ new I<_> with + member this.M(i: int) = () } +""" + let symbolUse = + getSymbolUses checkResults + |> Seq.findBack (fun symbolUse -> symbolUse.Symbol.DisplayName = "I") + + let _, typeArg = symbolUse.GenericArguments[0] + typeArg.Format(symbolUse.DisplayContext) |> shouldEqual "int" + + [] + let ``Interface 06 - Type arg`` () = + let _, checkResults = getParseAndCheckResults """ +type I<'T> = + abstract M: 'T -> unit + +{ new I with + member this.M _ = () } +""" + let symbolUse = + getSymbolUses checkResults + |> Seq.findBack (fun symbolUse -> symbolUse.Symbol.DisplayName = "I") + + let _, typeArg = symbolUse.GenericArguments[0] + typeArg.Format(symbolUse.DisplayContext) |> shouldEqual "int" [] let ``FSharpType.Format can use prefix representations`` () = From b9b1abae4861f844323b2a7d6d9646af46cb44de Mon Sep 17 00:00:00 2001 From: Eugene Auduchinok Date: Tue, 26 Dec 2023 20:33:05 +0100 Subject: [PATCH 09/13] More freshen typar APIs properly --- src/Compiler/Checking/ConstraintSolver.fs | 85 +---------------- src/Compiler/Checking/ConstraintSolver.fsi | 55 ----------- src/Compiler/Checking/NameResolution.fs | 104 ++++++++++++++++----- src/Compiler/Checking/NameResolution.fsi | 54 +++++++++++ 4 files changed, 136 insertions(+), 162 deletions(-) diff --git a/src/Compiler/Checking/ConstraintSolver.fs b/src/Compiler/Checking/ConstraintSolver.fs index c30ca0cdc66..2667ea6ccfc 100644 --- a/src/Compiler/Checking/ConstraintSolver.fs +++ b/src/Compiler/Checking/ConstraintSolver.fs @@ -57,97 +57,18 @@ open FSharp.Compiler.Import open FSharp.Compiler.InfoReader open FSharp.Compiler.Infos open FSharp.Compiler.MethodCalls +open FSharp.Compiler.NameResolution open FSharp.Compiler.Syntax open FSharp.Compiler.Syntax.PrettyNaming open FSharp.Compiler.SyntaxTreeOps open FSharp.Compiler.TcGlobals open FSharp.Compiler.Text -open FSharp.Compiler.Text.Range open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps open FSharp.Compiler.TypeHierarchy open FSharp.Compiler.TypeRelations -//------------------------------------------------------------------------- -// Generate type variables and record them in within the scope of the -// compilation environment, which currently corresponds to the scope -// of the constraint resolution carried out by type checking. -//------------------------------------------------------------------------- - -let compgenId = mkSynId range0 unassignedTyparName - -let NewCompGenTypar (kind, rigid, staticReq, dynamicReq, error) = - Construct.NewTypar(kind, rigid, SynTypar(compgenId, staticReq, true), error, dynamicReq, [], false, false) - -let AnonTyparId m = mkSynId m unassignedTyparName - -let NewAnonTypar (kind, m, rigid, var, dyn) = - Construct.NewTypar (kind, rigid, SynTypar(AnonTyparId m, var, true), false, dyn, [], false, false) - -let NewNamedInferenceMeasureVar (_m, rigid, var, id) = - Construct.NewTypar(TyparKind.Measure, rigid, SynTypar(id, var, false), false, TyparDynamicReq.No, [], false, false) - -let NewInferenceMeasurePar () = - NewCompGenTypar (TyparKind.Measure, TyparRigidity.Flexible, TyparStaticReq.None, TyparDynamicReq.No, false) - -let NewErrorTypar () = - NewCompGenTypar (TyparKind.Type, TyparRigidity.Flexible, TyparStaticReq.None, TyparDynamicReq.No, true) - -let NewErrorMeasureVar () = - NewCompGenTypar (TyparKind.Measure, TyparRigidity.Flexible, TyparStaticReq.None, TyparDynamicReq.No, true) - -let NewInferenceType (g: TcGlobals) = - ignore g // included for future, minimizing code diffs, see https://github.com/dotnet/fsharp/pull/6804 - mkTyparTy (Construct.NewTypar (TyparKind.Type, TyparRigidity.Flexible, SynTypar(compgenId, TyparStaticReq.None, true), false, TyparDynamicReq.No, [], false, false)) - -let NewErrorType () = - mkTyparTy (NewErrorTypar ()) - -let NewErrorMeasure () = - Measure.Var (NewErrorMeasureVar ()) - -let NewByRefKindInferenceType (g: TcGlobals) m = - let tp = Construct.NewTypar (TyparKind.Type, TyparRigidity.Flexible, SynTypar(compgenId, TyparStaticReq.HeadType, true), false, TyparDynamicReq.No, [], false, false) - if g.byrefkind_InOut_tcr.CanDeref then - tp.SetConstraints [TyparConstraint.DefaultsTo(10, TType_app(g.byrefkind_InOut_tcr, [], g.knownWithoutNull), m)] - mkTyparTy tp - -let NewInferenceTypes g l = l |> List.map (fun _ -> NewInferenceType g) - -let FreshenTypar (g: TcGlobals) rigid (tp: Typar) = - let clearStaticReq = g.langVersion.SupportsFeature LanguageFeature.InterfacesWithAbstractStaticMembers - let staticReq = if clearStaticReq then TyparStaticReq.None else tp.StaticReq - let dynamicReq = if rigid = TyparRigidity.Rigid then TyparDynamicReq.Yes else TyparDynamicReq.No - NewCompGenTypar (tp.Kind, rigid, staticReq, dynamicReq, false) - -// QUERY: should 'rigid' ever really be 'true'? We set this when we know -// we are going to have to generalize a typar, e.g. when implementing a -// abstract generic method slot. But we later check the generalization -// condition anyway, so we could get away with a non-rigid typar. This -// would sort of be cleaner, though give errors later. -let FreshenAndFixupTypars g m rigid fctps tinst tpsorig = - let tps = tpsorig |> List.map (FreshenTypar g rigid) - let renaming, tinst = FixupNewTypars m fctps tinst tpsorig tps - tps, renaming, tinst - -let FreshenTypeInst g m tpsorig = - FreshenAndFixupTypars g m TyparRigidity.Flexible [] [] tpsorig - -let FreshMethInst g m fctps tinst tpsorig = - FreshenAndFixupTypars g m TyparRigidity.Flexible fctps tinst tpsorig - -let FreshenTypars g m tpsorig = - match tpsorig with - | [] -> [] - | _ -> - let _, _, tpTys = FreshenTypeInst g m tpsorig - tpTys - -let FreshenMethInfo m (minfo: MethInfo) = - let _, _, tpTys = FreshMethInst minfo.TcGlobals m (minfo.GetFormalTyparsOfDeclaringType m) minfo.DeclaringTypeInst minfo.FormalMethodTypars - tpTys - //------------------------------------------------------------------------- // Unification of types: solve/record equality constraints // Subsumption of types: solve/record subtyping constraints @@ -1718,8 +1639,8 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload let propName = nm[4..] let props = supportTys |> List.choose (fun ty -> - match NameResolution.TryFindAnonRecdFieldOfType g ty propName with - | Some (NameResolution.Item.AnonRecdField(anonInfo, tinst, i, _)) -> Some (anonInfo, tinst, i) + match TryFindAnonRecdFieldOfType g ty propName with + | Some (Item.AnonRecdField(anonInfo, tinst, i, _)) -> Some (anonInfo, tinst, i) | _ -> None) match props with | [ prop ] -> Some prop diff --git a/src/Compiler/Checking/ConstraintSolver.fsi b/src/Compiler/Checking/ConstraintSolver.fsi index eb48ce3b439..aab7c04dfec 100644 --- a/src/Compiler/Checking/ConstraintSolver.fsi +++ b/src/Compiler/Checking/ConstraintSolver.fsi @@ -15,61 +15,6 @@ open FSharp.Compiler.Text open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeOps -/// Create a type variable representing the use of a "_" in F# code -val NewAnonTypar: TyparKind * range * TyparRigidity * TyparStaticReq * TyparDynamicReq -> Typar - -/// Create an inference type variable -val NewInferenceType: TcGlobals -> TType - -/// Create an inference type variable for the kind of a byref pointer -val NewByRefKindInferenceType: TcGlobals -> range -> TType - -/// Create an inference type variable representing an error condition when checking an expression -val NewErrorType: unit -> TType - -/// Create an inference type variable representing an error condition when checking a measure -val NewErrorMeasure: unit -> Measure - -/// Create a list of inference type variables, one for each element in the input list -val NewInferenceTypes: TcGlobals -> 'T list -> TType list - -/// Given a set of formal type parameters and their constraints, make new inference type variables for -/// each and ensure that the constraints on the new type variables are adjusted to refer to these. -/// -/// Returns -/// 1. the new type parameters -/// 2. the instantiation mapping old type parameters to inference variables -/// 3. the inference type variables as a list of types. -val FreshenAndFixupTypars: - g: TcGlobals -> - m: range -> - rigid: TyparRigidity -> - Typars -> - TType list -> - Typars -> - Typars * TyparInstantiation * TType list - -/// Given a set of type parameters, make new inference type variables for -/// each and ensure that the constraints on the new type variables are adjusted. -/// -/// Returns -/// 1. the new type parameters -/// 2. the instantiation mapping old type parameters to inference variables -/// 3. the inference type variables as a list of types. -val FreshenTypeInst: g: TcGlobals -> range -> Typars -> Typars * TyparInstantiation * TType list - -/// Given a set of type parameters, make new inference type variables for -/// each and ensure that the constraints on the new type variables are adjusted. -/// -/// Returns the inference type variables as a list of types. -val FreshenTypars: g: TcGlobals -> range -> Typars -> TType list - -/// Given a method, which may be generic, make new inference type variables for -/// its generic parameters, and ensure that the constraints the new type variables are adjusted. -/// -/// Returns the inference type variables as a list of types. -val FreshenMethInfo: range -> MethInfo -> TType list - /// Information about the context of a type equation. [] type ContextInfo = diff --git a/src/Compiler/Checking/NameResolution.fs b/src/Compiler/Checking/NameResolution.fs index 521c5993179..2ef76971c6c 100644 --- a/src/Compiler/Checking/NameResolution.fs +++ b/src/Compiler/Checking/NameResolution.fs @@ -1566,6 +1566,85 @@ let FreshenUnionCaseRef (ncenv: NameResolver) m (ucref: UnionCaseRef) = let FreshenRecdFieldRef (ncenv: NameResolver) m (rfref: RecdFieldRef) = RecdFieldInfo(ncenv.InstantiationGenerator m (rfref.Tycon.Typars m), rfref) +//------------------------------------------------------------------------- +// Generate type variables and record them in within the scope of the +// compilation environment, which currently corresponds to the scope +// of the constraint resolution carried out by type checking. +//------------------------------------------------------------------------- + +let compgenId = mkSynId range0 unassignedTyparName + +let NewCompGenTypar (kind, rigid, staticReq, dynamicReq, error) = + Construct.NewTypar(kind, rigid, SynTypar(compgenId, staticReq, true), error, dynamicReq, [], false, false) + +let AnonTyparId m = mkSynId m unassignedTyparName + +let NewAnonTypar (kind, m, rigid, var, dyn) = + Construct.NewTypar (kind, rigid, SynTypar(AnonTyparId m, var, true), false, dyn, [], false, false) + +let NewNamedInferenceMeasureVar (_m: range, rigid, var, id) = + Construct.NewTypar(TyparKind.Measure, rigid, SynTypar(id, var, false), false, TyparDynamicReq.No, [], false, false) + +let NewInferenceMeasurePar () = + NewCompGenTypar (TyparKind.Measure, TyparRigidity.Flexible, TyparStaticReq.None, TyparDynamicReq.No, false) + +let NewErrorTypar () = + NewCompGenTypar (TyparKind.Type, TyparRigidity.Flexible, TyparStaticReq.None, TyparDynamicReq.No, true) + +let NewErrorMeasureVar () = + NewCompGenTypar (TyparKind.Measure, TyparRigidity.Flexible, TyparStaticReq.None, TyparDynamicReq.No, true) + +let NewInferenceType (g: TcGlobals) = + ignore g // included for future, minimizing code diffs, see https://github.com/dotnet/fsharp/pull/6804 + mkTyparTy (Construct.NewTypar (TyparKind.Type, TyparRigidity.Flexible, SynTypar(compgenId, TyparStaticReq.None, true), false, TyparDynamicReq.No, [], false, false)) + +let NewErrorType () = + mkTyparTy (NewErrorTypar ()) + +let NewErrorMeasure () = + Measure.Var (NewErrorMeasureVar ()) + +let NewByRefKindInferenceType (g: TcGlobals) m = + let tp = Construct.NewTypar (TyparKind.Type, TyparRigidity.Flexible, SynTypar(compgenId, TyparStaticReq.HeadType, true), false, TyparDynamicReq.No, [], false, false) + if g.byrefkind_InOut_tcr.CanDeref then + tp.SetConstraints [TyparConstraint.DefaultsTo(10, TType_app(g.byrefkind_InOut_tcr, [], g.knownWithoutNull), m)] + mkTyparTy tp + +let NewInferenceTypes g l = l |> List.map (fun _ -> NewInferenceType g) + +let FreshenTypar (g: TcGlobals) rigid (tp: Typar) = + let clearStaticReq = g.langVersion.SupportsFeature LanguageFeature.InterfacesWithAbstractStaticMembers + let staticReq = if clearStaticReq then TyparStaticReq.None else tp.StaticReq + let dynamicReq = if rigid = TyparRigidity.Rigid then TyparDynamicReq.Yes else TyparDynamicReq.No + NewCompGenTypar (tp.Kind, rigid, staticReq, dynamicReq, false) + +// QUERY: should 'rigid' ever really be 'true'? We set this when we know +// we are going to have to generalize a typar, e.g. when implementing a +// abstract generic method slot. But we later check the generalization +// condition anyway, so we could get away with a non-rigid typar. This +// would sort of be cleaner, though give errors later. +let FreshenAndFixupTypars g m rigid fctps tinst tpsorig = + let tps = tpsorig |> List.map (FreshenTypar g rigid) + let renaming, tinst = FixupNewTypars m fctps tinst tpsorig tps + tps, renaming, tinst + +let FreshenTypeInst g m tpsorig = + FreshenAndFixupTypars g m TyparRigidity.Flexible [] [] tpsorig + +let FreshMethInst g m fctps tinst tpsorig = + FreshenAndFixupTypars g m TyparRigidity.Flexible fctps tinst tpsorig + +let FreshenTypars g m tpsorig = + match tpsorig with + | [] -> [] + | _ -> + let _, _, tpTys = FreshenTypeInst g m tpsorig + tpTys + +let FreshenMethInfo m (minfo: MethInfo) = + let _, _, tpTys = FreshMethInst minfo.TcGlobals m (minfo.GetFormalTyparsOfDeclaringType m) minfo.DeclaringTypeInst minfo.FormalMethodTypars + tpTys + /// This must be called after fetching unqualified items that may need to be freshened /// or have type instantiations let ResolveUnqualifiedItem (ncenv: NameResolver) nenv m res = @@ -2978,31 +3057,6 @@ let ResolveUnqualifiedTyconRefs nenv tcrefs = | Some tinst -> (resInfo.WithEnclosingTypeInst tinst, tcref)) -let compgenId = mkSynId range0 unassignedTyparName - -let NewCompGenTypar (kind, rigid, staticReq, dynamicReq, error) = - Construct.NewTypar(kind, rigid, SynTypar(compgenId, staticReq, true), error, dynamicReq, [], false, false) - -let FreshenTypar (g: TcGlobals) rigid (tp: Typar) = - let clearStaticReq = g.langVersion.SupportsFeature LanguageFeature.InterfacesWithAbstractStaticMembers - let staticReq = if clearStaticReq then TyparStaticReq.None else tp.StaticReq - let dynamicReq = if rigid = TyparRigidity.Rigid then TyparDynamicReq.Yes else TyparDynamicReq.No - NewCompGenTypar (tp.Kind, rigid, staticReq, dynamicReq, false) - -// QUERY: should 'rigid' ever really be 'true'? We set this when we know -// we are going to have to generalize a typar, e.g. when implementing a -// abstract generic method slot. But we later check the generalization -// condition anyway, so we could get away with a non-rigid typar. This -// would sort of be cleaner, though give errors later. -let FreshenAndFixupTypars g m rigid fctps tinst tpsorig = - let tps = tpsorig |> List.map (FreshenTypar g rigid) - let renaming, tinst = FixupNewTypars m fctps tinst tpsorig tps - tps, renaming, tinst - -let FreshenTypeInst g m tpsorig = - FreshenAndFixupTypars g m TyparRigidity.Flexible [] [] tpsorig - - /// Resolve F# "A.B.C" syntax in expressions /// Not all of the sequence will necessarily be swallowed, i.e. we return some identifiers /// that may represent further actions, e.g. further lookups. diff --git a/src/Compiler/Checking/NameResolution.fsi b/src/Compiler/Checking/NameResolution.fsi index fe40c88b546..576121ab333 100755 --- a/src/Compiler/Checking/NameResolution.fsi +++ b/src/Compiler/Checking/NameResolution.fsi @@ -676,6 +676,60 @@ exception internal UpperCaseIdentifierInPattern of range /// Generate a new reference to a record field with a fresh type instantiation val FreshenRecdFieldRef: NameResolver -> range -> RecdFieldRef -> RecdFieldInfo +/// Create a type variable representing the use of a "_" in F# code +val NewAnonTypar: TyparKind * range * TyparRigidity * TyparStaticReq * TyparDynamicReq -> Typar + +val NewNamedInferenceMeasureVar: range * TyparRigidity * TyparStaticReq * Ident -> Typar + +val NewNamedInferenceMeasureVar: range * TyparRigidity * TyparStaticReq * Ident -> Typar + +val NewInferenceMeasurePar: unit -> Typar + +/// Create an inference type variable +val NewInferenceType: TcGlobals -> TType + +/// Create an inference type variable for the kind of a byref pointer +val NewByRefKindInferenceType: TcGlobals -> range -> TType + +/// Create an inference type variable representing an error condition when checking an expression +val NewErrorType: unit -> TType + +/// Create an inference type variable representing an error condition when checking a measure +val NewErrorMeasure: unit -> Measure + +/// Create a list of inference type variables, one for each element in the input list +val NewInferenceTypes: TcGlobals -> 'T list -> TType list + +/// Given a set of type parameters, make new inference type variables for +/// each and ensure that the constraints on the new type variables are adjusted. +/// +/// Returns the inference type variables as a list of types. +val FreshenTypars: g: TcGlobals -> range -> Typars -> TType list + +/// Given a method, which may be generic, make new inference type variables for +/// its generic parameters, and ensure that the constraints the new type variables are adjusted. +/// +/// Returns the inference type variables as a list of types. +val FreshenMethInfo: range -> MethInfo -> TType list + +/// Given a set of formal type parameters and their constraints, make new inference type variables for +/// each and ensure that the constraints on the new type variables are adjusted to refer to these. +/// +/// Returns +/// 1. the new type parameters +/// 2. the instantiation mapping old type parameters to inference variables +/// 3. the inference type variables as a list of types. +val FreshenAndFixupTypars: g: TcGlobals -> m: range -> rigid: TyparRigidity -> fctps: Typars -> tinst: TType list -> tpsorig: Typar list -> Typar list * TyparInstantiation * TTypes + +/// Given a set of type parameters, make new inference type variables for +/// each and ensure that the constraints on the new type variables are adjusted. +/// +/// Returns +/// 1. the new type parameters +/// 2. the instantiation mapping old type parameters to inference variables +/// 3. the inference type variables as a list of types. +val FreshenTypeInst: g: TcGlobals -> m: range -> tpsorig: Typar list -> Typar list * TyparInstantiation * TTypes + /// Resolve a long identifier to a namespace, module. val internal ResolveLongIdentAsModuleOrNamespace: sink: TcResultsSink -> From 58a6e03e6c4551237e92434778951a980ca0528b Mon Sep 17 00:00:00 2001 From: Eugene Auduchinok Date: Tue, 26 Dec 2023 20:36:37 +0100 Subject: [PATCH 10/13] Fantomas --- src/Compiler/Checking/NameResolution.fsi | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/src/Compiler/Checking/NameResolution.fsi b/src/Compiler/Checking/NameResolution.fsi index 576121ab333..c80125f1862 100755 --- a/src/Compiler/Checking/NameResolution.fsi +++ b/src/Compiler/Checking/NameResolution.fsi @@ -719,7 +719,14 @@ val FreshenMethInfo: range -> MethInfo -> TType list /// 1. the new type parameters /// 2. the instantiation mapping old type parameters to inference variables /// 3. the inference type variables as a list of types. -val FreshenAndFixupTypars: g: TcGlobals -> m: range -> rigid: TyparRigidity -> fctps: Typars -> tinst: TType list -> tpsorig: Typar list -> Typar list * TyparInstantiation * TTypes +val FreshenAndFixupTypars: + g: TcGlobals -> + m: range -> + rigid: TyparRigidity -> + fctps: Typars -> + tinst: TType list -> + tpsorig: Typar list -> + Typar list * TyparInstantiation * TTypes /// Given a set of type parameters, make new inference type variables for /// each and ensure that the constraints on the new type variables are adjusted. From e1679c43d2aab9cde2cedae32efea6779f9fc5b6 Mon Sep 17 00:00:00 2001 From: Eugene Auduchinok Date: Tue, 26 Dec 2023 22:02:23 +0100 Subject: [PATCH 11/13] Cleanup --- src/Compiler/Checking/NameResolution.fs | 26 ++++++++++++------------- 1 file changed, 12 insertions(+), 14 deletions(-) diff --git a/src/Compiler/Checking/NameResolution.fs b/src/Compiler/Checking/NameResolution.fs index 2ef76971c6c..cbea7f4cf6f 100644 --- a/src/Compiler/Checking/NameResolution.fs +++ b/src/Compiler/Checking/NameResolution.fs @@ -3162,10 +3162,8 @@ let rec ResolveExprLongIdentPrim sink (ncenv: NameResolver) first fullyQualified match tyconSearch () with | Result((resInfo, tcref) :: _) -> - let inst = FreshenTypeInst ncenv.g m (tcref.Typars m) - let _, _, tTypes = inst - let tType = TType_app(tcref, tTypes, ncenv.g.knownWithoutNull) - let item = Item.Types(id.idText, [ tType ]) + let _, _, tyargs = FreshenTypeInst ncenv.g m (tcref.Typars m) + let item = Item.Types(id.idText, [TType_app(tcref, tyargs, ncenv.g.knownWithoutNull)]) success (resInfo, item) | _ -> @@ -3530,11 +3528,11 @@ let ResolveTypeLongIdentInTyconRef sink (ncenv: NameResolver) nenv typeNameResIn ForceRaise (ResolveTypeLongIdentInTyconRefPrim ncenv typeNameResInfo ad ResolutionInfo.Empty PermitDirectReferenceToGeneratedType.No 0 m tcref id rest) ResolutionInfo.SendEntityPathToSink(sink, ncenv, nenv, ItemOccurence.Use, ad, resInfo, ResultTyparChecker(fun () -> true)) - let _, tinst, args = FreshenTypeInst ncenv.g m (tcref.Typars m) - let ttype = TType_app(tcref, args, ncenv.g.knownWithoutNull) - let item = Item.Types(tcref.DisplayName, [ttype]) + let _, tinst, tyargs = FreshenTypeInst ncenv.g m (tcref.Typars m) + let item = Item.Types(tcref.DisplayName, [TType_app(tcref, tyargs, ncenv.g.knownWithoutNull)]) CallNameResolutionSink sink (rangeOfLid lid, nenv, item, tinst, ItemOccurence.UseInType, ad) - tcref, args + + tcref, tyargs /// Create an UndefinedName error with details let SuggestTypeLongIdentInModuleOrNamespace depth (modref: ModuleOrNamespaceRef) amap ad m (id: Ident) = @@ -3692,12 +3690,12 @@ let ResolveTypeLongIdentAux sink (ncenv: NameResolver) occurence fullyQualified match res with | Result (resInfo, tcref) -> ResolutionInfo.SendEntityPathToSink(sink, ncenv, nenv, ItemOccurence.UseInType, ad, resInfo, ResultTyparChecker(fun () -> true)) - let inst = FreshenTypeInst ncenv.g m (tcref.Typars m) - let _, inst2, tTypes = inst - let ttype = TType_app(tcref, tTypes, ncenv.g.knownWithoutNull) - let item = Item.Types(tcref.DisplayName, [ttype]) - CallNameResolutionSink sink (m, nenv, item, inst2, occurence, ad) - Result(resInfo, tcref, tTypes) + + let _, tinst, tyargs = FreshenTypeInst ncenv.g m (tcref.Typars m) + let item = Item.Types(tcref.DisplayName, [TType_app(tcref, tyargs, ncenv.g.knownWithoutNull)]) + CallNameResolutionSink sink (m, nenv, item, tinst, occurence, ad) + + Result(resInfo, tcref, tyargs) | Exception exn -> Exception exn From 05dd468608daa47264d61641ee830b3a4801bae0 Mon Sep 17 00:00:00 2001 From: Eugene Auduchinok Date: Wed, 3 Jan 2024 14:08:57 +0100 Subject: [PATCH 12/13] Add release notes --- docs/release-notes/.FSharp.Compiler.Service/8.0.200.md | 1 + 1 file changed, 1 insertion(+) diff --git a/docs/release-notes/.FSharp.Compiler.Service/8.0.200.md b/docs/release-notes/.FSharp.Compiler.Service/8.0.200.md index 3eb14e5457c..ff568c60eb8 100644 --- a/docs/release-notes/.FSharp.Compiler.Service/8.0.200.md +++ b/docs/release-notes/.FSharp.Compiler.Service/8.0.200.md @@ -13,3 +13,4 @@ * Parser recovers on unfinished enum case declarations. ([PR #16401](https://github.com/dotnet/fsharp/pull/16401)) * Parser recovers on unfinished record declarations. ([PR #16357](https://github.com/dotnet/fsharp/pull/16357)) * `MutableKeyword` to [SynFieldTrivia](../reference/fsharp-compiler-syntaxtrivia-synfieldtrivia.html) ([PR #16357](https://github.com/dotnet/fsharp/pull/16357)) +* Name resolution: keep type vars in subsequent checks ([PR #16456](https://github.com/dotnet/fsharp/pull/16456)) From 798e069705de9bfb0455cc7506b0ccbca2795c56 Mon Sep 17 00:00:00 2001 From: Eugene Auduchinok Date: Mon, 15 Jan 2024 16:00:33 +0100 Subject: [PATCH 13/13] 123 --- docs/release-notes/.FSharp.Compiler.Service/8.0.200.md | 1 - docs/release-notes/.FSharp.Compiler.Service/8.0.300.md | 1 + 2 files changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/release-notes/.FSharp.Compiler.Service/8.0.200.md b/docs/release-notes/.FSharp.Compiler.Service/8.0.200.md index 952e7d4c37d..72037533dfd 100644 --- a/docs/release-notes/.FSharp.Compiler.Service/8.0.200.md +++ b/docs/release-notes/.FSharp.Compiler.Service/8.0.200.md @@ -14,7 +14,6 @@ * Parser recovers on unfinished enum case declarations. ([PR #16401](https://github.com/dotnet/fsharp/pull/16401)) * Parser recovers on unfinished record declarations. ([PR #16357](https://github.com/dotnet/fsharp/pull/16357)) * `MutableKeyword` to [SynFieldTrivia](../reference/fsharp-compiler-syntaxtrivia-synfieldtrivia.html) ([PR #16357](https://github.com/dotnet/fsharp/pull/16357)) -* Name resolution: keep type vars in subsequent checks ([PR #16456](https://github.com/dotnet/fsharp/pull/16456)) * Added support for a new parameterless constructor for `CustomOperationAttribute`, which, when applied, will use method name as keyword for custom operation in computation expression builder. ([PR #16475](https://github.com/dotnet/fsharp/pull/16475), part of implementation for [fslang-suggestions/1250](https://github.com/fsharp/fslang-suggestions/issues/1250)) ### Changed diff --git a/docs/release-notes/.FSharp.Compiler.Service/8.0.300.md b/docs/release-notes/.FSharp.Compiler.Service/8.0.300.md index ac442a61549..d153e616586 100644 --- a/docs/release-notes/.FSharp.Compiler.Service/8.0.300.md +++ b/docs/release-notes/.FSharp.Compiler.Service/8.0.300.md @@ -5,6 +5,7 @@ ### Added * Parser recovers on complex primary constructor patterns, better tree representation for primary constructor patterns. ([PR #16425](https://github.com/dotnet/fsharp/pull/16425)) +* Name resolution: keep type vars in subsequent checks ([PR #16456](https://github.com/dotnet/fsharp/pull/16456)) ### Changed