2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 1998
5 \section[Literal]{@Literal@: Machine literals (unboxed, of course)}
8 {-# OPTIONS -fno-warn-incomplete-patterns #-}
9 -- The above warning supression flag is a temporary kludge.
10 -- While working on this module you are encouraged to remove it and fix
11 -- any warnings in the module. See
12 -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
18 Literal(..) -- Exported to ParseIface
20 -- ** Creating Literals
21 , mkMachInt, mkMachWord
22 , mkMachInt64, mkMachWord64
23 , mkMachFloat, mkMachDouble
24 , mkMachChar, mkMachString
26 -- ** Operations on Literals
31 -- ** Predicates on Literals and their contents
32 , litIsDupable, litIsTrivial
33 , inIntRange, inWordRange, tARGET_MAX_INT, inCharRange
38 , word2IntLit, int2WordLit
39 , narrow8IntLit, narrow16IntLit, narrow32IntLit
40 , narrow8WordLit, narrow16WordLit, narrow32WordLit
41 , char2IntLit, int2CharLit
42 , float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit
43 , nullAddrLit, float2DoubleLit, double2FloatLit
61 %************************************************************************
65 %************************************************************************
67 If we're compiling with GHC (and we're not cross-compiling), then we
68 know that minBound and maxBound :: Int are the right values for the
69 target architecture. Otherwise, we assume -2^31 and 2^31-1
70 respectively (which will be wrong on a 64-bit machine).
73 tARGET_MIN_INT, tARGET_MAX_INT, tARGET_MAX_WORD :: Integer
74 #ifdef __GLASGOW_HASKELL__
75 tARGET_MIN_INT = toInteger (minBound :: Int)
76 tARGET_MAX_INT = toInteger (maxBound :: Int)
78 tARGET_MIN_INT = -2147483648
79 tARGET_MAX_INT = 2147483647
81 tARGET_MAX_WORD = (tARGET_MAX_INT * 2) + 1
83 tARGET_MAX_CHAR :: Int
84 tARGET_MAX_CHAR = 0x10ffff
87 %************************************************************************
91 %************************************************************************
94 -- | So-called 'Literal's are one of:
96 -- * An unboxed (/machine/) literal ('MachInt', 'MachFloat', etc.),
97 -- which is presumed to be surrounded by appropriate constructors
98 -- (@Int#@, etc.), so that the overall thing makes sense.
100 -- * The literal derived from the label mentioned in a \"foreign label\"
101 -- declaration ('MachLabel')
104 -- First the primitive guys
105 MachChar Char -- ^ @Char#@ - at least 31 bits. Create with 'mkMachChar'
107 | MachStr FastString -- ^ A string-literal: stored and emitted
108 -- UTF-8 encoded, we'll arrange to decode it
109 -- at runtime. Also emitted with a @'\0'@
110 -- terminator. Create with 'mkMachString'
112 | MachNullAddr -- ^ The @NULL@ pointer, the only pointer value
113 -- that can be represented as a Literal. Create
114 -- with 'nullAddrLit'
116 | MachInt Integer -- ^ @Int#@ - at least @WORD_SIZE_IN_BITS@ bits. Create with 'mkMachInt'
117 | MachInt64 Integer -- ^ @Int64#@ - at least 64 bits. Create with 'mkMachInt64'
118 | MachWord Integer -- ^ @Word#@ - at least @WORD_SIZE_IN_BITS@ bits. Create with 'mkMachWord'
119 | MachWord64 Integer -- ^ @Word64#@ - at least 64 bits. Create with 'mkMachWord64'
121 | MachFloat Rational -- ^ @Float#@. Create with 'mkMachFloat'
122 | MachDouble Rational -- ^ @Double#@. Create with 'mkMachDouble'
124 | MachLabel FastString
127 -- ^ A label literal. Parameters:
129 -- 1) The name of the symbol mentioned in the declaration
131 -- 2) The size (in bytes) of the arguments
132 -- the label expects. Only applicable with
133 -- @stdcall@ labels. @Just x@ => @\<x\>@ will
134 -- be appended to label name when emitting assembly.
140 instance Binary Literal where
141 put_ bh (MachChar aa) = do putByte bh 0; put_ bh aa
142 put_ bh (MachStr ab) = do putByte bh 1; put_ bh ab
143 put_ bh (MachNullAddr) = do putByte bh 2
144 put_ bh (MachInt ad) = do putByte bh 3; put_ bh ad
145 put_ bh (MachInt64 ae) = do putByte bh 4; put_ bh ae
146 put_ bh (MachWord af) = do putByte bh 5; put_ bh af
147 put_ bh (MachWord64 ag) = do putByte bh 6; put_ bh ag
148 put_ bh (MachFloat ah) = do putByte bh 7; put_ bh ah
149 put_ bh (MachDouble ai) = do putByte bh 8; put_ bh ai
150 put_ bh (MachLabel aj mb fod)
165 return (MachNullAddr)
171 return (MachInt64 ae)
177 return (MachWord64 ag)
180 return (MachFloat ah)
183 return (MachDouble ai)
188 return (MachLabel aj mb fod)
192 instance Outputable Literal where
195 instance Show Literal where
196 showsPrec p lit = showsPrecSDoc p (ppr lit)
198 instance Eq Literal where
199 a == b = case (a `compare` b) of { EQ -> True; _ -> False }
200 a /= b = case (a `compare` b) of { EQ -> False; _ -> True }
202 instance Ord Literal where
203 a <= b = case (a `compare` b) of { LT -> True; EQ -> True; GT -> False }
204 a < b = case (a `compare` b) of { LT -> True; EQ -> False; GT -> False }
205 a >= b = case (a `compare` b) of { LT -> False; EQ -> True; GT -> True }
206 a > b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True }
207 compare a b = cmpLit a b
214 -- | Creates a 'Literal' of type @Int#@
215 mkMachInt :: Integer -> Literal
216 mkMachInt x = -- ASSERT2( inIntRange x, integer x )
217 -- Not true: you can write out of range Int# literals
218 -- For example, one can write (intToWord# 0xffff0000) to
219 -- get a particular Word bit-pattern, and there's no other
220 -- convenient way to write such literals, which is why we allow it.
223 -- | Creates a 'Literal' of type @Word#@
224 mkMachWord :: Integer -> Literal
225 mkMachWord x = -- ASSERT2( inWordRange x, integer x )
228 -- | Creates a 'Literal' of type @Int64#@
229 mkMachInt64 :: Integer -> Literal
230 mkMachInt64 x = MachInt64 x
232 -- | Creates a 'Literal' of type @Word64#@
233 mkMachWord64 :: Integer -> Literal
234 mkMachWord64 x = MachWord64 x
236 -- | Creates a 'Literal' of type @Float#@
237 mkMachFloat :: Rational -> Literal
238 mkMachFloat = MachFloat
240 -- | Creates a 'Literal' of type @Double#@
241 mkMachDouble :: Rational -> Literal
242 mkMachDouble = MachDouble
244 -- | Creates a 'Literal' of type @Char#@
245 mkMachChar :: Char -> Literal
246 mkMachChar = MachChar
248 -- | Creates a 'Literal' of type @Addr#@, which is appropriate for passing to
249 -- e.g. some of the \"error\" functions in GHC.Err such as @GHC.Err.runtimeError@
250 mkMachString :: String -> Literal
251 mkMachString s = MachStr (mkFastString s) -- stored UTF-8 encoded
253 inIntRange, inWordRange :: Integer -> Bool
254 inIntRange x = x >= tARGET_MIN_INT && x <= tARGET_MAX_INT
255 inWordRange x = x >= 0 && x <= tARGET_MAX_WORD
257 inCharRange :: Char -> Bool
258 inCharRange c = c >= '\0' && c <= chr tARGET_MAX_CHAR
260 -- | Tests whether the literal represents a zero of whatever type it is
261 isZeroLit :: Literal -> Bool
262 isZeroLit (MachInt 0) = True
263 isZeroLit (MachInt64 0) = True
264 isZeroLit (MachWord 0) = True
265 isZeroLit (MachWord64 0) = True
266 isZeroLit (MachFloat 0) = True
267 isZeroLit (MachDouble 0) = True
274 word2IntLit, int2WordLit,
275 narrow8IntLit, narrow16IntLit, narrow32IntLit,
276 narrow8WordLit, narrow16WordLit, narrow32WordLit,
277 char2IntLit, int2CharLit,
278 float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit,
279 float2DoubleLit, double2FloatLit
280 :: Literal -> Literal
282 word2IntLit (MachWord w)
283 | w > tARGET_MAX_INT = MachInt (w - tARGET_MAX_WORD - 1)
284 | otherwise = MachInt w
286 int2WordLit (MachInt i)
287 | i < 0 = MachWord (1 + tARGET_MAX_WORD + i) -- (-1) ---> tARGET_MAX_WORD
288 | otherwise = MachWord i
290 narrow8IntLit (MachInt i) = MachInt (toInteger (fromInteger i :: Int8))
291 narrow16IntLit (MachInt i) = MachInt (toInteger (fromInteger i :: Int16))
292 narrow32IntLit (MachInt i) = MachInt (toInteger (fromInteger i :: Int32))
293 narrow8WordLit (MachWord w) = MachWord (toInteger (fromInteger w :: Word8))
294 narrow16WordLit (MachWord w) = MachWord (toInteger (fromInteger w :: Word16))
295 narrow32WordLit (MachWord w) = MachWord (toInteger (fromInteger w :: Word32))
297 char2IntLit (MachChar c) = MachInt (toInteger (ord c))
298 int2CharLit (MachInt i) = MachChar (chr (fromInteger i))
300 float2IntLit (MachFloat f) = MachInt (truncate f)
301 int2FloatLit (MachInt i) = MachFloat (fromInteger i)
303 double2IntLit (MachDouble f) = MachInt (truncate f)
304 int2DoubleLit (MachInt i) = MachDouble (fromInteger i)
306 float2DoubleLit (MachFloat f) = MachDouble f
307 double2FloatLit (MachDouble d) = MachFloat d
309 nullAddrLit :: Literal
310 nullAddrLit = MachNullAddr
316 -- | True if there is absolutely no penalty to duplicating the literal.
317 -- False principally of strings
318 litIsTrivial :: Literal -> Bool
319 -- c.f. CoreUtils.exprIsTrivial
320 litIsTrivial (MachStr _) = False
321 litIsTrivial _ = True
323 -- | True if code space does not go bad if we duplicate this literal
324 -- Currently we treat it just like 'litIsTrivial'
325 litIsDupable :: Literal -> Bool
326 -- c.f. CoreUtils.exprIsDupable
327 litIsDupable (MachStr _) = False
328 litIsDupable _ = True
330 litFitsInChar :: Literal -> Bool
331 litFitsInChar (MachInt i)
332 = fromInteger i <= ord minBound
333 && fromInteger i >= ord maxBound
334 litFitsInChar _ = False
336 -- | Finds a nominal size of a string literal. Every literal has size at least 1
337 litSize :: Literal -> Int
338 -- Used by CoreUnfold.sizeExpr
339 litSize (MachStr str) = 1 + ((lengthFS str + 3) `div` 4)
340 -- If size could be 0 then @f "x"@ might be too small
341 -- [Sept03: make literal strings a bit bigger to avoid fruitless
342 -- duplication of little strings]
349 -- | Find the Haskell 'Type' the literal occupies
350 literalType :: Literal -> Type
351 literalType MachNullAddr = addrPrimTy
352 literalType (MachChar _) = charPrimTy
353 literalType (MachStr _) = addrPrimTy
354 literalType (MachInt _) = intPrimTy
355 literalType (MachWord _) = wordPrimTy
356 literalType (MachInt64 _) = int64PrimTy
357 literalType (MachWord64 _) = word64PrimTy
358 literalType (MachFloat _) = floatPrimTy
359 literalType (MachDouble _) = doublePrimTy
360 literalType (MachLabel _ _ _) = addrPrimTy
367 cmpLit :: Literal -> Literal -> Ordering
368 cmpLit (MachChar a) (MachChar b) = a `compare` b
369 cmpLit (MachStr a) (MachStr b) = a `compare` b
370 cmpLit (MachNullAddr) (MachNullAddr) = EQ
371 cmpLit (MachInt a) (MachInt b) = a `compare` b
372 cmpLit (MachWord a) (MachWord b) = a `compare` b
373 cmpLit (MachInt64 a) (MachInt64 b) = a `compare` b
374 cmpLit (MachWord64 a) (MachWord64 b) = a `compare` b
375 cmpLit (MachFloat a) (MachFloat b) = a `compare` b
376 cmpLit (MachDouble a) (MachDouble b) = a `compare` b
377 cmpLit (MachLabel a _ _) (MachLabel b _ _) = a `compare` b
378 cmpLit lit1 lit2 | litTag lit1 <# litTag lit2 = LT
381 litTag :: Literal -> FastInt
382 litTag (MachChar _) = _ILIT(1)
383 litTag (MachStr _) = _ILIT(2)
384 litTag (MachNullAddr) = _ILIT(3)
385 litTag (MachInt _) = _ILIT(4)
386 litTag (MachWord _) = _ILIT(5)
387 litTag (MachInt64 _) = _ILIT(6)
388 litTag (MachWord64 _) = _ILIT(7)
389 litTag (MachFloat _) = _ILIT(8)
390 litTag (MachDouble _) = _ILIT(9)
391 litTag (MachLabel _ _ _) = _ILIT(10)
396 * MachX (i.e. unboxed) things are printed unadornded (e.g. 3, 'a', "foo")
397 exceptions: MachFloat gets an initial keyword prefix.
400 pprLit :: Literal -> SDoc
401 pprLit (MachChar ch) = pprHsChar ch
402 pprLit (MachStr s) = pprHsString s
403 pprLit (MachInt i) = pprIntVal i
404 pprLit (MachInt64 i) = ptext (sLit "__int64") <+> integer i
405 pprLit (MachWord w) = ptext (sLit "__word") <+> integer w
406 pprLit (MachWord64 w) = ptext (sLit "__word64") <+> integer w
407 pprLit (MachFloat f) = ptext (sLit "__float") <+> rational f
408 pprLit (MachDouble d) = rational d
409 pprLit (MachNullAddr) = ptext (sLit "__NULL")
410 pprLit (MachLabel l mb fod) = ptext (sLit "__label") <+> b <+> ppr fod
412 Nothing -> pprHsString l
413 Just x -> doubleQuotes (text (unpackFS l ++ '@':show x))
415 pprIntVal :: Integer -> SDoc
416 -- ^ Print negative integers with parens to be sure it's unambiguous
417 pprIntVal i | i < 0 = parens (integer i)
418 | otherwise = integer i
422 %************************************************************************
426 %************************************************************************
428 Hash values should be zero or a positive integer. No negatives please.
429 (They mess up the UniqFM for some reason.)
432 hashLiteral :: Literal -> Int
433 hashLiteral (MachChar c) = ord c + 1000 -- Keep it out of range of common ints
434 hashLiteral (MachStr s) = hashFS s
435 hashLiteral (MachNullAddr) = 0
436 hashLiteral (MachInt i) = hashInteger i
437 hashLiteral (MachInt64 i) = hashInteger i
438 hashLiteral (MachWord i) = hashInteger i
439 hashLiteral (MachWord64 i) = hashInteger i
440 hashLiteral (MachFloat r) = hashRational r
441 hashLiteral (MachDouble r) = hashRational r
442 hashLiteral (MachLabel s _ _) = hashFS s
444 hashRational :: Rational -> Int
445 hashRational r = hashInteger (numerator r)
447 hashInteger :: Integer -> Int
448 hashInteger i = 1 + abs (fromInteger (i `rem` 10000))
449 -- The 1+ is to avoid zero, which is a Bad Number
450 -- since we use * to combine hash values
452 hashFS :: FastString -> Int
453 hashFS s = iBox (uniqueOfFS s)