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)}
9 ( Literal(..) -- Exported to ParseIface
10 , mkMachInt, mkMachWord
11 , mkMachInt64, mkMachWord64, mkStringLit
13 , litIsDupable, litIsTrivial
17 , inIntRange, inWordRange, tARGET_MAX_INT, inCharRange
21 , word2IntLit, int2WordLit
22 , narrow8IntLit, narrow16IntLit, narrow32IntLit
23 , narrow8WordLit, narrow16WordLit, narrow32WordLit
24 , char2IntLit, int2CharLit
25 , float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit
26 , nullAddrLit, float2DoubleLit, double2FloatLit
29 #include "HsVersions.h"
45 %************************************************************************
49 %************************************************************************
51 If we're compiling with GHC (and we're not cross-compiling), then we
52 know that minBound and maxBound :: Int are the right values for the
53 target architecture. Otherwise, we assume -2^31 and 2^31-1
54 respectively (which will be wrong on a 64-bit machine).
57 tARGET_MIN_INT, tARGET_MAX_INT, tARGET_MAX_WORD :: Integer
58 #if __GLASGOW_HASKELL__
59 tARGET_MIN_INT = toInteger (minBound :: Int)
60 tARGET_MAX_INT = toInteger (maxBound :: Int)
62 tARGET_MIN_INT = -2147483648
63 tARGET_MAX_INT = 2147483647
65 tARGET_MAX_WORD = (tARGET_MAX_INT * 2) + 1
67 tARGET_MAX_CHAR :: Int
68 tARGET_MAX_CHAR = 0x10ffff
72 %************************************************************************
76 %************************************************************************
78 So-called @Literals@ are {\em either}:
81 An unboxed (``machine'') literal (type: @IntPrim@, @FloatPrim@, etc.),
82 which is presumed to be surrounded by appropriate constructors
83 (@mKINT@, etc.), so that the overall thing makes sense.
85 An Integer, Rational, or String literal whose representation we are
86 {\em uncommitted} about; i.e., the surrounding with constructors,
87 function applications, etc., etc., has not yet been done.
93 -- First the primitive guys
94 MachChar Char -- Char# At least 31 bits
96 | MachStr FastString -- A string-literal: stored and emitted
97 -- UTF-8 encoded, we'll arrange to decode it
98 -- at runtime. Also emitted with a '\0'
101 | MachNullAddr -- the NULL pointer, the only pointer value
102 -- that can be represented as a Literal.
104 | MachInt Integer -- Int# At least WORD_SIZE_IN_BITS bits
105 | MachInt64 Integer -- Int64# At least 64 bits
106 | MachWord Integer -- Word# At least WORD_SIZE_IN_BITS bits
107 | MachWord64 Integer -- Word64# At least 64 bits
110 | MachDouble Rational
112 -- MachLabel is used (only) for the literal derived from a
113 -- "foreign label" declaration.
114 -- string argument is the name of a symbol. This literal
115 -- refers to the *address* of the label.
116 | MachLabel FastString -- always an Addr#
117 (Maybe Int) -- the size (in bytes) of the arguments
118 -- the label expects. Only applicable with
120 -- Just x => "@<x>" will be appended to label
121 -- name when emitting asm.
127 instance Binary Literal where
128 put_ bh (MachChar aa) = do putByte bh 0; put_ bh aa
129 put_ bh (MachStr ab) = do putByte bh 1; put_ bh ab
130 put_ bh (MachNullAddr) = do putByte bh 2
131 put_ bh (MachInt ad) = do putByte bh 3; put_ bh ad
132 put_ bh (MachInt64 ae) = do putByte bh 4; put_ bh ae
133 put_ bh (MachWord af) = do putByte bh 5; put_ bh af
134 put_ bh (MachWord64 ag) = do putByte bh 6; put_ bh ag
135 put_ bh (MachFloat ah) = do putByte bh 7; put_ bh ah
136 put_ bh (MachDouble ai) = do putByte bh 8; put_ bh ai
137 put_ bh (MachLabel aj mb) = do putByte bh 9; put_ bh aj ; put_ bh mb
148 return (MachNullAddr)
154 return (MachInt64 ae)
160 return (MachWord64 ag)
163 return (MachFloat ah)
166 return (MachDouble ai)
170 return (MachLabel aj mb)
174 instance Outputable Literal where
177 instance Show Literal where
178 showsPrec p lit = showsPrecSDoc p (ppr lit)
180 instance Eq Literal where
181 a == b = case (a `compare` b) of { EQ -> True; _ -> False }
182 a /= b = case (a `compare` b) of { EQ -> False; _ -> True }
184 instance Ord Literal where
185 a <= b = case (a `compare` b) of { LT -> True; EQ -> True; GT -> False }
186 a < b = case (a `compare` b) of { LT -> True; EQ -> False; GT -> False }
187 a >= b = case (a `compare` b) of { LT -> False; EQ -> True; GT -> True }
188 a > b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True }
189 compare a b = cmpLit a b
196 mkMachInt, mkMachWord, mkMachInt64, mkMachWord64 :: Integer -> Literal
198 mkMachInt x = -- ASSERT2( inIntRange x, integer x )
199 -- Not true: you can write out of range Int# literals
200 -- For example, one can write (intToWord# 0xffff0000) to
201 -- get a particular Word bit-pattern, and there's no other
202 -- convenient way to write such literals, which is why we allow it.
204 mkMachWord x = -- ASSERT2( inWordRange x, integer x )
206 mkMachInt64 x = MachInt64 x
207 mkMachWord64 x = MachWord64 x
209 mkStringLit :: String -> Literal
210 mkStringLit s = MachStr (mkFastString s) -- stored UTF-8 encoded
212 inIntRange, inWordRange :: Integer -> Bool
213 inIntRange x = x >= tARGET_MIN_INT && x <= tARGET_MAX_INT
214 inWordRange x = x >= 0 && x <= tARGET_MAX_WORD
216 inCharRange :: Char -> Bool
217 inCharRange c = c >= '\0' && c <= chr tARGET_MAX_CHAR
219 isZeroLit :: Literal -> Bool
220 isZeroLit (MachInt 0) = True
221 isZeroLit (MachInt64 0) = True
222 isZeroLit (MachWord 0) = True
223 isZeroLit (MachWord64 0) = True
224 isZeroLit (MachFloat 0) = True
225 isZeroLit (MachDouble 0) = True
226 isZeroLit other = False
232 word2IntLit, int2WordLit,
233 narrow8IntLit, narrow16IntLit, narrow32IntLit,
234 narrow8WordLit, narrow16WordLit, narrow32WordLit,
235 char2IntLit, int2CharLit,
236 float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit,
237 float2DoubleLit, double2FloatLit
238 :: Literal -> Literal
240 word2IntLit (MachWord w)
241 | w > tARGET_MAX_INT = MachInt (w - tARGET_MAX_WORD - 1)
242 | otherwise = MachInt w
244 int2WordLit (MachInt i)
245 | i < 0 = MachWord (1 + tARGET_MAX_WORD + i) -- (-1) ---> tARGET_MAX_WORD
246 | otherwise = MachWord i
248 narrow8IntLit (MachInt i) = MachInt (toInteger (fromInteger i :: Int8))
249 narrow16IntLit (MachInt i) = MachInt (toInteger (fromInteger i :: Int16))
250 narrow32IntLit (MachInt i) = MachInt (toInteger (fromInteger i :: Int32))
251 narrow8WordLit (MachWord w) = MachWord (toInteger (fromInteger w :: Word8))
252 narrow16WordLit (MachWord w) = MachWord (toInteger (fromInteger w :: Word16))
253 narrow32WordLit (MachWord w) = MachWord (toInteger (fromInteger w :: Word32))
255 char2IntLit (MachChar c) = MachInt (toInteger (ord c))
256 int2CharLit (MachInt i) = MachChar (chr (fromInteger i))
258 float2IntLit (MachFloat f) = MachInt (truncate f)
259 int2FloatLit (MachInt i) = MachFloat (fromInteger i)
261 double2IntLit (MachDouble f) = MachInt (truncate f)
262 int2DoubleLit (MachInt i) = MachDouble (fromInteger i)
264 float2DoubleLit (MachFloat f) = MachDouble f
265 double2FloatLit (MachDouble d) = MachFloat d
267 nullAddrLit :: Literal
268 nullAddrLit = MachNullAddr
274 litIsTrivial :: Literal -> Bool
275 -- True if there is absolutely no penalty to duplicating the literal
276 -- c.f. CoreUtils.exprIsTrivial
277 -- False principally of strings
278 litIsTrivial (MachStr _) = False
279 litIsTrivial other = True
281 litIsDupable :: Literal -> Bool
282 -- True if code space does not go bad if we duplicate this literal
283 -- c.f. CoreUtils.exprIsDupable
284 -- Currently we treat it just like litIsTrivial
285 litIsDupable (MachStr _) = False
286 litIsDupable other = True
288 litFitsInChar :: Literal -> Bool
289 litFitsInChar (MachInt i)
290 = fromInteger i <= ord minBound
291 && fromInteger i >= ord maxBound
292 litFitsInChar _ = False
294 litSize :: Literal -> Int
295 -- Used by CoreUnfold.sizeExpr
296 litSize (MachStr str) = 1 + ((lengthFS str + 3) `div` 4)
297 -- Every literal has size at least 1, otherwise
299 -- might be too small
300 -- [Sept03: make literal strings a bit bigger to avoid fruitless
301 -- duplication of little strings]
308 literalType :: Literal -> Type
309 literalType MachNullAddr = addrPrimTy
310 literalType (MachChar _) = charPrimTy
311 literalType (MachStr _) = addrPrimTy
312 literalType (MachInt _) = intPrimTy
313 literalType (MachWord _) = wordPrimTy
314 literalType (MachInt64 _) = int64PrimTy
315 literalType (MachWord64 _) = word64PrimTy
316 literalType (MachFloat _) = floatPrimTy
317 literalType (MachDouble _) = doublePrimTy
318 literalType (MachLabel _ _) = addrPrimTy
325 cmpLit (MachChar a) (MachChar b) = a `compare` b
326 cmpLit (MachStr a) (MachStr b) = a `compare` b
327 cmpLit (MachNullAddr) (MachNullAddr) = EQ
328 cmpLit (MachInt a) (MachInt b) = a `compare` b
329 cmpLit (MachWord a) (MachWord b) = a `compare` b
330 cmpLit (MachInt64 a) (MachInt64 b) = a `compare` b
331 cmpLit (MachWord64 a) (MachWord64 b) = a `compare` b
332 cmpLit (MachFloat a) (MachFloat b) = a `compare` b
333 cmpLit (MachDouble a) (MachDouble b) = a `compare` b
334 cmpLit (MachLabel a _) (MachLabel b _) = a `compare` b
335 cmpLit lit1 lit2 | litTag lit1 <# litTag lit2 = LT
338 litTag (MachChar _) = _ILIT(1)
339 litTag (MachStr _) = _ILIT(2)
340 litTag (MachNullAddr) = _ILIT(3)
341 litTag (MachInt _) = _ILIT(4)
342 litTag (MachWord _) = _ILIT(5)
343 litTag (MachInt64 _) = _ILIT(6)
344 litTag (MachWord64 _) = _ILIT(7)
345 litTag (MachFloat _) = _ILIT(8)
346 litTag (MachDouble _) = _ILIT(9)
347 litTag (MachLabel _ _) = _ILIT(10)
352 * MachX (i.e. unboxed) things are printed unadornded (e.g. 3, 'a', "foo")
353 exceptions: MachFloat gets an initial keyword prefix.
356 pprLit (MachChar ch) = pprHsChar ch
357 pprLit (MachStr s) = pprHsString s
358 pprLit (MachInt i) = pprIntVal i
359 pprLit (MachInt64 i) = ptext SLIT("__int64") <+> integer i
360 pprLit (MachWord w) = ptext SLIT("__word") <+> integer w
361 pprLit (MachWord64 w) = ptext SLIT("__word64") <+> integer w
362 pprLit (MachFloat f) = ptext SLIT("__float") <+> rational f
363 pprLit (MachDouble d) = rational d
364 pprLit (MachNullAddr) = ptext SLIT("__NULL")
365 pprLit (MachLabel l mb) = ptext SLIT("__label") <+>
367 Nothing -> pprHsString l
368 Just x -> doubleQuotes (text (unpackFS l ++ '@':show x))
370 pprIntVal :: Integer -> SDoc
371 -- Print negative integers with parens to be sure it's unambiguous
372 pprIntVal i | i < 0 = parens (integer i)
373 | otherwise = integer i
377 %************************************************************************
381 %************************************************************************
383 Hash values should be zero or a positive integer. No negatives please.
384 (They mess up the UniqFM for some reason.)
387 hashLiteral :: Literal -> Int
388 hashLiteral (MachChar c) = ord c + 1000 -- Keep it out of range of common ints
389 hashLiteral (MachStr s) = hashFS s
390 hashLiteral (MachNullAddr) = 0
391 hashLiteral (MachInt i) = hashInteger i
392 hashLiteral (MachInt64 i) = hashInteger i
393 hashLiteral (MachWord i) = hashInteger i
394 hashLiteral (MachWord64 i) = hashInteger i
395 hashLiteral (MachFloat r) = hashRational r
396 hashLiteral (MachDouble r) = hashRational r
397 hashLiteral (MachLabel s _) = hashFS s
399 hashRational :: Rational -> Int
400 hashRational r = hashInteger (numerator r)
402 hashInteger :: Integer -> Int
403 hashInteger i = 1 + abs (fromInteger (i `rem` 10000))
404 -- The 1+ is to avoid zero, which is a Bad Number
405 -- since we use * to combine hash values
407 hashFS :: FastString -> Int
408 hashFS s = iBox (uniqueOfFS s)