Support printing `integer-simple` Integers in GHCi

This means that `:p` no longer leaks the implementation details of
`Integer` with `integer-simple`. The `print037` test case should
exercise all possible code paths for GHCi's code around printing
`Integer`s (both in `integer-simple` and `integer-gmp`).

`ghc` the package now also has a Cabal `integer-simple` flag (like the
`integer-gmp` one).

7 files changed, 80 insertions, 2 deletions

diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in
index 5b93d3ceb2..4be4d60cb7 100644
--- a/compiler/ghc.cabal.in
+++ b/compiler/ghc.cabal.in
@@ -45,6 +45,11 @@ Flag terminfo
     Default: True
     Manual: True
 
+Flag integer-simple
+    Description: Use integer-simple
+    Manual: True
+    Default: False
+
 Flag integer-gmp
     Description: Use integer-gmp
     Manual: True
@@ -89,11 +94,20 @@ Library
         CPP-Options: -DGHCI
         Include-Dirs: ../rts/dist/build @FFIIncludeDir@
 
+    -- sanity-check to ensure not more than one integer flag is set
+    if flag(integer-gmp) && flag(integer-simple)
+        build-depends: invalid-cabal-flag-settings<0
+
     -- gmp internals are used by the GHCi debugger if available
     if flag(integer-gmp)
         CPP-Options: -DINTEGER_GMP
         build-depends: integer-gmp >= 1.0.2
 
+    -- simple internals are used by the GHCi debugger if available
+    if flag(integer-simple)
+        CPP-Options: -DINTEGER_SIMPLE
+        build-depends: integer-simple >= 0.1.1.1
+
     Other-Extensions:
         BangPatterns
         CPP
diff --git a/compiler/ghci/RtClosureInspect.hs b/compiler/ghci/RtClosureInspect.hs
index a61d776576..4a119a991b 100644
--- a/compiler/ghci/RtClosureInspect.hs
+++ b/compiler/ghci/RtClosureInspect.hs
@@ -67,6 +67,9 @@ import Data.List
 import GHC.Exts
 import Data.Array.Base
 import GHC.Integer.GMP.Internals
+#elif defined(INTEGER_SIMPLE)
+import GHC.Exts
+import GHC.Integer.Simple.Internals
 #endif
 import qualified Data.Sequence as Seq
 import Data.Sequence (viewl, ViewL(..))
