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 -- The above warning supression flag is a temporary kludge.
10 -- While working on this module you are encouraged to remove it and fix
11 -- any warnings in the module. See
12 -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
16 ( Literal(..) -- Exported to ParseIface
17 , mkMachInt, mkMachWord
18 , mkMachInt64, mkMachWord64, mkStringLit
20 , litIsDupable, litIsTrivial
24 , inIntRange, inWordRange, tARGET_MAX_INT, inCharRange
28 , word2IntLit, int2WordLit
29 , narrow8IntLit, narrow16IntLit, narrow32IntLit
30 , narrow8WordLit, narrow16WordLit, narrow32WordLit
31 , char2IntLit, int2CharLit
32 , float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit
33 , nullAddrLit, float2DoubleLit, double2FloatLit
36 #include "HsVersions.h"
52 %************************************************************************
56 %************************************************************************
58 If we're compiling with GHC (and we're not cross-compiling), then we
59 know that minBound and maxBound :: Int are the right values for the
60 target architecture. Otherwise, we assume -2^31 and 2^31-1
61 respectively (which will be wrong on a 64-bit machine).
64 tARGET_MIN_INT, tARGET_MAX_INT, tARGET_MAX_WORD :: Integer
65 #ifdef __GLASGOW_HASKELL__
66 tARGET_MIN_INT = toInteger (minBound :: Int)
67 tARGET_MAX_INT = toInteger (maxBound :: Int)
69 tARGET_MIN_INT = -2147483648
70 tARGET_MAX_INT = 2147483647
72 tARGET_MAX_WORD = (tARGET_MAX_INT * 2) + 1
74 tARGET_MAX_CHAR :: Int
75 tARGET_MAX_CHAR = 0x10ffff
79 %************************************************************************
83 %************************************************************************
85 So-called @Literals@ are {\em either}:
88 An unboxed (``machine'') literal (type: @IntPrim@, @FloatPrim@, etc.),
89 which is presumed to be surrounded by appropriate constructors
90 (@mKINT@, etc.), so that the overall thing makes sense.
92 An Integer, Rational, or String literal whose representation we are
93 {\em uncommitted} about; i.e., the surrounding with constructors,
94 function applications, etc., etc., has not yet been done.
100 -- First the primitive guys
101 MachChar Char -- Char# At least 31 bits
103 | MachStr FastString -- A string-literal: stored and emitted
104 -- UTF-8 encoded, we'll arrange to decode it
105 -- at runtime. Also emitted with a '\0'
108 | MachNullAddr -- the NULL pointer, the only pointer value
109 -- that can be represented as a Literal.
111 | MachInt Integer -- Int# At least WORD_SIZE_IN_BITS bits
112 | MachInt64 Integer -- Int64# At least 64 bits
113 | MachWord Integer -- Word# At least WORD_SIZE_IN_BITS bits
114 | MachWord64 Integer -- Word64# At least 64 bits
117 | MachDouble Rational
119 -- MachLabel is used (only) for the literal derived from a
120 -- "foreign label" declaration.
121 -- string argument is the name of a symbol. This literal
122 -- refers to the *address* of the label.
123 | MachLabel FastString -- always an Addr#
124 (Maybe Int) -- the size (in bytes) of the arguments
125 -- the label expects. Only applicable with
127 -- Just x => "@<x>" will be appended to label
128 -- name when emitting asm.
134 instance Binary Literal where
135 put_ bh (MachChar aa) = do putByte bh 0; put_ bh aa
136 put_ bh (MachStr ab) = do putByte bh 1; put_ bh ab
137 put_ bh (MachNullAddr) = do putByte bh 2
138 put_ bh (MachInt ad) = do putByte bh 3; put_ bh ad
139 put_ bh (MachInt64 ae) = do putByte bh 4; put_ bh ae
140 put_ bh (MachWord af) = do putByte bh 5; put_ bh af
141 put_ bh (MachWord64 ag) = do putByte bh 6; put_ bh ag
142 put_ bh (MachFloat ah) = do putByte bh 7; put_ bh ah
143 put_ bh (MachDouble ai) = do putByte bh 8; put_ bh ai
144 put_ bh (MachLabel aj mb) = do putByte bh 9; put_ bh aj ; put_ bh mb
155 return (MachNullAddr)
161 return (MachInt64 ae)
167 return (MachWord64 ag)
170 return (MachFloat ah)
173 return (MachDouble ai)
177 return (MachLabel aj mb)
181 instance Outputable Literal where
184 instance Show Literal where
185 showsPrec p lit = showsPrecSDoc p (ppr lit)
187 instance Eq Literal where
188 a == b = case (a `compare` b) of { EQ -> True; _ -> False }
189 a /= b = case (a `compare` b) of { EQ -> False; _ -> True }
191 instance Ord Literal where
192 a <= b = case (a `compare` b) of { LT -> True; EQ -> True; GT -> False }
193 a < b = case (a `compare` b) of { LT -> True; EQ -> False; GT -> False }
194 a >= b = case (a `compare` b) of { LT -> False; EQ -> True; GT -> True }
195 a > b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True }
196 compare a b = cmpLit a b
203 mkMachInt, mkMachWord, mkMachInt64, mkMachWord64 :: Integer -> Literal
205 mkMachInt x = -- ASSERT2( inIntRange x, integer x )
206 -- Not true: you can write out of range Int# literals
207 -- For example, one can write (intToWord# 0xffff0000) to
208 -- get a particular Word bit-pattern, and there's no other
209 -- convenient way to write such literals, which is why we allow it.
211 mkMachWord x = -- ASSERT2( inWordRange x, integer x )
213 mkMachInt64 x = MachInt64 x
214 mkMachWord64 x = MachWord64 x
216 mkStringLit :: String -> Literal
217 mkStringLit s = MachStr (mkFastString s) -- stored UTF-8 encoded
219 inIntRange, inWordRange :: Integer -> Bool
220 inIntRange x = x >= tARGET_MIN_INT && x <= tARGET_MAX_INT
221 inWordRange x = x >= 0 && x <= tARGET_MAX_WORD
223 inCharRange :: Char -> Bool
224 inCharRange c = c >= '\0' && c <= chr tARGET_MAX_CHAR
226 isZeroLit :: Literal -> Bool
227 isZeroLit (MachInt 0) = True
228 isZeroLit (MachInt64 0) = True
229 isZeroLit (MachWord 0) = True
230 isZeroLit (MachWord64 0) = True
231 isZeroLit (MachFloat 0) = True
232 isZeroLit (MachDouble 0) = True
233 isZeroLit other = False
239 word2IntLit, int2WordLit,
240 narrow8IntLit, narrow16IntLit, narrow32IntLit,
241 narrow8WordLit, narrow16WordLit, narrow32WordLit,
242 char2IntLit, int2CharLit,
243 float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit,
244 float2DoubleLit, double2FloatLit
245 :: Literal -> Literal
247 word2IntLit (MachWord w)
248 | w > tARGET_MAX_INT = MachInt (w - tARGET_MAX_WORD - 1)
249 | otherwise = MachInt w
251 int2WordLit (MachInt i)
252 | i < 0 = MachWord (1 + tARGET_MAX_WORD + i) -- (-1) ---> tARGET_MAX_WORD
253 | otherwise = MachWord i
255 narrow8IntLit (MachInt i) = MachInt (toInteger (fromInteger i :: Int8))
256 narrow16IntLit (MachInt i) = MachInt (toInteger (fromInteger i :: Int16))
257 narrow32IntLit (MachInt i) = MachInt (toInteger (fromInteger i :: Int32))
258 narrow8WordLit (MachWord w) = MachWord (toInteger (fromInteger w :: Word8))
259 narrow16WordLit (MachWord w) = MachWord (toInteger (fromInteger w :: Word16))
260 narrow32WordLit (MachWord w) = MachWord (toInteger (fromInteger w :: Word32))
262 char2IntLit (MachChar c) = MachInt (toInteger (ord c))
263 int2CharLit (MachInt i) = MachChar (chr (fromInteger i))
265 float2IntLit (MachFloat f) = MachInt (truncate f)
266 int2FloatLit (MachInt i) = MachFloat (fromInteger i)
268 double2IntLit (MachDouble f) = MachInt (truncate f)
269 int2DoubleLit (MachInt i) = MachDouble (fromInteger i)
271 float2DoubleLit (MachFloat f) = MachDouble f
272 double2FloatLit (MachDouble d) = MachFloat d
274 nullAddrLit :: Literal
275 nullAddrLit = MachNullAddr
281 litIsTrivial :: Literal -> Bool
282 -- True if there is absolutely no penalty to duplicating the literal
283 -- c.f. CoreUtils.exprIsTrivial
284 -- False principally of strings
285 litIsTrivial (MachStr _) = False
286 litIsTrivial other = True
288 litIsDupable :: Literal -> Bool
289 -- True if code space does not go bad if we duplicate this literal
290 -- c.f. CoreUtils.exprIsDupable
291 -- Currently we treat it just like litIsTrivial
292 litIsDupable (MachStr _) = False
293 litIsDupable other = True
295 litFitsInChar :: Literal -> Bool
296 litFitsInChar (MachInt i)
297 = fromInteger i <= ord minBound
298 && fromInteger i >= ord maxBound
299 litFitsInChar _ = False
301 litSize :: Literal -> Int
302 -- Used by CoreUnfold.sizeExpr
303 litSize (MachStr str) = 1 + ((lengthFS str + 3) `div` 4)
304 -- Every literal has size at least 1, otherwise
306 -- might be too small
307 -- [Sept03: make literal strings a bit bigger to avoid fruitless
308 -- duplication of little strings]
315 literalType :: Literal -> Type
316 literalType MachNullAddr = addrPrimTy
317 literalType (MachChar _) = charPrimTy
318 literalType (MachStr _) = addrPrimTy
319 literalType (MachInt _) = intPrimTy
320 literalType (MachWord _) = wordPrimTy
321 literalType (MachInt64 _) = int64PrimTy
322 literalType (MachWord64 _) = word64PrimTy
323 literalType (MachFloat _) = floatPrimTy
324 literalType (MachDouble _) = doublePrimTy
325 literalType (MachLabel _ _) = addrPrimTy
332 cmpLit (MachChar a) (MachChar b) = a `compare` b
333 cmpLit (MachStr a) (MachStr b) = a `compare` b
334 cmpLit (MachNullAddr) (MachNullAddr) = EQ
335 cmpLit (MachInt a) (MachInt b) = a `compare` b
336 cmpLit (MachWord a) (MachWord b) = a `compare` b
337 cmpLit (MachInt64 a) (MachInt64 b) = a `compare` b
338 cmpLit (MachWord64 a) (MachWord64 b) = a `compare` b
339 cmpLit (MachFloat a) (MachFloat b) = a `compare` b
340 cmpLit (MachDouble a) (MachDouble b) = a `compare` b
341 cmpLit (MachLabel a _) (MachLabel b _) = a `compare` b
342 cmpLit lit1 lit2 | litTag lit1 <# litTag lit2 = LT
345 litTag (MachChar _) = _ILIT(1)
346 litTag (MachStr _) = _ILIT(2)
347 litTag (MachNullAddr) = _ILIT(3)
348 litTag (MachInt _) = _ILIT(4)
349 litTag (MachWord _) = _ILIT(5)
350 litTag (MachInt64 _) = _ILIT(6)
351 litTag (MachWord64 _) = _ILIT(7)
352 litTag (MachFloat _) = _ILIT(8)
353 litTag (MachDouble _) = _ILIT(9)
354 litTag (MachLabel _ _) = _ILIT(10)
359 * MachX (i.e. unboxed) things are printed unadornded (e.g. 3, 'a', "foo")
360 exceptions: MachFloat gets an initial keyword prefix.
363 pprLit (MachChar ch) = pprHsChar ch
364 pprLit (MachStr s) = pprHsString s
365 pprLit (MachInt i) = pprIntVal i
366 pprLit (MachInt64 i) = ptext SLIT("__int64") <+> integer i
367 pprLit (MachWord w) = ptext SLIT("__word") <+> integer w
368 pprLit (MachWord64 w) = ptext SLIT("__word64") <+> integer w
369 pprLit (MachFloat f) = ptext SLIT("__float") <+> rational f
370 pprLit (MachDouble d) = rational d
371 pprLit (MachNullAddr) = ptext SLIT("__NULL")
372 pprLit (MachLabel l mb) = ptext SLIT("__label") <+>
374 Nothing -> pprHsString l
375 Just x -> doubleQuotes (text (unpackFS l ++ '@':show x))
377 pprIntVal :: Integer -> SDoc
378 -- Print negative integers with parens to be sure it's unambiguous
379 pprIntVal i | i < 0 = parens (integer i)
380 | otherwise = integer i
384 %************************************************************************
388 %************************************************************************
390 Hash values should be zero or a positive integer. No negatives please.
391 (They mess up the UniqFM for some reason.)
394 hashLiteral :: Literal -> Int
395 hashLiteral (MachChar c) = ord c + 1000 -- Keep it out of range of common ints
396 hashLiteral (MachStr s) = hashFS s
397 hashLiteral (MachNullAddr) = 0
398 hashLiteral (MachInt i) = hashInteger i
399 hashLiteral (MachInt64 i) = hashInteger i
400 hashLiteral (MachWord i) = hashInteger i
401 hashLiteral (MachWord64 i) = hashInteger i
402 hashLiteral (MachFloat r) = hashRational r
403 hashLiteral (MachDouble r) = hashRational r
404 hashLiteral (MachLabel s _) = hashFS s
406 hashRational :: Rational -> Int
407 hashRational r = hashInteger (numerator r)
409 hashInteger :: Integer -> Int
410 hashInteger i = 1 + abs (fromInteger (i `rem` 10000))
411 -- The 1+ is to avoid zero, which is a Bad Number
412 -- since we use * to combine hash values
414 hashFS :: FastString -> Int
415 hashFS s = iBox (uniqueOfFS s)