Skip to content

Commit

Permalink
Handle |null types when optimizing away equals/hash/compare from Lang…
Browse files Browse the repository at this point in the history
…uagePrimitves into instance method calls (#18296)

* Handle |null types when optimizing away eqals/hash/compare from function call to instance method

* Set propper test assert

* fantomas and notes

* remove comment
  • Loading branch information
T-Gro authored Feb 7, 2025
1 parent 841ba8e commit ee55997
Show file tree
Hide file tree
Showing 4 changed files with 94 additions and 25 deletions.
1 change: 1 addition & 0 deletions docs/release-notes/.FSharp.Compiler.Service/9.0.300.md
Original file line number Diff line number Diff line change
Expand Up @@ -7,6 +7,7 @@
* Fix missing nullness warning when static upcast dropped nullness ([Issue #18232](https://github.com/dotnet/fsharp/issues/18232), [PR #18261](https://github.com/dotnet/fsharp/pull/18261))
* Cancellable: only cancel on OCE with own token ([PR #18277](https://github.com/dotnet/fsharp/pull/18277))
* Cancellable: set token in more places ([PR #18283](https://github.com/dotnet/fsharp/pull/18283))
* Fix NRE when accessing nullable fields of types within their equals/hash/compare methods ([PR #18296](https://github.com/dotnet/fsharp/pull/18296))

### Added
* Added missing type constraints in FCS. ([PR #18241](https://github.com/dotnet/fsharp/pull/18241))
Expand Down
6 changes: 6 additions & 0 deletions src/Compiler/Checking/AugmentWithHashCompare.fsi
Original file line number Diff line number Diff line change
Expand Up @@ -14,6 +14,12 @@ type EqualityWithComparerAugmentation =
EqualsWithComparer: Val
EqualsExactWithComparer: Val }

val mkBindNullComparison: TcGlobals -> Text.Range -> thise: Expr -> thate: Expr -> expr: Expr -> Expr

val mkBindThisNullEquals: TcGlobals -> Text.Range -> thise: Expr -> thate: Expr -> expr: Expr -> Expr

val mkBindNullHash: TcGlobals -> Text.Range -> thise: Expr -> expr: Expr -> Expr

val CheckAugmentationAttribs: bool -> TcGlobals -> Import.ImportMap -> Tycon -> unit

val TyconIsCandidateForAugmentationWithCompare: TcGlobals -> Tycon -> bool
Expand Down
66 changes: 42 additions & 24 deletions src/Compiler/Optimize/Optimizer.fs
Original file line number Diff line number Diff line change
Expand Up @@ -1664,7 +1664,9 @@ and OpHasEffect g m op =
| TOp.ExnFieldGet (ecref, n) -> isExnFieldMutable ecref n
| TOp.RefAddrGet _ -> false
| TOp.AnonRecdGet _ -> true // conservative
| TOp.ValFieldGet rfref -> rfref.RecdField.IsMutable || (TryFindTyconRefBoolAttribute g range0 g.attrib_AllowNullLiteralAttribute rfref.TyconRef = Some true)
| TOp.ValFieldGet rfref ->
rfref.RecdField.IsMutable
|| (TryFindTyconRefBoolAttribute g range0 g.attrib_AllowNullLiteralAttribute rfref.TyconRef = Some true)
| TOp.ValFieldGetAddr (rfref, _readonly) -> rfref.RecdField.IsMutable
| TOp.UnionCaseFieldGetAddr _ -> false // union case fields are immutable
| TOp.LValueOp (LAddrOf _, _) -> false // addresses of values are always constants
Expand Down Expand Up @@ -3167,7 +3169,7 @@ and CanDevirtualizeApplication cenv v vref ty args =
&& not (isUnitTy g ty)
&& isAppTy g ty
// Exclusion: Some unions have null as representations
&& not (IsUnionTypeWithNullAsTrueValue g (fst(StripToNominalTyconRef cenv ty)).Deref)
&& not (IsUnionTypeWithNullAsTrueValue g (fst(StripToNominalTyconRef cenv ty)).Deref)
// If we de-virtualize an operation on structs then we have to take the address of the object argument
// Hence we have to actually have the object argument available to us,
&& (not (isStructTy g ty) || not (isNil args))
Expand All @@ -3189,9 +3191,13 @@ and TakeAddressOfStructArgumentIfNeeded cenv (vref: ValRef) ty args m =
else
id, args

and DevirtualizeApplication cenv env (vref: ValRef) ty tyargs args m =
and DevirtualizeApplication cenv env (vref: ValRef) ty tyargs args m nullHandlerOpt =
let g = cenv.g
let wrap, args = TakeAddressOfStructArgumentIfNeeded cenv vref ty args m
let wrap, args =
match nullHandlerOpt with
| Some nullHandler when g.checkNullness && TypeNullIsExtraValueNew g vref.Range ty ->
nullHandler g m, args
| _ -> TakeAddressOfStructArgumentIfNeeded cenv vref ty args m
let transformedExpr = wrap (MakeApplicationAndBetaReduce g (exprForValRef m vref, vref.Type, (if isNil tyargs then [] else [tyargs]), args, m))
OptimizeExpr cenv env transformedExpr

Expand All @@ -3212,8 +3218,10 @@ and TryDevirtualizeApplication cenv env (f, tyargs, args, m) =
| Expr.Val (v, _, _), [ty], _ when CanDevirtualizeApplication cenv v g.generic_comparison_inner_vref ty args ->

let tcref, tyargs = StripToNominalTyconRef cenv ty
match tcref.GeneratedCompareToValues with
| Some (_, vref) -> Some (DevirtualizeApplication cenv env vref ty tyargs args m)
match tcref.GeneratedCompareToValues, args with
| Some (_, vref), [x;y] ->
let nullHandler g m = AugmentTypeDefinitions.mkBindNullComparison g m x y
Some (DevirtualizeApplication cenv env vref ty tyargs args m (Some nullHandler))
| _ -> None

| Expr.Val (v, _, _), [ty], _ when CanDevirtualizeApplication cenv v g.generic_comparison_withc_inner_vref ty args ->
Expand All @@ -3225,7 +3233,8 @@ and TryDevirtualizeApplication cenv env (f, tyargs, args, m) =
// arg list, and create a tuple of y & comp
// push the comparer to the end and box the argument
let args2 = [x; mkRefTupledNoTypes g m [mkCoerceExpr(y, g.obj_ty_ambivalent, m, ty) ; comp]]
Some (DevirtualizeApplication cenv env vref ty tyargs args2 m)
let nullHandler g m = AugmentTypeDefinitions.mkBindNullComparison g m x y
Some (DevirtualizeApplication cenv env vref ty tyargs args2 m (Some nullHandler))
| _ -> None

// Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericEqualityIntrinsic when type is known
Expand All @@ -3235,8 +3244,10 @@ and TryDevirtualizeApplication cenv env (f, tyargs, args, m) =
| Expr.Val (v, _, _), [ty], _ when CanDevirtualizeApplication cenv v g.generic_equality_er_inner_vref ty args ->

let tcref, tyargs = StripToNominalTyconRef cenv ty
match tcref.GeneratedHashAndEqualsValues with
| Some (_, vref) -> Some (DevirtualizeApplication cenv env vref ty tyargs args m)
match tcref.GeneratedHashAndEqualsValues, args with
| Some (_, vref),[x;y] ->
let nullHandler g m = AugmentTypeDefinitions.mkBindThisNullEquals g m x y
Some (DevirtualizeApplication cenv env vref ty tyargs args m (Some nullHandler))
| _ -> None

// Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericEqualityWithComparerIntrinsic
Expand All @@ -3246,11 +3257,13 @@ and TryDevirtualizeApplication cenv env (f, tyargs, args, m) =
| Some (_, _, _, Some withcEqualsExactVal), [comp; x; y] ->
// push the comparer to the end
let args2 = [x; mkRefTupledNoTypes g m [y; comp]]
Some (DevirtualizeApplication cenv env withcEqualsExactVal ty tyargs args2 m)
let nullHandler g m = AugmentTypeDefinitions.mkBindThisNullEquals g m x y
Some (DevirtualizeApplication cenv env withcEqualsExactVal ty tyargs args2 m (Some nullHandler))
| Some (_, _, withcEqualsVal, _ ), [comp; x; y] ->
// push the comparer to the end and box the argument
let args2 = [x; mkRefTupledNoTypes g m [mkCoerceExpr(y, g.obj_ty_ambivalent, m, ty) ; comp]]
Some (DevirtualizeApplication cenv env withcEqualsVal ty tyargs args2 m)
let nullHandler g m = AugmentTypeDefinitions.mkBindThisNullEquals g m x y
Some (DevirtualizeApplication cenv env withcEqualsVal ty tyargs args2 m (Some nullHandler))
| _ -> None

// Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericEqualityIntrinsic
Expand All @@ -3259,20 +3272,23 @@ and TryDevirtualizeApplication cenv env (f, tyargs, args, m) =
match tcref.GeneratedHashAndEqualsWithComparerValues, args with
| Some (_, _, _, Some withcEqualsExactVal), [x; y] ->
let args2 = [x; mkRefTupledNoTypes g m [y; (mkCallGetGenericPEREqualityComparer g m)]]
Some (DevirtualizeApplication cenv env withcEqualsExactVal ty tyargs args2 m)
let nullHandler g m = AugmentTypeDefinitions.mkBindThisNullEquals g m x y
Some (DevirtualizeApplication cenv env withcEqualsExactVal ty tyargs args2 m (Some nullHandler))
| Some (_, _, withcEqualsVal, _), [x; y] ->
let equalsExactOpt =
tcref.MembersOfFSharpTyconByName.TryFind("Equals")
|> Option.map (List.where (fun x -> x.IsCompilerGenerated))
|> Option.bind List.tryExactlyOne

let nullHandler g m = AugmentTypeDefinitions.mkBindThisNullEquals g m x y

match equalsExactOpt with
| Some equalsExact ->
let args2 = [x; mkRefTupledNoTypes g m [y; (mkCallGetGenericPEREqualityComparer g m)]]
Some (DevirtualizeApplication cenv env equalsExact ty tyargs args2 m)
Some (DevirtualizeApplication cenv env equalsExact ty tyargs args2 m (Some nullHandler))
| None ->
let args2 = [x; mkRefTupledNoTypes g m [mkCoerceExpr(y, g.obj_ty_ambivalent, m, ty); (mkCallGetGenericPEREqualityComparer g m)]]
Some (DevirtualizeApplication cenv env withcEqualsVal ty tyargs args2 m)
Some (DevirtualizeApplication cenv env withcEqualsVal ty tyargs args2 m (Some nullHandler))
| _ -> None

// Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericHashIntrinsic
Expand All @@ -3281,7 +3297,8 @@ and TryDevirtualizeApplication cenv env (f, tyargs, args, m) =
match tcref.GeneratedHashAndEqualsWithComparerValues, args with
| Some (_, withcGetHashCodeVal, _, _), [x] ->
let args2 = [x; mkCallGetGenericEREqualityComparer g m]
Some (DevirtualizeApplication cenv env withcGetHashCodeVal ty tyargs args2 m)
let nullHandler g m = AugmentTypeDefinitions.mkBindNullHash g m x
Some (DevirtualizeApplication cenv env withcGetHashCodeVal ty tyargs args2 m (Some nullHandler))
| _ -> None

// Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericHashWithComparerIntrinsic
Expand All @@ -3290,7 +3307,8 @@ and TryDevirtualizeApplication cenv env (f, tyargs, args, m) =
match tcref.GeneratedHashAndEqualsWithComparerValues, args with
| Some (_, withcGetHashCodeVal, _, _), [comp; x] ->
let args2 = [x; comp]
Some (DevirtualizeApplication cenv env withcGetHashCodeVal ty tyargs args2 m)
let nullHandler g m = AugmentTypeDefinitions.mkBindNullHash g m x
Some (DevirtualizeApplication cenv env withcGetHashCodeVal ty tyargs args2 m (Some nullHandler))
| _ -> None

// Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericComparisonWithComparerIntrinsic for tuple types
Expand All @@ -3304,7 +3322,7 @@ and TryDevirtualizeApplication cenv env (f, tyargs, args, m) =
| 5 -> Some g.generic_compare_withc_tuple5_vref
| _ -> None
match vref with
| Some vref -> Some (DevirtualizeApplication cenv env vref ty tyargs (mkCallGetGenericComparer g m :: args) m)
| Some vref -> Some (DevirtualizeApplication cenv env vref ty tyargs (mkCallGetGenericComparer g m :: args) m None)
| None -> None

// Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericHashWithComparerIntrinsic for tuple types
Expand All @@ -3318,7 +3336,7 @@ and TryDevirtualizeApplication cenv env (f, tyargs, args, m) =
| 5 -> Some g.generic_hash_withc_tuple5_vref
| _ -> None
match vref with
| Some vref -> Some (DevirtualizeApplication cenv env vref ty tyargs (mkCallGetGenericEREqualityComparer g m :: args) m)
| Some vref -> Some (DevirtualizeApplication cenv env vref ty tyargs (mkCallGetGenericEREqualityComparer g m :: args) m None)
| None -> None

// Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericEqualityIntrinsic for tuple types
Expand All @@ -3334,7 +3352,7 @@ and TryDevirtualizeApplication cenv env (f, tyargs, args, m) =
| 5 -> Some g.generic_equals_withc_tuple5_vref
| _ -> None
match vref with
| Some vref -> Some (DevirtualizeApplication cenv env vref ty tyargs (mkCallGetGenericPEREqualityComparer g m :: args) m)
| Some vref -> Some (DevirtualizeApplication cenv env vref ty tyargs (mkCallGetGenericPEREqualityComparer g m :: args) m None)
| None -> None

// Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericComparisonWithComparerIntrinsic for tuple types
Expand All @@ -3348,7 +3366,7 @@ and TryDevirtualizeApplication cenv env (f, tyargs, args, m) =
| 5 -> Some g.generic_compare_withc_tuple5_vref
| _ -> None
match vref with
| Some vref -> Some (DevirtualizeApplication cenv env vref ty tyargs args m)
| Some vref -> Some (DevirtualizeApplication cenv env vref ty tyargs args m None)
| None -> None

// Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericHashWithComparerIntrinsic for tuple types
Expand All @@ -3362,7 +3380,7 @@ and TryDevirtualizeApplication cenv env (f, tyargs, args, m) =
| 5 -> Some g.generic_hash_withc_tuple5_vref
| _ -> None
match vref with
| Some vref -> Some (DevirtualizeApplication cenv env vref ty tyargs args m)
| Some vref -> Some (DevirtualizeApplication cenv env vref ty tyargs args m None)
| None -> None

// Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericEqualityWithComparerIntrinsic for tuple types
Expand All @@ -3376,7 +3394,7 @@ and TryDevirtualizeApplication cenv env (f, tyargs, args, m) =
| 5 -> Some g.generic_equals_withc_tuple5_vref
| _ -> None
match vref with
| Some vref -> Some (DevirtualizeApplication cenv env vref ty tyargs args m)
| Some vref -> Some (DevirtualizeApplication cenv env vref ty tyargs args m None)
| None -> None

// Calls to LanguagePrimitives.IntrinsicFunctions.UnboxGeneric can be optimized to calls to UnboxFast when we know that the
Expand All @@ -3385,15 +3403,15 @@ and TryDevirtualizeApplication cenv env (f, tyargs, args, m) =
| Expr.Val (v, _, _), [ty], _ when valRefEq g v g.unbox_vref &&
canUseUnboxFast g m ty ->

Some(DevirtualizeApplication cenv env g.unbox_fast_vref ty tyargs args m)
Some(DevirtualizeApplication cenv env g.unbox_fast_vref ty tyargs args m None)

// Calls to LanguagePrimitives.IntrinsicFunctions.TypeTestGeneric can be optimized to calls to TypeTestFast when we know that the
// target type isn't 'NullNotTrueValue', i.e. that the target type is not an F# union, record etc.
// Note TypeTestFast is just the .NET IL 'isinst' instruction followed by a non-null comparison
| Expr.Val (v, _, _), [ty], _ when valRefEq g v g.istype_vref &&
canUseTypeTestFast g ty ->

Some(DevirtualizeApplication cenv env g.istype_fast_vref ty tyargs args m)
Some(DevirtualizeApplication cenv env g.istype_fast_vref ty tyargs args m None)

// Don't fiddle with 'methodhandleof' calls - just remake the application
| Expr.Val (vref, _, _), _, _ when valRefEq g vref g.methodhandleof_vref ->
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -1329,4 +1329,48 @@ let myOption () : option<string> = None """
.maxstack 8
IL_0000: ldnull
IL_0001: ret
}"]
}"]

// Regression https://github.com/dotnet/fsharp/issues/18286
[<Fact>]
let ``Equality and hashcode augmentation is null safe`` () =

Fsx """
type Bar = { b: string | null }
type Foo = { f: Bar | null }
type DUFoo = WithNull of (Foo|null)
let a = { f = null }
let b = { f = null }
let c = WithNull(null)
let d = WithNull(null)
let e = WithNull(a)
let f = WithNull(b)
[<EntryPoint>]
let main _ =
printf "Test %A;" ({b = null} = {b = null})
printf ",1 %A" (a = b)
printf ",2 %A" (a.GetHashCode() = b.GetHashCode())
printf ",3 %A" (c = d)
printf ",4 %A" (c.GetHashCode() = d.GetHashCode())
printf ",5 %A" (e = f)
printf ",6 %A" (e = c)
printf ",7 %A" (e.GetHashCode() = f.GetHashCode())
printf ",8 %A" (e.GetHashCode() = c.GetHashCode())
printf ",9 %A" (a > b)
printf ",10 %A" (c > d)
printf ",11 %A" (e > f)
printf ",12 %A" (e > c)
0
"""
|> withNullnessOptions
|> withOptimization false
|> asExe
|> compile
//|> verifyIL ["abc"]
|> run
|> verifyOutputContains [|"Test true;,1 true,2 true,3 true,4 true,5 true,6 false,7 true,8 false,9 false,10 false,11 false,12 true"|]

0 comments on commit ee55997

Please sign in to comment.