Typos in comments
[ghc.git] / compiler / basicTypes / Literal.lhs
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 \begin{code}
8 {-# LANGUAGE DeriveDataTypeable #-}
9
10 module Literal
11         (
12         -- * Main data type
13           Literal(..)           -- Exported to ParseIface
14
15         -- ** Creating Literals
16         , mkMachInt, mkMachWord
17         , mkMachInt64, mkMachWord64
18         , mkMachFloat, mkMachDouble
19         , mkMachChar, mkMachString
20         , mkLitInteger
21
22         -- ** Operations on Literals
23         , literalType
24         , hashLiteral
25         , absentLiteralOf
26         , pprLiteral
27
28         -- ** Predicates on Literals and their contents
29         , litIsDupable, litIsTrivial, litIsLifted
30         , inIntRange, inWordRange, tARGET_MAX_INT, inCharRange
31         , isZeroLit
32         , litFitsInChar
33
34         -- ** Coercions
35         , word2IntLit, int2WordLit
36         , narrow8IntLit, narrow16IntLit, narrow32IntLit
37         , narrow8WordLit, narrow16WordLit, narrow32WordLit
38         , char2IntLit, int2CharLit
39         , float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit
40         , nullAddrLit, float2DoubleLit, double2FloatLit
41         ) where
42
43 #include "HsVersions.h"
44
45 import TysPrim
46 import PrelNames
47 import Type
48 import TyCon
49 import Outputable
50 import FastTypes
51 import FastString
52 import BasicTypes
53 import Binary
54 import Constants
55 import DynFlags
56 import UniqFM
57 import Util
58
59 import Data.ByteString (ByteString)
60 import Data.Int
61 import Data.Ratio
62 import Data.Word
63 import Data.Char
64 import Data.Data ( Data, Typeable )
65 import Numeric ( fromRat )
66 \end{code}
67
68
69 %************************************************************************
70 %*                                                                      *
71 \subsection{Literals}
72 %*                                                                      *
73 %************************************************************************
74
75 \begin{code}
76 -- | So-called 'Literal's are one of:
77 --
78 -- * An unboxed (/machine/) literal ('MachInt', 'MachFloat', etc.),
79 --   which is presumed to be surrounded by appropriate constructors
80 --   (@Int#@, etc.), so that the overall thing makes sense.
81 --
82 -- * The literal derived from the label mentioned in a \"foreign label\"
83 --   declaration ('MachLabel')
84 data Literal
85   =     ------------------
86         -- First the primitive guys
87     MachChar    Char            -- ^ @Char#@ - at least 31 bits. Create with 'mkMachChar'
88
89   | MachStr     ByteString      -- ^ A string-literal: stored and emitted
90                                 -- UTF-8 encoded, we'll arrange to decode it
91                                 -- at runtime.  Also emitted with a @'\0'@
92                                 -- terminator. Create with 'mkMachString'
93
94   | MachNullAddr                -- ^ The @NULL@ pointer, the only pointer value
95                                 -- that can be represented as a Literal. Create
96                                 -- with 'nullAddrLit'
97
98   | MachInt     Integer         -- ^ @Int#@ - at least @WORD_SIZE_IN_BITS@ bits. Create with 'mkMachInt'
99   | MachInt64   Integer         -- ^ @Int64#@ - at least 64 bits. Create with 'mkMachInt64'
100   | MachWord    Integer         -- ^ @Word#@ - at least @WORD_SIZE_IN_BITS@ bits. Create with 'mkMachWord'
101   | MachWord64  Integer         -- ^ @Word64#@ - at least 64 bits. Create with 'mkMachWord64'
102
103   | MachFloat   Rational        -- ^ @Float#@. Create with 'mkMachFloat'
104   | MachDouble  Rational        -- ^ @Double#@. Create with 'mkMachDouble'
105
106   | MachLabel   FastString
107                 (Maybe Int)
108         FunctionOrData
109                 -- ^ A label literal. Parameters:
110                         --
111                         -- 1) The name of the symbol mentioned in the declaration
112                         --
113                         -- 2) The size (in bytes) of the arguments
114                                 --    the label expects. Only applicable with
115                                 --    @stdcall@ labels. @Just x@ => @\<x\>@ will
116                                 --    be appended to label name when emitting assembly.
117
118   | LitInteger Integer Type --  ^ Integer literals
119                             -- See Note [Integer literals]
120   deriving (Data, Typeable)
121 \end{code}
122
123 Note [Integer literals]
124 ~~~~~~~~~~~~~~~~~~~~~~~
125 An Integer literal is represented using, well, an Integer, to make it
126 easier to write RULEs for them. They also contain the Integer type, so
127 that e.g. literalType can return the right Type for them.
128
129 They only get converted into real Core,
130     mkInteger [c1, c2, .., cn]
131 during the CorePrep phase, although TidyPgm looks ahead at what the
132 core will be, so that it can see whether it involves CAFs.
133
134 When we initally build an Integer literal, notably when
135 deserialising it from an interface file (see the Binary instance
136 below), we don't have convenient access to the mkInteger Id.  So we
137 just use an error thunk, and fill in the real Id when we do tcIfaceLit
138 in TcIface.
139
140
141 Binary instance
142
143 \begin{code}
144 instance Binary Literal where
145     put_ bh (MachChar aa)     = do putByte bh 0; put_ bh aa
146     put_ bh (MachStr ab)      = do putByte bh 1; put_ bh ab
147     put_ bh (MachNullAddr)    = do putByte bh 2
148     put_ bh (MachInt ad)      = do putByte bh 3; put_ bh ad
149     put_ bh (MachInt64 ae)    = do putByte bh 4; put_ bh ae
150     put_ bh (MachWord af)     = do putByte bh 5; put_ bh af
151     put_ bh (MachWord64 ag)   = do putByte bh 6; put_ bh ag
152     put_ bh (MachFloat ah)    = do putByte bh 7; put_ bh ah
153     put_ bh (MachDouble ai)   = do putByte bh 8; put_ bh ai
154     put_ bh (MachLabel aj mb fod)
155         = do putByte bh 9
156              put_ bh aj
157              put_ bh mb
158              put_ bh fod
159     put_ bh (LitInteger i _) = do putByte bh 10; put_ bh i
160     get bh = do
161             h <- getByte bh
162             case h of
163               0 -> do
164                     aa <- get bh
165                     return (MachChar aa)
166               1 -> do
167                     ab <- get bh
168                     return (MachStr ab)
169               2 -> do
170                     return (MachNullAddr)
171               3 -> do
172                     ad <- get bh
173                     return (MachInt ad)
174               4 -> do
175                     ae <- get bh
176                     return (MachInt64 ae)
177               5 -> do
178                     af <- get bh
179                     return (MachWord af)
180               6 -> do
181                     ag <- get bh
182                     return (MachWord64 ag)
183               7 -> do
184                     ah <- get bh
185                     return (MachFloat ah)
186               8 -> do
187                     ai <- get bh
188                     return (MachDouble ai)
189               9 -> do
190                     aj <- get bh
191                     mb <- get bh
192                     fod <- get bh
193                     return (MachLabel aj mb fod)
194               _ -> do
195                     i <- get bh
196                     -- See Note [Integer literals]
197                     return $ mkLitInteger i (panic "Evaluated the place holder for mkInteger")
198 \end{code}
199
200 \begin{code}
201 instance Outputable Literal where
202     ppr lit = pprLiteral (\d -> d) lit
203
204 instance Eq Literal where
205     a == b = case (a `compare` b) of { EQ -> True;   _ -> False }
206     a /= b = case (a `compare` b) of { EQ -> False;  _ -> True  }
207
208 instance Ord Literal where
209     a <= b = case (a `compare` b) of { LT -> True;  EQ -> True;  GT -> False }
210     a <  b = case (a `compare` b) of { LT -> True;  EQ -> False; GT -> False }
211     a >= b = case (a `compare` b) of { LT -> False; EQ -> True;  GT -> True  }
212     a >  b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True  }
213     compare a b = cmpLit a b
214 \end{code}
215
216
217         Construction
218         ~~~~~~~~~~~~
219 \begin{code}
220 -- | Creates a 'Literal' of type @Int#@
221 mkMachInt :: DynFlags -> Integer -> Literal
222 mkMachInt dflags x   = ASSERT2( inIntRange dflags x,  integer x )
223                        MachInt x
224
225 -- | Creates a 'Literal' of type @Word#@
226 mkMachWord :: DynFlags -> Integer -> Literal
227 mkMachWord dflags x   = ASSERT2( inWordRange dflags x, integer x )
228                         MachWord x
229
230 -- | Creates a 'Literal' of type @Int64#@
231 mkMachInt64 :: Integer -> Literal
232 mkMachInt64  x = MachInt64 x
233
234 -- | Creates a 'Literal' of type @Word64#@
235 mkMachWord64 :: Integer -> Literal
236 mkMachWord64 x = MachWord64 x
237
238 -- | Creates a 'Literal' of type @Float#@
239 mkMachFloat :: Rational -> Literal
240 mkMachFloat = MachFloat
241
242 -- | Creates a 'Literal' of type @Double#@
243 mkMachDouble :: Rational -> Literal
244 mkMachDouble = MachDouble
245
246 -- | Creates a 'Literal' of type @Char#@
247 mkMachChar :: Char -> Literal
248 mkMachChar = MachChar
249
250 -- | Creates a 'Literal' of type @Addr#@, which is appropriate for passing to
251 -- e.g. some of the \"error\" functions in GHC.Err such as @GHC.Err.runtimeError@
252 mkMachString :: String -> Literal
253 -- stored UTF-8 encoded
254 mkMachString s = MachStr (fastStringToByteString $ mkFastString s)
255
256 mkLitInteger :: Integer -> Type -> Literal
257 mkLitInteger = LitInteger
258
259 inIntRange, inWordRange :: DynFlags -> Integer -> Bool
260 inIntRange  dflags x = x >= tARGET_MIN_INT dflags && x <= tARGET_MAX_INT dflags
261 inWordRange dflags x = x >= 0                     && x <= tARGET_MAX_WORD dflags
262
263 inCharRange :: Char -> Bool
264 inCharRange c =  c >= '\0' && c <= chr tARGET_MAX_CHAR
265
266 -- | Tests whether the literal represents a zero of whatever type it is
267 isZeroLit :: Literal -> Bool
268 isZeroLit (MachInt    0) = True
269 isZeroLit (MachInt64  0) = True
270 isZeroLit (MachWord   0) = True
271 isZeroLit (MachWord64 0) = True
272 isZeroLit (MachFloat  0) = True
273 isZeroLit (MachDouble 0) = True
274 isZeroLit _              = False
275 \end{code}
276
277         Coercions
278         ~~~~~~~~~
279 \begin{code}
280 narrow8IntLit, narrow16IntLit, narrow32IntLit,
281   narrow8WordLit, narrow16WordLit, narrow32WordLit,
282   char2IntLit, int2CharLit,
283   float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit,
284   float2DoubleLit, double2FloatLit
285   :: Literal -> Literal
286
287 word2IntLit, int2WordLit :: DynFlags -> Literal -> Literal
288 word2IntLit dflags (MachWord w)
289   | w > tARGET_MAX_INT dflags = MachInt (w - tARGET_MAX_WORD dflags - 1)
290   | otherwise                 = MachInt w
291 word2IntLit _ l = pprPanic "word2IntLit" (ppr l)
292
293 int2WordLit dflags (MachInt i)
294   | i < 0     = MachWord (1 + tARGET_MAX_WORD dflags + i)      -- (-1)  --->  tARGET_MAX_WORD
295   | otherwise = MachWord i
296 int2WordLit _ l = pprPanic "int2WordLit" (ppr l)
297
298 narrow8IntLit    (MachInt  i) = MachInt  (toInteger (fromInteger i :: Int8))
299 narrow8IntLit    l            = pprPanic "narrow8IntLit" (ppr l)
300 narrow16IntLit   (MachInt  i) = MachInt  (toInteger (fromInteger i :: Int16))
301 narrow16IntLit   l            = pprPanic "narrow16IntLit" (ppr l)
302 narrow32IntLit   (MachInt  i) = MachInt  (toInteger (fromInteger i :: Int32))
303 narrow32IntLit   l            = pprPanic "narrow32IntLit" (ppr l)
304 narrow8WordLit   (MachWord w) = MachWord (toInteger (fromInteger w :: Word8))
305 narrow8WordLit   l            = pprPanic "narrow8WordLit" (ppr l)
306 narrow16WordLit  (MachWord w) = MachWord (toInteger (fromInteger w :: Word16))
307 narrow16WordLit  l            = pprPanic "narrow16WordLit" (ppr l)
308 narrow32WordLit  (MachWord w) = MachWord (toInteger (fromInteger w :: Word32))
309 narrow32WordLit  l            = pprPanic "narrow32WordLit" (ppr l)
310
311 char2IntLit (MachChar c) = MachInt  (toInteger (ord c))
312 char2IntLit l            = pprPanic "char2IntLit" (ppr l)
313 int2CharLit (MachInt  i) = MachChar (chr (fromInteger i))
314 int2CharLit l            = pprPanic "int2CharLit" (ppr l)
315
316 float2IntLit (MachFloat f) = MachInt   (truncate    f)
317 float2IntLit l             = pprPanic "float2IntLit" (ppr l)
318 int2FloatLit (MachInt   i) = MachFloat (fromInteger i)
319 int2FloatLit l             = pprPanic "int2FloatLit" (ppr l)
320
321 double2IntLit (MachDouble f) = MachInt    (truncate    f)
322 double2IntLit l              = pprPanic "double2IntLit" (ppr l)
323 int2DoubleLit (MachInt    i) = MachDouble (fromInteger i)
324 int2DoubleLit l              = pprPanic "int2DoubleLit" (ppr l)
325
326 float2DoubleLit (MachFloat  f) = MachDouble f
327 float2DoubleLit l              = pprPanic "float2DoubleLit" (ppr l)
328 double2FloatLit (MachDouble d) = MachFloat  d
329 double2FloatLit l              = pprPanic "double2FloatLit" (ppr l)
330
331 nullAddrLit :: Literal
332 nullAddrLit = MachNullAddr
333 \end{code}
334
335         Predicates
336         ~~~~~~~~~~
337 \begin{code}
338 -- | True if there is absolutely no penalty to duplicating the literal.
339 -- False principally of strings
340 litIsTrivial :: Literal -> Bool
341 --      c.f. CoreUtils.exprIsTrivial
342 litIsTrivial (MachStr _)      = False
343 litIsTrivial (LitInteger {})  = False
344 litIsTrivial _                = True
345
346 -- | True if code space does not go bad if we duplicate this literal
347 -- Currently we treat it just like 'litIsTrivial'
348 litIsDupable :: DynFlags -> Literal -> Bool
349 --      c.f. CoreUtils.exprIsDupable
350 litIsDupable _      (MachStr _)      = False
351 litIsDupable dflags (LitInteger i _) = inIntRange dflags i
352 litIsDupable _      _                = True
353
354 litFitsInChar :: Literal -> Bool
355 litFitsInChar (MachInt i) = i >= toInteger (ord minBound)
356                          && i <= toInteger (ord maxBound)
357 litFitsInChar _           = False
358
359 litIsLifted :: Literal -> Bool
360 litIsLifted (LitInteger {}) = True
361 litIsLifted _               = False
362 \end{code}
363
364         Types
365         ~~~~~
366 \begin{code}
367 -- | Find the Haskell 'Type' the literal occupies
368 literalType :: Literal -> Type
369 literalType MachNullAddr    = addrPrimTy
370 literalType (MachChar _)    = charPrimTy
371 literalType (MachStr  _)    = addrPrimTy
372 literalType (MachInt  _)    = intPrimTy
373 literalType (MachWord  _)   = wordPrimTy
374 literalType (MachInt64  _)  = int64PrimTy
375 literalType (MachWord64  _) = word64PrimTy
376 literalType (MachFloat _)   = floatPrimTy
377 literalType (MachDouble _)  = doublePrimTy
378 literalType (MachLabel _ _ _) = addrPrimTy
379 literalType (LitInteger _ t) = t
380
381 absentLiteralOf :: TyCon -> Maybe Literal
382 -- Return a literal of the appropriate primtive
383 -- TyCon, to use as a placeholder when it doesn't matter
384 absentLiteralOf tc = lookupUFM absent_lits (tyConName tc)
385
386 absent_lits :: UniqFM Literal
387 absent_lits = listToUFM [ (addrPrimTyConKey,    MachNullAddr)
388                         , (charPrimTyConKey,    MachChar 'x')
389                         , (intPrimTyConKey,     MachInt 0)
390                         , (int64PrimTyConKey,   MachInt64 0)
391                         , (floatPrimTyConKey,   MachFloat 0)
392                         , (doublePrimTyConKey,  MachDouble 0)
393                         , (wordPrimTyConKey,    MachWord 0)
394                         , (word64PrimTyConKey,  MachWord64 0) ]
395 \end{code}
396
397
398         Comparison
399         ~~~~~~~~~~
400 \begin{code}
401 cmpLit :: Literal -> Literal -> Ordering
402 cmpLit (MachChar      a)   (MachChar       b)   = a `compare` b
403 cmpLit (MachStr       a)   (MachStr        b)   = a `compare` b
404 cmpLit (MachNullAddr)      (MachNullAddr)       = EQ
405 cmpLit (MachInt       a)   (MachInt        b)   = a `compare` b
406 cmpLit (MachWord      a)   (MachWord       b)   = a `compare` b
407 cmpLit (MachInt64     a)   (MachInt64      b)   = a `compare` b
408 cmpLit (MachWord64    a)   (MachWord64     b)   = a `compare` b
409 cmpLit (MachFloat     a)   (MachFloat      b)   = a `compare` b
410 cmpLit (MachDouble    a)   (MachDouble     b)   = a `compare` b
411 cmpLit (MachLabel     a _ _) (MachLabel      b _ _) = a `compare` b
412 cmpLit (LitInteger    a _) (LitInteger     b _) = a `compare` b
413 cmpLit lit1                lit2                 | litTag lit1 <# litTag lit2 = LT
414                                                 | otherwise                  = GT
415
416 litTag :: Literal -> FastInt
417 litTag (MachChar      _)   = _ILIT(1)
418 litTag (MachStr       _)   = _ILIT(2)
419 litTag (MachNullAddr)      = _ILIT(3)
420 litTag (MachInt       _)   = _ILIT(4)
421 litTag (MachWord      _)   = _ILIT(5)
422 litTag (MachInt64     _)   = _ILIT(6)
423 litTag (MachWord64    _)   = _ILIT(7)
424 litTag (MachFloat     _)   = _ILIT(8)
425 litTag (MachDouble    _)   = _ILIT(9)
426 litTag (MachLabel _ _ _)   = _ILIT(10)
427 litTag (LitInteger  {})    = _ILIT(11)
428 \end{code}
429
430         Printing
431         ~~~~~~~~
432 * MachX (i.e. unboxed) things are printed unadornded (e.g. 3, 'a', "foo")
433   exceptions: MachFloat gets an initial keyword prefix.
434
435 \begin{code}
436 pprLiteral :: (SDoc -> SDoc) -> Literal -> SDoc
437 -- The function is used on non-atomic literals
438 -- to wrap parens around literals that occur in
439 -- a context requiring an atomic thing
440 pprLiteral _       (MachChar ch)    = pprHsChar ch
441 pprLiteral _       (MachStr s)      = pprHsBytes s
442 pprLiteral _       (MachInt i)      = pprIntVal i
443 pprLiteral _       (MachDouble d)   = double (fromRat d)
444 pprLiteral _       (MachNullAddr)   = ptext (sLit "__NULL")
445 pprLiteral add_par (LitInteger i _) = add_par (ptext (sLit "__integer") <+> integer i)
446 pprLiteral add_par (MachInt64 i)    = add_par (ptext (sLit "__int64") <+> integer i)
447 pprLiteral add_par (MachWord w)     = add_par (ptext (sLit "__word") <+> integer w)
448 pprLiteral add_par (MachWord64 w)   = add_par (ptext (sLit "__word64") <+> integer w)
449 pprLiteral add_par (MachFloat f)    = add_par (ptext (sLit "__float") <+> float (fromRat f))
450 pprLiteral add_par (MachLabel l mb fod) = add_par (ptext (sLit "__label") <+> b <+> ppr fod)
451     where b = case mb of
452               Nothing -> pprHsString l
453               Just x  -> doubleQuotes (text (unpackFS l ++ '@':show x))
454
455 pprIntVal :: Integer -> SDoc
456 -- ^ Print negative integers with parens to be sure it's unambiguous
457 pprIntVal i | i < 0     = parens (integer i)
458             | otherwise = integer i
459 \end{code}
460
461
462 %************************************************************************
463 %*                                                                      *
464 \subsection{Hashing}
465 %*                                                                      *
466 %************************************************************************
467
468 Hash values should be zero or a positive integer.  No negatives please.
469 (They mess up the UniqFM for some reason.)
470
471 \begin{code}
472 hashLiteral :: Literal -> Int
473 hashLiteral (MachChar c)        = ord c + 1000  -- Keep it out of range of common ints
474 hashLiteral (MachStr s)         = hashByteString s
475 hashLiteral (MachNullAddr)      = 0
476 hashLiteral (MachInt i)         = hashInteger i
477 hashLiteral (MachInt64 i)       = hashInteger i
478 hashLiteral (MachWord i)        = hashInteger i
479 hashLiteral (MachWord64 i)      = hashInteger i
480 hashLiteral (MachFloat r)       = hashRational r
481 hashLiteral (MachDouble r)      = hashRational r
482 hashLiteral (MachLabel s _ _)     = hashFS s
483 hashLiteral (LitInteger i _)    = hashInteger i
484
485 hashRational :: Rational -> Int
486 hashRational r = hashInteger (numerator r)
487
488 hashInteger :: Integer -> Int
489 hashInteger i = 1 + abs (fromInteger (i `rem` 10000))
490                 -- The 1+ is to avoid zero, which is a Bad Number
491                 -- since we use * to combine hash values
492
493 hashFS :: FastString -> Int
494 hashFS s = iBox (uniqueOfFS s)
495 \end{code}