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
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
124 (Maybe Int) -- ^ A label literal. Parameters:
126 -- 1) The name of the symbol mentioned in the declaration
128 -- 2) The size (in bytes) of the arguments
129 -- the label expects. Only applicable with
130 -- @stdcall@ labels. @Just x@ => @\<x\>@ will
131 -- be appended to label name when emitting assembly.
137 instance Binary Literal where
138 put_ bh (MachChar aa) = do putByte bh 0; put_ bh aa
139 put_ bh (MachStr ab) = do putByte bh 1; put_ bh ab
140 put_ bh (MachNullAddr) = do putByte bh 2
141 put_ bh (MachInt ad) = do putByte bh 3; put_ bh ad
142 put_ bh (MachInt64 ae) = do putByte bh 4; put_ bh ae
143 put_ bh (MachWord af) = do putByte bh 5; put_ bh af
144 put_ bh (MachWord64 ag) = do putByte bh 6; put_ bh ag
145 put_ bh (MachFloat ah) = do putByte bh 7; put_ bh ah
146 put_ bh (MachDouble ai) = do putByte bh 8; put_ bh ai
147 put_ bh (MachLabel aj mb) = do putByte bh 9; put_ bh aj ; put_ bh mb
158 return (MachNullAddr)
164 return (MachInt64 ae)
170 return (MachWord64 ag)
173 return (MachFloat ah)
176 return (MachDouble ai)
180 return (MachLabel aj mb)
184 instance Outputable Literal where
187 instance Show Literal where
188 showsPrec p lit = showsPrecSDoc p (ppr lit)
190 instance Eq Literal where
191 a == b = case (a `compare` b) of { EQ -> True; _ -> False }
192 a /= b = case (a `compare` b) of { EQ -> False; _ -> True }
194 instance Ord Literal where
195 a <= b = case (a `compare` b) of { LT -> True; EQ -> True; GT -> False }
196 a < b = case (a `compare` b) of { LT -> True; EQ -> False; GT -> False }
197 a >= b = case (a `compare` b) of { LT -> False; EQ -> True; GT -> True }
198 a > b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True }
199 compare a b = cmpLit a b
206 -- | Creates a 'Literal' of type @Int#@
207 mkMachInt :: Integer -> Literal
208 mkMachInt x = -- ASSERT2( inIntRange x, integer x )
209 -- Not true: you can write out of range Int# literals
210 -- For example, one can write (intToWord# 0xffff0000) to
211 -- get a particular Word bit-pattern, and there's no other
212 -- convenient way to write such literals, which is why we allow it.
215 -- | Creates a 'Literal' of type @Word#@
216 mkMachWord :: Integer -> Literal
217 mkMachWord x = -- ASSERT2( inWordRange x, integer x )
220 -- | Creates a 'Literal' of type @Int64#@
221 mkMachInt64 :: Integer -> Literal
222 mkMachInt64 x = MachInt64 x
224 -- | Creates a 'Literal' of type @Word64#@
225 mkMachWord64 :: Integer -> Literal
226 mkMachWord64 x = MachWord64 x
228 -- | Creates a 'Literal' of type @Float#@
229 mkMachFloat :: Rational -> Literal
230 mkMachFloat = MachFloat
232 -- | Creates a 'Literal' of type @Double#@
233 mkMachDouble :: Rational -> Literal
234 mkMachDouble = MachDouble
236 -- | Creates a 'Literal' of type @Char#@
237 mkMachChar :: Char -> Literal
238 mkMachChar = MachChar
240 -- | Creates a 'Literal' of type @Addr#@, which is appropriate for passing to
241 -- e.g. some of the \"error\" functions in GHC.Err such as @GHC.Err.runtimeError@
242 mkMachString :: String -> Literal
243 mkMachString s = MachStr (mkFastString s) -- stored UTF-8 encoded
245 inIntRange, inWordRange :: Integer -> Bool
246 inIntRange x = x >= tARGET_MIN_INT && x <= tARGET_MAX_INT
247 inWordRange x = x >= 0 && x <= tARGET_MAX_WORD
249 inCharRange :: Char -> Bool
250 inCharRange c = c >= '\0' && c <= chr tARGET_MAX_CHAR
252 -- | Tests whether the literal represents a zero of whatever type it is
253 isZeroLit :: Literal -> Bool
254 isZeroLit (MachInt 0) = True
255 isZeroLit (MachInt64 0) = True
256 isZeroLit (MachWord 0) = True
257 isZeroLit (MachWord64 0) = True
258 isZeroLit (MachFloat 0) = True
259 isZeroLit (MachDouble 0) = True
266 word2IntLit, int2WordLit,
267 narrow8IntLit, narrow16IntLit, narrow32IntLit,
268 narrow8WordLit, narrow16WordLit, narrow32WordLit,
269 char2IntLit, int2CharLit,
270 float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit,
271 float2DoubleLit, double2FloatLit
272 :: Literal -> Literal
274 word2IntLit (MachWord w)
275 | w > tARGET_MAX_INT = MachInt (w - tARGET_MAX_WORD - 1)
276 | otherwise = MachInt w
278 int2WordLit (MachInt i)
279 | i < 0 = MachWord (1 + tARGET_MAX_WORD + i) -- (-1) ---> tARGET_MAX_WORD
280 | otherwise = MachWord i
282 narrow8IntLit (MachInt i) = MachInt (toInteger (fromInteger i :: Int8))
283 narrow16IntLit (MachInt i) = MachInt (toInteger (fromInteger i :: Int16))
284 narrow32IntLit (MachInt i) = MachInt (toInteger (fromInteger i :: Int32))
285 narrow8WordLit (MachWord w) = MachWord (toInteger (fromInteger w :: Word8))
286 narrow16WordLit (MachWord w) = MachWord (toInteger (fromInteger w :: Word16))
287 narrow32WordLit (MachWord w) = MachWord (toInteger (fromInteger w :: Word32))
289 char2IntLit (MachChar c) = MachInt (toInteger (ord c))
290 int2CharLit (MachInt i) = MachChar (chr (fromInteger i))
292 float2IntLit (MachFloat f) = MachInt (truncate f)
293 int2FloatLit (MachInt i) = MachFloat (fromInteger i)
295 double2IntLit (MachDouble f) = MachInt (truncate f)
296 int2DoubleLit (MachInt i) = MachDouble (fromInteger i)
298 float2DoubleLit (MachFloat f) = MachDouble f
299 double2FloatLit (MachDouble d) = MachFloat d
301 nullAddrLit :: Literal
302 nullAddrLit = MachNullAddr
308 -- | True if there is absolutely no penalty to duplicating the literal.
309 -- False principally of strings
310 litIsTrivial :: Literal -> Bool
311 -- c.f. CoreUtils.exprIsTrivial
312 litIsTrivial (MachStr _) = False
313 litIsTrivial _ = True
315 -- | True if code space does not go bad if we duplicate this literal
316 -- Currently we treat it just like 'litIsTrivial'
317 litIsDupable :: Literal -> Bool
318 -- c.f. CoreUtils.exprIsDupable
319 litIsDupable (MachStr _) = False
320 litIsDupable _ = True
322 litFitsInChar :: Literal -> Bool
323 litFitsInChar (MachInt i)
324 = fromInteger i <= ord minBound
325 && fromInteger i >= ord maxBound
326 litFitsInChar _ = False
328 -- | Finds a nominal size of a string literal. Every literal has size at least 1
329 litSize :: Literal -> Int
330 -- Used by CoreUnfold.sizeExpr
331 litSize (MachStr str) = 1 + ((lengthFS str + 3) `div` 4)
332 -- If size could be 0 then @f "x"@ might be too small
333 -- [Sept03: make literal strings a bit bigger to avoid fruitless
334 -- duplication of little strings]
341 -- | Find the Haskell 'Type' the literal occupies
342 literalType :: Literal -> Type
343 literalType MachNullAddr = addrPrimTy
344 literalType (MachChar _) = charPrimTy
345 literalType (MachStr _) = addrPrimTy
346 literalType (MachInt _) = intPrimTy
347 literalType (MachWord _) = wordPrimTy
348 literalType (MachInt64 _) = int64PrimTy
349 literalType (MachWord64 _) = word64PrimTy
350 literalType (MachFloat _) = floatPrimTy
351 literalType (MachDouble _) = doublePrimTy
352 literalType (MachLabel _ _) = addrPrimTy
359 cmpLit :: Literal -> Literal -> Ordering
360 cmpLit (MachChar a) (MachChar b) = a `compare` b
361 cmpLit (MachStr a) (MachStr b) = a `compare` b
362 cmpLit (MachNullAddr) (MachNullAddr) = EQ
363 cmpLit (MachInt a) (MachInt b) = a `compare` b
364 cmpLit (MachWord a) (MachWord b) = a `compare` b
365 cmpLit (MachInt64 a) (MachInt64 b) = a `compare` b
366 cmpLit (MachWord64 a) (MachWord64 b) = a `compare` b
367 cmpLit (MachFloat a) (MachFloat b) = a `compare` b
368 cmpLit (MachDouble a) (MachDouble b) = a `compare` b
369 cmpLit (MachLabel a _) (MachLabel b _) = a `compare` b
370 cmpLit lit1 lit2 | litTag lit1 <# litTag lit2 = LT
373 litTag :: Literal -> FastInt
374 litTag (MachChar _) = _ILIT(1)
375 litTag (MachStr _) = _ILIT(2)
376 litTag (MachNullAddr) = _ILIT(3)
377 litTag (MachInt _) = _ILIT(4)
378 litTag (MachWord _) = _ILIT(5)
379 litTag (MachInt64 _) = _ILIT(6)
380 litTag (MachWord64 _) = _ILIT(7)
381 litTag (MachFloat _) = _ILIT(8)
382 litTag (MachDouble _) = _ILIT(9)
383 litTag (MachLabel _ _) = _ILIT(10)
388 * MachX (i.e. unboxed) things are printed unadornded (e.g. 3, 'a', "foo")
389 exceptions: MachFloat gets an initial keyword prefix.
392 pprLit :: Literal -> SDoc
393 pprLit (MachChar ch) = pprHsChar ch
394 pprLit (MachStr s) = pprHsString s
395 pprLit (MachInt i) = pprIntVal i
396 pprLit (MachInt64 i) = ptext (sLit "__int64") <+> integer i
397 pprLit (MachWord w) = ptext (sLit "__word") <+> integer w
398 pprLit (MachWord64 w) = ptext (sLit "__word64") <+> integer w
399 pprLit (MachFloat f) = ptext (sLit "__float") <+> rational f
400 pprLit (MachDouble d) = rational d
401 pprLit (MachNullAddr) = ptext (sLit "__NULL")
402 pprLit (MachLabel l mb) = ptext (sLit "__label") <+>
404 Nothing -> pprHsString l
405 Just x -> doubleQuotes (text (unpackFS l ++ '@':show x))
407 pprIntVal :: Integer -> SDoc
408 -- ^ Print negative integers with parens to be sure it's unambiguous
409 pprIntVal i | i < 0 = parens (integer i)
410 | otherwise = integer i
414 %************************************************************************
418 %************************************************************************
420 Hash values should be zero or a positive integer. No negatives please.
421 (They mess up the UniqFM for some reason.)
424 hashLiteral :: Literal -> Int
425 hashLiteral (MachChar c) = ord c + 1000 -- Keep it out of range of common ints
426 hashLiteral (MachStr s) = hashFS s
427 hashLiteral (MachNullAddr) = 0
428 hashLiteral (MachInt i) = hashInteger i
429 hashLiteral (MachInt64 i) = hashInteger i
430 hashLiteral (MachWord i) = hashInteger i
431 hashLiteral (MachWord64 i) = hashInteger i
432 hashLiteral (MachFloat r) = hashRational r
433 hashLiteral (MachDouble r) = hashRational r
434 hashLiteral (MachLabel s _) = hashFS s
436 hashRational :: Rational -> Int
437 hashRational r = hashInteger (numerator r)
439 hashInteger :: Integer -> Int
440 hashInteger i = 1 + abs (fromInteger (i `rem` 10000))
441 -- The 1+ is to avoid zero, which is a Bad Number
442 -- since we use * to combine hash values
444 hashFS :: FastString -> Int
445 hashFS s = iBox (uniqueOfFS s)