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
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
99 | MachNullAddr -- the NULL pointer, the only pointer value
100 -- that can be represented as a Literal.
102 | MachInt Integer -- Int# At least WORD_SIZE_IN_BITS bits
103 | MachInt64 Integer -- Int64# At least 64 bits
104 | MachWord Integer -- Word# At least WORD_SIZE_IN_BITS bits
105 | MachWord64 Integer -- Word64# At least 64 bits
108 | MachDouble Rational
110 -- MachLabel is used (only) for the literal derived from a
111 -- "foreign label" declaration.
112 -- string argument is the name of a symbol. This literal
113 -- refers to the *address* of the label.
114 | MachLabel FastString -- always an Addr#
115 (Maybe Int) -- the size (in bytes) of the arguments
116 -- the label expects. Only applicable with
118 -- Just x => "@<x>" will be appended to label
119 -- name when emitting asm.
125 instance Binary Literal where
126 put_ bh (MachChar aa) = do putByte bh 0; put_ bh aa
127 put_ bh (MachStr ab) = do putByte bh 1; put_ bh ab
128 put_ bh (MachNullAddr) = do putByte bh 2
129 put_ bh (MachInt ad) = do putByte bh 3; put_ bh ad
130 put_ bh (MachInt64 ae) = do putByte bh 4; put_ bh ae
131 put_ bh (MachWord af) = do putByte bh 5; put_ bh af
132 put_ bh (MachWord64 ag) = do putByte bh 6; put_ bh ag
133 put_ bh (MachFloat ah) = do putByte bh 7; put_ bh ah
134 put_ bh (MachDouble ai) = do putByte bh 8; put_ bh ai
135 put_ bh (MachLabel aj mb) = do putByte bh 9; put_ bh aj ; put_ bh mb
146 return (MachNullAddr)
152 return (MachInt64 ae)
158 return (MachWord64 ag)
161 return (MachFloat ah)
164 return (MachDouble ai)
168 return (MachLabel aj mb)
172 instance Outputable Literal where
175 instance Show Literal where
176 showsPrec p lit = showsPrecSDoc p (ppr lit)
178 instance Eq Literal where
179 a == b = case (a `compare` b) of { EQ -> True; _ -> False }
180 a /= b = case (a `compare` b) of { EQ -> False; _ -> True }
182 instance Ord Literal where
183 a <= b = case (a `compare` b) of { LT -> True; EQ -> True; GT -> False }
184 a < b = case (a `compare` b) of { LT -> True; EQ -> False; GT -> False }
185 a >= b = case (a `compare` b) of { LT -> False; EQ -> True; GT -> True }
186 a > b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True }
187 compare a b = cmpLit a b
194 mkMachInt, mkMachWord, mkMachInt64, mkMachWord64 :: Integer -> Literal
196 mkMachInt x = -- ASSERT2( inIntRange x, integer x )
197 -- Not true: you can write out of range Int# literals
198 -- For example, one can write (intToWord# 0xffff0000) to
199 -- get a particular Word bit-pattern, and there's no other
200 -- convenient way to write such literals, which is why we allow it.
202 mkMachWord x = -- ASSERT2( inWordRange x, integer x )
204 mkMachInt64 x = MachInt64 x
205 mkMachWord64 x = MachWord64 x
207 inIntRange, inWordRange :: Integer -> Bool
208 inIntRange x = x >= tARGET_MIN_INT && x <= tARGET_MAX_INT
209 inWordRange x = x >= 0 && x <= tARGET_MAX_WORD
211 inCharRange :: Char -> Bool
212 inCharRange c = c >= '\0' && c <= chr tARGET_MAX_CHAR
214 isZeroLit :: Literal -> Bool
215 isZeroLit (MachInt 0) = True
216 isZeroLit (MachInt64 0) = True
217 isZeroLit (MachWord 0) = True
218 isZeroLit (MachWord64 0) = True
219 isZeroLit (MachFloat 0) = True
220 isZeroLit (MachDouble 0) = True
221 isZeroLit other = False
227 word2IntLit, int2WordLit,
228 narrow8IntLit, narrow16IntLit, narrow32IntLit,
229 narrow8WordLit, narrow16WordLit, narrow32WordLit,
230 char2IntLit, int2CharLit,
231 float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit,
232 float2DoubleLit, double2FloatLit
233 :: Literal -> Literal
235 word2IntLit (MachWord w)
236 | w > tARGET_MAX_INT = MachInt (w - tARGET_MAX_WORD - 1)
237 | otherwise = MachInt w
239 int2WordLit (MachInt i)
240 | i < 0 = MachWord (1 + tARGET_MAX_WORD + i) -- (-1) ---> tARGET_MAX_WORD
241 | otherwise = MachWord i
243 narrow8IntLit (MachInt i) = MachInt (toInteger (fromInteger i :: Int8))
244 narrow16IntLit (MachInt i) = MachInt (toInteger (fromInteger i :: Int16))
245 narrow32IntLit (MachInt i) = MachInt (toInteger (fromInteger i :: Int32))
246 narrow8WordLit (MachWord w) = MachWord (toInteger (fromInteger w :: Word8))
247 narrow16WordLit (MachWord w) = MachWord (toInteger (fromInteger w :: Word16))
248 narrow32WordLit (MachWord w) = MachWord (toInteger (fromInteger w :: Word32))
250 char2IntLit (MachChar c) = MachInt (toInteger (ord c))
251 int2CharLit (MachInt i) = MachChar (chr (fromInteger i))
253 float2IntLit (MachFloat f) = MachInt (truncate f)
254 int2FloatLit (MachInt i) = MachFloat (fromInteger i)
256 double2IntLit (MachDouble f) = MachInt (truncate f)
257 int2DoubleLit (MachInt i) = MachDouble (fromInteger i)
259 float2DoubleLit (MachFloat f) = MachDouble f
260 double2FloatLit (MachDouble d) = MachFloat d
262 nullAddrLit :: Literal
263 nullAddrLit = MachNullAddr
269 litIsTrivial :: Literal -> Bool
270 -- True if there is absolutely no penalty to duplicating the literal
271 -- c.f. CoreUtils.exprIsTrivial
272 -- False principally of strings
273 litIsTrivial (MachStr _) = False
274 litIsTrivial other = True
276 litIsDupable :: Literal -> Bool
277 -- True if code space does not go bad if we duplicate this literal
278 -- c.f. CoreUtils.exprIsDupable
279 -- Currently we treat it just like litIsTrivial
280 litIsDupable (MachStr _) = False
281 litIsDupable other = True
283 litSize :: Literal -> Int
284 -- Used by CoreUnfold.sizeExpr
285 litSize (MachStr str) = 1 + ((lengthFS str + 3) `div` 4)
286 -- Every literal has size at least 1, otherwise
288 -- might be too small
289 -- [Sept03: make literal strings a bit bigger to avoid fruitless
290 -- duplication of little strings]
297 literalType :: Literal -> Type
298 literalType MachNullAddr = addrPrimTy
299 literalType (MachChar _) = charPrimTy
300 literalType (MachStr _) = addrPrimTy
301 literalType (MachInt _) = intPrimTy
302 literalType (MachWord _) = wordPrimTy
303 literalType (MachInt64 _) = int64PrimTy
304 literalType (MachWord64 _) = word64PrimTy
305 literalType (MachFloat _) = floatPrimTy
306 literalType (MachDouble _) = doublePrimTy
307 literalType (MachLabel _ _) = addrPrimTy
314 cmpLit (MachChar a) (MachChar b) = a `compare` b
315 cmpLit (MachStr a) (MachStr b) = a `compare` b
316 cmpLit (MachNullAddr) (MachNullAddr) = EQ
317 cmpLit (MachInt a) (MachInt b) = a `compare` b
318 cmpLit (MachWord a) (MachWord b) = a `compare` b
319 cmpLit (MachInt64 a) (MachInt64 b) = a `compare` b
320 cmpLit (MachWord64 a) (MachWord64 b) = a `compare` b
321 cmpLit (MachFloat a) (MachFloat b) = a `compare` b
322 cmpLit (MachDouble a) (MachDouble b) = a `compare` b
323 cmpLit (MachLabel a _) (MachLabel b _) = a `compare` b
324 cmpLit lit1 lit2 | litTag lit1 <# litTag lit2 = LT
327 litTag (MachChar _) = _ILIT(1)
328 litTag (MachStr _) = _ILIT(2)
329 litTag (MachNullAddr) = _ILIT(3)
330 litTag (MachInt _) = _ILIT(4)
331 litTag (MachWord _) = _ILIT(5)
332 litTag (MachInt64 _) = _ILIT(6)
333 litTag (MachWord64 _) = _ILIT(7)
334 litTag (MachFloat _) = _ILIT(8)
335 litTag (MachDouble _) = _ILIT(9)
336 litTag (MachLabel _ _) = _ILIT(10)
341 * MachX (i.e. unboxed) things are printed unadornded (e.g. 3, 'a', "foo")
342 exceptions: MachFloat gets an initial keyword prefix.
345 pprLit (MachChar ch) = pprHsChar ch
346 pprLit (MachStr s) = pprHsString s
347 pprLit (MachInt i) = pprIntVal i
348 pprLit (MachInt64 i) = ptext SLIT("__int64") <+> integer i
349 pprLit (MachWord w) = ptext SLIT("__word") <+> integer w
350 pprLit (MachWord64 w) = ptext SLIT("__word64") <+> integer w
351 pprLit (MachFloat f) = ptext SLIT("__float") <+> rational f
352 pprLit (MachDouble d) = rational d
353 pprLit (MachNullAddr) = ptext SLIT("__NULL")
354 pprLit (MachLabel l mb) = ptext SLIT("__label") <+>
356 Nothing -> pprHsString l
357 Just x -> doubleQuotes (text (unpackFS l ++ '@':show x))
359 pprIntVal :: Integer -> SDoc
360 -- Print negative integers with parens to be sure it's unambiguous
361 pprIntVal i | i < 0 = parens (integer i)
362 | otherwise = integer i
366 %************************************************************************
370 %************************************************************************
372 Hash values should be zero or a positive integer. No negatives please.
373 (They mess up the UniqFM for some reason.)
376 hashLiteral :: Literal -> Int
377 hashLiteral (MachChar c) = ord c + 1000 -- Keep it out of range of common ints
378 hashLiteral (MachStr s) = hashFS s
379 hashLiteral (MachNullAddr) = 0
380 hashLiteral (MachInt i) = hashInteger i
381 hashLiteral (MachInt64 i) = hashInteger i
382 hashLiteral (MachWord i) = hashInteger i
383 hashLiteral (MachWord64 i) = hashInteger i
384 hashLiteral (MachFloat r) = hashRational r
385 hashLiteral (MachDouble r) = hashRational r
386 hashLiteral (MachLabel s _) = hashFS s
388 hashRational :: Rational -> Int
389 hashRational r = hashInteger (numerator r)
391 hashInteger :: Integer -> Int
392 hashInteger i = 1 + abs (fromInteger (i `rem` 10000))
393 -- The 1+ is to avoid zero, which is a Bad Number
394 -- since we use * to combine hash values
396 hashFS :: FastString -> Int
397 hashFS s = iBox (uniqueOfFS s)