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
20 , word2IntLit, int2WordLit
21 , narrow8IntLit, narrow16IntLit, narrow32IntLit
22 , narrow8WordLit, narrow16WordLit, narrow32WordLit
23 , char2IntLit, int2CharLit
24 , float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit
25 , nullAddrLit, float2DoubleLit, double2FloatLit
28 #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 litSize :: Literal -> Int
289 -- Used by CoreUnfold.sizeExpr
290 litSize (MachStr str) = 1 + ((lengthFS str + 3) `div` 4)
291 -- Every literal has size at least 1, otherwise
293 -- might be too small
294 -- [Sept03: make literal strings a bit bigger to avoid fruitless
295 -- duplication of little strings]
302 literalType :: Literal -> Type
303 literalType MachNullAddr = addrPrimTy
304 literalType (MachChar _) = charPrimTy
305 literalType (MachStr _) = addrPrimTy
306 literalType (MachInt _) = intPrimTy
307 literalType (MachWord _) = wordPrimTy
308 literalType (MachInt64 _) = int64PrimTy
309 literalType (MachWord64 _) = word64PrimTy
310 literalType (MachFloat _) = floatPrimTy
311 literalType (MachDouble _) = doublePrimTy
312 literalType (MachLabel _ _) = addrPrimTy
319 cmpLit (MachChar a) (MachChar b) = a `compare` b
320 cmpLit (MachStr a) (MachStr b) = a `compare` b
321 cmpLit (MachNullAddr) (MachNullAddr) = EQ
322 cmpLit (MachInt a) (MachInt b) = a `compare` b
323 cmpLit (MachWord a) (MachWord b) = a `compare` b
324 cmpLit (MachInt64 a) (MachInt64 b) = a `compare` b
325 cmpLit (MachWord64 a) (MachWord64 b) = a `compare` b
326 cmpLit (MachFloat a) (MachFloat b) = a `compare` b
327 cmpLit (MachDouble a) (MachDouble b) = a `compare` b
328 cmpLit (MachLabel a _) (MachLabel b _) = a `compare` b
329 cmpLit lit1 lit2 | litTag lit1 <# litTag lit2 = LT
332 litTag (MachChar _) = _ILIT(1)
333 litTag (MachStr _) = _ILIT(2)
334 litTag (MachNullAddr) = _ILIT(3)
335 litTag (MachInt _) = _ILIT(4)
336 litTag (MachWord _) = _ILIT(5)
337 litTag (MachInt64 _) = _ILIT(6)
338 litTag (MachWord64 _) = _ILIT(7)
339 litTag (MachFloat _) = _ILIT(8)
340 litTag (MachDouble _) = _ILIT(9)
341 litTag (MachLabel _ _) = _ILIT(10)
346 * MachX (i.e. unboxed) things are printed unadornded (e.g. 3, 'a', "foo")
347 exceptions: MachFloat gets an initial keyword prefix.
350 pprLit (MachChar ch) = pprHsChar ch
351 pprLit (MachStr s) = pprHsString s
352 pprLit (MachInt i) = pprIntVal i
353 pprLit (MachInt64 i) = ptext SLIT("__int64") <+> integer i
354 pprLit (MachWord w) = ptext SLIT("__word") <+> integer w
355 pprLit (MachWord64 w) = ptext SLIT("__word64") <+> integer w
356 pprLit (MachFloat f) = ptext SLIT("__float") <+> rational f
357 pprLit (MachDouble d) = rational d
358 pprLit (MachNullAddr) = ptext SLIT("__NULL")
359 pprLit (MachLabel l mb) = ptext SLIT("__label") <+>
361 Nothing -> pprHsString l
362 Just x -> doubleQuotes (text (unpackFS l ++ '@':show x))
364 pprIntVal :: Integer -> SDoc
365 -- Print negative integers with parens to be sure it's unambiguous
366 pprIntVal i | i < 0 = parens (integer i)
367 | otherwise = integer i
371 %************************************************************************
375 %************************************************************************
377 Hash values should be zero or a positive integer. No negatives please.
378 (They mess up the UniqFM for some reason.)
381 hashLiteral :: Literal -> Int
382 hashLiteral (MachChar c) = ord c + 1000 -- Keep it out of range of common ints
383 hashLiteral (MachStr s) = hashFS s
384 hashLiteral (MachNullAddr) = 0
385 hashLiteral (MachInt i) = hashInteger i
386 hashLiteral (MachInt64 i) = hashInteger i
387 hashLiteral (MachWord i) = hashInteger i
388 hashLiteral (MachWord64 i) = hashInteger i
389 hashLiteral (MachFloat r) = hashRational r
390 hashLiteral (MachDouble r) = hashRational r
391 hashLiteral (MachLabel s _) = hashFS s
393 hashRational :: Rational -> Int
394 hashRational r = hashInteger (numerator r)
396 hashInteger :: Integer -> Int
397 hashInteger i = 1 + abs (fromInteger (i `rem` 10000))
398 -- The 1+ is to avoid zero, which is a Bad Number
399 -- since we use * to combine hash values
401 hashFS :: FastString -> Int
402 hashFS s = iBox (uniqueOfFS s)