Canonicalize bignum literals

Before this patch Integer and Natural literals were desugared into "real"
Core in Core prep. Now we desugar them directly into their final ConApp
form in HsToCore. We only keep the double representation for BigNat#
(literals larger than a machine Word/Int) which are still desugared in
Core prep.

Using the final form directly allows case-of-known-constructor to fire
for bignum literals, fixing #20245.

Slight increase (+2.3) in T4801 which is a pathological case with
Integer literals.

Metric Increase:
    T4801
    T11545

10 files changed, 40 insertions, 23 deletions

diff --git a/testsuite/tests/lib/integer/all.T b/testsuite/tests/lib/integer/all.T
index 4366955e81..96cb055b9c 100644
--- a/testsuite/tests/lib/integer/all.T
+++ b/testsuite/tests/lib/integer/all.T
@@ -5,12 +5,7 @@ test('plusMinusInteger', [omit_ways(['ghci'])], compile_and_run, [''])
 test('integerConstantFolding', normal, makefile_test, ['integerConstantFolding'])
 test('naturalConstantFolding', normal, makefile_test, ['naturalConstantFolding'])
 
-# 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('fromToInteger', normal, makefile_test, ['fromToInteger'])
 
 test('IntegerConversionRules', [], makefile_test, ['IntegerConversionRules'])
 test('gcdInteger', normal, compile_and_run, [''])
diff --git a/testsuite/tests/numeric/should_compile/T14170.stdout b/testsuite/tests/numeric/should_compile/T14170.stdout
index a4fe7ecd7b..89e0f1b461 100644
--- a/testsuite/tests/numeric/should_compile/T14170.stdout
+++ b/testsuite/tests/numeric/should_compile/T14170.stdout
@@ -1,7 +1,7 @@
 
 ==================== Tidy Core ====================
 Result size of Tidy Core
-  = {terms: 16, types: 6, coercions: 0, joins: 0/0}
+  = {terms: 17, types: 6, coercions: 0, joins: 0/0}
 
 NatVal.$trModule4 :: GHC.Prim.Addr#
 [GblId,
@@ -37,8 +37,8 @@ NatVal.$trModule
 foo :: Integer
 [GblId,
  Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 100 0}]
-foo = 0
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+foo = GHC.Num.Integer.IS 0#
 
 
 
diff --git a/testsuite/tests/numeric/should_compile/T14465.stdout b/testsuite/tests/numeric/should_compile/T14465.stdout
index 808b75f633..de0c34607d 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: 35, types: 14, coercions: 0, joins: 0/0}
+  = {terms: 37, types: 14, coercions: 0, joins: 0/0}
 
 ten :: Natural
 [GblId,
@@ -42,8 +42,8 @@ M.$trModule = GHC.Types.Module M.$trModule3 M.$trModule1
 M.minusOne1 :: Natural
 [GblId,
  Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 100 0}]
