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
30 -- ** Predicates on Literals and their contents
31 , litIsDupable, litIsTrivial
32 , inIntRange, inWordRange, tARGET_MAX_INT, inCharRange
37 , word2IntLit, int2WordLit
38 , narrow8IntLit, narrow16IntLit, narrow32IntLit
39 , narrow8WordLit, narrow16WordLit, narrow32WordLit
40 , char2IntLit, int2CharLit
41 , float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit
42 , nullAddrLit, float2DoubleLit, double2FloatLit
60 %************************************************************************
64 %************************************************************************
66 If we're compiling with GHC (and we're not cross-compiling), then we
67 know that minBound and maxBound :: Int are the right values for the
68 target architecture. Otherwise, we assume -2^31 and 2^31-1
69 respectively (which will be wrong on a 64-bit machine).
72 tARGET_MIN_INT, tARGET_MAX_INT, tARGET_MAX_WORD :: Integer
73 #ifdef __GLASGOW_HASKELL__
74 tARGET_MIN_INT = toInteger (minBound :: Int)
75 tARGET_MAX_INT = toInteger (maxBound :: Int)
77 tARGET_MIN_INT = -2147483648
78 tARGET_MAX_INT = 2147483647
80 tARGET_MAX_WORD = (tARGET_MAX_INT * 2) + 1
82 tARGET_MAX_CHAR :: Int
83 tARGET_MAX_CHAR = 0x10ffff
86 %************************************************************************
90 %************************************************************************
93 -- | So-called 'Literal's are one of:
95 -- * An unboxed (/machine/) literal ('MachInt', 'MachFloat', etc.),
96 -- which is presumed to be surrounded by appropriate constructors
97 -- (@Int#@, etc.), so that the overall thing makes sense.
99 -- * The literal derived from the label mentioned in a \"foreign label\"
100 -- declaration ('MachLabel')
103 -- First the primitive guys
104 MachChar Char -- ^ @Char#@ - at least 31 bits. Create with 'mkMachChar'
106 | MachStr FastString -- ^ A string-literal: stored and emitted
107 -- UTF-8 encoded, we'll arrange to decode it
108 -- at runtime. Also emitted with a @'\0'@
109 -- terminator. Create with 'mkMachString'
111 | MachNullAddr -- ^ The @NULL@ pointer, the only pointer value
112 -- that can be represented as a Literal. Create
113 -- with 'nullAddrLit'
115 | MachInt Integer -- ^ @Int#@ - at least @WORD_SIZE_IN_BITS@ bits. Create with 'mkMachInt'
116 | MachInt64 Integer -- ^ @Int64#@ - at least 64 bits. Create with 'mkMachInt64'
117 | MachWord Integer -- ^ @Word#@ - at least @WORD_SIZE_IN_BITS@ bits. Create with 'mkMachWord'
118 | MachWord64 Integer -- ^ @Word64#@ - at least 64 bits. Create with 'mkMachWord64'
120 | MachFloat Rational -- ^ @Float#@. Create with 'mkMachFloat'
121 | MachDouble Rational -- ^ @Double#@. Create with 'mkMachDouble'
123 | MachLabel FastString
126 -- ^ A label literal. Parameters:
128 -- 1) The name of the symbol mentioned in the declaration
130 -- 2) The size (in bytes) of the arguments
131 -- the label expects. Only applicable with
132 -- @stdcall@ labels. @Just x@ => @\<x\>@ will
133 -- be appended to label name when emitting assembly.
139 instance Binary Literal where
140 put_ bh (MachChar aa) = do putByte bh 0; put_ bh aa
141 put_ bh (MachStr ab) = do putByte bh 1; put_ bh ab
142 put_ bh (MachNullAddr) = do putByte bh 2
143 put_ bh (MachInt ad) = do putByte bh 3; put_ bh ad
144 put_ bh (MachInt64 ae) = do putByte bh 4; put_ bh ae
145 put_ bh (MachWord af) = do putByte bh 5; put_ bh af
146 put_ bh (MachWord64 ag) = do putByte bh 6; put_ bh ag
147 put_ bh (MachFloat ah) = do putByte bh 7; put_ bh ah
148 put_ bh (MachDouble ai) = do putByte bh 8; put_ bh ai
149 put_ bh (MachLabel aj mb fod)
164 return (MachNullAddr)
170 return (MachInt64 ae)
176 return (MachWord64 ag)
179 return (MachFloat ah)
182 return (MachDouble ai)
187 return (MachLabel aj mb fod)
191 instance Outputable Literal where
194 instance Show Literal where
195 showsPrec p lit = showsPrecSDoc p (ppr lit)
197 instance Eq Literal where
198 a == b = case (a `compare` b) of { EQ -> True; _ -> False }
199 a /= b = case (a `compare` b) of { EQ -> False; _ -> True }
201 instance Ord Literal where
202 a <= b = case (a `compare` b) of { LT -> True; EQ -> True; GT -> False }
203 a < b = case (a `compare` b) of { LT -> True; EQ -> False; GT -> False }
204 a >= b = case (a `compare` b) of { LT -> False; EQ -> True; GT -> True }
205 a > b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True }
206 compare a b = cmpLit a b
213 -- | Creates a 'Literal' of type @Int#@
214 mkMachInt :: Integer -> Literal
215 mkMachInt x = -- ASSERT2( inIntRange x, integer x )
216 -- Not true: you can write out of range Int# literals
217 -- For example, one can write (intToWord# 0xffff0000) to
218 -- get a particular Word bit-pattern, and there's no other
219 -- convenient way to write such literals, which is why we allow it.
222 -- | Creates a 'Literal' of type @Word#@
223 mkMachWord :: Integer -> Literal
224 mkMachWord x = -- ASSERT2( inWordRange x, integer x )
227 -- | Creates a 'Literal' of type @Int64#@
228 mkMachInt64 :: Integer -> Literal
229 mkMachInt64 x = MachInt64 x
231 -- | Creates a 'Literal' of type @Word64#@
232 mkMachWord64 :: Integer -> Literal
233 mkMachWord64 x = MachWord64 x
235 -- | Creates a 'Literal' of type @Float#@
236 mkMachFloat :: Rational -> Literal
237 mkMachFloat = MachFloat
239 -- | Creates a 'Literal' of type @Double#@
240 mkMachDouble :: Rational -> Literal
241 mkMachDouble = MachDouble
243 -- | Creates a 'Literal' of type @Char#@
244 mkMachChar :: Char -> Literal
245 mkMachChar = MachChar
247 -- | Creates a 'Literal' of type @Addr#@, which is appropriate for passing to
248 -- e.g. some of the \"error\" functions in GHC.Err such as @GHC.Err.runtimeError@
249 mkMachString :: String -> Literal
250 mkMachString s = MachStr (mkFastString s) -- stored UTF-8 encoded
252 inIntRange, inWordRange :: Integer -> Bool
253 inIntRange x = x >= tARGET_MIN_INT && x <= tARGET_MAX_INT
254 inWordRange x = x >= 0 && x <= tARGET_MAX_WORD
256 inCharRange :: Char -> Bool
257 inCharRange c = c >= '\0' && c <= chr tARGET_MAX_CHAR
259 -- | Tests whether the literal represents a zero of whatever type it is
260 isZeroLit :: Literal -> Bool
261 isZeroLit (MachInt 0) = True
262 isZeroLit (MachInt64 0) = True
263 isZeroLit (MachWord 0) = True
264 isZeroLit (MachWord64 0) = True
265 isZeroLit (MachFloat 0) = True
266 isZeroLit (MachDouble 0) = True
273 word2IntLit, int2WordLit,
274 narrow8IntLit, narrow16IntLit, narrow32IntLit,
275 narrow8WordLit, narrow16WordLit, narrow32WordLit,
276 char2IntLit, int2CharLit,
277 float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit,
278 float2DoubleLit, double2FloatLit
279 :: Literal -> Literal
281 word2IntLit (MachWord w)
282 | w > tARGET_MAX_INT = MachInt (w - tARGET_MAX_WORD - 1)
283 | otherwise = MachInt w
285 int2WordLit (MachInt i)
286 | i < 0 = MachWord (1 + tARGET_MAX_WORD + i) -- (-1) ---> tARGET_MAX_WORD
287 | otherwise = MachWord i
289 narrow8IntLit (MachInt i) = MachInt (toInteger (fromInteger i :: Int8))
290 narrow16IntLit (MachInt i) = MachInt (toInteger (fromInteger i :: Int16))
291 narrow32IntLit (MachInt i) = MachInt (toInteger (fromInteger i :: Int32))
292 narrow8WordLit (MachWord w) = MachWord (toInteger (fromInteger w :: Word8))
293 narrow16WordLit (MachWord w) = MachWord (toInteger (fromInteger w :: Word16))
294 narrow32WordLit (MachWord w) = MachWord (toInteger (fromInteger w :: Word32))
296 char2IntLit (MachChar c) = MachInt (toInteger (ord c))
297 int2CharLit (MachInt i) = MachChar (chr (fromInteger i))
299 float2IntLit (MachFloat f) = MachInt (truncate f)
300 int2FloatLit (MachInt i) = MachFloat (fromInteger i)
302 double2IntLit (MachDouble f) = MachInt (truncate f)
303 int2DoubleLit (MachInt i) = MachDouble (fromInteger i)
305 float2DoubleLit (MachFloat f) = MachDouble f
306 double2FloatLit (MachDouble d) = MachFloat d
308 nullAddrLit :: Literal
309 nullAddrLit = MachNullAddr
315 -- | True if there is absolutely no penalty to duplicating the literal.
316 -- False principally of strings
317 litIsTrivial :: Literal -> Bool
318 -- c.f. CoreUtils.exprIsTrivial
319 litIsTrivial (MachStr _) = False
320 litIsTrivial _ = True
322 -- | True if code space does not go bad if we duplicate this literal
323 -- Currently we treat it just like 'litIsTrivial'
324 litIsDupable :: Literal -> Bool
325 -- c.f. CoreUtils.exprIsDupable
326 litIsDupable (MachStr _) = False
327 litIsDupable _ = True
329 litFitsInChar :: Literal -> Bool
330 litFitsInChar (MachInt i)
331 = fromInteger i <= ord minBound
332 && fromInteger i >= ord maxBound
333 litFitsInChar _ = False
339 -- | Find the Haskell 'Type' the literal occupies
340 literalType :: Literal -> Type
341 literalType MachNullAddr = addrPrimTy
342 literalType (MachChar _) = charPrimTy
343 literalType (MachStr _) = addrPrimTy
344 literalType (MachInt _) = intPrimTy
345 literalType (MachWord _) = wordPrimTy
346 literalType (MachInt64 _) = int64PrimTy
347 literalType (MachWord64 _) = word64PrimTy
348 literalType (MachFloat _) = floatPrimTy
349 literalType (MachDouble _) = doublePrimTy
350 literalType (MachLabel _ _ _) = addrPrimTy
357 cmpLit :: Literal -> Literal -> Ordering
358 cmpLit (MachChar a) (MachChar b) = a `compare` b
359 cmpLit (MachStr a) (MachStr b) = a `compare` b
360 cmpLit (MachNullAddr) (MachNullAddr) = EQ
361 cmpLit (MachInt a) (MachInt b) = a `compare` b
362 cmpLit (MachWord a) (MachWord b) = a `compare` b
363 cmpLit (MachInt64 a) (MachInt64 b) = a `compare` b
364 cmpLit (MachWord64 a) (MachWord64 b) = a `compare` b
365 cmpLit (MachFloat a) (MachFloat b) = a `compare` b
366 cmpLit (MachDouble a) (MachDouble b) = a `compare` b
367 cmpLit (MachLabel a _ _) (MachLabel b _ _) = a `compare` b
368 cmpLit lit1 lit2 | litTag lit1 <# litTag lit2 = LT
371 litTag :: Literal -> FastInt
372 litTag (MachChar _) = _ILIT(1)
373 litTag (MachStr _) = _ILIT(2)
374 litTag (MachNullAddr) = _ILIT(3)
375 litTag (MachInt _) = _ILIT(4)
376 litTag (MachWord _) = _ILIT(5)
377 litTag (MachInt64 _) = _ILIT(6)
378 litTag (MachWord64 _) = _ILIT(7)
379 litTag (MachFloat _) = _ILIT(8)
380 litTag (MachDouble _) = _ILIT(9)
381 litTag (MachLabel _ _ _) = _ILIT(10)
386 * MachX (i.e. unboxed) things are printed unadornded (e.g. 3, 'a', "foo")
387 exceptions: MachFloat gets an initial keyword prefix.
390 pprLit :: Literal -> SDoc
391 pprLit (MachChar ch) = pprHsChar ch
392 pprLit (MachStr s) = pprHsString s
393 pprLit (MachInt i) = pprIntVal i
394 pprLit (MachInt64 i) = ptext (sLit "__int64") <+> integer i
395 pprLit (MachWord w) = ptext (sLit "__word") <+> integer w
396 pprLit (MachWord64 w) = ptext (sLit "__word64") <+> integer w
397 pprLit (MachFloat f) = ptext (sLit "__float") <+> rational f
398 pprLit (MachDouble d) = rational d
399 pprLit (MachNullAddr) = ptext (sLit "__NULL")
400 pprLit (MachLabel l mb fod) = ptext (sLit "__label") <+> b <+> ppr fod
402 Nothing -> pprHsString l
403 Just x -> doubleQuotes (text (unpackFS l ++ '@':show x))
405 pprIntVal :: Integer -> SDoc
406 -- ^ Print negative integers with parens to be sure it's unambiguous
407 pprIntVal i | i < 0 = parens (integer i)
408 | otherwise = integer i
412 %************************************************************************
416 %************************************************************************
418 Hash values should be zero or a positive integer. No negatives please.
419 (They mess up the UniqFM for some reason.)
422 hashLiteral :: Literal -> Int
423 hashLiteral (MachChar c) = ord c + 1000 -- Keep it out of range of common ints
424 hashLiteral (MachStr s) = hashFS s
425 hashLiteral (MachNullAddr) = 0
426 hashLiteral (MachInt i) = hashInteger i
427 hashLiteral (MachInt64 i) = hashInteger i
428 hashLiteral (MachWord i) = hashInteger i
429 hashLiteral (MachWord64 i) = hashInteger i
430 hashLiteral (MachFloat r) = hashRational r
431 hashLiteral (MachDouble r) = hashRational r
432 hashLiteral (MachLabel s _ _) = hashFS s
434 hashRational :: Rational -> Int
435 hashRational r = hashInteger (numerator r)
437 hashInteger :: Integer -> Int
438 hashInteger i = 1 + abs (fromInteger (i `rem` 10000))
439 -- The 1+ is to avoid zero, which is a Bad Number
440 -- since we use * to combine hash values
442 hashFS :: FastString -> Int
443 hashFS s = iBox (uniqueOfFS s)