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
18 Literal(..) -- Exported to ParseIface
20 -- ** Creating Literals
21 , mkMachInt, mkMachWord
22 , mkMachInt64, mkMachWord64
23 , mkMachFloat, mkMachDouble
24 , mkMachChar, mkMachString
26 -- ** Operations on Literals
30 -- ** Predicates on Literals and their contents
31 , litIsDupable, litIsTrivial
32 , inIntRange, inWordRange, tARGET_MAX_INT, inCharRange
37 , word2IntLit, int2WordLit
38 , narrow8IntLit, narrow16IntLit, narrow32IntLit
39 , narrow8WordLit, narrow16WordLit, narrow32WordLit
40 , char2IntLit, int2CharLit
41 , float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit
42 , nullAddrLit, float2DoubleLit, double2FloatLit
61 %************************************************************************
65 %************************************************************************
68 -- | So-called 'Literal's are one of:
70 -- * An unboxed (/machine/) literal ('MachInt', 'MachFloat', etc.),
71 -- which is presumed to be surrounded by appropriate constructors
72 -- (@Int#@, etc.), so that the overall thing makes sense.
74 -- * The literal derived from the label mentioned in a \"foreign label\"
75 -- declaration ('MachLabel')
78 -- First the primitive guys
79 MachChar Char -- ^ @Char#@ - at least 31 bits. Create with 'mkMachChar'
81 | MachStr FastString -- ^ A string-literal: stored and emitted
82 -- UTF-8 encoded, we'll arrange to decode it
83 -- at runtime. Also emitted with a @'\0'@
84 -- terminator. Create with 'mkMachString'
86 | MachNullAddr -- ^ The @NULL@ pointer, the only pointer value
87 -- that can be represented as a Literal. Create
90 | MachInt Integer -- ^ @Int#@ - at least @WORD_SIZE_IN_BITS@ bits. Create with 'mkMachInt'
91 | MachInt64 Integer -- ^ @Int64#@ - at least 64 bits. Create with 'mkMachInt64'
92 | MachWord Integer -- ^ @Word#@ - at least @WORD_SIZE_IN_BITS@ bits. Create with 'mkMachWord'
93 | MachWord64 Integer -- ^ @Word64#@ - at least 64 bits. Create with 'mkMachWord64'
95 | MachFloat Rational -- ^ @Float#@. Create with 'mkMachFloat'
96 | MachDouble Rational -- ^ @Double#@. Create with 'mkMachDouble'
98 | MachLabel FastString
101 -- ^ A label literal. Parameters:
103 -- 1) The name of the symbol mentioned in the declaration
105 -- 2) The size (in bytes) of the arguments
106 -- the label expects. Only applicable with
107 -- @stdcall@ labels. @Just x@ => @\<x\>@ will
108 -- be appended to label name when emitting assembly.
114 instance Binary Literal where
115 put_ bh (MachChar aa) = do putByte bh 0; put_ bh aa
116 put_ bh (MachStr ab) = do putByte bh 1; put_ bh ab
117 put_ bh (MachNullAddr) = do putByte bh 2
118 put_ bh (MachInt ad) = do putByte bh 3; put_ bh ad
119 put_ bh (MachInt64 ae) = do putByte bh 4; put_ bh ae
120 put_ bh (MachWord af) = do putByte bh 5; put_ bh af
121 put_ bh (MachWord64 ag) = do putByte bh 6; put_ bh ag
122 put_ bh (MachFloat ah) = do putByte bh 7; put_ bh ah
123 put_ bh (MachDouble ai) = do putByte bh 8; put_ bh ai
124 put_ bh (MachLabel aj mb fod)
139 return (MachNullAddr)
145 return (MachInt64 ae)
151 return (MachWord64 ag)
154 return (MachFloat ah)
157 return (MachDouble ai)
162 return (MachLabel aj mb fod)
166 instance Outputable Literal where
169 instance Show Literal where
170 showsPrec p lit = showsPrecSDoc p (ppr lit)
172 instance Eq Literal where
173 a == b = case (a `compare` b) of { EQ -> True; _ -> False }
174 a /= b = case (a `compare` b) of { EQ -> False; _ -> True }
176 instance Ord Literal where
177 a <= b = case (a `compare` b) of { LT -> True; EQ -> True; GT -> False }
178 a < b = case (a `compare` b) of { LT -> True; EQ -> False; GT -> False }
179 a >= b = case (a `compare` b) of { LT -> False; EQ -> True; GT -> True }
180 a > b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True }
181 compare a b = cmpLit a b
188 -- | Creates a 'Literal' of type @Int#@
189 mkMachInt :: Integer -> Literal
190 mkMachInt x = -- ASSERT2( inIntRange x, integer x )
191 -- Not true: you can write out of range Int# literals
192 -- For example, one can write (intToWord# 0xffff0000) to
193 -- get a particular Word bit-pattern, and there's no other
194 -- convenient way to write such literals, which is why we allow it.
197 -- | Creates a 'Literal' of type @Word#@
198 mkMachWord :: Integer -> Literal
199 mkMachWord x = -- ASSERT2( inWordRange x, integer x )
202 -- | Creates a 'Literal' of type @Int64#@
203 mkMachInt64 :: Integer -> Literal
204 mkMachInt64 x = MachInt64 x
206 -- | Creates a 'Literal' of type @Word64#@
207 mkMachWord64 :: Integer -> Literal
208 mkMachWord64 x = MachWord64 x
210 -- | Creates a 'Literal' of type @Float#@
211 mkMachFloat :: Rational -> Literal
212 mkMachFloat = MachFloat
214 -- | Creates a 'Literal' of type @Double#@
215 mkMachDouble :: Rational -> Literal
216 mkMachDouble = MachDouble
218 -- | Creates a 'Literal' of type @Char#@
219 mkMachChar :: Char -> Literal
220 mkMachChar = MachChar
222 -- | Creates a 'Literal' of type @Addr#@, which is appropriate for passing to
223 -- e.g. some of the \"error\" functions in GHC.Err such as @GHC.Err.runtimeError@
224 mkMachString :: String -> Literal
225 mkMachString s = MachStr (mkFastString s) -- stored UTF-8 encoded
227 inIntRange, inWordRange :: Integer -> Bool
228 inIntRange x = x >= tARGET_MIN_INT && x <= tARGET_MAX_INT
229 inWordRange x = x >= 0 && x <= tARGET_MAX_WORD
231 inCharRange :: Char -> Bool
232 inCharRange c = c >= '\0' && c <= chr tARGET_MAX_CHAR
234 -- | Tests whether the literal represents a zero of whatever type it is
235 isZeroLit :: Literal -> Bool
236 isZeroLit (MachInt 0) = True
237 isZeroLit (MachInt64 0) = True
238 isZeroLit (MachWord 0) = True
239 isZeroLit (MachWord64 0) = True
240 isZeroLit (MachFloat 0) = True
241 isZeroLit (MachDouble 0) = True
248 word2IntLit, int2WordLit,
249 narrow8IntLit, narrow16IntLit, narrow32IntLit,
250 narrow8WordLit, narrow16WordLit, narrow32WordLit,
251 char2IntLit, int2CharLit,
252 float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit,
253 float2DoubleLit, double2FloatLit
254 :: Literal -> Literal
256 word2IntLit (MachWord w)
257 | w > tARGET_MAX_INT = MachInt (w - tARGET_MAX_WORD - 1)
258 | otherwise = MachInt w
260 int2WordLit (MachInt i)
261 | i < 0 = MachWord (1 + tARGET_MAX_WORD + i) -- (-1) ---> tARGET_MAX_WORD
262 | otherwise = MachWord i
264 narrow8IntLit (MachInt i) = MachInt (toInteger (fromInteger i :: Int8))
265 narrow16IntLit (MachInt i) = MachInt (toInteger (fromInteger i :: Int16))
266 narrow32IntLit (MachInt i) = MachInt (toInteger (fromInteger i :: Int32))
267 narrow8WordLit (MachWord w) = MachWord (toInteger (fromInteger w :: Word8))
268 narrow16WordLit (MachWord w) = MachWord (toInteger (fromInteger w :: Word16))
269 narrow32WordLit (MachWord w) = MachWord (toInteger (fromInteger w :: Word32))
271 char2IntLit (MachChar c) = MachInt (toInteger (ord c))
272 int2CharLit (MachInt i) = MachChar (chr (fromInteger i))
274 float2IntLit (MachFloat f) = MachInt (truncate f)
275 int2FloatLit (MachInt i) = MachFloat (fromInteger i)
277 double2IntLit (MachDouble f) = MachInt (truncate f)
278 int2DoubleLit (MachInt i) = MachDouble (fromInteger i)
280 float2DoubleLit (MachFloat f) = MachDouble f
281 double2FloatLit (MachDouble d) = MachFloat d
283 nullAddrLit :: Literal
284 nullAddrLit = MachNullAddr
290 -- | True if there is absolutely no penalty to duplicating the literal.
291 -- False principally of strings
292 litIsTrivial :: Literal -> Bool
293 -- c.f. CoreUtils.exprIsTrivial
294 litIsTrivial (MachStr _) = False
295 litIsTrivial _ = True
297 -- | True if code space does not go bad if we duplicate this literal
298 -- Currently we treat it just like 'litIsTrivial'
299 litIsDupable :: Literal -> Bool
300 -- c.f. CoreUtils.exprIsDupable
301 litIsDupable (MachStr _) = False
302 litIsDupable _ = True
304 litFitsInChar :: Literal -> Bool
305 litFitsInChar (MachInt i)
306 = fromInteger i <= ord minBound
307 && fromInteger i >= ord maxBound
308 litFitsInChar _ = False
314 -- | Find the Haskell 'Type' the literal occupies
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 :: Literal -> Literal -> Ordering
333 cmpLit (MachChar a) (MachChar b) = a `compare` b
334 cmpLit (MachStr a) (MachStr b) = a `compare` b
335 cmpLit (MachNullAddr) (MachNullAddr) = EQ
336 cmpLit (MachInt a) (MachInt b) = a `compare` b
337 cmpLit (MachWord a) (MachWord b) = a `compare` b
338 cmpLit (MachInt64 a) (MachInt64 b) = a `compare` b
339 cmpLit (MachWord64 a) (MachWord64 b) = a `compare` b
340 cmpLit (MachFloat a) (MachFloat b) = a `compare` b
341 cmpLit (MachDouble a) (MachDouble b) = a `compare` b
342 cmpLit (MachLabel a _ _) (MachLabel b _ _) = a `compare` b
343 cmpLit lit1 lit2 | litTag lit1 <# litTag lit2 = LT
346 litTag :: Literal -> FastInt
347 litTag (MachChar _) = _ILIT(1)
348 litTag (MachStr _) = _ILIT(2)
349 litTag (MachNullAddr) = _ILIT(3)
350 litTag (MachInt _) = _ILIT(4)
351 litTag (MachWord _) = _ILIT(5)
352 litTag (MachInt64 _) = _ILIT(6)
353 litTag (MachWord64 _) = _ILIT(7)
354 litTag (MachFloat _) = _ILIT(8)
355 litTag (MachDouble _) = _ILIT(9)
356 litTag (MachLabel _ _ _) = _ILIT(10)
361 * MachX (i.e. unboxed) things are printed unadornded (e.g. 3, 'a', "foo")
362 exceptions: MachFloat gets an initial keyword prefix.
365 pprLit :: Literal -> SDoc
366 pprLit (MachChar ch) = pprHsChar ch
367 pprLit (MachStr s) = pprHsString s
368 pprLit (MachInt i) = pprIntVal i
369 pprLit (MachInt64 i) = ptext (sLit "__int64") <+> integer i
370 pprLit (MachWord w) = ptext (sLit "__word") <+> integer w
371 pprLit (MachWord64 w) = ptext (sLit "__word64") <+> integer w
372 pprLit (MachFloat f) = ptext (sLit "__float") <+> rational f
373 pprLit (MachDouble d) = rational d
374 pprLit (MachNullAddr) = ptext (sLit "__NULL")
375 pprLit (MachLabel l mb fod) = ptext (sLit "__label") <+> b <+> ppr fod
377 Nothing -> pprHsString l
378 Just x -> doubleQuotes (text (unpackFS l ++ '@':show x))
380 pprIntVal :: Integer -> SDoc
381 -- ^ Print negative integers with parens to be sure it's unambiguous
382 pprIntVal i | i < 0 = parens (integer i)
383 | otherwise = integer i
387 %************************************************************************
391 %************************************************************************
393 Hash values should be zero or a positive integer. No negatives please.
394 (They mess up the UniqFM for some reason.)
397 hashLiteral :: Literal -> Int
398 hashLiteral (MachChar c) = ord c + 1000 -- Keep it out of range of common ints
399 hashLiteral (MachStr s) = hashFS s
400 hashLiteral (MachNullAddr) = 0
401 hashLiteral (MachInt i) = hashInteger i
402 hashLiteral (MachInt64 i) = hashInteger i
403 hashLiteral (MachWord i) = hashInteger i
404 hashLiteral (MachWord64 i) = hashInteger i
405 hashLiteral (MachFloat r) = hashRational r
406 hashLiteral (MachDouble r) = hashRational r
407 hashLiteral (MachLabel s _ _) = hashFS s
409 hashRational :: Rational -> Int
410 hashRational r = hashInteger (numerator r)
412 hashInteger :: Integer -> Int
413 hashInteger i = 1 + abs (fromInteger (i `rem` 10000))
414 -- The 1+ is to avoid zero, which is a Bad Number
415 -- since we use * to combine hash values
417 hashFS :: FastString -> Int
418 hashFS s = iBox (uniqueOfFS s)