| ... |
... |
@@ -39,7 +39,7 @@ module GHC.Utils.Outputable ( |
|
39
|
39
|
spaceIfSingleQuote,
|
|
40
|
40
|
isEmpty, nest,
|
|
41
|
41
|
ptext,
|
|
42
|
|
- int, intWithCommas, integer, word64, word, float, double, rational, doublePrec,
|
|
|
42
|
+ int, intWithCommas, integer, natural, word64, word, float, double, rational, doublePrec,
|
|
43
|
43
|
parens, cparen, brackets, braces, quotes, quote, quoteIfPunsEnabled,
|
|
44
|
44
|
doubleQuotes, angleBrackets,
|
|
45
|
45
|
semi, comma, colon, dcolon, space, equals, dot, vbar,
|
| ... |
... |
@@ -150,6 +150,7 @@ import System.IO ( Handle ) |
|
150
|
150
|
import System.FilePath
|
|
151
|
151
|
import Text.Printf
|
|
152
|
152
|
import Numeric (showFFloat)
|
|
|
153
|
+import Numeric.Natural (Natural)
|
|
153
|
154
|
import Data.Graph (SCC(..))
|
|
154
|
155
|
import Data.List (intersperse)
|
|
155
|
156
|
import Data.List.NonEmpty (NonEmpty (..))
|
| ... |
... |
@@ -684,6 +685,7 @@ docToSDoc d = SDoc (\_ -> d) |
|
684
|
685
|
|
|
685
|
686
|
ptext :: PtrString -> SDoc
|
|
686
|
687
|
int :: IsLine doc => Int -> doc
|
|
|
688
|
+natural :: IsLine doc => Int -> doc
|
|
687
|
689
|
integer :: IsLine doc => Integer -> doc
|
|
688
|
690
|
word :: Integer -> SDoc
|
|
689
|
691
|
word64 :: IsLine doc => Word64 -> doc
|
| ... |
... |
@@ -695,6 +697,8 @@ rational :: Rational -> SDoc |
|
695
|
697
|
ptext s = docToSDoc $ Pretty.ptext s
|
|
696
|
698
|
{-# INLINE CONLIKE int #-}
|
|
697
|
699
|
int n = text $ show n
|
|
|
700
|
+{-# INLINE CONLIKE natural #-}
|
|
|
701
|
+natural n = text $ show n
|
|
698
|
702
|
{-# INLINE CONLIKE integer #-}
|
|
699
|
703
|
integer n = text $ show n
|
|
700
|
704
|
{-# INLINE CONLIKE float #-}
|
| ... |
... |
@@ -947,6 +951,9 @@ instance Outputable Int64 where |
|
947
|
951
|
instance Outputable Int where
|
|
948
|
952
|
ppr n = int n
|
|
949
|
953
|
|
|
|
954
|
+instance Outputable Natural where
|
|
|
955
|
+ ppr n = natural n
|
|
|
956
|
+
|
|
950
|
957
|
instance Outputable Integer where
|
|
951
|
958
|
ppr n = integer n
|
|
952
|
959
|
|