diff --git a/docs/release-notes/.FSharp.Compiler.Service/11.0.0.md b/docs/release-notes/.FSharp.Compiler.Service/11.0.0.md index c2358744c8f..660fb9e62cb 100644 --- a/docs/release-notes/.FSharp.Compiler.Service/11.0.0.md +++ b/docs/release-notes/.FSharp.Compiler.Service/11.0.0.md @@ -8,6 +8,7 @@ * Type relations cache: handle potentially "infinite" types ([PR #19010](https://github.com/dotnet/fsharp/pull/19010)) * Disallow recursive structs with lifted type parameters ([Issue #18993](https://github.com/dotnet/fsharp/issues/18993), [PR #19031](https://github.com/dotnet/fsharp/pull/19031)) * Fix units-of-measure changes not invalidating incremental builds. ([Issue #19049](https://github.com/dotnet/fsharp/issues/19049)) +* Type relations cache: handle unsolved type variables ([Issue #19037](https://github.com/dotnet/fsharp/issues/19037)) ([PR #19040](https://github.com/dotnet/fsharp/pull/19040)) ### Added diff --git a/src/Compiler/Checking/TypeRelations.fs b/src/Compiler/Checking/TypeRelations.fs index cb71ea87de8..75a06487c61 100644 --- a/src/Compiler/Checking/TypeRelations.fs +++ b/src/Compiler/Checking/TypeRelations.fs @@ -29,11 +29,13 @@ type CanCoerce = type TTypeCacheKey = | TTypeCacheKey of TypeStructure * TypeStructure * CanCoerce static member TryGetFromStrippedTypes(ty1, ty2, canCoerce) = - let t1, t2 = getTypeStructure ty1, getTypeStructure ty2 - if t1.IsPossiblyInfinite || t2.IsPossiblyInfinite then - ValueNone - else - ValueSome (TTypeCacheKey(t1, t2, canCoerce)) + let tryGetTypeStructure ty = + match ty with + | TType_app _ -> tryGetTypeStructureOfStrippedType ty + | _ -> ValueNone + + (tryGetTypeStructure ty1, tryGetTypeStructure ty2) + ||> ValueOption.map2(fun t1 t2 -> TTypeCacheKey(t1, t2, canCoerce)) let getTypeSubsumptionCache = let factory (g: TcGlobals) = @@ -137,10 +139,6 @@ let rec TypeFeasiblySubsumesType ndeep (g: TcGlobals) (amap: ImportMap) m (ty1: let checkSubsumes ty1 ty2 = match ty1, ty2 with - | TType_measure _, TType_measure _ - | 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 @@ -160,13 +158,17 @@ let rec TypeFeasiblySubsumesType ndeep (g: TcGlobals) (amap: ImportMap) m (ty1: // See if any interface in type hierarchy of ty2 is a supertype of ty1 List.exists (TypeFeasiblySubsumesType (ndeep + 1) g amap m ty1 NoCoerce) interfaces - if g.langVersion.SupportsFeature LanguageFeature.UseTypeSubsumptionCache then + match ty1, ty2 with + | TType_measure _, TType_measure _ + | TType_var _, _ | _, TType_var _ -> + true + + | _ when g.langVersion.SupportsFeature LanguageFeature.UseTypeSubsumptionCache -> match TTypeCacheKey.TryGetFromStrippedTypes(ty1, ty2, canCoerce) with | ValueSome key -> (getTypeSubsumptionCache g).GetOrAdd(key, fun _ -> checkSubsumes ty1 ty2) | _ -> checkSubsumes ty1 ty2 - else - checkSubsumes ty1 ty2 + | _ -> checkSubsumes ty1 ty2 and TypeFeasiblySubsumesTypeWithSupertypeCheck g amap m ndeep ty1 ty2 = match GetSuperTypeOfType g amap m ty2 with diff --git a/src/Compiler/Utilities/TypeHashing.fs b/src/Compiler/Utilities/TypeHashing.fs index e026411ed71..7270d69deb3 100644 --- a/src/Compiler/Utilities/TypeHashing.fs +++ b/src/Compiler/Utilities/TypeHashing.fs @@ -1,7 +1,6 @@ module internal Internal.Utilities.TypeHashing open Internal.Utilities.Rational -open Internal.Utilities.Library open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.Syntax open FSharp.Compiler.TcGlobals @@ -9,7 +8,6 @@ open FSharp.Compiler.Text open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps -open System.Collections.Immutable type ObserverVisibility = | PublicOnly @@ -126,7 +124,6 @@ module HashAccessibility = | _ -> true module rec HashTypes = - open Microsoft.FSharp.Core.LanguagePrimitives /// Hash a reference to a type let hashTyconRef tcref = hashTyconRefImpl tcref @@ -380,7 +377,7 @@ module HashTastMemberOrVals = /// * Uses per-compilation stamps (entities, typars, anon records, measures). /// * Emits shape for union cases (declaring type stamp + case name), tuple structness, /// function arrows, forall binders, nullness, measures, generic arguments. -/// * Unknown/variable nullness => NeverEqual token to force inequality (avoid unsound hits). +/// * Does not include type constraints. /// /// Non-goals: /// * Cross-compilation stability. @@ -388,53 +385,48 @@ module HashTastMemberOrVals = /// /// module StructuralUtilities = - [] - type NeverEqual = - struct - interface System.IEquatable with - member _.Equals _ = false - - override _.Equals _ = false - override _.GetHashCode() = 0 - end - - static member Singleton = NeverEqual() [] type TypeToken = | Stamp of stamp: Stamp | UCase of name: string | Nullness of nullness: NullnessInfo + | NullnessUnsolved | TupInfo of b: bool + | Forall of int | MeasureOne | MeasureRational of int * int - | NeverEqual of never: NeverEqual + | Unsolved of int + | Rigid of int - type TypeStructure = - | TypeStructure of TypeToken[] - | PossiblyInfinite of never: NeverEqual + type TypeStructure = TypeStructure of TypeToken[] + + type private EmitContext = + { + typarMap: System.Collections.Generic.Dictionary + } - let inline toNullnessToken (n: Nullness) = + let inline emitNullness (n: Nullness) = match n.TryEvaluate() with | ValueSome k -> TypeToken.Nullness k - | _ -> TypeToken.NeverEqual NeverEqual.Singleton + | ValueNone -> TypeToken.NullnessUnsolved - let rec private accumulateMeasure (m: Measure) = + let rec private emitMeasure (m: Measure) = seq { match m with | Measure.Var mv -> TypeToken.Stamp mv.Stamp | Measure.Const(tcref, _) -> TypeToken.Stamp tcref.Stamp | Measure.Prod(m1, m2, _) -> - yield! accumulateMeasure m1 - yield! accumulateMeasure m2 - | Measure.Inv m1 -> yield! accumulateMeasure m1 + yield! emitMeasure m1 + yield! emitMeasure m2 + | Measure.Inv m1 -> yield! emitMeasure m1 | Measure.One _ -> TypeToken.MeasureOne | Measure.RationalPower(m1, r) -> - yield! accumulateMeasure m1 + yield! emitMeasure m1 TypeToken.MeasureRational(GetNumerator r, GetDenominator r) } - let rec private accumulateTType (ty: TType) = + and private emitTType (env: EmitContext) (ty: TType) = seq { match ty with | TType_ucase(u, tinst) -> @@ -442,48 +434,77 @@ module StructuralUtilities = TypeToken.UCase u.CaseName for arg in tinst do - yield! accumulateTType arg + yield! emitTType env arg | TType_app(tcref, tinst, n) -> TypeToken.Stamp tcref.Stamp - toNullnessToken n + emitNullness n for arg in tinst do - yield! accumulateTType arg + yield! emitTType env arg + | TType_anon(info, tys) -> TypeToken.Stamp info.Stamp for arg in tys do - yield! accumulateTType arg + yield! emitTType env arg + | TType_tuple(tupInfo, tys) -> TypeToken.TupInfo(evalTupInfoIsStruct tupInfo) for arg in tys do - yield! accumulateTType arg + yield! emitTType env arg + | TType_forall(tps, tau) -> for tp in tps do - TypeToken.Stamp tp.Stamp + env.typarMap.[tp.Stamp] <- env.typarMap.Count + + TypeToken.Forall tps.Length + + yield! emitTType env tau - yield! accumulateTType tau | TType_fun(d, r, n) -> - yield! accumulateTType d - yield! accumulateTType r - toNullnessToken n + yield! emitTType env d + yield! emitTType env r + emitNullness n + | TType_var(r, n) -> - TypeToken.Stamp r.Stamp - toNullnessToken n - | TType_measure m -> yield! accumulateMeasure m + emitNullness n + + let typarId = + match env.typarMap.TryGetValue r.Stamp with + | true, idx -> idx + | _ -> + let idx = env.typarMap.Count + env.typarMap.[r.Stamp] <- idx + idx + + match r.Solution with + | Some ty -> + yield! emitTType env ty + | None -> + if r.Rigidity = TyparRigidity.Rigid then + TypeToken.Rigid typarId + else + TypeToken.Unsolved typarId + | TType_measure m -> yield! emitMeasure m } - // If the sequence got too long, just drop it, we could be dealing with an infinite type. - let private toTypeStructure tokens = - let tokens = tokens |> Seq.truncate 256 |> Array.ofSeq + let tryGetTypeStructureOfStrippedType (ty: TType) = + let env = + { + typarMap = System.Collections.Generic.Dictionary() + } + + let tokens = + emitTType env ty + |> Seq.filter (fun t -> t <> TypeToken.Nullness NullnessInfo.WithoutNull) + |> Seq.truncate 256 + |> Seq.toArray + + // If the sequence got too long, just drop it, we could be dealing with an infinite type. if tokens.Length = 256 then - PossiblyInfinite NeverEqual.Singleton + ValueNone else - TypeStructure tokens - - /// Get the full structure of a type as a sequence of tokens, suitable for equality - let getTypeStructure = - Extras.WeakMap.getOrCreate (fun ty -> accumulateTType ty |> toTypeStructure) + ValueSome(TypeStructure tokens) diff --git a/src/Compiler/Utilities/lib.fs b/src/Compiler/Utilities/lib.fs index 540ea8c4527..a05bf5d20bc 100755 --- a/src/Compiler/Utilities/lib.fs +++ b/src/Compiler/Utilities/lib.fs @@ -473,3 +473,15 @@ module WeakMap = // Cached factory to avoid allocating a new lambda per lookup. let factory = ConditionalWeakTable.CreateValueCallback(fun k -> valueFactory k) fun (key: 'Key when 'Key: not null) -> table.GetValue(key, factory) + + /// Like getOrCreate, but only cache the value if it satisfies the given predicate. + let cacheConditionally shouldCache valueFactory = + let table = ConditionalWeakTable<_, _>() + fun (key: 'Key when 'Key: not null) -> + match table.TryGetValue key with + | true, value -> value + | false, _ -> + let value = valueFactory key + if shouldCache value then + try table.Add(key, value) with _ -> () + value diff --git a/src/Compiler/Utilities/lib.fsi b/src/Compiler/Utilities/lib.fsi index fcf977683d3..132fbc42182 100644 --- a/src/Compiler/Utilities/lib.fsi +++ b/src/Compiler/Utilities/lib.fsi @@ -307,3 +307,8 @@ module internal WeakMap = val internal getOrCreate: valueFactory: ('Key -> 'Value) -> ('Key -> 'Value) when 'Key: not struct and 'Key: not null and 'Value: not struct + + /// Like getOrCreate, but only cache the value if it satisfies the given predicate. + val cacheConditionally: + shouldCache: ('Value -> bool) -> valueFactory: ('Key -> 'Value) -> ('Key -> 'Value) + when 'Key: not struct and 'Key: not null and 'Value: not struct diff --git a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj index 29847415be2..8f5ace7aade 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj +++ b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj @@ -277,6 +277,7 @@ + diff --git a/tests/FSharp.Compiler.ComponentTests/TypeChecks/CrgpLibrary.fs b/tests/FSharp.Compiler.ComponentTests/TypeChecks/CrgpLibrary.fs new file mode 100644 index 00000000000..0c64b053d30 --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/TypeChecks/CrgpLibrary.fs @@ -0,0 +1,34 @@ +module MyModule + +type IFoo<'T when 'T :> IFoo<'T>> = + abstract member Bar: other:'T -> unit + +[] +type FooBase() = + + interface IFoo with + member this.Bar (other: FooBase) = () + +[] +type FooDerived<'T>() = + inherit FooBase() + + interface IFoo> with + member this.Bar other = () + +type IFooContainer<'T> = + abstract member Foo: FooDerived<'T> + +let inline bar<'a when 'a :> IFoo<'a>> (x: 'a) (y: 'a) = x.Bar y +let inline takeSame<'a> (x: 'a) (y: 'a) = () + +// Successfully compiles under .NET 9 + F# 9 +// Error under .NET 10 + F# 10: Program.fs(26,13): Error FS0193 : The type 'FooDerived<'TId>' does not match the type 'FooBase' +let callBar_NewlyBroken (foo1: IFooContainer<'TId>) (foo2: IFooContainer<'TId>) = + bar foo1.Foo foo2.Foo + +// Successfully compiles under both versions +let callBar (foo1: IFooContainer<'TId>) (foo2: IFooContainer<'TId>) = + let id1 = foo1.Foo + let id2 = foo2.Foo + bar id1 id2 \ No newline at end of file diff --git a/tests/FSharp.Compiler.ComponentTests/TypeChecks/TypeRelations.fs b/tests/FSharp.Compiler.ComponentTests/TypeChecks/TypeRelations.fs new file mode 100644 index 00000000000..d3110beb697 --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/TypeChecks/TypeRelations.fs @@ -0,0 +1,12 @@ +module TypeChecks.TypeRelations + +open Xunit +open FSharp.Test.Compiler +open FSharp.Test + +[] +let ``Unsolved type variables are not cached`` compilation = + compilation + |> getCompilation + |> typecheck + |> shouldSucceed \ No newline at end of file