Bignum: allow naturalToWordClamp/Negate/Signum to inline (#20361)

We don't need built-in rules now that bignum literals (e.g. 123 :: Natural)
match with their constructors (e.g. NS 123##).

4 files changed, 19 insertions, 52 deletions

diff --git a/compiler/GHC/Builtin/Names.hs b/compiler/GHC/Builtin/Names.hs
index 5407e16b90..22b2cf6b9c 100644
--- a/compiler/GHC/Builtin/Names.hs
+++ b/compiler/GHC/Builtin/Names.hs
@@ -397,7 +397,6 @@ basicKnownKeyNames
         integerShiftRName,
 
         naturalToWordName,
-        naturalToWordClampName,
         naturalPopCountName,
         naturalShiftRName,
         naturalShiftLName,
@@ -406,8 +405,6 @@ basicKnownKeyNames
         naturalSubThrowName,
         naturalSubUnsafeName,
         naturalMulName,
-        naturalSignumName,
-        naturalNegateName,
         naturalQuotRemName,
         naturalQuotName,
         naturalRemName,
@@ -1189,7 +1186,6 @@ integerFromNaturalName
    , integerShiftLName
    , integerShiftRName
    , naturalToWordName
-   , naturalToWordClampName
    , naturalPopCountName
    , naturalShiftRName
    , naturalShiftLName
@@ -1198,8 +1194,6 @@ integerFromNaturalName
    , naturalSubThrowName
    , naturalSubUnsafeName
    , naturalMulName
-   , naturalSignumName
-   , naturalNegateName
    , naturalQuotRemName
    , naturalQuotName
    , naturalRemName
@@ -1232,7 +1226,6 @@ bignatEqName              = bnbVarQual "bigNatEq#"                 bignatEqIdKey
 bignatCompareName         = bnbVarQual "bigNatCompare"             bignatCompareIdKey
 
 naturalToWordName         = bnnVarQual "naturalToWord#"            naturalToWordIdKey
-naturalToWordClampName    = bnnVarQual "naturalToWordClamp#"       naturalToWordClampIdKey
 naturalPopCountName       = bnnVarQual "naturalPopCount#"          naturalPopCountIdKey
 naturalShiftRName         = bnnVarQual "naturalShiftR#"            naturalShiftRIdKey
 naturalShiftLName         = bnnVarQual "naturalShiftL#"            naturalShiftLIdKey
@@ -1241,8 +1234,6 @@ naturalSubName            = bnnVarQual "naturalSub"                naturalSubIdK
 naturalSubThrowName       = bnnVarQual "naturalSubThrow"           naturalSubThrowIdKey
 naturalSubUnsafeName      = bnnVarQual "naturalSubUnsafe"          naturalSubUnsafeIdKey
 naturalMulName            = bnnVarQual "naturalMul"                naturalMulIdKey
-naturalSignumName         = bnnVarQual "naturalSignum"             naturalSignumIdKey
-naturalNegateName         = bnnVarQual "naturalNegate"             naturalNegateIdKey
 naturalQuotRemName        = bnnVarQual "naturalQuotRem#"           naturalQuotRemIdKey
 naturalQuotName           = bnnVarQual "naturalQuot"               naturalQuotIdKey
 naturalRemName            = bnnVarQual "naturalRem"                naturalRemIdKey
@@ -2580,7 +2571,6 @@ integerFromNaturalIdKey
    , integerFromWord64IdKey
    , integerFromInt64IdKey
    , naturalToWordIdKey
-   , naturalToWordClampIdKey
    , naturalPopCountIdKey
    , naturalShiftRIdKey
    , naturalShiftLIdKey
@@ -2589,8 +2579,6 @@ integerFromNaturalIdKey
    , naturalSubThrowIdKey
    , naturalSubUnsafeIdKey
    , naturalMulIdKey
-   , naturalSignumIdKey
-   , naturalNegateIdKey
    , naturalQuotRemIdKey
    , naturalQuotIdKey
    , naturalRemIdKey
@@ -2657,7 +2645,6 @@ integerFromWord64IdKey     = mkPreludeMiscIdUnique 643
 integerFromInt64IdKey      = mkPreludeMiscIdUnique 644
 
 naturalToWordIdKey         = mkPreludeMiscIdUnique 650
-naturalToWordClampIdKey    = mkPreludeMiscIdUnique 651
 naturalPopCountIdKey       = mkPreludeMiscIdUnique 659
 naturalShiftRIdKey         = mkPreludeMiscIdUnique 660
 naturalShiftLIdKey         = mkPreludeMiscIdUnique 661
@@ -2666,8 +2653,6 @@ naturalSubIdKey            = mkPreludeMiscIdUnique 663
 naturalSubThrowIdKey       = mkPreludeMiscIdUnique 664
 naturalSubUnsafeIdKey      = mkPreludeMiscIdUnique 665
 naturalMulIdKey            = mkPreludeMiscIdUnique 666
-naturalSignumIdKey         = mkPreludeMiscIdUnique 667
-naturalNegateIdKey         = mkPreludeMiscIdUnique 668
 naturalQuotRemIdKey        = mkPreludeMiscIdUnique 669
 naturalQuotIdKey           = mkPreludeMiscIdUnique 670
 naturalRemIdKey            = mkPreludeMiscIdUnique 671
diff --git a/compiler/GHC/Core/Opt/ConstantFold.hs b/compiler/GHC/Core/Opt/ConstantFold.hs
index 3d327e69eb..975cf67b38 100644
--- a/compiler/GHC/Core/Opt/ConstantFold.hs
+++ b/compiler/GHC/Core/Opt/ConstantFold.hs
@@ -2052,8 +2052,7 @@ builtinBignumRules =
   , integer_to_natural "Integer -> Natural (wrap)"  integerToNaturalName      False False
   , integer_to_natural "Integer -> Natural (throw)" integerToNaturalThrowName True False
 
-  , natural_to_word "Natural -> Word# (wrap)"  naturalToWordName      False
-  , natural_to_word "Natural -> Word# (clamp)" naturalToWordClampName True
+  , natural_to_word "Natural -> Word# (wrap)"  naturalToWordName
 
     -- comparisons (return an unlifted Int#)
   , bignum_bin_pred "integerEq#" integerEqName (==)
@@ -2107,14 +2106,6 @@ builtinBignumRules =
   , bignum_unop "integerSignum"     integerSignumName     mkIntegerExpr signum
   , bignum_unop "integerComplement" integerComplementName mkIntegerExpr complement
 
-  , bignum_unop "naturalSignum"     naturalSignumName     mkNaturalExpr signum
-
-  , mkRule "naturalNegate" naturalNegateName 1 $ do
-        [a0] <- getArgs
-        x <- isNaturalLiteral a0
-        guard (x == 0) -- negate is only valid for (0 :: Natural)
-        pure a0
-
   , bignum_popcount "integerPopCount" integerPopCountName mkLitIntWrap
   , bignum_popcount "naturalPopCount" naturalPopCountName mkLitWordWrap
 
@@ -2179,13 +2170,11 @@ builtinBignumRules =
       x <- isBigIntegerLiteral a0
       pure (convert platform x)
 
-    natural_to_word str name clamp = mkRule str name 1 $ do
+    natural_to_word str name = mkRule str name 1 $ do
       [a0] <- getArgs
       n <- isNaturalLiteral a0
       platform <- getPlatform
-      if clamp && not (platformInWordRange platform n)
-          then pure (Lit (mkLitWord platform (platformMaxWord platform)))
-          else pure (Lit (mkLitWordWrap platform n))
+      pure (Lit (mkLitWordWrap platform n))
 
     integer_to_natural str name thrw clamp = mkRule str name 1 $ do
       [a0] <- getArgs
diff --git a/libraries/ghc-bignum/src/GHC/Num/Natural.hs b/libraries/ghc-bignum/src/GHC/Num/Natural.hs
index a494ccee70..bf83b01a71 100644
--- a/libraries/ghc-bignum/src/GHC/Num/Natural.hs
+++ b/libraries/ghc-bignum/src/GHC/Num/Natural.hs
@@ -114,7 +114,6 @@ naturalToWord !n = W# (naturalToWord# n)
 
 -- | Convert a Natural into a Word# clamping to (maxBound :: Word#).
 naturalToWordClamp# :: Natural -> Word#
-{-# NOINLINE naturalToWordClamp# #-}
 naturalToWordClamp# (NS x) = x
 naturalToWordClamp# (NB _) = WORD_MAXBOUND##
 
@@ -325,13 +324,11 @@ naturalSqr !a = naturalMul a a
 
 -- | Signum for Natural
 naturalSignum :: Natural -> Natural
-{-# NOINLINE naturalSignum #-}
 naturalSignum (NS 0##) = NS 0##
 naturalSignum _        = NS 1##
 
 -- | Negate for Natural
 naturalNegate :: Natural -> Natural
-{-# NOINLINE naturalNegate #-}
 naturalNegate (NS 0##) = NS 0##
 naturalNegate _        = raiseUnderflow
 
@@ -589,9 +586,6 @@ naturalFromByteArray# sz ba off e s = case bigNatFromByteArray# sz ba off e s of
 "Word# -> Natural -> Word#"
   forall x. naturalToWord# (NS x) = x
 
-"Word# -> Natural -> Word# (clamp)"
-  forall x. naturalToWordClamp# (NS x) = x
-
 "BigNat# -> Natural -> BigNat#"
   forall x. naturalToBigNat# (naturalFromBigNat# x) = x
 #-}
diff --git a/testsuite/tests/numeric/should_compile/T14465.stdout b/testsuite/tests/numeric/should_compile/T14465.stdout
index c672fdf3e0..7ce467bc60 100644
--- a/testsuite/tests/numeric/should_compile/T14465.stdout
+++ b/testsuite/tests/numeric/should_compile/T14465.stdout
@@ -1,7 +1,7 @@
 
 ==================== Tidy Core ====================
 Result size of Tidy Core
-  = {terms: 37, types: 14, coercions: 0, joins: 0/0}
+  = {terms: 32, types: 14, coercions: 0, joins: 0/0}
 
 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 ten :: Natural
@@ -45,23 +45,15 @@ M.$trModule :: GHC.Types.Module
          WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
 M.$trModule = GHC.Types.Module M.$trModule3 M.$trModule1
 
--- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
-M.minusOne1 :: Natural
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
-M.minusOne1 = GHC.Num.Natural.NS 1##
-
--- RHS size: {terms: 6, types: 1, coercions: 0, joins: 0/0}
+-- RHS size: {terms: 1, types: 1, coercions: 0, joins: 0/0}
 minusOne :: Natural
 [GblId,
+ Str=b,
+ Cpr=b,
  Unf=Unf{Src=<vanilla>, TopLvl=True, Value=False, ConLike=False,
-         WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 40 10}]
-minusOne
-  = case GHC.Num.Natural.$wnaturalNegate M.minusOne1 of ww
-    { __DEFAULT ->
-    GHC.Num.Natural.NS ww
-    }
+         WorkFree=True, Expandable=True,
+         Guidance=ALWAYS_IF(arity=0,unsat_ok=True,boring_ok=True)}]
+minusOne = GHC.Prim.Exception.raiseUnderflow @Natural
 
 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
 twoTimesTwo :: Natural
@@ -70,6 +62,13 @@ twoTimesTwo :: Natural
          WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
 twoTimesTwo = GHC.Num.Natural.NS 4##
 
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+M.one1 :: Natural
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+M.one1 = GHC.Num.Natural.NS 1##
+
 -- RHS size: {terms: 4, types: 1, coercions: 0, joins: 0/0}
 plusOne :: Natural -> Natural
 [GblId,
@@ -77,7 +76,7 @@ plusOne :: Natural -> Natural
  Str=<1L>,
  Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
          WorkFree=True, Expandable=True, Guidance=IF_ARGS [0] 30 0}]
-plusOne = \ (n :: Natural) -> naturalAdd n M.minusOne1
+plusOne = \ (n :: Natural) -> naturalAdd n M.one1
 
 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
 one :: Natural
@@ -85,7 +84,7 @@ one :: Natural
  Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
          WorkFree=True, Expandable=True,
          Guidance=ALWAYS_IF(arity=0,unsat_ok=True,boring_ok=True)}]
-one = M.minusOne1
+one = M.one1