Refactor numeric constant folding rules

Avoid the use of global pattern synonyms.

1) I think it's going to be helpful to implement constant folding for
   other numeric types, especially Natural which doesn't have a wrapping
   behavior. We'll have to refactor these rules even more so we'd better
   make them less cryptic.

2) It should also be slightly faster because global pattern synonyms
   matched operations for every numeric types instead of the current one:
   e.g., ":**:" pattern was matching multiplication for both Int# and
   Word# types. As we will probably want to implement constant folding
   for other numeric types (Int8#, Int16#, etc.), it is more efficient
   to only match primops for a given type as we do now.

3 files changed, 112 insertions, 0 deletions

diff --git a/testsuite/tests/simplCore/should_run/NumConstantFolding.hs b/testsuite/tests/simplCore/should_run/NumConstantFolding.hs
new file mode 100644
index 0000000000..6466adfe4d
--- /dev/null
+++ b/testsuite/tests/simplCore/should_run/NumConstantFolding.hs
@@ -0,0 +1,109 @@
+{-# LANGUAGE MagicHash #-}
+
+import GHC.Exts
+import Data.Word
+import Data.Int
+
+(+&) = plusWord#
+(-&) = minusWord#
+(*&) = timesWord#
+
+{-# NOINLINE testsW #-}
+-- NOINLINE otherwise basic constant folding rules (without
+-- variables) are applied
+testsW :: Word# -> Word# -> [Word]
+testsW x y = fmap (\z -> fromIntegral (fromIntegral z :: Word32))
+             -- narrowing to get the same results on both 64- and 32-bit arch
+   [ W# (43## +& (37## +& x))
+   , W# (43## +& (37## -& x))
+   , W# (43## +& (x -& 37##))
+   , W# (43## -& (37## +& x))
+   , W# (43## -& (37## -& x))
+   , W# (43## -& (x -& 37##))
+   , W# ((43## +& x) -& 37##)
+   , W# ((x +& 43##) -& 37##)
+   , W# ((43## -& x) -& 37##)
+   , W# ((x -& 43##) -& 37##)
+
+   , W# ((x +& 43##) +& (y +& 37##))
+   , W# ((x +& 43##) +& (y -& 37##))
+   , W# ((x +& 43##) +& (37## -& y))
+   , W# ((x -& 43##) +& (37## -& y))
+   , W# ((x -& 43##) +& (y -& 37##))
+   , W# ((43## -& x) +& (37## -& y))
+   , W# ((43## -& x) +& (y -& 37##))
+   ]
+
+{-# NOINLINE testsI #-}
+testsI :: Int# -> Int# -> [Int]
+testsI x y = fmap (\z -> fromIntegral (fromIntegral z :: Int32))
+   [ I# (43# +# (37# +# x))
+   , I# (43# +# (37# -# x))
+   , I# (43# +# (x -# 37#))
+   , I# (43# -# (37# +# x))
+   , I# (43# -# (37# -# x))
+   , I# (43# -# (x -# 37#))
+   , I# ((43# +# x) -# 37#)
+   , I# ((x +# 43#) -# 37#)
+   , I# ((43# -# x) -# 37#)
+   , I# ((x -# 43#) -# 37#)
+
+   , I# ((x +# 43#) +# (y +# 37#))
+   , I# ((x +# 43#) +# (y -# 37#))
+   , I# ((x +# 43#) +# (37# -# y))
+   , I# ((x -# 43#) +# (37# -# y))
+   , I# ((x -# 43#) +# (y -# 37#))
+   , I# ((43# -# x) +# (37# -# y))
+   , I# ((43# -# x) +# (y -# 37#))
+
+   , I# ((x +# 43#) -# (y +# 37#))
+   , I# ((x +# 43#) -# (y -# 37#))
+   , I# ((x +# 43#) -# (37# -# y))
+   , I# ((x -# 43#) -# (y +# 37#))
+   , I# ((43# -# x) -# (37# +# y))
+   , I# ((x -# 43#) -# (y -# 37#))
+   , I# ((x -# 43#) -# (37# -# y))
+   , I# ((43# -# x) -# (y -# 37#))
+   , I# ((43# -# x) -# (37# -# y))
+
+   , I# (43# *# (37# *# y))
+   , I# (43# *# (y *# 37#))
+   , I# ((43# *# x) *# (y *# 37#))
+
+   , I# (43# *# (37# +# y))
+   , I# (43# *# (37# -# y))
+   , I# (43# *# (y -# 37#))
+
+   , I# (x +# x)
+   , I# ((43# *# x) +# x)
+   , I# (x +# (43# *# x))
+   , I# ((43# *# x) +# (37# *# x))
+   , I# ((43# *# x) +# (x *# 37#))
+
+   , I# (x -# x)
+   , I# ((43# *# x) -# x)
+   , I# (x -# (43# *# x))
+   , I# ((43# *# x) -# (37# *# x))
+   , I# ((43# *# x) -# (x *# 37#))
+
+   , I# (x +# (37# +# y))
+   , I# (x +# (y +# 37#))
+   , I# (x +# (37# -# y))
+   , I# (x +# (y -# 37#))
+   , I# (x -# (37# +# y))
+   , I# (x -# (y +# 37#))
+   , I# (x -# (37# -# y))
+   , I# (x -# (y -# 37#))
+   , I# ((37# +# y) -# x)
+   , I# ((y +# 37#) -# x)
+   , I# ((37# -# y) -# x)
+   , I# ((y -# 37#) -# x)
+
+   , I# (y *# y)
+   ]
+
+
+main :: IO ()
+main = do
+   print (testsW 7## 13##)
+   print (testsI 7#  13#)
diff --git a/testsuite/tests/simplCore/should_run/NumConstantFolding.stdout b/testsuite/tests/simplCore/should_run/NumConstantFolding.stdout
new file mode 100644
index 0000000000..da6f72855f
--- /dev/null
+++ b/testsuite/tests/simplCore/should_run/NumConstantFolding.stdout
@@ -0,0 +1,2 @@
+[87,73,13,4294967295,13,73,13,13,4294967295,4294967223,100,26,74,4294967284,4294967236,60,12]
+[87,73,13,-1,13,73,13,13,-1,-73,100,26,74,-12,-60,60,12,0,74,26,-86,-14,-12,-60,60,12,20683,20683,144781,2150,1032,-1032,14,308,308,560,560,0,294,-294,42,42,57,57,31,-17,-43,-43,-17,31,43,43,17,-31,169]
diff --git a/testsuite/tests/simplCore/should_run/all.T b/testsuite/tests/simplCore/should_run/all.T
index a04558be89..ea10cd7914 100644
--- a/testsuite/tests/simplCore/should_run/all.T
+++ b/testsuite/tests/simplCore/should_run/all.T
@@ -93,3 +93,4 @@ test('T17151', [], multimod_compile_and_run, ['T17151', ''])
 test('T18012', normal, compile_and_run, [''])
 test('T17744', normal, compile_and_run, [''])
 test('T18638', normal, compile_and_run, [''])
+test('NumConstantFolding', normal, compile_and_run, [''])