-M.minusOne1 = 1
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+M.minusOne1 = GHC.Num.Natural.NS 1##
 
 minusOne :: Natural
 [GblId,
@@ -58,8 +58,8 @@ minusOne
 twoTimesTwo :: Natural
 [GblId,
  Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
-         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 100 0}]
-twoTimesTwo = 4
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+twoTimesTwo = GHC.Num.Natural.NS 4##
 
 plusOne :: Natural -> Natural
 [GblId,
diff --git a/testsuite/tests/numeric/should_compile/T20245.hs b/testsuite/tests/numeric/should_compile/T20245.hs
new file mode 100644
index 0000000000..1196987cf9
--- /dev/null
+++ b/testsuite/tests/numeric/should_compile/T20245.hs
@@ -0,0 +1,9 @@
+module T20245 where
+
+import GHC.Num.Integer
+
+foo :: Int
+foo = case 2 of
+  IS _ -> 9999
+  IP _ -> 7777
+  IN _ -> 7777
diff --git a/testsuite/tests/numeric/should_compile/T20245.stderr b/testsuite/tests/numeric/should_compile/T20245.stderr
new file mode 100644
index 0000000000..e3fe0ed315
--- /dev/null
+++ b/testsuite/tests/numeric/should_compile/T20245.stderr
@@ -0,0 +1,9 @@
+
+==================== Tidy Core ====================
+Result size of Tidy Core
+  = {terms: 3, types: 1, coercions: 0, joins: 0/0}
+
+foo = I# 9999#
+
+
+
diff --git a/testsuite/tests/numeric/should_compile/all.T b/testsuite/tests/numeric/should_compile/all.T
index 425d0dbd85..c95296fcde 100644
--- a/testsuite/tests/numeric/should_compile/all.T
+++ b/testsuite/tests/numeric/should_compile/all.T
@@ -11,3 +11,4 @@ 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'])
 test('T20062', [ grep_errmsg(r'integer') ], compile, ['-ddump-simpl -O -dsuppress-all'])
+test('T20245', normal, compile, ['-ddump-simpl -O -dsuppress-all -dno-typeable-binds'])
diff --git a/testsuite/tests/simplCore/should_compile/T15445.stderr b/testsuite/tests/simplCore/should_compile/T15445.stderr
index 3421b37072..5e8a086e6d 100644
--- a/testsuite/tests/simplCore/should_compile/T15445.stderr
+++ b/testsuite/tests/simplCore/should_compile/T15445.stderr
@@ -1,6 +1,6 @@
 Rule fired: Class op + (BUILTIN)
 Rule fired: Class op fromInteger (BUILTIN)
-Rule fired: Integer -> Int# (wrap) (BUILTIN)
+Rule fired: Int# -> Integer -> Int# (GHC.Num.Integer)
 Rule fired: SPEC plusTwoRec (T15445a)
 Rule fired: SPEC $fShow[] (GHC.Show)
 Rule fired: Class op >> (BUILTIN)
diff --git a/testsuite/tests/simplCore/should_compile/T8832.stdout-ws-32 b/testsuite/tests/simplCore/should_compile/T8832.stdout-ws-32
index 459d2689c7..53b2c046c1 100644
--- a/testsuite/tests/simplCore/should_compile/T8832.stdout-ws-32
+++ b/testsuite/tests/simplCore/should_compile/T8832.stdout-ws-32
@@ -6,4 +6,4 @@ w = GHC.Types.W# 0##
 w8 = GHC.Word.W8# 0##8
 w16 = GHC.Word.W16# 0##16
 w32 = GHC.Word.W32# 0##32
-z = 0
+z = GHC.Num.Integer.IS 0#
diff --git a/testsuite/tests/simplCore/should_compile/T8832.stdout-ws-64 b/testsuite/tests/simplCore/should_compile/T8832.stdout-ws-64
index 657f517c68..625102854d 100644
--- a/testsuite/tests/simplCore/should_compile/T8832.stdout-ws-64
+++ b/testsuite/tests/simplCore/should_compile/T8832.stdout-ws-64
@@ -8,4 +8,4 @@ w8 = GHC.Word.W8# 0##8
 w16 = GHC.Word.W16# 0##16
 w32 = GHC.Word.W32# 0##32
 w64 = GHC.Word.W64# 0##
-z = 0
+z = GHC.Num.Integer.IS 0#
diff --git a/testsuite/tests/tcplugins/ArgsPlugin.hs b/testsuite/tests/tcplugins/ArgsPlugin.hs
index c25c8dc8a3..19e99bedd0 100644
--- a/testsuite/tests/tcplugins/ArgsPlugin.hs
+++ b/testsuite/tests/tcplugins/ArgsPlugin.hs
@@ -22,13 +22,15 @@ import GHC.Core.Type
 import GHC.Plugins
   ( Plugin )
 import GHC.Tc.Plugin
-  ( TcPluginM )
+  ( TcPluginM, getTargetPlatform )
 import GHC.Tc.Types
   ( TcPluginSolveResult(..) )
 import GHC.Tc.Types.Constraint
   ( Ct(..) )
 import GHC.Tc.Types.Evidence
   ( EvBindsVar, EvTerm(EvExpr) )
+import GHC.Platform
+  ( Platform )
 
 -- common
 import Common
@@ -62,11 +64,12 @@ solver args defs _ev _gs _ds ws = do
     argsVal = case args of
       arg : _ -> read arg
       _       -> error "ArgsPlugin: expected at least one argument"
-  solved <- catMaybes <$> traverse ( solveCt defs argsVal ) ws
+  platform <- getTargetPlatform
+  solved <- catMaybes <$> traverse ( solveCt platform defs argsVal ) ws
   pure $ TcPluginOk solved []
 
-solveCt :: PluginDefs -> Integer -> Ct -> TcPluginM ( Maybe (EvTerm, Ct) )
-solveCt ( PluginDefs {..} ) i ct@( CDictCan { cc_class, cc_tyargs } )
+solveCt :: Platform -> PluginDefs -> Integer -> Ct -> TcPluginM ( Maybe (EvTerm, Ct) )
+solveCt platform ( PluginDefs {..} ) i ct@( CDictCan { cc_class, cc_tyargs } )
   | className cc_class == className myClass
   , [tyArg] <- cc_tyargs
   , tyArg `eqType` integerTy
@@ -74,6 +77,6 @@ solveCt ( PluginDefs {..} ) i ct@( CDictCan { cc_class, cc_tyargs } )
       evTerm :: EvTerm
       evTerm = EvExpr $
         mkCoreConApps ( classDataCon cc_class )
-         [ Type integerTy, mkIntegerExpr i ]
+         [ Type integerTy, mkIntegerExpr platform i ]
   = pure $ Just ( evTerm, ct )
-solveCt _ _ ct = pure Nothing
+solveCt _ _ _ ct = pure Nothing