-instance Outputable Literal where
- ppr sty (MachChar ch)
- = let
- char_encoding
- = case sty of
- PprForC -> charToC ch
- PprForAsm _ _ -> charToC ch
- PprInterface -> charToEasyHaskell ch
- _ -> [ch]
- in
- hcat [ppCast sty SLIT("(C_)"), char '\'', text char_encoding, char '\'']
-
- ppr sty (MachStr s)
- | codeStyle sty = hcat [char '"', text (stringToC (_UNPK_ s)), char '"']
- | otherwise = text (show (_UNPK_ s))
-
- ppr sty lit@(NoRepStr s)
- | codeStyle sty = pprPanic "NoRep in code style" (ppr PprDebug lit)
- | otherwise = hcat [ptext SLIT("_string_ "), text (show (_UNPK_ s))]
-
- ppr sty (MachInt i signed)
- | codeStyle sty && out_of_range
- = panic ("ERROR: Int " ++ show i ++ " out of range [" ++
- show range_min ++ " .. " ++ show range_max ++ "]\n")
-
- | otherwise = integer i
-
- where
- range_min = if signed then minInt else 0
- range_max = maxInt
- out_of_range = not (i >= toInteger range_min && i <= toInteger range_max)
-
- ppr sty (MachFloat f)
- | codeStyle sty = hcat [ppCast sty SLIT("(StgFloat)"), rational f]
- | otherwise = hcat [ptext SLIT("_float_ "), rational f]
-
- ppr sty (MachDouble d) = rational d
-
- ppr sty (MachAddr p)
- | codeStyle sty = hcat [ppCast sty SLIT("(void*)"), integer p]
- | otherwise = hcat [ptext SLIT("_addr_ "), integer p]
-
- ppr sty lit@(NoRepInteger i _)
- | codeStyle sty = pprPanic "NoRep in code style" (ppr PprDebug lit)
- | otherwise = hsep [ptext SLIT("_integer_ "), integer i]
-
- ppr sty lit@(NoRepRational r _)
- | codeStyle sty = pprPanic "NoRep in code style" (ppr PprDebug lit)
- | otherwise = hsep [ptext SLIT("_rational_ "), integer (numerator r), integer (denominator r)]
-
- ppr sty (MachLitLit s k)
- | codeStyle sty = ptext s
- | otherwise = hcat [ptext SLIT("_litlit_ "), ppPrimRep k, char ' ', text (show (_UNPK_ s))]
-
-showLiteral :: PprStyle -> Literal -> String
-showLiteral sty lit = show (ppr sty lit)
+\begin{code}
+pprLit lit
+ = getPprStyle $ \ sty ->
+ let
+ code_style = codeStyle sty
+ in
+ case lit of
+ MachChar ch | code_style -> hcat [ptext SLIT("(C_)"), text (show ch)]
+ | otherwise -> pprHsChar ch
+
+ MachStr s | code_style -> pprFSInCStyle s
+ | otherwise -> pprHsString s
+ -- Warning: printing MachStr in code_style assumes it contains
+ -- only characters '\0'..'\xFF'!
+
+ MachInt i | code_style && i == tARGET_MIN_INT -> parens (integer (i+1) <> text "-1")
+ -- Avoid a problem whereby gcc interprets
+ -- the constant minInt as unsigned.
+ | otherwise -> pprIntVal i
+
+ MachInt64 i | code_style -> pprIntVal i -- Same problem with gcc???
+ | otherwise -> ptext SLIT("__int64") <+> integer i
+
+ MachWord w | code_style -> pprHexVal w
+ | otherwise -> ptext SLIT("__word") <+> integer w
+
+ MachWord64 w | code_style -> pprHexVal w
+ | otherwise -> ptext SLIT("__word64") <+> integer w
+
+ MachFloat f | code_style -> ptext SLIT("(StgFloat)") <> code_rational f
+ | otherwise -> ptext SLIT("__float") <+> rational f
+
+ MachDouble d | code_style -> code_rational d
+ | otherwise -> rational d
+
+ MachAddr p | code_style -> ptext SLIT("(void*)") <> integer p
+ | otherwise -> ptext SLIT("__addr") <+> integer p
+
+ MachLabel l | code_style -> ptext SLIT("(&") <> ftext l <> char ')'
+ | otherwise -> ptext SLIT("__label") <+> pprHsString l
+
+ MachLitLit s ty | code_style -> ftext s
+ | otherwise -> parens (hsep [ptext SLIT("__litlit"),
+ pprHsString s,
+ pprParendType ty])
+
+-- negative floating literals in code style need parentheses to avoid
+-- interacting with surrounding syntax.
+code_rational d | d < 0 = parens (rational d)
+ | otherwise = rational d
+
+pprIntVal :: Integer -> SDoc
+-- Print negative integers with parens to be sure it's unambiguous
+pprIntVal i | i < 0 = parens (integer i)
+ | otherwise = integer i
+
+pprHexVal :: Integer -> SDoc
+-- Print in C hex format: 0x13fa
+pprHexVal 0 = ptext SLIT("0x0")
+pprHexVal w = ptext SLIT("0x") <> go w
+ where
+ go 0 = empty
+ go w = go quot <> dig
+ where
+ (quot,rem) = w `quotRem` 16
+ dig | rem < 10 = char (chr (fromInteger rem + ord '0'))
+ | otherwise = char (chr (fromInteger rem - 10 + ord 'a'))