2 % (c) The GRASP/AQUA Project, Glasgow University, 1998
4 \section[Literal]{@Literal@: Machine literals (unboxed, of course)}
8 ( Literal(..) -- Exported to ParseIface
9 , mkMachInt, mkMachWord
10 , mkMachInt64, mkMachWord64, mkStringLit
12 , litIsDupable, litIsTrivial
16 , inIntRange, inWordRange, tARGET_MAX_INT, inCharRange
19 , word2IntLit, int2WordLit
20 , narrow8IntLit, narrow16IntLit, narrow32IntLit
21 , narrow8WordLit, narrow16WordLit, narrow32WordLit
22 , char2IntLit, int2CharLit
23 , float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit
24 , nullAddrLit, float2DoubleLit, double2FloatLit
27 #include "HsVersions.h"
29 import TysPrim ( charPrimTy, addrPrimTy, floatPrimTy, doublePrimTy,
30 intPrimTy, wordPrimTy, int64PrimTy, word64PrimTy
38 import Ratio ( numerator )
39 import FastString ( uniqueOfFS, lengthFS )
40 import DATA_INT ( Int8, Int16, Int32 )
41 import DATA_WORD ( Word8, Word16, Word32 )
42 import Char ( ord, chr )
47 %************************************************************************
51 %************************************************************************
53 If we're compiling with GHC (and we're not cross-compiling), then we
54 know that minBound and maxBound :: Int are the right values for the
55 target architecture. Otherwise, we assume -2^31 and 2^31-1
56 respectively (which will be wrong on a 64-bit machine).
59 tARGET_MIN_INT, tARGET_MAX_INT, tARGET_MAX_WORD :: Integer
60 #if __GLASGOW_HASKELL__
61 tARGET_MIN_INT = toInteger (minBound :: Int)
62 tARGET_MAX_INT = toInteger (maxBound :: Int)
64 tARGET_MIN_INT = -2147483648
65 tARGET_MAX_INT = 2147483647
67 tARGET_MAX_WORD = (tARGET_MAX_INT * 2) + 1
69 tARGET_MAX_CHAR :: Int
70 tARGET_MAX_CHAR = 0x10ffff
74 %************************************************************************
78 %************************************************************************
80 So-called @Literals@ are {\em either}:
83 An unboxed (``machine'') literal (type: @IntPrim@, @FloatPrim@, etc.),
84 which is presumed to be surrounded by appropriate constructors
85 (@mKINT@, etc.), so that the overall thing makes sense.
87 An Integer, Rational, or String literal whose representation we are
88 {\em uncommitted} about; i.e., the surrounding with constructors,
89 function applications, etc., etc., has not yet been done.
95 -- First the primitive guys
96 MachChar Char -- Char# At least 31 bits
98 | MachStr FastString -- A string-literal: stored and emitted
99 -- UTF-8 encoded, we'll arrange to decode it
100 -- at runtime. Also emitted with a '\0'
103 | MachNullAddr -- the NULL pointer, the only pointer value
104 -- that can be represented as a Literal.
106 | MachInt Integer -- Int# At least WORD_SIZE_IN_BITS bits
107 | MachInt64 Integer -- Int64# At least 64 bits
108 | MachWord Integer -- Word# At least WORD_SIZE_IN_BITS bits
109 | MachWord64 Integer -- Word64# At least 64 bits
112 | MachDouble Rational
114 -- MachLabel is used (only) for the literal derived from a
115 -- "foreign label" declaration.
116 -- string argument is the name of a symbol. This literal
117 -- refers to the *address* of the label.
118 | MachLabel FastString -- always an Addr#
119 (Maybe Int) -- the size (in bytes) of the arguments
120 -- the label expects. Only applicable with
122 -- Just x => "@<x>" will be appended to label
123 -- name when emitting asm.
129 instance Binary Literal where
130 put_ bh (MachChar aa) = do putByte bh 0; put_ bh aa
131 put_ bh (MachStr ab) = do putByte bh 1; put_ bh ab
132 put_ bh (MachNullAddr) = do putByte bh 2
133 put_ bh (MachInt ad) = do putByte bh 3; put_ bh ad
134 put_ bh (MachInt64 ae) = do putByte bh 4; put_ bh ae
135 put_ bh (MachWord af) = do putByte bh 5; put_ bh af
136 put_ bh (MachWord64 ag) = do putByte bh 6; put_ bh ag
137 put_ bh (MachFloat ah) = do putByte bh 7; put_ bh ah
138 put_ bh (MachDouble ai) = do putByte bh 8; put_ bh ai
139 put_ bh (MachLabel aj mb) = do putByte bh 9; put_ bh aj ; put_ bh mb
150 return (MachNullAddr)
156 return (MachInt64 ae)
162 return (MachWord64 ag)
165 return (MachFloat ah)
168 return (MachDouble ai)
172 return (MachLabel aj mb)
176 instance Outputable Literal where
179 instance Show Literal where
180 showsPrec p lit = showsPrecSDoc p (ppr lit)
182 instance Eq Literal where
183 a == b = case (a `compare` b) of { EQ -> True; _ -> False }
184 a /= b = case (a `compare` b) of { EQ -> False; _ -> True }
186 instance Ord Literal where
187 a <= b = case (a `compare` b) of { LT -> True; EQ -> True; GT -> False }
188 a < b = case (a `compare` b) of { LT -> True; EQ -> False; GT -> False }
189 a >= b = case (a `compare` b) of { LT -> False; EQ -> True; GT -> True }
190 a > b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True }
191 compare a b = cmpLit a b
198 mkMachInt, mkMachWord, mkMachInt64, mkMachWord64 :: Integer -> Literal
200 mkMachInt x = -- ASSERT2( inIntRange x, integer x )
201 -- Not true: you can write out of range Int# literals
202 -- For example, one can write (intToWord# 0xffff0000) to
203 -- get a particular Word bit-pattern, and there's no other
204 -- convenient way to write such literals, which is why we allow it.
206 mkMachWord x = -- ASSERT2( inWordRange x, integer x )
208 mkMachInt64 x = MachInt64 x
209 mkMachWord64 x = MachWord64 x
211 mkStringLit :: String -> Literal
212 mkStringLit s = MachStr (mkFastString s) -- stored UTF-8 encoded
214 inIntRange, inWordRange :: Integer -> Bool
215 inIntRange x = x >= tARGET_MIN_INT && x <= tARGET_MAX_INT
216 inWordRange x = x >= 0 && x <= tARGET_MAX_WORD
218 inCharRange :: Char -> Bool
219 inCharRange c = c >= '\0' && c <= chr tARGET_MAX_CHAR
221 isZeroLit :: Literal -> Bool
222 isZeroLit (MachInt 0) = True
223 isZeroLit (MachInt64 0) = True
224 isZeroLit (MachWord 0) = True
225 isZeroLit (MachWord64 0) = True
226 isZeroLit (MachFloat 0) = True
227 isZeroLit (MachDouble 0) = True
228 isZeroLit other = False
234 word2IntLit, int2WordLit,
235 narrow8IntLit, narrow16IntLit, narrow32IntLit,
236 narrow8WordLit, narrow16WordLit, narrow32WordLit,
237 char2IntLit, int2CharLit,
238 float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit,
239 float2DoubleLit, double2FloatLit
240 :: Literal -> Literal
242 word2IntLit (MachWord w)
243 | w > tARGET_MAX_INT = MachInt (w - tARGET_MAX_WORD - 1)
244 | otherwise = MachInt w
246 int2WordLit (MachInt i)
247 | i < 0 = MachWord (1 + tARGET_MAX_WORD + i) -- (-1) ---> tARGET_MAX_WORD
248 | otherwise = MachWord i
250 narrow8IntLit (MachInt i) = MachInt (toInteger (fromInteger i :: Int8))
251 narrow16IntLit (MachInt i) = MachInt (toInteger (fromInteger i :: Int16))
252 narrow32IntLit (MachInt i) = MachInt (toInteger (fromInteger i :: Int32))
253 narrow8WordLit (MachWord w) = MachWord (toInteger (fromInteger w :: Word8))
254 narrow16WordLit (MachWord w) = MachWord (toInteger (fromInteger w :: Word16))
255 narrow32WordLit (MachWord w) = MachWord (toInteger (fromInteger w :: Word32))
257 char2IntLit (MachChar c) = MachInt (toInteger (ord c))
258 int2CharLit (MachInt i) = MachChar (chr (fromInteger i))
260 float2IntLit (MachFloat f) = MachInt (truncate f)
261 int2FloatLit (MachInt i) = MachFloat (fromInteger i)
263 double2IntLit (MachDouble f) = MachInt (truncate f)
264 int2DoubleLit (MachInt i) = MachDouble (fromInteger i)
266 float2DoubleLit (MachFloat f) = MachDouble f
267 double2FloatLit (MachDouble d) = MachFloat d
269 nullAddrLit :: Literal
270 nullAddrLit = MachNullAddr
276 litIsTrivial :: Literal -> Bool
277 -- True if there is absolutely no penalty to duplicating the literal
278 -- c.f. CoreUtils.exprIsTrivial
279 -- False principally of strings
280 litIsTrivial (MachStr _) = False
281 litIsTrivial other = True
283 litIsDupable :: Literal -> Bool
284 -- True if code space does not go bad if we duplicate this literal
285 -- c.f. CoreUtils.exprIsDupable
286 -- Currently we treat it just like litIsTrivial
287 litIsDupable (MachStr _) = False
288 litIsDupable other = True
290 litSize :: Literal -> Int
291 -- Used by CoreUnfold.sizeExpr
292 litSize (MachStr str) = 1 + ((lengthFS str + 3) `div` 4)
293 -- Every literal has size at least 1, otherwise
295 -- might be too small
296 -- [Sept03: make literal strings a bit bigger to avoid fruitless
297 -- duplication of little strings]
304 literalType :: Literal -> Type
305 literalType MachNullAddr = addrPrimTy
306 literalType (MachChar _) = charPrimTy
307 literalType (MachStr _) = addrPrimTy
308 literalType (MachInt _) = intPrimTy
309 literalType (MachWord _) = wordPrimTy
310 literalType (MachInt64 _) = int64PrimTy
311 literalType (MachWord64 _) = word64PrimTy
312 literalType (MachFloat _) = floatPrimTy
313 literalType (MachDouble _) = doublePrimTy
314 literalType (MachLabel _ _) = addrPrimTy
321 cmpLit (MachChar a) (MachChar b) = a `compare` b
322 cmpLit (MachStr a) (MachStr b) = a `compare` b
323 cmpLit (MachNullAddr) (MachNullAddr) = EQ
324 cmpLit (MachInt a) (MachInt b) = a `compare` b
325 cmpLit (MachWord a) (MachWord b) = a `compare` b
326 cmpLit (MachInt64 a) (MachInt64 b) = a `compare` b
327 cmpLit (MachWord64 a) (MachWord64 b) = a `compare` b
328 cmpLit (MachFloat a) (MachFloat b) = a `compare` b
329 cmpLit (MachDouble a) (MachDouble b) = a `compare` b
330 cmpLit (MachLabel a _) (MachLabel b _) = a `compare` b
331 cmpLit lit1 lit2 | litTag lit1 <# litTag lit2 = LT
334 litTag (MachChar _) = _ILIT(1)
335 litTag (MachStr _) = _ILIT(2)
336 litTag (MachNullAddr) = _ILIT(3)
337 litTag (MachInt _) = _ILIT(4)
338 litTag (MachWord _) = _ILIT(5)
339 litTag (MachInt64 _) = _ILIT(6)
340 litTag (MachWord64 _) = _ILIT(7)
341 litTag (MachFloat _) = _ILIT(8)
342 litTag (MachDouble _) = _ILIT(9)
343 litTag (MachLabel _ _) = _ILIT(10)
348 * MachX (i.e. unboxed) things are printed unadornded (e.g. 3, 'a', "foo")
349 exceptions: MachFloat gets an initial keyword prefix.
352 pprLit (MachChar ch) = pprHsChar ch
353 pprLit (MachStr s) = pprHsString s
354 pprLit (MachInt i) = pprIntVal i
355 pprLit (MachInt64 i) = ptext SLIT("__int64") <+> integer i
356 pprLit (MachWord w) = ptext SLIT("__word") <+> integer w
357 pprLit (MachWord64 w) = ptext SLIT("__word64") <+> integer w
358 pprLit (MachFloat f) = ptext SLIT("__float") <+> rational f
359 pprLit (MachDouble d) = rational d
360 pprLit (MachNullAddr) = ptext SLIT("__NULL")
361 pprLit (MachLabel l mb) = ptext SLIT("__label") <+>
363 Nothing -> pprHsString l
364 Just x -> doubleQuotes (text (unpackFS l ++ '@':show x))
366 pprIntVal :: Integer -> SDoc
367 -- Print negative integers with parens to be sure it's unambiguous
368 pprIntVal i | i < 0 = parens (integer i)
369 | otherwise = integer i
373 %************************************************************************
377 %************************************************************************
379 Hash values should be zero or a positive integer. No negatives please.
380 (They mess up the UniqFM for some reason.)
383 hashLiteral :: Literal -> Int
384 hashLiteral (MachChar c) = ord c + 1000 -- Keep it out of range of common ints
385 hashLiteral (MachStr s) = hashFS s
386 hashLiteral (MachNullAddr) = 0
387 hashLiteral (MachInt i) = hashInteger i
388 hashLiteral (MachInt64 i) = hashInteger i
389 hashLiteral (MachWord i) = hashInteger i
390 hashLiteral (MachWord64 i) = hashInteger i
391 hashLiteral (MachFloat r) = hashRational r
392 hashLiteral (MachDouble r) = hashRational r
393 hashLiteral (MachLabel s _) = hashFS s
395 hashRational :: Rational -> Int
396 hashRational r = hashInteger (numerator r)
398 hashInteger :: Integer -> Int
399 hashInteger i = 1 + abs (fromInteger (i `rem` 10000))
400 -- The 1+ is to avoid zero, which is a Bad Number
401 -- since we use * to combine hash values
403 hashFS :: FastString -> Int
404 hashFS s = iBox (uniqueOfFS s)