Bignum: match on DataCon workers in rules (#19892)

We need to match on DataCon workers for the rules to be triggered.

T13701 ghc/alloc decreases by ~2.5% on some archs

Metric Decrease:
    T13701

6 files changed, 59 insertions, 12 deletions

diff --git a/compiler/GHC/Core/Opt/ConstantFold.hs b/compiler/GHC/Core/Opt/ConstantFold.hs
index 63175e1b99..e6cf3b1da0 100644
--- a/compiler/GHC/Core/Opt/ConstantFold.hs
+++ b/compiler/GHC/Core/Opt/ConstantFold.hs
@@ -1784,7 +1784,7 @@ builtinBignumRules =
   , integer_to_natural "Integer -> Natural (wrap)"  integerToNaturalName      False False
   , integer_to_natural "Integer -> Natural (throw)" integerToNaturalThrowName True False
 
-  , lit_to_natural  "Word# -> Natural"         naturalNSDataConName
+  , lit_to_natural  "Word# -> Natural"         naturalNSName
   , natural_to_word "Natural -> Word# (wrap)"  naturalToWordName      False
   , natural_to_word "Natural -> Word# (clamp)" naturalToWordClampName True
 
@@ -1857,21 +1857,21 @@ builtinBignumRules =
   , bignum_popcount "naturalPopCount" naturalPopCountName mkLitWordWrap
 
     -- identity passthrough
-  , id_passthrough "Int# -> Integer -> Int#"       integerToIntName    integerISDataConName
+  , id_passthrough "Int# -> Integer -> Int#"       integerToIntName    integerISName
   , id_passthrough "Word# -> Integer -> Word#"     integerToWordName   integerFromWordName
   , id_passthrough "Int64# -> Integer -> Int64#"   integerToInt64Name  integerFromInt64Name
   , id_passthrough "Word64# -> Integer -> Word64#" integerToWord64Name integerFromWord64Name
-  , id_passthrough "Word# -> Natural -> Word#"     naturalToWordName   naturalNSDataConName
+  , id_passthrough "Word# -> Natural -> Word#"     naturalToWordName   naturalNSName
 
     -- identity passthrough with a conversion that can be done directly instead
   , small_passthrough "Int# -> Integer -> Word#"
-        integerISDataConName integerToWordName   (mkPrimOpId IntToWordOp)
+        integerISName integerToWordName   (mkPrimOpId IntToWordOp)
   , small_passthrough "Int# -> Integer -> Float#"
-        integerISDataConName integerToFloatName  (mkPrimOpId IntToFloatOp)
+        integerISName integerToFloatName  (mkPrimOpId IntToFloatOp)
   , small_passthrough "Int# -> Integer -> Double#"
-        integerISDataConName integerToDoubleName (mkPrimOpId IntToDoubleOp)
+        integerISName integerToDoubleName (mkPrimOpId IntToDoubleOp)
   , small_passthrough "Word# -> Natural -> Int#"
-        naturalNSDataConName naturalToWordName   (mkPrimOpId WordToIntOp)
+        naturalNSName naturalToWordName   (mkPrimOpId WordToIntOp)
 
     -- Bits.bit
   , bignum_bit "integerBit" integerBitName mkLitInteger
@@ -1908,6 +1908,25 @@ builtinBignumRules =
   , integer_encode_float "integerEncodeDouble" integerEncodeDoubleName mkDoubleLitDouble
   ]
   where
