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