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
13 , literalType, literalPrimRep
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
32 import PrimRep ( PrimRep(..) )
33 import TcType ( Type, tcCmpType )
34 import Type ( typePrimRep )
35 import PprType ( pprParendType )
36 import CStrings ( pprFSInCStyle )
42 import Util ( thenCmp )
44 import Ratio ( numerator )
45 import FastString ( uniqueOfFS, lengthFS )
46 import DATA_INT ( Int8, Int16, Int32 )
47 import DATA_WORD ( Word8, Word16, Word32 )
48 import Char ( ord, chr )
53 %************************************************************************
57 %************************************************************************
59 If we're compiling with GHC (and we're not cross-compiling), then we
60 know that minBound and maxBound :: Int are the right values for the
61 target architecture. Otherwise, we assume -2^31 and 2^31-1
62 respectively (which will be wrong on a 64-bit machine).
65 tARGET_MIN_INT, tARGET_MAX_INT, tARGET_MAX_WORD :: Integer
66 #if __GLASGOW_HASKELL__
67 tARGET_MIN_INT = toInteger (minBound :: Int)
68 tARGET_MAX_INT = toInteger (maxBound :: Int)
70 tARGET_MIN_INT = -2147483648
71 tARGET_MAX_INT = 2147483647
73 tARGET_MAX_WORD = (tARGET_MAX_INT * 2) + 1
75 tARGET_MAX_CHAR :: Int
76 tARGET_MAX_CHAR = 0x10ffff
80 %************************************************************************
84 %************************************************************************
86 So-called @Literals@ are {\em either}:
89 An unboxed (``machine'') literal (type: @IntPrim@, @FloatPrim@, etc.),
90 which is presumed to be surrounded by appropriate constructors
91 (@mKINT@, etc.), so that the overall thing makes sense.
93 An Integer, Rational, or String literal whose representation we are
94 {\em uncommitted} about; i.e., the surrounding with constructors,
95 function applications, etc., etc., has not yet been done.
101 -- First the primitive guys
102 MachChar Int -- Char# At least 31 bits
105 | MachNullAddr -- the NULL pointer, the only pointer value
106 -- that can be represented as a Literal.
108 | MachInt Integer -- Int# At least WORD_SIZE_IN_BITS bits
109 | MachInt64 Integer -- Int64# At least 64 bits
110 | MachWord Integer -- Word# At least WORD_SIZE_IN_BITS bits
111 | MachWord64 Integer -- Word64# At least 64 bits
114 | MachDouble Rational
116 -- MachLabel is used (only) for the literal derived from a
117 -- "foreign label" declaration.
118 -- string argument is the name of a symbol. This literal
119 -- refers to the *address* of the label.
120 | MachLabel FastString -- always an Addr#
121 (Maybe Int) -- the size (in bytes) of the arguments
122 -- the label expects. Only applicable with
124 -- Just x => "@<x>" will be appended to label
125 -- name when emitting asm.
131 instance Binary Literal where
132 put_ bh (MachChar aa) = do putByte bh 0; put_ bh aa
133 put_ bh (MachStr ab) = do putByte bh 1; put_ bh ab
134 put_ bh (MachNullAddr) = do putByte bh 2
135 put_ bh (MachInt ad) = do putByte bh 3; put_ bh ad
136 put_ bh (MachInt64 ae) = do putByte bh 4; put_ bh ae
137 put_ bh (MachWord af) = do putByte bh 5; put_ bh af
138 put_ bh (MachWord64 ag) = do putByte bh 6; put_ bh ag
139 put_ bh (MachFloat ah) = do putByte bh 7; put_ bh ah
140 put_ bh (MachDouble ai) = do putByte bh 8; put_ bh ai
141 put_ bh (MachLabel aj mb) = do putByte bh 9; put_ bh aj ; put_ bh mb
152 return (MachNullAddr)
158 return (MachInt64 ae)
164 return (MachWord64 ag)
167 return (MachFloat ah)
170 return (MachDouble ai)
174 return (MachLabel aj mb)
178 instance Outputable Literal where
181 instance Show Literal where
182 showsPrec p lit = showsPrecSDoc p (ppr lit)
184 instance Eq Literal where
185 a == b = case (a `compare` b) of { EQ -> True; _ -> False }
186 a /= b = case (a `compare` b) of { EQ -> False; _ -> True }
188 instance Ord Literal where
189 a <= b = case (a `compare` b) of { LT -> True; EQ -> True; GT -> False }
190 a < b = case (a `compare` b) of { LT -> True; EQ -> False; GT -> False }
191 a >= b = case (a `compare` b) of { LT -> False; EQ -> True; GT -> True }
192 a > b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True }
193 compare a b = cmpLit a b
200 mkMachInt, mkMachWord, mkMachInt64, mkMachWord64 :: Integer -> Literal
202 mkMachInt x = -- ASSERT2( inIntRange x, integer x )
203 -- Not true: you can write out of range Int# literals
204 -- For example, one can write (intToWord# 0xffff0000) to
205 -- get a particular Word bit-pattern, and there's no other
206 -- convenient way to write such literals, which is why we allow it.
208 mkMachWord x = -- ASSERT2( inWordRange x, integer x )
210 mkMachInt64 x = MachInt64 x
211 mkMachWord64 x = MachWord64 x
213 inIntRange, inWordRange :: Integer -> Bool
214 inIntRange x = x >= tARGET_MIN_INT && x <= tARGET_MAX_INT
215 inWordRange x = x >= 0 && x <= tARGET_MAX_WORD
217 inCharRange :: Int -> Bool
218 inCharRange c = c >= 0 && c <= tARGET_MAX_CHAR
220 isZeroLit :: Literal -> Bool
221 isZeroLit (MachInt 0) = True
222 isZeroLit (MachInt64 0) = True
223 isZeroLit (MachWord 0) = True
224 isZeroLit (MachWord64 0) = True
225 isZeroLit (MachFloat 0) = True
226 isZeroLit (MachDouble 0) = True
227 isZeroLit other = False
233 word2IntLit, int2WordLit,
234 narrow8IntLit, narrow16IntLit, narrow32IntLit,
235 narrow8WordLit, narrow16WordLit, narrow32WordLit,
236 char2IntLit, int2CharLit,
237 float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit,
238 float2DoubleLit, double2FloatLit
239 :: Literal -> Literal
241 word2IntLit (MachWord w)
242 | w > tARGET_MAX_INT = MachInt (w - tARGET_MAX_WORD - 1)
243 | otherwise = MachInt w
245 int2WordLit (MachInt i)
246 | i < 0 = MachWord (1 + tARGET_MAX_WORD + i) -- (-1) ---> tARGET_MAX_WORD
247 | otherwise = MachWord i
249 narrow8IntLit (MachInt i) = MachInt (toInteger (fromInteger i :: Int8))
250 narrow16IntLit (MachInt i) = MachInt (toInteger (fromInteger i :: Int16))
251 narrow32IntLit (MachInt i) = MachInt (toInteger (fromInteger i :: Int32))
252 narrow8WordLit (MachWord w) = MachWord (toInteger (fromInteger w :: Word8))
253 narrow16WordLit (MachWord w) = MachWord (toInteger (fromInteger w :: Word16))
254 narrow32WordLit (MachWord w) = MachWord (toInteger (fromInteger w :: Word32))
256 char2IntLit (MachChar c) = MachInt (toInteger c)
257 int2CharLit (MachInt i) = MachChar (fromInteger i)
259 float2IntLit (MachFloat f) = MachInt (truncate f)
260 int2FloatLit (MachInt i) = MachFloat (fromInteger i)
262 double2IntLit (MachDouble f) = MachInt (truncate f)
263 int2DoubleLit (MachInt i) = MachDouble (fromInteger i)
265 float2DoubleLit (MachFloat f) = MachDouble f
266 double2FloatLit (MachDouble d) = MachFloat d
268 nullAddrLit :: Literal
269 nullAddrLit = MachNullAddr
275 litIsTrivial :: Literal -> Bool
276 -- True if there is absolutely no penalty to duplicating the literal
277 -- c.f. CoreUtils.exprIsTrivial
278 -- False principally of strings
279 litIsTrivial (MachStr _) = False
280 litIsTrivial other = True
282 litIsDupable :: Literal -> Bool
283 -- True if code space does not go bad if we duplicate this literal
284 -- c.f. CoreUtils.exprIsDupable
285 -- Currently we treat it just like litIsTrivial
286 litIsDupable (MachStr _) = False
287 litIsDupable other = True
289 litSize :: Literal -> Int
290 -- Used by CoreUnfold.sizeExpr
291 litSize (MachStr str) = 1 + (lengthFS str `div` 4)
292 -- Every literal has size at least 1, otherwise
294 -- might be too small
301 literalType :: Literal -> Type
302 literalType (MachChar _) = charPrimTy
303 literalType (MachStr _) = addrPrimTy
304 literalType (MachNullAddr) = 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
315 literalPrimRep :: Literal -> PrimRep
317 literalPrimRep (MachChar _) = CharRep
318 literalPrimRep (MachStr _) = AddrRep -- specifically: "char *"
319 literalPrimRep (MachNullAddr) = AddrRep
320 literalPrimRep (MachInt _) = IntRep
321 literalPrimRep (MachWord _) = WordRep
322 literalPrimRep (MachInt64 _) = Int64Rep
323 literalPrimRep (MachWord64 _) = Word64Rep
324 literalPrimRep (MachFloat _) = FloatRep
325 literalPrimRep (MachDouble _) = DoubleRep
326 literalPrimRep (MachLabel _ _) = AddrRep
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 (MachChar _) = _ILIT(1)
347 litTag (MachStr _) = _ILIT(2)
348 litTag (MachNullAddr) = _ILIT(3)
349 litTag (MachInt _) = _ILIT(4)
350 litTag (MachWord _) = _ILIT(5)
351 litTag (MachInt64 _) = _ILIT(6)
352 litTag (MachWord64 _) = _ILIT(7)
353 litTag (MachFloat _) = _ILIT(8)
354 litTag (MachDouble _) = _ILIT(9)
355 litTag (MachLabel _ _) = _ILIT(10)
360 * MachX (i.e. unboxed) things are printed unadornded (e.g. 3, 'a', "foo")
361 exceptions: MachFloat gets an initial keyword prefix.
365 = getPprStyle $ \ sty ->
367 code_style = codeStyle sty
370 MachChar ch | code_style -> hcat [ptext SLIT("(C_)"), text (show ch)]
371 | otherwise -> pprHsChar ch
373 MachStr s | code_style -> pprFSInCStyle s
374 | otherwise -> pprHsString s
375 -- Warning: printing MachStr in code_style assumes it contains
376 -- only characters '\0'..'\xFF'!
378 MachInt i | code_style && i == tARGET_MIN_INT -> parens (integer (i+1) <> text "-1")
379 -- Avoid a problem whereby gcc interprets
380 -- the constant minInt as unsigned.
381 | otherwise -> pprIntVal i
383 MachInt64 i | code_style -> pprIntVal i -- Same problem with gcc???
384 | otherwise -> ptext SLIT("__int64") <+> integer i
386 MachWord w | code_style -> pprHexVal w
387 | otherwise -> ptext SLIT("__word") <+> integer w
389 MachWord64 w | code_style -> pprHexVal w
390 | otherwise -> ptext SLIT("__word64") <+> integer w
392 MachFloat f | code_style -> ptext SLIT("(StgFloat)") <> code_rational f
393 | otherwise -> ptext SLIT("__float") <+> rational f
395 MachDouble d | code_style -> code_rational d
396 | otherwise -> rational d
398 MachNullAddr | code_style -> ptext SLIT("(void*)0")
399 | otherwise -> ptext SLIT("__NULL")
402 | code_style -> ptext SLIT("(&") <> ftext l <> char ')'
403 | otherwise -> ptext SLIT("__label") <+>
405 Nothing -> pprHsString l
406 Just x -> doubleQuotes (text (unpackFS l ++ '@':show x))
408 -- negative floating literals in code style need parentheses to avoid
409 -- interacting with surrounding syntax.
410 code_rational d | d < 0 = parens (rational d)
411 | otherwise = rational d
413 pprIntVal :: Integer -> SDoc
414 -- Print negative integers with parens to be sure it's unambiguous
415 pprIntVal i | i < 0 = parens (integer i)
416 | otherwise = integer i
418 pprHexVal :: Integer -> SDoc
419 -- Print in C hex format: 0x13fa
420 pprHexVal 0 = ptext SLIT("0x0")
421 pprHexVal w = ptext SLIT("0x") <> go w
424 go w = go quot <> dig
426 (quot,rem) = w `quotRem` 16
427 dig | rem < 10 = char (chr (fromInteger rem + ord '0'))
428 | otherwise = char (chr (fromInteger rem - 10 + ord 'a'))
432 %************************************************************************
436 %************************************************************************
438 Hash values should be zero or a positive integer. No negatives please.
439 (They mess up the UniqFM for some reason.)
442 hashLiteral :: Literal -> Int
443 hashLiteral (MachChar c) = c + 1000 -- Keep it out of range of common ints
444 hashLiteral (MachStr s) = hashFS s
445 hashLiteral (MachNullAddr) = 0
446 hashLiteral (MachInt i) = hashInteger i
447 hashLiteral (MachInt64 i) = hashInteger i
448 hashLiteral (MachWord i) = hashInteger i
449 hashLiteral (MachWord64 i) = hashInteger i
450 hashLiteral (MachFloat r) = hashRational r
451 hashLiteral (MachDouble r) = hashRational r
452 hashLiteral (MachLabel s _) = hashFS s
454 hashRational :: Rational -> Int
455 hashRational r = hashInteger (numerator r)
457 hashInteger :: Integer -> Int
458 hashInteger i = 1 + abs (fromInteger (i `rem` 10000))
459 -- The 1+ is to avoid zero, which is a Bad Number
460 -- since we use * to combine hash values
462 hashFS :: FastString -> Int
463 hashFS s = iBox (uniqueOfFS s)