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 {-# 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
  13 -- for details
  14
  15 module Literal
  16         (
  17         -- * Main data type
  18           Literal(..)           -- Exported to ParseIface
  19
  20         -- ** Creating Literals
  21         , mkMachInt, mkMachWord
  22         , mkMachInt64, mkMachWord64
  23         , mkMachFloat, mkMachDouble
  24         , mkMachChar, mkMachString
  25
  26         -- ** Operations on Literals
  27         , litSize
  28         , literalType
  29         , hashLiteral
  30
  31         -- ** Predicates on Literals and their contents
  32         , litIsDupable, litIsTrivial
  33         , inIntRange, inWordRange, tARGET_MAX_INT, inCharRange
  34         , isZeroLit
  35         , litFitsInChar
  36
  37         -- ** Coercions
  38         , word2IntLit, int2WordLit
  39         , narrow8IntLit, narrow16IntLit, narrow32IntLit
  40         , narrow8WordLit, narrow16WordLit, narrow32WordLit
  41         , char2IntLit, int2CharLit
  42         , float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit
  43         , nullAddrLit, float2DoubleLit, double2FloatLit
  44         ) where
  45
  46 import TysPrim
  47 import Type
  48 import Outputable
  49 import FastTypes
  50 import FastString
  51 import BasicTypes
  52 import Binary
  53 import Ratio
  54
  55 import Data.Int
  56 import Data.Word
  57 import Data.Char
  58 \end{code}
  59
  60
  61 %************************************************************************
  62 %*                                                                      *
  63 \subsection{Sizes}
  64 %*                                                                      *
  65 %************************************************************************
  66
  67 If we're compiling with GHC (and we're not cross-compiling), then we
  68 know that minBound and maxBound :: Int are the right values for the
  69 target architecture.  Otherwise, we assume -2^31 and 2^31-1
  70 respectively (which will be wrong on a 64-bit machine).
  71
  72 \begin{code}
  73 tARGET_MIN_INT, tARGET_MAX_INT, tARGET_MAX_WORD :: Integer
  74 #ifdef __GLASGOW_HASKELL__
  75 tARGET_MIN_INT  = toInteger (minBound :: Int)
  76 tARGET_MAX_INT  = toInteger (maxBound :: Int)
  77 #else
  78 tARGET_MIN_INT = -2147483648
  79 tARGET_MAX_INT =  2147483647
  80 #endif
  81 tARGET_MAX_WORD = (tARGET_MAX_INT * 2) + 1
  82
  83 tARGET_MAX_CHAR :: Int
  84 tARGET_MAX_CHAR = 0x10ffff
  85 \end{code}
  86
  87 %************************************************************************
  88 %*                                                                      *
  89 \subsection{Literals}
  90 %*                                                                      *
  91 %************************************************************************
  92
  93 \begin{code}
  94 -- | So-called 'Literal's are one of:
  95 --
  96 -- * An unboxed (/machine/) literal ('MachInt', 'MachFloat', etc.),
  97 --   which is presumed to be surrounded by appropriate constructors
  98 --   (@Int#@, etc.), so that the overall thing makes sense.
  99 --
 100 -- * The literal derived from the label mentioned in a \"foreign label\"
 101 --   declaration ('MachLabel')
 102 data Literal
 103   =     ------------------
 104         -- First the primitive guys
 105     MachChar    Char            -- ^ @Char#@ - at least 31 bits. Create with 'mkMachChar'
 106
 107   | MachStr     FastString      -- ^ A string-literal: stored and emitted
 108                                 -- UTF-8 encoded, we'll arrange to decode it
 109                                 -- at runtime.  Also emitted with a @'\0'@
 110                                 -- terminator. Create with 'mkMachString'
 111
 112   | MachNullAddr                -- ^ The @NULL@ pointer, the only pointer value
 113                                 -- that can be represented as a Literal. Create
 114                                 -- with 'nullAddrLit'
 115
 116   | MachInt     Integer         -- ^ @Int#@ - at least @WORD_SIZE_IN_BITS@ bits. Create with 'mkMachInt'
 117   | MachInt64   Integer         -- ^ @Int64#@ - at least 64 bits. Create with 'mkMachInt64'
 118   | MachWord    Integer         -- ^ @Word#@ - at least @WORD_SIZE_IN_BITS@ bits. Create with 'mkMachWord'
 119   | MachWord64  Integer         -- ^ @Word64#@ - at least 64 bits. Create with 'mkMachWord64'
 120
 121   | MachFloat   Rational        -- ^ @Float#@. Create with 'mkMachFloat'
 122   | MachDouble  Rational        -- ^ @Double#@. Create with 'mkMachDouble'
 123
 124   | MachLabel   FastString
 125                 (Maybe Int)
 126         FunctionOrData
 127                 -- ^ A label literal. Parameters:
 128                         --
 129                         -- 1) The name of the symbol mentioned in the declaration
 130                         --
 131                         -- 2) The size (in bytes) of the arguments
 132                                 --    the label expects. Only applicable with
 133                                 --    @stdcall@ labels. @Just x@ => @\<x\>@ will
 134                                 --    be appended to label name when emitting assembly.
 135 \end{code}
 136
 137 Binary instance
 138
 139 \begin{code}
 140 instance Binary Literal where
 141     put_ bh (MachChar aa)     = do putByte bh 0; put_ bh aa
 142     put_ bh (MachStr ab)      = do putByte bh 1; put_ bh ab
 143     put_ bh (MachNullAddr)    = do putByte bh 2
 144     put_ bh (MachInt ad)      = do putByte bh 3; put_ bh ad
 145     put_ bh (MachInt64 ae)    = do putByte bh 4; put_ bh ae
 146     put_ bh (MachWord af)     = do putByte bh 5; put_ bh af
 147     put_ bh (MachWord64 ag)   = do putByte bh 6; put_ bh ag
 148     put_ bh (MachFloat ah)    = do putByte bh 7; put_ bh ah
 149     put_ bh (MachDouble ai)   = do putByte bh 8; put_ bh ai
 150     put_ bh (MachLabel aj mb fod)
 151         = do putByte bh 9
 152              put_ bh aj
 153              put_ bh mb
 154              put_ bh fod
 155     get bh = do
 156             h <- getByte bh
 157             case h of
 158               0 -> do
 159                     aa <- get bh
 160                     return (MachChar aa)
 161               1 -> do
 162                     ab <- get bh
 163                     return (MachStr ab)
 164               2 -> do
 165                     return (MachNullAddr)
 166               3 -> do
 167                     ad <- get bh
 168                     return (MachInt ad)
 169               4 -> do
 170                     ae <- get bh
 171                     return (MachInt64 ae)
 172               5 -> do
 173                     af <- get bh
 174                     return (MachWord af)
 175               6 -> do
 176                     ag <- get bh
 177                     return (MachWord64 ag)
 178               7 -> do
 179                     ah <- get bh
 180                     return (MachFloat ah)
 181               8 -> do
 182                     ai <- get bh
 183                     return (MachDouble ai)
 184               9 -> do
 185                     aj <- get bh
 186                     mb <- get bh
 187                     fod <- get bh
 188                     return (MachLabel aj mb fod)
 189 \end{code}
 190
 191 \begin{code}
 192 instance Outputable Literal where
 193     ppr lit = pprLit lit
 194
 195 instance Show Literal where
 196     showsPrec p lit = showsPrecSDoc p (ppr lit)
 197
 198 instance Eq Literal where
 199     a == b = case (a `compare` b) of { EQ -> True;   _ -> False }
 200     a /= b = case (a `compare` b) of { EQ -> False;  _ -> True  }
 201
 202 instance Ord Literal where
 203     a <= b = case (a `compare` b) of { LT -> True;  EQ -> True;  GT -> False }
 204     a <  b = case (a `compare` b) of { LT -> True;  EQ -> False; GT -> False }
 205     a >= b = case (a `compare` b) of { LT -> False; EQ -> True;  GT -> True  }
 206     a >  b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True  }
 207     compare a b = cmpLit a b
 208 \end{code}
 209
 210
 211         Construction
 212         ~~~~~~~~~~~~
 213 \begin{code}
 214 -- | Creates a 'Literal' of type @Int#@
 215 mkMachInt :: Integer -> Literal
 216 mkMachInt  x   = -- ASSERT2( inIntRange x,  integer x )
 217                  -- Not true: you can write out of range Int# literals
 218                  -- For example, one can write (intToWord# 0xffff0000) to
 219                  -- get a particular Word bit-pattern, and there's no other
 220                  -- convenient way to write such literals, which is why we allow it.
 221                  MachInt x
 222
 223 -- | Creates a 'Literal' of type @Word#@
 224 mkMachWord :: Integer -> Literal
 225 mkMachWord x   = -- ASSERT2( inWordRange x, integer x )
 226                  MachWord x
 227
 228 -- | Creates a 'Literal' of type @Int64#@
 229 mkMachInt64 :: Integer -> Literal
 230 mkMachInt64  x = MachInt64 x
 231
 232 -- | Creates a 'Literal' of type @Word64#@
 233 mkMachWord64 :: Integer -> Literal
 234 mkMachWord64 x = MachWord64 x
 235
 236 -- | Creates a 'Literal' of type @Float#@
 237 mkMachFloat :: Rational -> Literal
 238 mkMachFloat = MachFloat
 239
 240 -- | Creates a 'Literal' of type @Double#@
 241 mkMachDouble :: Rational -> Literal
 242 mkMachDouble = MachDouble
 243
 244 -- | Creates a 'Literal' of type @Char#@
 245 mkMachChar :: Char -> Literal
 246 mkMachChar = MachChar
 247
 248 -- | Creates a 'Literal' of type @Addr#@, which is appropriate for passing to
 249 -- e.g. some of the \"error\" functions in GHC.Err such as @GHC.Err.runtimeError@
 250 mkMachString :: String -> Literal
 251 mkMachString s = MachStr (mkFastString s) -- stored UTF-8 encoded
 252
 253 inIntRange, inWordRange :: Integer -> Bool
 254 inIntRange  x = x >= tARGET_MIN_INT && x <= tARGET_MAX_INT
 255 inWordRange x = x >= 0              && x <= tARGET_MAX_WORD
 256
 257 inCharRange :: Char -> Bool
 258 inCharRange c =  c >= '\0' && c <= chr tARGET_MAX_CHAR
 259
 260 -- | Tests whether the literal represents a zero of whatever type it is
 261 isZeroLit :: Literal -> Bool
 262 isZeroLit (MachInt    0) = True
 263 isZeroLit (MachInt64  0) = True
 264 isZeroLit (MachWord   0) = True
 265 isZeroLit (MachWord64 0) = True
 266 isZeroLit (MachFloat  0) = True
 267 isZeroLit (MachDouble 0) = True
 268 isZeroLit _              = False
 269 \end{code}
 270
 271         Coercions
 272         ~~~~~~~~~
 273 \begin{code}
 274 word2IntLit, int2WordLit,
 275   narrow8IntLit, narrow16IntLit, narrow32IntLit,
 276   narrow8WordLit, narrow16WordLit, narrow32WordLit,
 277   char2IntLit, int2CharLit,
 278   float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit,
 279   float2DoubleLit, double2FloatLit
 280   :: Literal -> Literal
 281
 282 word2IntLit (MachWord w)
 283   | w > tARGET_MAX_INT = MachInt (w - tARGET_MAX_WORD - 1)
 284   | otherwise          = MachInt w
 285
 286 int2WordLit (MachInt i)
 287   | i < 0     = MachWord (1 + tARGET_MAX_WORD + i)      -- (-1)  --->  tARGET_MAX_WORD
 288   | otherwise = MachWord i
 289
 290 narrow8IntLit    (MachInt  i) = MachInt  (toInteger (fromInteger i :: Int8))
 291 narrow16IntLit   (MachInt  i) = MachInt  (toInteger (fromInteger i :: Int16))
 292 narrow32IntLit   (MachInt  i) = MachInt  (toInteger (fromInteger i :: Int32))
 293 narrow8WordLit   (MachWord w) = MachWord (toInteger (fromInteger w :: Word8))
 294 narrow16WordLit  (MachWord w) = MachWord (toInteger (fromInteger w :: Word16))
 295 narrow32WordLit  (MachWord w) = MachWord (toInteger (fromInteger w :: Word32))
 296
 297 char2IntLit (MachChar c) = MachInt  (toInteger (ord c))
 298 int2CharLit (MachInt  i) = MachChar (chr (fromInteger i))
 299
 300 float2IntLit (MachFloat f) = MachInt   (truncate    f)
 301 int2FloatLit (MachInt   i) = MachFloat (fromInteger i)
 302
 303 double2IntLit (MachDouble f) = MachInt    (truncate    f)
 304 int2DoubleLit (MachInt   i) = MachDouble (fromInteger i)
 305
 306 float2DoubleLit (MachFloat  f) = MachDouble f
 307 double2FloatLit (MachDouble d) = MachFloat  d
 308
 309 nullAddrLit :: Literal
 310 nullAddrLit = MachNullAddr
 311 \end{code}
 312
 313         Predicates
 314         ~~~~~~~~~~
 315 \begin{code}
 316 -- | True if there is absolutely no penalty to duplicating the literal.
 317 -- False principally of strings
 318 litIsTrivial :: Literal -> Bool
 319 --      c.f. CoreUtils.exprIsTrivial
 320 litIsTrivial (MachStr _) = False
 321 litIsTrivial _           = True
 322
 323 -- | True if code space does not go bad if we duplicate this literal
 324 -- Currently we treat it just like 'litIsTrivial'
 325 litIsDupable :: Literal -> Bool
 326 --      c.f. CoreUtils.exprIsDupable
 327 litIsDupable (MachStr _) = False
 328 litIsDupable _           = True
 329
 330 litFitsInChar :: Literal -> Bool
 331 litFitsInChar (MachInt i)
 332                          = fromInteger i <= ord minBound
 333                         && fromInteger i >= ord maxBound
 334 litFitsInChar _         = False
 335
 336 -- | Finds a nominal size of a string literal. Every literal has size at least 1
 337 litSize :: Literal -> Int
 338 -- Used by CoreUnfold.sizeExpr
 339 litSize (MachStr str) = 1 + ((lengthFS str + 3) `div` 4)
 340         -- If size could be 0 then @f "x"@ might be too small
 341         -- [Sept03: make literal strings a bit bigger to avoid fruitless
 342         --  duplication of little strings]
 343 litSize _other        = 1
 344 \end{code}
 345
 346         Types
 347         ~~~~~
 348 \begin{code}
 349 -- | Find the Haskell 'Type' the literal occupies
 350 literalType :: Literal -> Type
 351 literalType MachNullAddr    = addrPrimTy
 352 literalType (MachChar _)    = charPrimTy
 353 literalType (MachStr  _)    = addrPrimTy
 354 literalType (MachInt  _)    = intPrimTy
 355 literalType (MachWord  _)   = wordPrimTy
 356 literalType (MachInt64  _)  = int64PrimTy
 357 literalType (MachWord64  _) = word64PrimTy
 358 literalType (MachFloat _)   = floatPrimTy
 359 literalType (MachDouble _)  = doublePrimTy
 360 literalType (MachLabel _ _ _) = addrPrimTy
 361 \end{code}
 362
 363
 364         Comparison
 365         ~~~~~~~~~~
 366 \begin{code}
 367 cmpLit :: Literal -> Literal -> Ordering
 368 cmpLit (MachChar      a)   (MachChar       b)   = a `compare` b
 369 cmpLit (MachStr       a)   (MachStr        b)   = a `compare` b
 370 cmpLit (MachNullAddr)      (MachNullAddr)       = EQ
 371 cmpLit (MachInt       a)   (MachInt        b)   = a `compare` b
 372 cmpLit (MachWord      a)   (MachWord       b)   = a `compare` b
 373 cmpLit (MachInt64     a)   (MachInt64      b)   = a `compare` b
 374 cmpLit (MachWord64    a)   (MachWord64     b)   = a `compare` b
 375 cmpLit (MachFloat     a)   (MachFloat      b)   = a `compare` b
 376 cmpLit (MachDouble    a)   (MachDouble     b)   = a `compare` b
 377 cmpLit (MachLabel     a _ _) (MachLabel      b _ _) = a `compare` b
 378 cmpLit lit1                lit2                 | litTag lit1 <# litTag lit2 = LT
 379                                                 | otherwise                  = GT
 380
 381 litTag :: Literal -> FastInt
 382 litTag (MachChar      _)   = _ILIT(1)
 383 litTag (MachStr       _)   = _ILIT(2)
 384 litTag (MachNullAddr)      = _ILIT(3)
 385 litTag (MachInt       _)   = _ILIT(4)
 386 litTag (MachWord      _)   = _ILIT(5)
 387 litTag (MachInt64     _)   = _ILIT(6)
 388 litTag (MachWord64    _)   = _ILIT(7)
 389 litTag (MachFloat     _)   = _ILIT(8)
 390 litTag (MachDouble    _)   = _ILIT(9)
 391 litTag (MachLabel _ _ _)   = _ILIT(10)
 392 \end{code}
 393
 394         Printing
 395         ~~~~~~~~
 396 * MachX (i.e. unboxed) things are printed unadornded (e.g. 3, 'a', "foo")
 397   exceptions: MachFloat gets an initial keyword prefix.
 398
 399 \begin{code}
 400 pprLit :: Literal -> SDoc
 401 pprLit (MachChar ch)    = pprHsChar ch
 402 pprLit (MachStr s)      = pprHsString s
 403 pprLit (MachInt i)      = pprIntVal i
 404 pprLit (MachInt64 i)    = ptext (sLit "__int64") <+> integer i
 405 pprLit (MachWord w)     = ptext (sLit "__word") <+> integer w
 406 pprLit (MachWord64 w)   = ptext (sLit "__word64") <+> integer w
 407 pprLit (MachFloat f)    = ptext (sLit "__float") <+> rational f
 408 pprLit (MachDouble d)   = rational d
 409 pprLit (MachNullAddr)   = ptext (sLit "__NULL")
 410 pprLit (MachLabel l mb fod) = ptext (sLit "__label") <+> b <+> ppr fod
 411     where b = case mb of
 412               Nothing -> pprHsString l
 413               Just x  -> doubleQuotes (text (unpackFS l ++ '@':show x))
 414
 415 pprIntVal :: Integer -> SDoc
 416 -- ^ Print negative integers with parens to be sure it's unambiguous
 417 pprIntVal i | i < 0     = parens (integer i)
 418             | otherwise = integer i
 419 \end{code}
 420
 421
 422 %************************************************************************
 423 %*                                                                      *
 424 \subsection{Hashing}
 425 %*                                                                      *
 426 %************************************************************************
 427
 428 Hash values should be zero or a positive integer.  No negatives please.
 429 (They mess up the UniqFM for some reason.)
 430
 431 \begin{code}
 432 hashLiteral :: Literal -> Int
 433 hashLiteral (MachChar c)        = ord c + 1000  -- Keep it out of range of common ints
 434 hashLiteral (MachStr s)         = hashFS s
 435 hashLiteral (MachNullAddr)      = 0
 436 hashLiteral (MachInt i)         = hashInteger i
 437 hashLiteral (MachInt64 i)       = hashInteger i
 438 hashLiteral (MachWord i)        = hashInteger i
 439 hashLiteral (MachWord64 i)      = hashInteger i
 440 hashLiteral (MachFloat r)       = hashRational r
 441 hashLiteral (MachDouble r)      = hashRational r
 442 hashLiteral (MachLabel s _ _)     = hashFS s
 443
 444 hashRational :: Rational -> Int
 445 hashRational r = hashInteger (numerator r)
 446
 447 hashInteger :: Integer -> Int
 448 hashInteger i = 1 + abs (fromInteger (i `rem` 10000))
 449                 -- The 1+ is to avoid zero, which is a Bad Number
 450                 -- since we use * to combine hash values
 451
 452 hashFS :: FastString -> Int
 453 hashFS s = iBox (uniqueOfFS s)
 454 \end{code}