@@ -106,6 +106,9 @@ let mkEqualsTy g ty =
106
106
let mkEqualsWithComparerTy g ty =
107
107
mkFunTy g ( mkThisTy g ty) ( mkFunTy g ( mkRefTupledTy g [ g.obj_ ty; g.IEqualityComparer_ ty ]) g.bool_ ty)
108
108
109
+ let mkEqualsWithComparerTyExact g ty =
110
+ mkFunTy g ( mkThisTy g ty) ( mkFunTy g ( mkRefTupledTy g [ ty; g.IEqualityComparer_ ty ]) g.bool_ ty)
111
+
109
112
let mkHashTy g ty =
110
113
mkFunTy g ( mkThisTy g ty) ( mkFunTy g g.unit_ ty g.int_ ty)
111
114
@@ -361,7 +364,7 @@ let mkRecdEquality g tcref (tycon: Tycon) =
361
364
thisv, thatv, expr
362
365
363
366
/// Build the equality implementation for a record type when parameterized by a comparer
364
- let mkRecdEqualityWithComparer g tcref ( tycon : Tycon ) ( _thisv , thise ) thatobje ( thatv , thate ) compe =
367
+ let mkRecdEqualityWithComparer g tcref ( tycon : Tycon ) thise thatobje ( thatv , thate ) compe isexact =
365
368
let m = tycon.Range
366
369
let fields = tycon.AllInstanceFieldsAsList
367
370
let tinst , ty = mkMinimalTy g tcref
@@ -382,14 +385,21 @@ let mkRecdEqualityWithComparer g tcref (tycon: Tycon) (_thisv, thise) thatobje (
382
385
let expr = mkEqualsTestConjuncts g m ( List.map mkTest fields)
383
386
384
387
let expr = mkBindThatAddr g m ty thataddrv thatv thate expr
385
- // will be optimized away if not necessary
386
- let expr = mkIsInstConditional g m ty thatobje thatv expr ( mkFalse g m)
388
+
389
+ let expr =
390
+ if isexact then
391
+ expr
392
+ else
393
+ mkIsInstConditional g m ty thatobje thatv expr ( mkFalse g m)
387
394
388
395
let expr =
389
396
if tycon.IsStructOrEnumTycon then
390
397
expr
391
398
else
392
- mkBindThisNullEquals g m thise thatobje expr
399
+ if isexact then
400
+ mkBindThatNullEquals g m thise thate expr
401
+ else
402
+ mkBindThisNullEquals g m thise thatobje expr
393
403
394
404
expr
395
405
@@ -425,7 +435,7 @@ let mkExnEquality (g: TcGlobals) exnref (exnc: Tycon) =
425
435
thisv, thatv, expr
426
436
427
437
/// Build the equality implementation for an exception definition when parameterized by a comparer
428
- let mkExnEqualityWithComparer g exnref ( exnc : Tycon ) ( _thisv , thise ) thatobje ( thatv , thate ) compe =
438
+ let mkExnEqualityWithComparer g exnref ( exnc : Tycon ) thise thatobje ( thatv , thate ) compe isexact =
429
439
let m = exnc.Range
430
440
let thataddrv , thataddre = mkThatAddrLocal g m g.exn_ ty
431
441
@@ -453,13 +463,21 @@ let mkExnEqualityWithComparer g exnref (exnc: Tycon) (_thisv, thise) thatobje (t
453
463
mbuilder.Close( dtree, m, g.bool_ ty)
454
464
455
465
let expr = mkBindThatAddr g m g.exn_ ty thataddrv thatv thate expr
456
- let expr = mkIsInstConditional g m g.exn_ ty thatobje thatv expr ( mkFalse g m)
466
+
467
+ let expr =
468
+ if isexact then
469
+ expr
470
+ else
471
+ mkIsInstConditional g m g.exn_ ty thatobje thatv expr ( mkFalse g m)
457
472
458
473
let expr =
459
474
if exnc.IsStructOrEnumTycon then
460
475
expr
461
476
else
462
- mkBindThisNullEquals g m thise thatobje expr
477
+ if isexact then
478
+ mkBindThatNullEquals g m thise thate expr
479
+ else
480
+ mkBindThisNullEquals g m thise thatobje expr
463
481
464
482
expr
465
483
@@ -758,7 +776,7 @@ let mkUnionEquality g tcref (tycon: Tycon) =
758
776
thisv, thatv, expr
759
777
760
778
/// Build the equality implementation for a union type when parameterized by a comparer
761
- let mkUnionEqualityWithComparer g tcref ( tycon : Tycon ) ( _thisv , thise ) thatobje ( thatv , thate ) compe =
779
+ let mkUnionEqualityWithComparer g tcref ( tycon : Tycon ) thise thatobje ( thatv , thate ) compe isexact =
762
780
let m = tycon.Range
763
781
let ucases = tycon.UnionCasesAsList
764
782
let tinst , ty = mkMinimalTy g tcref
@@ -846,13 +864,21 @@ let mkUnionEqualityWithComparer g tcref (tycon: Tycon) (_thisv, thise) thatobje
846
864
( mkCompGenLet m thattagv ( mkUnionCaseTagGetViaExprAddr ( thataddre, tcref, tinst, m)) tagsEqTested)
847
865
848
866
let expr = mkBindThatAddr g m ty thataddrv thatv thate expr
849
- let expr = mkIsInstConditional g m ty thatobje thatv expr ( mkFalse g m)
867
+
868
+ let expr =
869
+ if isexact then
870
+ expr
871
+ else
872
+ mkIsInstConditional g m ty thatobje thatv expr ( mkFalse g m)
850
873
851
874
let expr =
852
875
if tycon.IsStructOrEnumTycon then
853
876
expr
854
877
else
855
- mkBindThisNullEquals g m thise thatobje expr
878
+ if isexact then
879
+ mkBindThatNullEquals g m thise thate expr
880
+ else
881
+ mkBindThisNullEquals g m thise thatobje expr
856
882
857
883
expr
858
884
@@ -1014,6 +1040,15 @@ let getAugmentationAttribs g (tycon: Tycon) =
1014
1040
TryFindFSharpBoolAttribute g g.attrib_ CustomComparisonAttribute tycon.Attribs,
1015
1041
TryFindFSharpBoolAttribute g g.attrib_ StructuralComparisonAttribute tycon.Attribs
1016
1042
1043
+ [<NoEquality; NoComparison; StructuredFormatDisplay( " {DebugText}" ) >]
1044
+ type EqualityWithComparerAugmentation =
1045
+ {
1046
+ GetHashCode: Val
1047
+ GetHashCodeWithComparer: Val
1048
+ EqualsWithComparer: Val
1049
+ EqualsExactWithComparer: Val
1050
+ }
1051
+
1017
1052
let CheckAugmentationAttribs isImplementation g amap ( tycon : Tycon ) =
1018
1053
let m = tycon.Range
1019
1054
let attribs = getAugmentationAttribs g tycon
@@ -1333,7 +1368,25 @@ let MakeValsForEqualityWithComparerAugmentation g (tcref: TyconRef) =
1333
1368
let withcEqualsVal =
1334
1369
mkValSpec g tcref ty vis ( Some( mkIStructuralEquatableEqualsSlotSig g)) " Equals" ( tps + -> ( mkEqualsWithComparerTy g ty)) tupArg false
1335
1370
1336
- objGetHashCodeVal, withcGetHashCodeVal, withcEqualsVal
1371
+ let withcEqualsValExact =
1372
+ mkValSpec
1373
+ g
1374
+ tcref
1375
+ ty
1376
+ vis
1377
+ // This doesn't implement any interface.
1378
+ None
1379
+ " Equals"
1380
+ ( tps + -> ( mkEqualsWithComparerTyExact g ty))
1381
+ tupArg
1382
+ false
1383
+
1384
+ {
1385
+ GetHashCode = objGetHashCodeVal
1386
+ GetHashCodeWithComparer = withcGetHashCodeVal
1387
+ EqualsWithComparer = withcEqualsVal
1388
+ EqualsExactWithComparer = withcEqualsValExact
1389
+ }
1337
1390
1338
1391
let MakeBindingsForCompareAugmentation g ( tycon : Tycon ) =
1339
1392
let tcref = mkLocalTyconRef tycon
@@ -1419,7 +1472,7 @@ let MakeBindingsForEqualityWithComparerAugmentation (g: TcGlobals) (tycon: Tycon
1419
1472
let mkStructuralEquatable hashf equalsf =
1420
1473
match tycon.GeneratedHashAndEqualsWithComparerValues with
1421
1474
| None -> []
1422
- | Some( objGetHashCodeVal, withcGetHashCodeVal, withcEqualsVal) ->
1475
+ | Some( objGetHashCodeVal, withcGetHashCodeVal, withcEqualsVal, withcEqualsExactValOption ) ->
1423
1476
1424
1477
// build the hash rhs
1425
1478
let withcGetHashCodeExpr =
@@ -1451,12 +1504,33 @@ let MakeBindingsForEqualityWithComparerAugmentation (g: TcGlobals) (tycon: Tycon
1451
1504
1452
1505
// build the equals rhs
1453
1506
let withcEqualsExpr =
1454
- let _tinst , ty = mkMinimalTy g tcref
1507
+ let tinst , ty = mkMinimalTy g tcref
1455
1508
let thisv , thise = mkThisVar g m ty
1456
1509
let thatobjv , thatobje = mkCompGenLocal m " obj" g.obj_ ty
1457
1510
let thatv , thate = mkCompGenLocal m " that" ty
1458
1511
let compv , compe = mkCompGenLocal m " comp" g.IEqualityComparer_ ty
1459
- let equalse = equalsf g tcref tycon ( thisv, thise) thatobje ( thatv, thate) compe
1512
+
1513
+ // if the new overload is available, use it
1514
+ // otherwise, generate the whole equals thing
1515
+ let equalse =
1516
+ match withcEqualsExactValOption with
1517
+ | Some withcEqualsExactVal ->
1518
+ mkIsInstConditional
1519
+ g
1520
+ m
1521
+ ty
1522
+ thatobje
1523
+ thatv
1524
+ ( mkApps
1525
+ g
1526
+ (( exprForValRef m withcEqualsExactVal, withcEqualsExactVal.Type),
1527
+ ( if isNil tinst then [] else [ tinst ]),
1528
+ [ thise; mkRefTupled g m [ thate; compe ] [ ty; g.IEqualityComparer_ ty ] ],
1529
+ m))
1530
+ ( mkFalse g m)
1531
+ | None ->
1532
+ equalsf g tcref tycon thise thatobje ( thatv, thate) compe false
1533
+
1460
1534
mkMultiLambdas g m tps [ [ thisv ]; [ thatobjv; compv ] ] ( equalse, g.bool_ ty)
1461
1535
1462
1536
let objGetHashCodeExpr =
@@ -1481,9 +1555,22 @@ let MakeBindingsForEqualityWithComparerAugmentation (g: TcGlobals) (tycon: Tycon
1481
1555
1482
1556
mkLambdas g m tps [ thisv; unitv ] ( hashe, g.int_ ty)
1483
1557
1558
+ let withcEqualsExactExpr =
1559
+ let _tinst , ty = mkMinimalTy g tcref
1560
+ let thisv , thise = mkThisVar g m ty
1561
+ let thatv , thate = mkCompGenLocal m " obj" ty
1562
+ let compv , compe = mkCompGenLocal m " comp" g.IEqualityComparer_ ty
1563
+
1564
+ let equalse = equalsf g tcref tycon thise thate ( thatv, thate) compe true
1565
+
1566
+ mkMultiLambdas g m tps [ [ thisv ]; [ thatv; compv ] ] ( equalse, g.bool_ ty)
1567
+
1484
1568
[
1485
1569
( mkCompGenBind withcGetHashCodeVal.Deref withcGetHashCodeExpr)
1486
1570
( mkCompGenBind objGetHashCodeVal.Deref objGetHashCodeExpr)
1571
+ match withcEqualsExactValOption with
1572
+ | Some withcEqualsExactVal -> mkCompGenBind withcEqualsExactVal.Deref withcEqualsExactExpr
1573
+ | None -> ()
1487
1574
( mkCompGenBind withcEqualsVal.Deref withcEqualsExpr)
1488
1575
]
1489
1576
0 commit comments