compiler/basicTypes/Literal.lhs

   1 %
   2 % (c) The University of Glasgow 2006
   3 % (c) The GRASP/AQUA Project, Glasgow University, 1998
   4 %
   5 \section[Literal]{@Literal@: Machine literals (unboxed, of course)}
   6
   7 \begin{code}
   8 module Literal
   9         ( Literal(..)           -- Exported to ParseIface
  10         , mkMachInt, mkMachWord
  11         , mkMachInt64, mkMachWord64, mkStringLit
  12         , litSize
  13         , litIsDupable, litIsTrivial
  14         , literalType
  15         , hashLiteral
  16
  17         , inIntRange, inWordRange, tARGET_MAX_INT, inCharRange
  18         , isZeroLit
  19
  20         , word2IntLit, int2WordLit
  21         , narrow8IntLit, narrow16IntLit, narrow32IntLit
  22         , narrow8WordLit, narrow16WordLit, narrow32WordLit
  23         , char2IntLit, int2CharLit
  24         , float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit
  25         , nullAddrLit, float2DoubleLit, double2FloatLit
  26         ) where
  27
  28 #include "HsVersions.h"
  29
  30 import TysPrim
  31 import Type
  32 import Outputable
  33 import FastTypes
  34 import FastString
  35 import Binary
  36 import Ratio
  37
  38 import Data.Int
  39 import Data.Word
  40 import Data.Char
  41 \end{code}
  42
  43
  44 %************************************************************************
  45 %*                                                                      *
  46 \subsection{Sizes}
  47 %*                                                                      *
  48 %************************************************************************
  49
  50 If we're compiling with GHC (and we're not cross-compiling), then we
  51 know that minBound and maxBound :: Int are the right values for the
  52 target architecture.  Otherwise, we assume -2^31 and 2^31-1
  53 respectively (which will be wrong on a 64-bit machine).
  54
  55 \begin{code}
  56 tARGET_MIN_INT, tARGET_MAX_INT, tARGET_MAX_WORD :: Integer
  57 #if __GLASGOW_HASKELL__
  58 tARGET_MIN_INT  = toInteger (minBound :: Int)
  59 tARGET_MAX_INT  = toInteger (maxBound :: Int)
  60 #else
  61 tARGET_MIN_INT = -2147483648
  62 tARGET_MAX_INT =  2147483647
  63 #endif
  64 tARGET_MAX_WORD = (tARGET_MAX_INT * 2) + 1
  65
  66 tARGET_MAX_CHAR :: Int
  67 tARGET_MAX_CHAR = 0x10ffff
  68 \end{code}
  69
  70
  71 %************************************************************************
  72 %*                                                                      *
  73 \subsection{Literals}
  74 %*                                                                      *
  75 %************************************************************************
  76
  77 So-called @Literals@ are {\em either}:
  78 \begin{itemize}
  79 \item
  80 An unboxed (``machine'') literal (type: @IntPrim@, @FloatPrim@, etc.),
  81 which is presumed to be surrounded by appropriate constructors
  82 (@mKINT@, etc.), so that the overall thing makes sense.
  83 \item
  84 An Integer, Rational, or String literal whose representation we are
  85 {\em uncommitted} about; i.e., the surrounding with constructors,
  86 function applications, etc., etc., has not yet been done.
  87 \end{itemize}
  88
  89 \begin{code}
  90 data Literal
  91   =     ------------------
  92         -- First the primitive guys
  93     MachChar    Char             -- Char#        At least 31 bits
  94
  95   | MachStr     FastString      -- A string-literal: stored and emitted
  96                                 -- UTF-8 encoded, we'll arrange to decode it
  97                                 -- at runtime.  Also emitted with a '\0'
  98                                 -- terminator.
  99
 100   | MachNullAddr                -- the NULL pointer, the only pointer value
 101                                 -- that can be represented as a Literal.
 102
 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
 107
 108   | MachFloat   Rational
 109   | MachDouble  Rational
 110
 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
 118                                         -- 'stdcall' labels.
 119                                         -- Just x => "@<x>" will be appended to label
 120                                         --           name when emitting asm.
 121 \end{code}
 122
 123 Binary instance
 124
 125 \begin{code}
 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
 137     get bh = do
 138             h <- getByte bh
 139             case h of
 140               0 -> do
 141                     aa <- get bh
 142                     return (MachChar aa)
 143               1 -> do
 144                     ab <- get bh
 145                     return (MachStr ab)
 146               2 -> do
 147                     return (MachNullAddr)
 148               3 -> do
 149                     ad <- get bh
 150                     return (MachInt ad)
 151               4 -> do
 152                     ae <- get bh
 153                     return (MachInt64 ae)
 154               5 -> do
 155                     af <- get bh
 156                     return (MachWord af)
 157               6 -> do
 158                     ag <- get bh
 159                     return (MachWord64 ag)
 160               7 -> do
 161                     ah <- get bh
 162                     return (MachFloat ah)
 163               8 -> do
 164                     ai <- get bh
 165                     return (MachDouble ai)
 166               9 -> do
 167                     aj <- get bh
 168                     mb <- get bh
 169                     return (MachLabel aj mb)
 170 \end{code}
 171
 172 \begin{code}
 173 instance Outputable Literal where
 174     ppr lit = pprLit lit
 175
 176 instance Show Literal where
 177     showsPrec p lit = showsPrecSDoc p (ppr lit)
 178
 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  }
 182
 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
 189 \end{code}
 190
 191
 192         Construction
 193         ~~~~~~~~~~~~
 194 \begin{code}
 195 mkMachInt, mkMachWord, mkMachInt64, mkMachWord64 :: Integer -> Literal
 196
 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.
 202                  MachInt x
 203 mkMachWord x   = -- ASSERT2( inWordRange x, integer x )
 204                  MachWord x
 205 mkMachInt64  x = MachInt64 x
 206 mkMachWord64 x = MachWord64 x
 207
 208 mkStringLit :: String -> Literal
 209 mkStringLit s = MachStr (mkFastString s) -- stored UTF-8 encoded
 210
 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
 214
 215 inCharRange :: Char -> Bool
 216 inCharRange c =  c >= '\0' && c <= chr tARGET_MAX_CHAR
 217
 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
 226 \end{code}
 227
 228         Coercions
 229         ~~~~~~~~~
 230 \begin{code}
 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
 238
 239 word2IntLit (MachWord w)
 240   | w > tARGET_MAX_INT = MachInt (w - tARGET_MAX_WORD - 1)
 241   | otherwise          = MachInt w
 242
 243 int2WordLit (MachInt i)
 244   | i < 0     = MachWord (1 + tARGET_MAX_WORD + i)      -- (-1)  --->  tARGET_MAX_WORD
 245   | otherwise = MachWord i
 246
 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))
 253
 254 char2IntLit (MachChar c) = MachInt  (toInteger (ord c))
 255 int2CharLit (MachInt  i) = MachChar (chr (fromInteger i))
 256
 257 float2IntLit (MachFloat f) = MachInt   (truncate    f)
 258 int2FloatLit (MachInt   i) = MachFloat (fromInteger i)
 259
 260 double2IntLit (MachDouble f) = MachInt    (truncate    f)
 261 int2DoubleLit (MachInt   i) = MachDouble (fromInteger i)
 262
 263 float2DoubleLit (MachFloat  f) = MachDouble f
 264 double2FloatLit (MachDouble d) = MachFloat  d
 265
 266 nullAddrLit :: Literal
 267 nullAddrLit = MachNullAddr
 268 \end{code}
 269
 270         Predicates
 271         ~~~~~~~~~~
 272 \begin{code}
 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
 279
 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
 286
 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
 291         --      f "x"
 292         -- might be too small
 293         -- [Sept03: make literal strings a bit bigger to avoid fruitless
 294         --  duplication of little strings]
 295 litSize _other        = 1
 296 \end{code}
 297
 298         Types
 299         ~~~~~
 300 \begin{code}
 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
 312 \end{code}
 313
 314
 315         Comparison
 316         ~~~~~~~~~~
 317 \begin{code}
 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
 329                                                 | otherwise                  = GT
 330
 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)
 341 \end{code}
 342
 343         Printing
 344         ~~~~~~~~
 345 * MachX (i.e. unboxed) things are printed unadornded (e.g. 3, 'a', "foo")
 346   exceptions: MachFloat gets an initial keyword prefix.
 347
 348 \begin{code}
 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") <+>
 359                              case mb of
 360                                Nothing -> pprHsString l
 361                                Just x  -> doubleQuotes (text (unpackFS l ++ '@':show x))
 362
 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
 367 \end{code}
 368
 369
 370 %************************************************************************
 371 %*                                                                      *
 372 \subsection{Hashing}
 373 %*                                                                      *
 374 %************************************************************************
 375
 376 Hash values should be zero or a positive integer.  No negatives please.
 377 (They mess up the UniqFM for some reason.)
 378
 379 \begin{code}
 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
 391
 392 hashRational :: Rational -> Int
 393 hashRational r = hashInteger (numerator r)
 394
 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
 399
 400 hashFS :: FastString -> Int
 401 hashFS s = iBox (uniqueOfFS s)
 402 \end{code}