@@ -410,9 +413,36 @@ cPprTermBase y =
       let
         !(UArray _ _ _ arr#) = listArray (0,length ws-1) ws
         constr
-          | "Jp#" <- occNameString (nameOccName (dataConName con)) = Jp#
+          | "Jp#" <- getOccString (dataConName con) = Jp#
           | otherwise = Jn#
       return (Just (Ppr.integer (constr (BN# arr#))))
+#elif defined(INTEGER_SIMPLE)
+   -- As with the GMP case, this depends deeply on the integer-simple
+   -- representation.
+   --
+   -- @
+   -- data Integer = Positive !Digits | Negative !Digits | Naught
+   --
+   -- data Digits = Some !Word# !Digits
+   --             | None
+   -- @
+   --
+   -- NB: the above has some type synonyms expanded out for the sake of brevity
+   ppr_integer _ Term{subTerms=[]} =
+      return (Just (Ppr.integer Naught))
+   ppr_integer _ Term{dc=Right con, subTerms=[digitTerm]}
+        | Just digits <- get_digits digitTerm
+        = return (Just (Ppr.integer (constr digits)))
+      where
+        get_digits :: Term -> Maybe Digits
+        get_digits Term{subTerms=[]} = Just None
+        get_digits Term{subTerms=[Prim{valRaw=[W# w]},t]}
+          = Some w <$> get_digits t
+        get_digits _ = Nothing
+
+        constr
+          | "Positive" <- getOccString (dataConName con) = Positive
+          | otherwise = Negative
 #endif
    ppr_integer _ _ = return Nothing
 
diff --git a/ghc.mk b/ghc.mk
index d90800b4f2..351012c3b0 100644
--- a/ghc.mk
+++ b/ghc.mk
@@ -616,6 +616,7 @@ libraries/base_dist-install_CONFIGURE_OPTS += --flags=integer-gmp
 compiler_stage2_CONFIGURE_OPTS += --flags=integer-gmp
 else ifeq "$(INTEGER_LIBRARY)" "integer-simple"
 libraries/base_dist-install_CONFIGURE_OPTS += --flags=integer-simple
+compiler_stage2_CONFIGURE_OPTS += --flags=integer-simple
 else
 $(error Unknown integer library: $(INTEGER_LIBRARY))
 endif
diff --git a/hadrian/src/Settings/Packages.hs b/hadrian/src/Settings/Packages.hs
index 8963c76a13..5993723bee 100644
--- a/hadrian/src/Settings/Packages.hs
+++ b/hadrian/src/Settings/Packages.hs
@@ -72,7 +72,9 @@ packageArgs = do
             , ghcWithInterpreter ? notStage0 ? arg "ghci"
             , flag CrossCompiling ? arg "-terminfo"
             , notStage0 ? intLib == integerGmp ?
-              arg "integer-gmp" ]
+              arg "integer-gmp"
+            , notStage0 ? intLib == integerSimple ?
+              arg "integer-simple" ]
 
           , builder (Haddock BuildPackage) ? arg ("--optghc=-I" ++ path) ]
 
diff --git a/testsuite/tests/ghci.debugger/scripts/all.T b/testsuite/tests/ghci.debugger/scripts/all.T
index 1ecf08f244..985f065d1f 100644
--- a/testsuite/tests/ghci.debugger/scripts/all.T
+++ b/testsuite/tests/ghci.debugger/scripts/all.T
@@ -45,6 +45,7 @@ test('print033', normal, ghci_script, ['print033.script'])
 test('print034', extra_files(['../GADT.hs', '../Test.hs']), ghci_script, ['print034.script'])
 test('print035', extra_files(['../Unboxed.hs']), ghci_script, ['print035.script'])
 test('print036', expect_broken(9046), ghci_script, ['print036.script'])
+test('print037', normal, ghci_script, ['print037.script'])
 
 test('break001', [broken_without_gmp, extra_files(['../Test2.hs'])], ghci_script, ['break001.script'])
 test('break002', extra_files(['../Test2.hs']), ghci_script, ['break002.script'])
diff --git a/testsuite/tests/ghci.debugger/scripts/print037.script b/testsuite/tests/ghci.debugger/scripts/print037.script
new file mode 100644
index 0000000000..7bf332c175
--- /dev/null
+++ b/testsuite/tests/ghci.debugger/scripts/print037.script
@@ -0,0 +1,25 @@
+-- Test out printing of integers in GHCi
+
+-- With @integer-gmp@, small integer literals get converted directly into
+-- @S# i#@. This optimization means that small integers are always already
+-- evaluated in the output for @:p@.
+--
+-- Since we want this test to work on @integer-simple@ too, we explicitly
+-- force the literals.
+
+let smallNeg = -53 :: Integer
+:f smallNeg
+
+let smallPos = 89 :: Integer
+:f smallPos
+
+let zero = 0 :: Integer
+:f zero
+
+let largeNeg = -4123841823694876543987265438957349857349 :: Integer
+:f largeNeg
+
+let largePos =  5402398759384752938475029384750298347554 :: Integer
+:f largePos
+
+:q
diff --git a/testsuite/tests/ghci.debugger/scripts/print037.stdout b/testsuite/tests/ghci.debugger/scripts/print037.stdout
new file mode 100644
index 0000000000..bce450ea3f
--- /dev/null
+++ b/testsuite/tests/ghci.debugger/scripts/print037.stdout
@@ -0,0 +1,5 @@
+smallNeg = -53
+smallPos = 89
+zero = 0
+largeNeg = -4123841823694876543987265438957349857349
+largePos = 5402398759384752938475029384750298347554