TcInteract: Ensure that tycons have representations before solving for Typeable
[ghc.git] / compiler / basicTypes / Literal.hs
1 {-
2 (c) The University of Glasgow 2006
3 (c) The GRASP/AQUA Project, Glasgow University, 1998
4
5 \section[Literal]{@Literal@: Machine literals (unboxed, of course)}
6 -}
7
8 {-# LANGUAGE CPP, DeriveDataTypeable #-}
9
10 module Literal
11 (
12 -- * Main data type
13 Literal(..) -- Exported to ParseIface
14
15 -- ** Creating Literals
16 , mkMachInt, mkMachIntWrap
17 , mkMachWord, mkMachWordWrap
18 , mkMachInt64, mkMachInt64Wrap
19 , mkMachWord64, mkMachWord64Wrap
20 , mkMachFloat, mkMachDouble
21 , mkMachChar, mkMachString
22 , mkLitInteger
23
24 -- ** Operations on Literals
25 , literalType
26 , absentLiteralOf
27 , pprLiteral
28
29 -- ** Predicates on Literals and their contents
30 , litIsDupable, litIsTrivial, litIsLifted
31 , inIntRange, inWordRange, tARGET_MAX_INT, inCharRange
32 , isZeroLit
33 , litFitsInChar
34 , litValue, isLitValue, isLitValue_maybe, mapLitValue
35
36 -- ** Coercions
37 , word2IntLit, int2WordLit
38 , narrow8IntLit, narrow16IntLit, narrow32IntLit
39 , narrow8WordLit, narrow16WordLit, narrow32WordLit
40 , char2IntLit, int2CharLit
41 , float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit
42 , nullAddrLit, float2DoubleLit, double2FloatLit
43 ) where
44
45 #include "HsVersions.h"
46
47 import GhcPrelude
48
49 import TysPrim
50 import PrelNames
51 import Type
52 import TyCon
53 import Outputable
54 import FastString
55 import BasicTypes
56 import Binary
57 import Constants
58 import DynFlags
59 import Platform
60 import UniqFM
61 import Util
62
63 import Data.ByteString (ByteString)
64 import Data.Int
65 import Data.Word
66 import Data.Char
67 import Data.Maybe ( isJust )
68 import Data.Data ( Data )
69 import Numeric ( fromRat )
70
71 {-
72 ************************************************************************
73 * *
74 \subsection{Literals}
75 * *
76 ************************************************************************
77 -}
78
79 -- | So-called 'Literal's are one of:
80 --
81 -- * An unboxed (/machine/) literal ('MachInt', 'MachFloat', etc.),
82 -- which is presumed to be surrounded by appropriate constructors
83 -- (@Int#@, etc.), so that the overall thing makes sense.
84 --
85 -- We maintain the invariant that the 'Integer' the Mach{Int,Word}*
86 -- constructors are actually in the (possibly target-dependent) range.
87 -- The mkMach{Int,Word}*Wrap smart constructors ensure this by applying
88 -- the target machine's wrapping semantics. Use these in situations
89 -- where you know the wrapping semantics are correct.
90 --
91 -- * The literal derived from the label mentioned in a \"foreign label\"
92 -- declaration ('MachLabel')
93 data Literal
94 = ------------------
95 -- First the primitive guys
96 MachChar Char -- ^ @Char#@ - at least 31 bits. Create with 'mkMachChar'
97
98 | MachStr ByteString -- ^ A string-literal: stored and emitted
99 -- UTF-8 encoded, we'll arrange to decode it
100 -- at runtime. Also emitted with a @'\0'@
101 -- terminator. Create with 'mkMachString'
102
103 | MachNullAddr -- ^ The @NULL@ pointer, the only pointer value
104 -- that can be represented as a Literal. Create
105 -- with 'nullAddrLit'
106
107 | MachInt Integer -- ^ @Int#@ - according to target machine
108 | MachInt64 Integer -- ^ @Int64#@ - exactly 64 bits
109 | MachWord Integer -- ^ @Word#@ - according to target machine
110 | MachWord64 Integer -- ^ @Word64#@ - exactly 64 bits
111
112 | MachFloat Rational -- ^ @Float#@. Create with 'mkMachFloat'
113 | MachDouble Rational -- ^ @Double#@. Create with 'mkMachDouble'
114
115 | MachLabel FastString
116 (Maybe Int)
117 FunctionOrData
118 -- ^ A label literal. Parameters:
119 --
120 -- 1) The name of the symbol mentioned in the declaration
121 --
122 -- 2) The size (in bytes) of the arguments
123 -- the label expects. Only applicable with
124 -- @stdcall@ labels. @Just x@ => @\<x\>@ will
125 -- be appended to label name when emitting assembly.
126
127 | LitInteger Integer Type -- ^ Integer literals
128 -- See Note [Integer literals]
129 deriving Data
130
131 {-
132 Note [Integer literals]
133 ~~~~~~~~~~~~~~~~~~~~~~~
134 An Integer literal is represented using, well, an Integer, to make it
135 easier to write RULEs for them. They also contain the Integer type, so
136 that e.g. literalType can return the right Type for them.
137
138 They only get converted into real Core,
139 mkInteger [c1, c2, .., cn]
140 during the CorePrep phase, although TidyPgm looks ahead at what the
141 core will be, so that it can see whether it involves CAFs.
142
143 When we initally build an Integer literal, notably when
144 deserialising it from an interface file (see the Binary instance
145 below), we don't have convenient access to the mkInteger Id. So we
146 just use an error thunk, and fill in the real Id when we do tcIfaceLit
147 in TcIface.
148
149
150 Binary instance
151 -}
152
153 instance Binary Literal where
154 put_ bh (MachChar aa) = do putByte bh 0; put_ bh aa
155 put_ bh (MachStr ab) = do putByte bh 1; put_ bh ab
156 put_ bh (MachNullAddr) = do putByte bh 2
157 put_ bh (MachInt ad) = do putByte bh 3; put_ bh ad
158 put_ bh (MachInt64 ae) = do putByte bh 4; put_ bh ae
159 put_ bh (MachWord af) = do putByte bh 5; put_ bh af
160 put_ bh (MachWord64 ag) = do putByte bh 6; put_ bh ag
161 put_ bh (MachFloat ah) = do putByte bh 7; put_ bh ah
162 put_ bh (MachDouble ai) = do putByte bh 8; put_ bh ai
163 put_ bh (MachLabel aj mb fod)
164 = do putByte bh 9
165 put_ bh aj
166 put_ bh mb
167 put_ bh fod
168 put_ bh (LitInteger i _) = do putByte bh 10; put_ bh i
169 get bh = do
170 h <- getByte bh
171 case h of
172 0 -> do
173 aa <- get bh
174 return (MachChar aa)
175 1 -> do
176 ab <- get bh
177 return (MachStr ab)
178 2 -> do
179 return (MachNullAddr)
180 3 -> do
181 ad <- get bh
182 return (MachInt ad)
183 4 -> do
184 ae <- get bh
185 return (MachInt64 ae)
186 5 -> do
187 af <- get bh
188 return (MachWord af)
189 6 -> do
190 ag <- get bh
191 return (MachWord64 ag)
192 7 -> do
193 ah <- get bh
194 return (MachFloat ah)
195 8 -> do
196 ai <- get bh
197 return (MachDouble ai)
198 9 -> do
199 aj <- get bh
200 mb <- get bh
201 fod <- get bh
202 return (MachLabel aj mb fod)
203 _ -> do
204 i <- get bh
205 -- See Note [Integer literals]
206 return $ mkLitInteger i (panic "Evaluated the place holder for mkInteger")
207
208 instance Outputable Literal where
209 ppr lit = pprLiteral (\d -> d) lit
210
211 instance Eq Literal where
212 a == b = case (a `compare` b) of { EQ -> True; _ -> False }
213 a /= b = case (a `compare` b) of { EQ -> False; _ -> True }
214
215 instance Ord Literal where
216 a <= b = case (a `compare` b) of { LT -> True; EQ -> True; GT -> False }
217 a < b = case (a `compare` b) of { LT -> True; EQ -> False; GT -> False }
218 a >= b = case (a `compare` b) of { LT -> False; EQ -> True; GT -> True }
219 a > b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True }
220 compare a b = cmpLit a b
221
222 {-
223 Construction
224 ~~~~~~~~~~~~
225 -}
226
227 {- Note [Word/Int underflow/overflow]
228 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
229 According to the Haskell Report 2010 (Sections 18.1 and 23.1 about signed and
230 unsigned integral types): "All arithmetic is performed modulo 2^n, where n is
231 the number of bits in the type."
232
233 GHC stores Word# and Int# constant values as Integer. Core optimizations such
234 as constant folding must ensure that the Integer value remains in the valid
235 target Word/Int range (see #13172). The following functions are used to
236 ensure this.
237
238 Note that we *don't* warn the user about overflow. It's not done at runtime
239 either, and compilation of completely harmless things like
240 ((124076834 :: Word32) + (2147483647 :: Word32))
241 doesn't yield a warning. Instead we simply squash the value into the *target*
242 Int/Word range.
243 -}
244
245 -- | Creates a 'Literal' of type @Int#@
246 mkMachInt :: DynFlags -> Integer -> Literal
247 mkMachInt dflags x = ASSERT2( inIntRange dflags x, integer x )
248 MachInt x
249
250 -- | Creates a 'Literal' of type @Int#@.
251 -- If the argument is out of the (target-dependent) range, it is wrapped.
252 -- See Note [Word/Int underflow/overflow]
253 mkMachIntWrap :: DynFlags -> Integer -> Literal
254 mkMachIntWrap dflags i
255 = MachInt $ case platformWordSize (targetPlatform dflags) of
256 4 -> toInteger (fromIntegral i :: Int32)
257 8 -> toInteger (fromIntegral i :: Int64)
258 w -> panic ("toIntRange: Unknown platformWordSize: " ++ show w)
259
260 -- | Creates a 'Literal' of type @Word#@
261 mkMachWord :: DynFlags -> Integer -> Literal
262 mkMachWord dflags x = ASSERT2( inWordRange dflags x, integer x )
263 MachWord x
264
265 -- | Creates a 'Literal' of type @Word#@.
266 -- If the argument is out of the (target-dependent) range, it is wrapped.
267 -- See Note [Word/Int underflow/overflow]
268 mkMachWordWrap :: DynFlags -> Integer -> Literal
269 mkMachWordWrap dflags i
270 = MachWord $ case platformWordSize (targetPlatform dflags) of
271 4 -> toInteger (fromInteger i :: Word32)
272 8 -> toInteger (fromInteger i :: Word64)
273 w -> panic ("toWordRange: Unknown platformWordSize: " ++ show w)
274
275 -- | Creates a 'Literal' of type @Int64#@
276 mkMachInt64 :: Integer -> Literal
277 mkMachInt64 x = ASSERT2( inInt64Range x, integer x )
278 MachInt64 x
279
280 -- | Creates a 'Literal' of type @Int64#@.
281 -- If the argument is out of the range, it is wrapped.
282 mkMachInt64Wrap :: Integer -> Literal
283 mkMachInt64Wrap i = MachInt64 (toInteger (fromIntegral i :: Int64))
284
285 -- | Creates a 'Literal' of type @Word64#@
286 mkMachWord64 :: Integer -> Literal
287 mkMachWord64 x = ASSERT2( inWord64Range x, integer x )
288 MachWord64 x
289
290 -- | Creates a 'Literal' of type @Word64#@.
291 -- If the argument is out of the range, it is wrapped.
292 mkMachWord64Wrap :: Integer -> Literal
293 mkMachWord64Wrap i = MachWord64 (toInteger (fromIntegral i :: Word64))
294
295 -- | Creates a 'Literal' of type @Float#@
296 mkMachFloat :: Rational -> Literal
297 mkMachFloat = MachFloat
298
299 -- | Creates a 'Literal' of type @Double#@
300 mkMachDouble :: Rational -> Literal
301 mkMachDouble = MachDouble
302
303 -- | Creates a 'Literal' of type @Char#@
304 mkMachChar :: Char -> Literal
305 mkMachChar = MachChar
306
307 -- | Creates a 'Literal' of type @Addr#@, which is appropriate for passing to
308 -- e.g. some of the \"error\" functions in GHC.Err such as @GHC.Err.runtimeError@
309 mkMachString :: String -> Literal
310 -- stored UTF-8 encoded
311 mkMachString s = MachStr (fastStringToByteString $ mkFastString s)
312
313 mkLitInteger :: Integer -> Type -> Literal
314 mkLitInteger = LitInteger
315
316 inIntRange, inWordRange :: DynFlags -> Integer -> Bool
317 inIntRange dflags x = x >= tARGET_MIN_INT dflags && x <= tARGET_MAX_INT dflags
318 inWordRange dflags x = x >= 0 && x <= tARGET_MAX_WORD dflags
319
320 inInt64Range, inWord64Range :: Integer -> Bool
321 inInt64Range x = x >= toInteger (minBound :: Int64) &&
322 x <= toInteger (maxBound :: Int64)
323 inWord64Range x = x >= toInteger (minBound :: Word64) &&
324 x <= toInteger (maxBound :: Word64)
325
326 inCharRange :: Char -> Bool
327 inCharRange c = c >= '\0' && c <= chr tARGET_MAX_CHAR
328
329 -- | Tests whether the literal represents a zero of whatever type it is
330 isZeroLit :: Literal -> Bool
331 isZeroLit (MachInt 0) = True
332 isZeroLit (MachInt64 0) = True
333 isZeroLit (MachWord 0) = True
334 isZeroLit (MachWord64 0) = True
335 isZeroLit (MachFloat 0) = True
336 isZeroLit (MachDouble 0) = True
337 isZeroLit _ = False
338
339 -- | Returns the 'Integer' contained in the 'Literal', for when that makes
340 -- sense, i.e. for 'Char', 'Int', 'Word' and 'LitInteger'.
341 litValue :: Literal -> Integer
342 litValue l = case isLitValue_maybe l of
343 Just x -> x
344 Nothing -> pprPanic "litValue" (ppr l)
345
346 -- | Returns the 'Integer' contained in the 'Literal', for when that makes
347 -- sense, i.e. for 'Char', 'Int', 'Word' and 'LitInteger'.
348 isLitValue_maybe :: Literal -> Maybe Integer
349 isLitValue_maybe (MachChar c) = Just $ toInteger $ ord c
350 isLitValue_maybe (MachInt i) = Just i
351 isLitValue_maybe (MachInt64 i) = Just i
352 isLitValue_maybe (MachWord i) = Just i
353 isLitValue_maybe (MachWord64 i) = Just i
354 isLitValue_maybe (LitInteger i _) = Just i
355 isLitValue_maybe _ = Nothing
356
357 -- | Apply a function to the 'Integer' contained in the 'Literal', for when that
358 -- makes sense, e.g. for 'Char', 'Int', 'Word' and 'LitInteger'. For
359 -- fixed-size integral literals, the result will be wrapped in
360 -- accordance with the semantics of the target type.
361 -- See Note [Word/Int underflow/overflow]
362 mapLitValue :: DynFlags -> (Integer -> Integer) -> Literal -> Literal
363 mapLitValue _ f (MachChar c) = mkMachChar (fchar c)
364 where fchar = chr . fromInteger . f . toInteger . ord
365 mapLitValue dflags f (MachInt i) = mkMachIntWrap dflags (f i)
366 mapLitValue _ f (MachInt64 i) = mkMachInt64Wrap (f i)
367 mapLitValue dflags f (MachWord i) = mkMachWordWrap dflags (f i)
368 mapLitValue _ f (MachWord64 i) = mkMachWord64Wrap (f i)
369 mapLitValue _ f (LitInteger i t) = mkLitInteger (f i) t
370 mapLitValue _ _ l = pprPanic "mapLitValue" (ppr l)
371
372 -- | Indicate if the `Literal` contains an 'Integer' value, e.g. 'Char',
373 -- 'Int', 'Word' and 'LitInteger'.
374 isLitValue :: Literal -> Bool
375 isLitValue = isJust . isLitValue_maybe
376
377 {-
378 Coercions
379 ~~~~~~~~~
380 -}
381
382 narrow8IntLit, narrow16IntLit, narrow32IntLit,
383 narrow8WordLit, narrow16WordLit, narrow32WordLit,
384 char2IntLit, int2CharLit,
385 float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit,
386 float2DoubleLit, double2FloatLit
387 :: Literal -> Literal
388
389 word2IntLit, int2WordLit :: DynFlags -> Literal -> Literal
390 word2IntLit dflags (MachWord w)
391 | w > tARGET_MAX_INT dflags = MachInt (w - tARGET_MAX_WORD dflags - 1)
392 | otherwise = MachInt w
393 word2IntLit _ l = pprPanic "word2IntLit" (ppr l)
394
395 int2WordLit dflags (MachInt i)
396 | i < 0 = MachWord (1 + tARGET_MAX_WORD dflags + i) -- (-1) ---> tARGET_MAX_WORD
397 | otherwise = MachWord i
398 int2WordLit _ l = pprPanic "int2WordLit" (ppr l)
399
400 narrow8IntLit (MachInt i) = MachInt (toInteger (fromInteger i :: Int8))
401 narrow8IntLit l = pprPanic "narrow8IntLit" (ppr l)
402 narrow16IntLit (MachInt i) = MachInt (toInteger (fromInteger i :: Int16))
403 narrow16IntLit l = pprPanic "narrow16IntLit" (ppr l)
404 narrow32IntLit (MachInt i) = MachInt (toInteger (fromInteger i :: Int32))
405 narrow32IntLit l = pprPanic "narrow32IntLit" (ppr l)
406 narrow8WordLit (MachWord w) = MachWord (toInteger (fromInteger w :: Word8))
407 narrow8WordLit l = pprPanic "narrow8WordLit" (ppr l)
408 narrow16WordLit (MachWord w) = MachWord (toInteger (fromInteger w :: Word16))
409 narrow16WordLit l = pprPanic "narrow16WordLit" (ppr l)
410 narrow32WordLit (MachWord w) = MachWord (toInteger (fromInteger w :: Word32))
411 narrow32WordLit l = pprPanic "narrow32WordLit" (ppr l)
412
413 char2IntLit (MachChar c) = MachInt (toInteger (ord c))
414 char2IntLit l = pprPanic "char2IntLit" (ppr l)
415 int2CharLit (MachInt i) = MachChar (chr (fromInteger i))
416 int2CharLit l = pprPanic "int2CharLit" (ppr l)
417
418 float2IntLit (MachFloat f) = MachInt (truncate f)
419 float2IntLit l = pprPanic "float2IntLit" (ppr l)
420 int2FloatLit (MachInt i) = MachFloat (fromInteger i)
421 int2FloatLit l = pprPanic "int2FloatLit" (ppr l)
422
423 double2IntLit (MachDouble f) = MachInt (truncate f)
424 double2IntLit l = pprPanic "double2IntLit" (ppr l)
425 int2DoubleLit (MachInt i) = MachDouble (fromInteger i)
426 int2DoubleLit l = pprPanic "int2DoubleLit" (ppr l)
427
428 float2DoubleLit (MachFloat f) = MachDouble f
429 float2DoubleLit l = pprPanic "float2DoubleLit" (ppr l)
430 double2FloatLit (MachDouble d) = MachFloat d
431 double2FloatLit l = pprPanic "double2FloatLit" (ppr l)
432
433 nullAddrLit :: Literal
434 nullAddrLit = MachNullAddr
435
436 {-
437 Predicates
438 ~~~~~~~~~~
439 -}
440
441 -- | True if there is absolutely no penalty to duplicating the literal.
442 -- False principally of strings.
443 --
444 -- "Why?", you say? I'm glad you asked. Well, for one duplicating strings would
445 -- blow up code sizes. Not only this, it's also unsafe.
446 --
447 -- Consider a program that wants to traverse a string. One way it might do this
448 -- is to first compute the Addr# pointing to the end of the string, and then,
449 -- starting from the beginning, bump a pointer using eqAddr# to determine the
450 -- end. For instance,
451 --
452 -- @
453 -- -- Given pointers to the start and end of a string, count how many zeros
454 -- -- the string contains.
455 -- countZeros :: Addr# -> Addr# -> -> Int
456 -- countZeros start end = go start 0
457 -- where
458 -- go off n
459 -- | off `addrEq#` end = n
460 -- | otherwise = go (off `plusAddr#` 1) n'
461 -- where n' | isTrue# (indexInt8OffAddr# off 0# ==# 0#) = n + 1
462 -- | otherwise = n
463 -- @
464 --
465 -- Consider what happens if we considered strings to be trivial (and therefore
466 -- duplicable) and emitted a call like @countZeros "hello"# ("hello"#
467 -- `plusAddr`# 5)@. The beginning and end pointers do not belong to the same
468 -- string, meaning that an iteration like the above would blow up terribly.
469 -- This is what happened in #12757.
470 --
471 -- Ultimately the solution here is to make primitive strings a bit more
472 -- structured, ensuring that the compiler can't inline in ways that will break
473 -- user code. One approach to this is described in #8472.
474 litIsTrivial :: Literal -> Bool
475 -- c.f. CoreUtils.exprIsTrivial
476 litIsTrivial (MachStr _) = False
477 litIsTrivial (LitInteger {}) = False
478 litIsTrivial _ = True
479
480 -- | True if code space does not go bad if we duplicate this literal
481 -- Currently we treat it just like 'litIsTrivial'
482 litIsDupable :: DynFlags -> Literal -> Bool
483 -- c.f. CoreUtils.exprIsDupable
484 litIsDupable _ (MachStr _) = False
485 litIsDupable dflags (LitInteger i _) = inIntRange dflags i
486 litIsDupable _ _ = True
487
488 litFitsInChar :: Literal -> Bool
489 litFitsInChar (MachInt i) = i >= toInteger (ord minBound)
490 && i <= toInteger (ord maxBound)
491 litFitsInChar _ = False
492
493 litIsLifted :: Literal -> Bool
494 litIsLifted (LitInteger {}) = True
495 litIsLifted _ = False
496
497 {-
498 Types
499 ~~~~~
500 -}
501
502 -- | Find the Haskell 'Type' the literal occupies
503 literalType :: Literal -> Type
504 literalType MachNullAddr = addrPrimTy
505 literalType (MachChar _) = charPrimTy
506 literalType (MachStr _) = addrPrimTy
507 literalType (MachInt _) = intPrimTy
508 literalType (MachWord _) = wordPrimTy
509 literalType (MachInt64 _) = int64PrimTy
510 literalType (MachWord64 _) = word64PrimTy
511 literalType (MachFloat _) = floatPrimTy
512 literalType (MachDouble _) = doublePrimTy
513 literalType (MachLabel _ _ _) = addrPrimTy
514 literalType (LitInteger _ t) = t
515
516 absentLiteralOf :: TyCon -> Maybe Literal
517 -- Return a literal of the appropriate primitive
518 -- TyCon, to use as a placeholder when it doesn't matter
519 absentLiteralOf tc = lookupUFM absent_lits (tyConName tc)
520
521 absent_lits :: UniqFM Literal
522 absent_lits = listToUFM [ (addrPrimTyConKey, MachNullAddr)
523 , (charPrimTyConKey, MachChar 'x')
524 , (intPrimTyConKey, MachInt 0)
525 , (int64PrimTyConKey, MachInt64 0)
526 , (floatPrimTyConKey, MachFloat 0)
527 , (doublePrimTyConKey, MachDouble 0)
528 , (wordPrimTyConKey, MachWord 0)
529 , (word64PrimTyConKey, MachWord64 0) ]
530
531 {-
532 Comparison
533 ~~~~~~~~~~
534 -}
535
536 cmpLit :: Literal -> Literal -> Ordering
537 cmpLit (MachChar a) (MachChar b) = a `compare` b
538 cmpLit (MachStr a) (MachStr b) = a `compare` b
539 cmpLit (MachNullAddr) (MachNullAddr) = EQ
540 cmpLit (MachInt a) (MachInt b) = a `compare` b
541 cmpLit (MachWord a) (MachWord b) = a `compare` b
542 cmpLit (MachInt64 a) (MachInt64 b) = a `compare` b
543 cmpLit (MachWord64 a) (MachWord64 b) = a `compare` b
544 cmpLit (MachFloat a) (MachFloat b) = a `compare` b
545 cmpLit (MachDouble a) (MachDouble b) = a `compare` b
546 cmpLit (MachLabel a _ _) (MachLabel b _ _) = a `compare` b
547 cmpLit (LitInteger a _) (LitInteger b _) = a `compare` b
548 cmpLit lit1 lit2 | litTag lit1 < litTag lit2 = LT
549 | otherwise = GT
550
551 litTag :: Literal -> Int
552 litTag (MachChar _) = 1
553 litTag (MachStr _) = 2
554 litTag (MachNullAddr) = 3
555 litTag (MachInt _) = 4
556 litTag (MachWord _) = 5
557 litTag (MachInt64 _) = 6
558 litTag (MachWord64 _) = 7
559 litTag (MachFloat _) = 8
560 litTag (MachDouble _) = 9
561 litTag (MachLabel _ _ _) = 10
562 litTag (LitInteger {}) = 11
563
564 {-
565 Printing
566 ~~~~~~~~
567 * See Note [Printing of literals in Core]
568 -}
569
570 pprLiteral :: (SDoc -> SDoc) -> Literal -> SDoc
571 pprLiteral _ (MachChar c) = pprPrimChar c
572 pprLiteral _ (MachStr s) = pprHsBytes s
573 pprLiteral _ (MachNullAddr) = text "__NULL"
574 pprLiteral _ (MachInt i) = pprPrimInt i
575 pprLiteral _ (MachInt64 i) = pprPrimInt64 i
576 pprLiteral _ (MachWord w) = pprPrimWord w
577 pprLiteral _ (MachWord64 w) = pprPrimWord64 w
578 pprLiteral _ (MachFloat f) = float (fromRat f) <> primFloatSuffix
579 pprLiteral _ (MachDouble d) = double (fromRat d) <> primDoubleSuffix
580 pprLiteral add_par (LitInteger i _) = pprIntegerVal add_par i
581 pprLiteral add_par (MachLabel l mb fod) = add_par (text "__label" <+> b <+> ppr fod)
582 where b = case mb of
583 Nothing -> pprHsString l
584 Just x -> doubleQuotes (text (unpackFS l ++ '@':show x))
585
586 pprIntegerVal :: (SDoc -> SDoc) -> Integer -> SDoc
587 -- See Note [Printing of literals in Core].
588 pprIntegerVal add_par i | i < 0 = add_par (integer i)
589 | otherwise = integer i
590
591 {-
592 Note [Printing of literals in Core]
593 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
594 The function `add_par` is used to wrap parenthesis around negative integers
595 (`LitInteger`) and labels (`MachLabel`), if they occur in a context requiring
596 an atomic thing (for example function application).
597
598 Although not all Core literals would be valid Haskell, we are trying to stay
599 as close as possible to Haskell syntax in the printing of Core, to make it
600 easier for a Haskell user to read Core.
601
602 To that end:
603 * We do print parenthesis around negative `LitInteger`, because we print
604 `LitInteger` using plain number literals (no prefix or suffix), and plain
605 number literals in Haskell require parenthesis in contexts like function
606 application (i.e. `1 - -1` is not valid Haskell).
607
608 * We don't print parenthesis around other (negative) literals, because they
609 aren't needed in GHC/Haskell either (i.e. `1# -# -1#` is accepted by GHC's
610 parser).
611
612 Literal Output Output if context requires
613 an atom (if different)
614 ------- ------- ----------------------
615 MachChar 'a'#
616 MachStr "aaa"#
617 MachNullAddr "__NULL"
618 MachInt -1#
619 MachInt64 -1L#
620 MachWord 1##
621 MachWord64 1L##
622 MachFloat -1.0#
623 MachDouble -1.0##
624 LitInteger -1 (-1)
625 MachLabel "__label" ... ("__label" ...)
626 -}