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 UnicodeUtil ( stringToUtf8 )
39 import Ratio ( numerator )
40 import FastString ( uniqueOfFS, lengthFS )
41 import DATA_INT ( Int8, Int16, Int32 )
42 import DATA_WORD ( Word8, Word16, Word32 )
43 import Char ( ord, chr )
48 %************************************************************************
52 %************************************************************************
54 If we're compiling with GHC (and we're not cross-compiling), then we
55 know that minBound and maxBound :: Int are the right values for the
56 target architecture. Otherwise, we assume -2^31 and 2^31-1
57 respectively (which will be wrong on a 64-bit machine).
60 tARGET_MIN_INT, tARGET_MAX_INT, tARGET_MAX_WORD :: Integer
61 #if __GLASGOW_HASKELL__
62 tARGET_MIN_INT = toInteger (minBound :: Int)
63 tARGET_MAX_INT = toInteger (maxBound :: Int)
65 tARGET_MIN_INT = -2147483648
66 tARGET_MAX_INT = 2147483647
68 tARGET_MAX_WORD = (tARGET_MAX_INT * 2) + 1
70 tARGET_MAX_CHAR :: Int
71 tARGET_MAX_CHAR = 0x10ffff
75 %************************************************************************
79 %************************************************************************
81 So-called @Literals@ are {\em either}:
84 An unboxed (``machine'') literal (type: @IntPrim@, @FloatPrim@, etc.),
85 which is presumed to be surrounded by appropriate constructors
86 (@mKINT@, etc.), so that the overall thing makes sense.
88 An Integer, Rational, or String literal whose representation we are
89 {\em uncommitted} about; i.e., the surrounding with constructors,
90 function applications, etc., etc., has not yet been done.
96 -- First the primitive guys
97 MachChar Char -- Char# At least 31 bits
100 | MachNullAddr -- the NULL pointer, the only pointer value
101 -- that can be represented as a Literal.
103 | MachInt Integer -- Int# At least WORD_SIZE_IN_BITS bits
104 | MachInt64 Integer -- Int64# At least 64 bits
105 | MachWord Integer -- Word# At least WORD_SIZE_IN_BITS bits
106 | MachWord64 Integer -- Word64# At least 64 bits
109 | MachDouble Rational
111 -- MachLabel is used (only) for the literal derived from a
112 -- "foreign label" declaration.
113 -- string argument is the name of a symbol. This literal
114 -- refers to the *address* of the label.
115 | MachLabel FastString -- always an Addr#
116 (Maybe Int) -- the size (in bytes) of the arguments
117 -- the label expects. Only applicable with
119 -- Just x => "@<x>" will be appended to label
120 -- name when emitting asm.
126 instance Binary Literal where
127 put_ bh (MachChar aa) = do putByte bh 0; put_ bh aa
128 put_ bh (MachStr ab) = do putByte bh 1; put_ bh ab
129 put_ bh (MachNullAddr) = do putByte bh 2
130 put_ bh (MachInt ad) = do putByte bh 3; put_ bh ad
131 put_ bh (MachInt64 ae) = do putByte bh 4; put_ bh ae
132 put_ bh (MachWord af) = do putByte bh 5; put_ bh af
133 put_ bh (MachWord64 ag) = do putByte bh 6; put_ bh ag
134 put_ bh (MachFloat ah) = do putByte bh 7; put_ bh ah
135 put_ bh (MachDouble ai) = do putByte bh 8; put_ bh ai
136 put_ bh (MachLabel aj mb) = do putByte bh 9; put_ bh aj ; put_ bh mb
147 return (MachNullAddr)
153 return (MachInt64 ae)
159 return (MachWord64 ag)
162 return (MachFloat ah)
165 return (MachDouble ai)
169 return (MachLabel aj mb)
173 instance Outputable Literal where
176 instance Show Literal where
177 showsPrec p lit = showsPrecSDoc p (ppr lit)
179 instance Eq Literal where
180 a == b = case (a `compare` b) of { EQ -> True; _ -> False }
181 a /= b = case (a `compare` b) of { EQ -> False; _ -> True }
183 instance Ord Literal where
184 a <= b = case (a `compare` b) of { LT -> True; EQ -> True; GT -> False }
185 a < b = case (a `compare` b) of { LT -> True; EQ -> False; GT -> False }
186 a >= b = case (a `compare` b) of { LT -> False; EQ -> True; GT -> True }
187 a > b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True }
188 compare a b = cmpLit a b
195 mkMachInt, mkMachWord, mkMachInt64, mkMachWord64 :: Integer -> Literal
197 mkMachInt x = -- ASSERT2( inIntRange x, integer x )
198 -- Not true: you can write out of range Int# literals
199 -- For example, one can write (intToWord# 0xffff0000) to
200 -- get a particular Word bit-pattern, and there's no other
201 -- convenient way to write such literals, which is why we allow it.
203 mkMachWord x = -- ASSERT2( inWordRange x, integer x )
205 mkMachInt64 x = MachInt64 x
206 mkMachWord64 x = MachWord64 x
208 mkStringLit :: String -> Literal
209 mkStringLit s = MachStr (mkFastString (stringToUtf8 s))
211 inIntRange, inWordRange :: Integer -> Bool
212 inIntRange x = x >= tARGET_MIN_INT && x <= tARGET_MAX_INT
213 inWordRange x = x >= 0 && x <= tARGET_MAX_WORD
215 inCharRange :: Char -> Bool
216 inCharRange c = c >= '\0' && c <= chr tARGET_MAX_CHAR
218 isZeroLit :: Literal -> Bool
219 isZeroLit (MachInt 0) = True
220 isZeroLit (MachInt64 0) = True
221 isZeroLit (MachWord 0) = True
222 isZeroLit (MachWord64 0) = True
223 isZeroLit (MachFloat 0) = True
224 isZeroLit (MachDouble 0) = True
225 isZeroLit other = False
231 word2IntLit, int2WordLit,
232 narrow8IntLit, narrow16IntLit, narrow32IntLit,
233 narrow8WordLit, narrow16WordLit, narrow32WordLit,
234 char2IntLit, int2CharLit,
235 float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit,
236 float2DoubleLit, double2FloatLit
237 :: Literal -> Literal
239 word2IntLit (MachWord w)
240 | w > tARGET_MAX_INT = MachInt (w - tARGET_MAX_WORD - 1)
241 | otherwise = MachInt w
243 int2WordLit (MachInt i)
244 | i < 0 = MachWord (1 + tARGET_MAX_WORD + i) -- (-1) ---> tARGET_MAX_WORD
245 | otherwise = MachWord i
247 narrow8IntLit (MachInt i) = MachInt (toInteger (fromInteger i :: Int8))
248 narrow16IntLit (MachInt i) = MachInt (toInteger (fromInteger i :: Int16))
249 narrow32IntLit (MachInt i) = MachInt (toInteger (fromInteger i :: Int32))
250 narrow8WordLit (MachWord w) = MachWord (toInteger (fromInteger w :: Word8))
251 narrow16WordLit (MachWord w) = MachWord (toInteger (fromInteger w :: Word16))
252 narrow32WordLit (MachWord w) = MachWord (toInteger (fromInteger w :: Word32))
254 char2IntLit (MachChar c) = MachInt (toInteger (ord c))
255 int2CharLit (MachInt i) = MachChar (chr (fromInteger i))
257 float2IntLit (MachFloat f) = MachInt (truncate f)
258 int2FloatLit (MachInt i) = MachFloat (fromInteger i)
260 double2IntLit (MachDouble f) = MachInt (truncate f)
261 int2DoubleLit (MachInt i) = MachDouble (fromInteger i)
263 float2DoubleLit (MachFloat f) = MachDouble f
264 double2FloatLit (MachDouble d) = MachFloat d
266 nullAddrLit :: Literal
267 nullAddrLit = MachNullAddr
273 litIsTrivial :: Literal -> Bool
274 -- True if there is absolutely no penalty to duplicating the literal
275 -- c.f. CoreUtils.exprIsTrivial
276 -- False principally of strings
277 litIsTrivial (MachStr _) = False
278 litIsTrivial other = True
280 litIsDupable :: Literal -> Bool
281 -- True if code space does not go bad if we duplicate this literal
282 -- c.f. CoreUtils.exprIsDupable
283 -- Currently we treat it just like litIsTrivial
284 litIsDupable (MachStr _) = False
285 litIsDupable other = True
287 litSize :: Literal -> Int
288 -- Used by CoreUnfold.sizeExpr
289 litSize (MachStr str) = 1 + ((lengthFS str + 3) `div` 4)
290 -- Every literal has size at least 1, otherwise
292 -- might be too small
293 -- [Sept03: make literal strings a bit bigger to avoid fruitless
294 -- duplication of little strings]
301 literalType :: Literal -> Type
302 literalType MachNullAddr = addrPrimTy
303 literalType (MachChar _) = charPrimTy
304 literalType (MachStr _) = addrPrimTy
305 literalType (MachInt _) = intPrimTy
306 literalType (MachWord _) = wordPrimTy
307 literalType (MachInt64 _) = int64PrimTy
308 literalType (MachWord64 _) = word64PrimTy
309 literalType (MachFloat _) = floatPrimTy
310 literalType (MachDouble _) = doublePrimTy
311 literalType (MachLabel _ _) = addrPrimTy
318 cmpLit (MachChar a) (MachChar b) = a `compare` b
319 cmpLit (MachStr a) (MachStr b) = a `compare` b
320 cmpLit (MachNullAddr) (MachNullAddr) = EQ
321 cmpLit (MachInt a) (MachInt b) = a `compare` b
322 cmpLit (MachWord a) (MachWord b) = a `compare` b
323 cmpLit (MachInt64 a) (MachInt64 b) = a `compare` b
324 cmpLit (MachWord64 a) (MachWord64 b) = a `compare` b
325 cmpLit (MachFloat a) (MachFloat b) = a `compare` b
326 cmpLit (MachDouble a) (MachDouble b) = a `compare` b
327 cmpLit (MachLabel a _) (MachLabel b _) = a `compare` b
328 cmpLit lit1 lit2 | litTag lit1 <# litTag lit2 = LT
331 litTag (MachChar _) = _ILIT(1)
332 litTag (MachStr _) = _ILIT(2)
333 litTag (MachNullAddr) = _ILIT(3)
334 litTag (MachInt _) = _ILIT(4)
335 litTag (MachWord _) = _ILIT(5)
336 litTag (MachInt64 _) = _ILIT(6)
337 litTag (MachWord64 _) = _ILIT(7)
338 litTag (MachFloat _) = _ILIT(8)
339 litTag (MachDouble _) = _ILIT(9)
340 litTag (MachLabel _ _) = _ILIT(10)
345 * MachX (i.e. unboxed) things are printed unadornded (e.g. 3, 'a', "foo")
346 exceptions: MachFloat gets an initial keyword prefix.
349 pprLit (MachChar ch) = pprHsChar ch
350 pprLit (MachStr s) = pprHsString s
351 pprLit (MachInt i) = pprIntVal i
352 pprLit (MachInt64 i) = ptext SLIT("__int64") <+> integer i
353 pprLit (MachWord w) = ptext SLIT("__word") <+> integer w
354 pprLit (MachWord64 w) = ptext SLIT("__word64") <+> integer w
355 pprLit (MachFloat f) = ptext SLIT("__float") <+> rational f
356 pprLit (MachDouble d) = rational d
357 pprLit (MachNullAddr) = ptext SLIT("__NULL")
358 pprLit (MachLabel l mb) = ptext SLIT("__label") <+>
360 Nothing -> pprHsString l
361 Just x -> doubleQuotes (text (unpackFS l ++ '@':show x))
363 pprIntVal :: Integer -> SDoc
364 -- Print negative integers with parens to be sure it's unambiguous
365 pprIntVal i | i < 0 = parens (integer i)
366 | otherwise = integer i
370 %************************************************************************
374 %************************************************************************
376 Hash values should be zero or a positive integer. No negatives please.
377 (They mess up the UniqFM for some reason.)
380 hashLiteral :: Literal -> Int
381 hashLiteral (MachChar c) = ord c + 1000 -- Keep it out of range of common ints
382 hashLiteral (MachStr s) = hashFS s
383 hashLiteral (MachNullAddr) = 0
384 hashLiteral (MachInt i) = hashInteger i
385 hashLiteral (MachInt64 i) = hashInteger i
386 hashLiteral (MachWord i) = hashInteger i
387 hashLiteral (MachWord64 i) = hashInteger i
388 hashLiteral (MachFloat r) = hashRational r
389 hashLiteral (MachDouble r) = hashRational r
390 hashLiteral (MachLabel s _) = hashFS s
392 hashRational :: Rational -> Int
393 hashRational r = hashInteger (numerator r)
395 hashInteger :: Integer -> Int
396 hashInteger i = 1 + abs (fromInteger (i `rem` 10000))
397 -- The 1+ is to avoid zero, which is a Bad Number
398 -- since we use * to combine hash values
400 hashFS :: FastString -> Int
401 hashFS s = iBox (uniqueOfFS s)