+    -- The rule is matching against an occurrence of a data constructor in a
+    -- Core expression. It must match either its worker name or its wrapper
+    -- name, /not/ the DataCon name itself, which is different.
+    -- See Note [Data Constructor Naming] in GHC.Core.DataCon and #19892
+    --
+    -- But data constructor wrappers deliberately inline late; See Note
+    -- [Activation for data constructor wrappers] in GHC.Types.Id.Make.
+    -- Suppose there is a wrapper and the rule matches on the worker: the
+    -- wrapper won't be inlined until rules have finished firing and the rule
+    -- will never fire.
+    --
+    -- Hence the rule must match on the wrapper, if there is one, otherwise on
+    -- the worker. That is exactly the dataConWrapId for the data constructor.
+    -- The data constructor may or may not have a wrapper, but if not
+    -- dataConWrapId will return the worker
+    --
+    integerISName = idName (dataConWrapId integerISDataCon)
+    naturalNSName = idName (dataConWrapId naturalNSDataCon)
+
     mkRule str name nargs f = BuiltinRule
       { ru_name = fsLit str
       , ru_fn = name
diff --git a/testsuite/tests/lib/integer/all.T b/testsuite/tests/lib/integer/all.T
index 7c9720ed1f..c6710c69a1 100644
--- a/testsuite/tests/lib/integer/all.T
+++ b/testsuite/tests/lib/integer/all.T
@@ -4,7 +4,14 @@ test('integerConversions', normal, compile_and_run, [''])
 test('plusMinusInteger', [omit_ways(['ghci'])], compile_and_run, [''])
 test('integerConstantFolding', normal, makefile_test, ['integerConstantFolding'])
 test('naturalConstantFolding', normal, makefile_test, ['naturalConstantFolding'])
-test('fromToInteger', [], makefile_test, ['fromToInteger'])
+
+# we ignore_stderr because there are 2 overlapping rules that are reported in
+# debug mode:
+#   Rules.findBest: rule overlap (Rule 1 wins)
+#     Rule 1: "Integer -> Int# (wrap)"
+#     Rule 2: "Int# -> Integer -> Int#"
+test('fromToInteger', [ignore_stderr], makefile_test, ['fromToInteger'])
+
 test('IntegerConversionRules', [], makefile_test, ['IntegerConversionRules'])
 test('gcdInteger', normal, compile_and_run, [''])
 test('gcdeInteger', normal, compile_and_run, [''])
diff --git a/testsuite/tests/numeric/should_compile/T14465.stdout b/testsuite/tests/numeric/should_compile/T14465.stdout
index 970ceb4fd2..00d3101eb4 100644
--- a/testsuite/tests/numeric/should_compile/T14465.stdout
+++ b/testsuite/tests/numeric/should_compile/T14465.stdout
@@ -1,14 +1,14 @@
 
 ==================== Tidy Core ====================
 Result size of Tidy Core
-  = {terms: 35, types: 14, coercions: 0, joins: 0/0}
+  = {terms: 34, types: 14, coercions: 0, joins: 0/0}
 
--- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
 ten :: Natural
 [GblId,
  Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
-ten = GHC.Num.Natural.NS 10##
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 100 0}]
+ten = 10
 
 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
 M.$trModule4 :: GHC.Prim.Addr#
diff --git a/testsuite/tests/numeric/should_compile/T19892.hs b/testsuite/tests/numeric/should_compile/T19892.hs
new file mode 100644
index 0000000000..cd8d9018b8
--- /dev/null
+++ b/testsuite/tests/numeric/should_compile/T19892.hs
@@ -0,0 +1,16 @@
+{-# LANGUAGE MagicHash #-}
+
+module T19892 where
+
+import GHC.Exts
+import GHC.Num.Integer
+import GHC.Num.Natural
+
+foo :: Word# -> Word#
+foo x = integerToWord# (IS (word2Int# x))
+
+bar :: Int# -> Int#
+bar x = integerToInt# (IS x)
+
+baz :: Word# -> Word#
+baz x = naturalToWord# (NS x)
diff --git a/testsuite/tests/numeric/should_compile/T19892.stderr b/testsuite/tests/numeric/should_compile/T19892.stderr
new file mode 100644
index 0000000000..89411a6df9
--- /dev/null
+++ b/testsuite/tests/numeric/should_compile/T19892.stderr
@@ -0,0 +1,4 @@
+Rule fired: Int# -> Integer -> Word# (BUILTIN)
+Rule fired: int2Word# (BUILTIN)
+Rule fired: Int# -> Integer -> Int# (BUILTIN)
+Rule fired: Word# -> Natural -> Word# (BUILTIN)
diff --git a/testsuite/tests/numeric/should_compile/all.T b/testsuite/tests/numeric/should_compile/all.T
index 8f0b268690..766dda4814 100644
--- a/testsuite/tests/numeric/should_compile/all.T
+++ b/testsuite/tests/numeric/should_compile/all.T
@@ -9,3 +9,4 @@ test('T7881', normal, compile, [''])
 test('T8542', omit_ways(['hpc']), compile, [''])
 test('T10929', normal, compile, [''])
 test('T16402', [ grep_errmsg(r'and'), when(wordsize(32), expect_broken(19024)) ], compile, [''])
+test('T19892', normal, compile, ['-O -ddump-rule-firings'])