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)}
8 {-# OPTIONS -fno-warn-incomplete-patterns #-}
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
50 %************************************************************************
54 %************************************************************************
56 If we're compiling with GHC (and we're not cross-compiling), then we
57 know that minBound and maxBound :: Int are the right values for the
58 target architecture. Otherwise, we assume -2^31 and 2^31-1
59 respectively (which will be wrong on a 64-bit machine).
62 tARGET_MIN_INT, tARGET_MAX_INT, tARGET_MAX_WORD :: Integer
63 #ifdef __GLASGOW_HASKELL__
64 tARGET_MIN_INT = toInteger (minBound :: Int)
65 tARGET_MAX_INT = toInteger (maxBound :: Int)
67 tARGET_MIN_INT = -2147483648
68 tARGET_MAX_INT = 2147483647
70 tARGET_MAX_WORD = (tARGET_MAX_INT * 2) + 1
72 tARGET_MAX_CHAR :: Int
73 tARGET_MAX_CHAR = 0x10ffff
77 %************************************************************************
81 %************************************************************************
83 So-called @Literals@ are {\em either}:
86 An unboxed (``machine'') literal (type: @IntPrim@, @FloatPrim@, etc.),
87 which is presumed to be surrounded by appropriate constructors
88 (@mKINT@, etc.), so that the overall thing makes sense.
90 An Integer, Rational, or String literal whose representation we are
91 {\em uncommitted} about; i.e., the surrounding with constructors,
92 function applications, etc., etc., has not yet been done.
98 -- First the primitive guys
99 MachChar Char -- Char# At least 31 bits
101 | MachStr FastString -- A string-literal: stored and emitted
102 -- UTF-8 encoded, we'll arrange to decode it
103 -- at runtime. Also emitted with a '\0'
106 | MachNullAddr -- the NULL pointer, the only pointer value
107 -- that can be represented as a Literal.
109 | MachInt Integer -- Int# At least WORD_SIZE_IN_BITS bits
110 | MachInt64 Integer -- Int64# At least 64 bits
111 | MachWord Integer -- Word# At least WORD_SIZE_IN_BITS bits
112 | MachWord64 Integer -- Word64# At least 64 bits
115 | MachDouble Rational
117 -- MachLabel is used (only) for the literal derived from a
118 -- "foreign label" declaration.
119 -- string argument is the name of a symbol. This literal
120 -- refers to the *address* of the label.
121 | MachLabel FastString -- always an Addr#
122 (Maybe Int) -- the size (in bytes) of the arguments
123 -- the label expects. Only applicable with
125 -- Just x => "@<x>" will be appended to label
126 -- name when emitting asm.
132 instance Binary Literal where
133 put_ bh (MachChar aa) = do putByte bh 0; put_ bh aa
134 put_ bh (MachStr ab) = do putByte bh 1; put_ bh ab
135 put_ bh (MachNullAddr) = do putByte bh 2
136 put_ bh (MachInt ad) = do putByte bh 3; put_ bh ad
137 put_ bh (MachInt64 ae) = do putByte bh 4; put_ bh ae
138 put_ bh (MachWord af) = do putByte bh 5; put_ bh af
139 put_ bh (MachWord64 ag) = do putByte bh 6; put_ bh ag
140 put_ bh (MachFloat ah) = do putByte bh 7; put_ bh ah
141 put_ bh (MachDouble ai) = do putByte bh 8; put_ bh ai
142 put_ bh (MachLabel aj mb) = do putByte bh 9; put_ bh aj ; put_ bh mb
153 return (MachNullAddr)
159 return (MachInt64 ae)
165 return (MachWord64 ag)
168 return (MachFloat ah)
171 return (MachDouble ai)
175 return (MachLabel aj mb)
179 instance Outputable Literal where
182 instance Show Literal where
183 showsPrec p lit = showsPrecSDoc p (ppr lit)
185 instance Eq Literal where
186 a == b = case (a `compare` b) of { EQ -> True; _ -> False }
187 a /= b = case (a `compare` b) of { EQ -> False; _ -> True }
189 instance Ord Literal where
190 a <= b = case (a `compare` b) of { LT -> True; EQ -> True; GT -> False }
191 a < b = case (a `compare` b) of { LT -> True; EQ -> False; GT -> False }
192 a >= b = case (a `compare` b) of { LT -> False; EQ -> True; GT -> True }
193 a > b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True }
194 compare a b = cmpLit a b
201 mkMachInt, mkMachWord, mkMachInt64, mkMachWord64 :: Integer -> Literal
203 mkMachInt x = -- ASSERT2( inIntRange x, integer x )
204 -- Not true: you can write out of range Int# literals
205 -- For example, one can write (intToWord# 0xffff0000) to
206 -- get a particular Word bit-pattern, and there's no other
207 -- convenient way to write such literals, which is why we allow it.
209 mkMachWord x = -- ASSERT2( inWordRange x, integer x )
211 mkMachInt64 x = MachInt64 x
212 mkMachWord64 x = MachWord64 x
214 mkStringLit :: String -> Literal
215 mkStringLit s = MachStr (mkFastString s) -- stored UTF-8 encoded
217 inIntRange, inWordRange :: Integer -> Bool
218 inIntRange x = x >= tARGET_MIN_INT && x <= tARGET_MAX_INT
219 inWordRange x = x >= 0 && x <= tARGET_MAX_WORD
221 inCharRange :: Char -> Bool
222 inCharRange c = c >= '\0' && c <= chr tARGET_MAX_CHAR
224 isZeroLit :: Literal -> Bool
225 isZeroLit (MachInt 0) = True
226 isZeroLit (MachInt64 0) = True
227 isZeroLit (MachWord 0) = True
228 isZeroLit (MachWord64 0) = True
229 isZeroLit (MachFloat 0) = True
230 isZeroLit (MachDouble 0) = True
237 word2IntLit, int2WordLit,
238 narrow8IntLit, narrow16IntLit, narrow32IntLit,
239 narrow8WordLit, narrow16WordLit, narrow32WordLit,
240 char2IntLit, int2CharLit,
241 float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit,
242 float2DoubleLit, double2FloatLit
243 :: Literal -> Literal
245 word2IntLit (MachWord w)
246 | w > tARGET_MAX_INT = MachInt (w - tARGET_MAX_WORD - 1)
247 | otherwise = MachInt w
249 int2WordLit (MachInt i)
250 | i < 0 = MachWord (1 + tARGET_MAX_WORD + i) -- (-1) ---> tARGET_MAX_WORD
251 | otherwise = MachWord i
253 narrow8IntLit (MachInt i) = MachInt (toInteger (fromInteger i :: Int8))
254 narrow16IntLit (MachInt i) = MachInt (toInteger (fromInteger i :: Int16))
255 narrow32IntLit (MachInt i) = MachInt (toInteger (fromInteger i :: Int32))
256 narrow8WordLit (MachWord w) = MachWord (toInteger (fromInteger w :: Word8))
257 narrow16WordLit (MachWord w) = MachWord (toInteger (fromInteger w :: Word16))
258 narrow32WordLit (MachWord w) = MachWord (toInteger (fromInteger w :: Word32))
260 char2IntLit (MachChar c) = MachInt (toInteger (ord c))
261 int2CharLit (MachInt i) = MachChar (chr (fromInteger i))
263 float2IntLit (MachFloat f) = MachInt (truncate f)
264 int2FloatLit (MachInt i) = MachFloat (fromInteger i)
266 double2IntLit (MachDouble f) = MachInt (truncate f)
267 int2DoubleLit (MachInt i) = MachDouble (fromInteger i)
269 float2DoubleLit (MachFloat f) = MachDouble f
270 double2FloatLit (MachDouble d) = MachFloat d
272 nullAddrLit :: Literal
273 nullAddrLit = MachNullAddr
279 litIsTrivial :: Literal -> Bool
280 -- True if there is absolutely no penalty to duplicating the literal
281 -- c.f. CoreUtils.exprIsTrivial
282 -- False principally of strings
283 litIsTrivial (MachStr _) = False
284 litIsTrivial _ = True
286 litIsDupable :: Literal -> Bool
287 -- True if code space does not go bad if we duplicate this literal
288 -- c.f. CoreUtils.exprIsDupable
289 -- Currently we treat it just like litIsTrivial
290 litIsDupable (MachStr _) = False
291 litIsDupable _ = True
293 litFitsInChar :: Literal -> Bool
294 litFitsInChar (MachInt i)
295 = fromInteger i <= ord minBound
296 && fromInteger i >= ord maxBound
297 litFitsInChar _ = False
299 litSize :: Literal -> Int
300 -- Used by CoreUnfold.sizeExpr
301 litSize (MachStr str) = 1 + ((lengthFS str + 3) `div` 4)
302 -- Every literal has size at least 1, otherwise
304 -- might be too small
305 -- [Sept03: make literal strings a bit bigger to avoid fruitless
306 -- duplication of little strings]
313 literalType :: Literal -> Type
314 literalType MachNullAddr = addrPrimTy
315 literalType (MachChar _) = charPrimTy
316 literalType (MachStr _) = addrPrimTy
317 literalType (MachInt _) = intPrimTy
318 literalType (MachWord _) = wordPrimTy
319 literalType (MachInt64 _) = int64PrimTy
320 literalType (MachWord64 _) = word64PrimTy
321 literalType (MachFloat _) = floatPrimTy
322 literalType (MachDouble _) = doublePrimTy
323 literalType (MachLabel _ _) = addrPrimTy
330 cmpLit :: Literal -> Literal -> Ordering
331 cmpLit (MachChar a) (MachChar b) = a `compare` b
332 cmpLit (MachStr a) (MachStr b) = a `compare` b
333 cmpLit (MachNullAddr) (MachNullAddr) = EQ
334 cmpLit (MachInt a) (MachInt b) = a `compare` b
335 cmpLit (MachWord a) (MachWord b) = a `compare` b
336 cmpLit (MachInt64 a) (MachInt64 b) = a `compare` b
337 cmpLit (MachWord64 a) (MachWord64 b) = a `compare` b
338 cmpLit (MachFloat a) (MachFloat b) = a `compare` b
339 cmpLit (MachDouble a) (MachDouble b) = a `compare` b
340 cmpLit (MachLabel a _) (MachLabel b _) = a `compare` b
341 cmpLit lit1 lit2 | litTag lit1 <# litTag lit2 = LT
344 litTag :: Literal -> FastInt
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 :: Literal -> SDoc
364 pprLit (MachChar ch) = pprHsChar ch
365 pprLit (MachStr s) = pprHsString s
366 pprLit (MachInt i) = pprIntVal i
367 pprLit (MachInt64 i) = ptext (sLit "__int64") <+> integer i
368 pprLit (MachWord w) = ptext (sLit "__word") <+> integer w
369 pprLit (MachWord64 w) = ptext (sLit "__word64") <+> integer w
370 pprLit (MachFloat f) = ptext (sLit "__float") <+> rational f
371 pprLit (MachDouble d) = rational d
372 pprLit (MachNullAddr) = ptext (sLit "__NULL")
373 pprLit (MachLabel l mb) = ptext (sLit "__label") <+>
375 Nothing -> pprHsString l
376 Just x -> doubleQuotes (text (unpackFS l ++ '@':show x))
378 pprIntVal :: Integer -> SDoc
379 -- Print negative integers with parens to be sure it's unambiguous
380 pprIntVal i | i < 0 = parens (integer i)
381 | otherwise = integer i
385 %************************************************************************
389 %************************************************************************
391 Hash values should be zero or a positive integer. No negatives please.
392 (They mess up the UniqFM for some reason.)
395 hashLiteral :: Literal -> Int
396 hashLiteral (MachChar c) = ord c + 1000 -- Keep it out of range of common ints
397 hashLiteral (MachStr s) = hashFS s
398 hashLiteral (MachNullAddr) = 0
399 hashLiteral (MachInt i) = hashInteger i
400 hashLiteral (MachInt64 i) = hashInteger i
401 hashLiteral (MachWord i) = hashInteger i
402 hashLiteral (MachWord64 i) = hashInteger i
403 hashLiteral (MachFloat r) = hashRational r
404 hashLiteral (MachDouble r) = hashRational r
405 hashLiteral (MachLabel s _) = hashFS s
407 hashRational :: Rational -> Int
408 hashRational r = hashInteger (numerator r)
410 hashInteger :: Integer -> Int
411 hashInteger i = 1 + abs (fromInteger (i `rem` 10000))
412 -- The 1+ is to avoid zero, which is a Bad Number
413 -- since we use * to combine hash values
415 hashFS :: FastString -> Int
416 hashFS s = iBox (uniqueOfFS s)