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         , literalType
  28         , hashLiteral
  29
  30         -- ** Predicates on Literals and their contents
  31         , litIsDupable, litIsTrivial
  32         , inIntRange, inWordRange, tARGET_MAX_INT, inCharRange
  33         , isZeroLit
  34         , litFitsInChar
  35
  36         -- ** Coercions
  37         , word2IntLit, int2WordLit
  38         , narrow8IntLit, narrow16IntLit, narrow32IntLit
  39         , narrow8WordLit, narrow16WordLit, narrow32WordLit
  40         , char2IntLit, int2CharLit
  41         , float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit
  42         , nullAddrLit, float2DoubleLit, double2FloatLit
  43         ) where
  44
  45 import TysPrim
  46 import Type
  47 import Outputable
  48 import FastTypes
  49 import FastString
  50 import BasicTypes
  51 import Binary
  52
  53 import Data.Int
  54 import Data.Ratio
  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)
 125         FunctionOrData
 126                 -- ^ A label literal. Parameters:
 127                         --
 128                         -- 1) The name of the symbol mentioned in the declaration
 129                         --
 130                         -- 2) The size (in bytes) of the arguments
 131                                 --    the label expects. Only applicable with
 132                                 --    @stdcall@ labels. @Just x@ => @\<x\>@ will
 133                                 --    be appended to label name when emitting assembly.
 134 \end{code}
 135
 136 Binary instance
 137
 138 \begin{code}
 139 instance Binary Literal where
 140     put_ bh (MachChar aa)     = do putByte bh 0; put_ bh aa
 141     put_ bh (MachStr ab)      = do putByte bh 1; put_ bh ab
 142     put_ bh (MachNullAddr)    = do putByte bh 2
 143     put_ bh (MachInt ad)      = do putByte bh 3; put_ bh ad
 144     put_ bh (MachInt64 ae)    = do putByte bh 4; put_ bh ae
 145     put_ bh (MachWord af)     = do putByte bh 5; put_ bh af
 146     put_ bh (MachWord64 ag)   = do putByte bh 6; put_ bh ag
 147     put_ bh (MachFloat ah)    = do putByte bh 7; put_ bh ah
 148     put_ bh (MachDouble ai)   = do putByte bh 8; put_ bh ai
 149     put_ bh (MachLabel aj mb fod)
 150         = do putByte bh 9
 151              put_ bh aj
 152              put_ bh mb
 153              put_ bh fod
 154     get bh = do
 155             h <- getByte bh
 156             case h of
 157               0 -> do
 158                     aa <- get bh
 159                     return (MachChar aa)
 160               1 -> do
 161                     ab <- get bh
 162                     return (MachStr ab)
 163               2 -> do
 164                     return (MachNullAddr)
 165               3 -> do
 166                     ad <- get bh
 167                     return (MachInt ad)
 168               4 -> do
 169                     ae <- get bh
 170                     return (MachInt64 ae)
 171               5 -> do
 172                     af <- get bh
 173                     return (MachWord af)
 174               6 -> do
 175                     ag <- get bh
 176                     return (MachWord64 ag)
 177               7 -> do
 178                     ah <- get bh
 179                     return (MachFloat ah)
 180               8 -> do
 181                     ai <- get bh
 182                     return (MachDouble ai)
 183               9 -> do
 184                     aj <- get bh
 185                     mb <- get bh
 186                     fod <- get bh
 187                     return (MachLabel aj mb fod)
 188 \end{code}
 189
 190 \begin{code}
 191 instance Outputable Literal where
 192     ppr lit = pprLit lit
 193
 194 instance Show Literal where
 195     showsPrec p lit = showsPrecSDoc p (ppr lit)
 196
 197 instance Eq Literal where
 198     a == b = case (a `compare` b) of { EQ -> True;   _ -> False }
 199     a /= b = case (a `compare` b) of { EQ -> False;  _ -> True  }
 200
 201 instance Ord Literal where
 202     a <= b = case (a `compare` b) of { LT -> True;  EQ -> True;  GT -> False }
 203     a <  b = case (a `compare` b) of { LT -> True;  EQ -> False; GT -> False }
 204     a >= b = case (a `compare` b) of { LT -> False; EQ -> True;  GT -> True  }
 205     a >  b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True  }
 206     compare a b = cmpLit a b
 207 \end{code}
 208
 209
 210         Construction
 211         ~~~~~~~~~~~~
 212 \begin{code}
 213 -- | Creates a 'Literal' of type @Int#@
 214 mkMachInt :: Integer -> Literal
 215 mkMachInt  x   = -- ASSERT2( inIntRange x,  integer x )
 216                  -- Not true: you can write out of range Int# literals
 217                  -- For example, one can write (intToWord# 0xffff0000) to
 218                  -- get a particular Word bit-pattern, and there's no other
 219                  -- convenient way to write such literals, which is why we allow it.
 220                  MachInt x
 221
 222 -- | Creates a 'Literal' of type @Word#@
 223 mkMachWord :: Integer -> Literal
 224 mkMachWord x   = -- ASSERT2( inWordRange x, integer x )
 225                  MachWord x
 226
 227 -- | Creates a 'Literal' of type @Int64#@
 228 mkMachInt64 :: Integer -> Literal
 229 mkMachInt64  x = MachInt64 x
 230
 231 -- | Creates a 'Literal' of type @Word64#@
 232 mkMachWord64 :: Integer -> Literal
 233 mkMachWord64 x = MachWord64 x
 234
 235 -- | Creates a 'Literal' of type @Float#@
 236 mkMachFloat :: Rational -> Literal
 237 mkMachFloat = MachFloat
 238
 239 -- | Creates a 'Literal' of type @Double#@
 240 mkMachDouble :: Rational -> Literal
 241 mkMachDouble = MachDouble
 242
 243 -- | Creates a 'Literal' of type @Char#@
 244 mkMachChar :: Char -> Literal
 245 mkMachChar = MachChar
 246
 247 -- | Creates a 'Literal' of type @Addr#@, which is appropriate for passing to
 248 -- e.g. some of the \"error\" functions in GHC.Err such as @GHC.Err.runtimeError@
 249 mkMachString :: String -> Literal
 250 mkMachString s = MachStr (mkFastString s) -- stored UTF-8 encoded
 251
 252 inIntRange, inWordRange :: Integer -> Bool
 253 inIntRange  x = x >= tARGET_MIN_INT && x <= tARGET_MAX_INT
 254 inWordRange x = x >= 0              && x <= tARGET_MAX_WORD
 255
 256 inCharRange :: Char -> Bool
 257 inCharRange c =  c >= '\0' && c <= chr tARGET_MAX_CHAR
 258
 259 -- | Tests whether the literal represents a zero of whatever type it is
 260 isZeroLit :: Literal -> Bool
 261 isZeroLit (MachInt    0) = True
 262 isZeroLit (MachInt64  0) = True
 263 isZeroLit (MachWord   0) = True
 264 isZeroLit (MachWord64 0) = True
 265 isZeroLit (MachFloat  0) = True
 266 isZeroLit (MachDouble 0) = True
 267 isZeroLit _              = False
 268 \end{code}
 269
 270         Coercions
 271         ~~~~~~~~~
 272 \begin{code}
 273 word2IntLit, int2WordLit,
 274   narrow8IntLit, narrow16IntLit, narrow32IntLit,
 275   narrow8WordLit, narrow16WordLit, narrow32WordLit,
 276   char2IntLit, int2CharLit,
 277   float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit,
 278   float2DoubleLit, double2FloatLit
 279   :: Literal -> Literal
 280
 281 word2IntLit (MachWord w)
 282   | w > tARGET_MAX_INT = MachInt (w - tARGET_MAX_WORD - 1)
 283   | otherwise          = MachInt w
 284
 285 int2WordLit (MachInt i)
 286   | i < 0     = MachWord (1 + tARGET_MAX_WORD + i)      -- (-1)  --->  tARGET_MAX_WORD
 287   | otherwise = MachWord i
 288
 289 narrow8IntLit    (MachInt  i) = MachInt  (toInteger (fromInteger i :: Int8))
 290 narrow16IntLit   (MachInt  i) = MachInt  (toInteger (fromInteger i :: Int16))
 291 narrow32IntLit   (MachInt  i) = MachInt  (toInteger (fromInteger i :: Int32))
 292 narrow8WordLit   (MachWord w) = MachWord (toInteger (fromInteger w :: Word8))
 293 narrow16WordLit  (MachWord w) = MachWord (toInteger (fromInteger w :: Word16))
 294 narrow32WordLit  (MachWord w) = MachWord (toInteger (fromInteger w :: Word32))
 295
 296 char2IntLit (MachChar c) = MachInt  (toInteger (ord c))
 297 int2CharLit (MachInt  i) = MachChar (chr (fromInteger i))
 298
 299 float2IntLit (MachFloat f) = MachInt   (truncate    f)
 300 int2FloatLit (MachInt   i) = MachFloat (fromInteger i)
 301
 302 double2IntLit (MachDouble f) = MachInt    (truncate    f)
 303 int2DoubleLit (MachInt   i) = MachDouble (fromInteger i)
 304
 305 float2DoubleLit (MachFloat  f) = MachDouble f
 306 double2FloatLit (MachDouble d) = MachFloat  d
 307
 308 nullAddrLit :: Literal
 309 nullAddrLit = MachNullAddr
 310 \end{code}
 311
 312         Predicates
 313         ~~~~~~~~~~
 314 \begin{code}
 315 -- | True if there is absolutely no penalty to duplicating the literal.
 316 -- False principally of strings
 317 litIsTrivial :: Literal -> Bool
 318 --      c.f. CoreUtils.exprIsTrivial
 319 litIsTrivial (MachStr _) = False
 320 litIsTrivial _           = True
 321
 322 -- | True if code space does not go bad if we duplicate this literal
 323 -- Currently we treat it just like 'litIsTrivial'
 324 litIsDupable :: Literal -> Bool
 325 --      c.f. CoreUtils.exprIsDupable
 326 litIsDupable (MachStr _) = False
 327 litIsDupable _           = True
 328
 329 litFitsInChar :: Literal -> Bool
 330 litFitsInChar (MachInt i)
 331                          = fromInteger i <= ord minBound
 332                         && fromInteger i >= ord maxBound
 333 litFitsInChar _         = False
 334 \end{code}
 335
 336         Types
 337         ~~~~~
 338 \begin{code}
 339 -- | Find the Haskell 'Type' the literal occupies
 340 literalType :: Literal -> Type
 341 literalType MachNullAddr    = addrPrimTy
 342 literalType (MachChar _)    = charPrimTy
 343 literalType (MachStr  _)    = addrPrimTy
 344 literalType (MachInt  _)    = intPrimTy
 345 literalType (MachWord  _)   = wordPrimTy
 346 literalType (MachInt64  _)  = int64PrimTy
 347 literalType (MachWord64  _) = word64PrimTy
 348 literalType (MachFloat _)   = floatPrimTy
 349 literalType (MachDouble _)  = doublePrimTy
 350 literalType (MachLabel _ _ _) = addrPrimTy
 351 \end{code}
 352
 353
 354         Comparison
 355         ~~~~~~~~~~
 356 \begin{code}
 357 cmpLit :: Literal -> Literal -> Ordering
 358 cmpLit (MachChar      a)   (MachChar       b)   = a `compare` b
 359 cmpLit (MachStr       a)   (MachStr        b)   = a `compare` b
 360 cmpLit (MachNullAddr)      (MachNullAddr)       = EQ
 361 cmpLit (MachInt       a)   (MachInt        b)   = a `compare` b
 362 cmpLit (MachWord      a)   (MachWord       b)   = a `compare` b
 363 cmpLit (MachInt64     a)   (MachInt64      b)   = a `compare` b
 364 cmpLit (MachWord64    a)   (MachWord64     b)   = a `compare` b
 365 cmpLit (MachFloat     a)   (MachFloat      b)   = a `compare` b
 366 cmpLit (MachDouble    a)   (MachDouble     b)   = a `compare` b
 367 cmpLit (MachLabel     a _ _) (MachLabel      b _ _) = a `compare` b
 368 cmpLit lit1                lit2                 | litTag lit1 <# litTag lit2 = LT
 369                                                 | otherwise                  = GT
 370
 371 litTag :: Literal -> FastInt
 372 litTag (MachChar      _)   = _ILIT(1)
 373 litTag (MachStr       _)   = _ILIT(2)
 374 litTag (MachNullAddr)      = _ILIT(3)
 375 litTag (MachInt       _)   = _ILIT(4)
 376 litTag (MachWord      _)   = _ILIT(5)
 377 litTag (MachInt64     _)   = _ILIT(6)
 378 litTag (MachWord64    _)   = _ILIT(7)
 379 litTag (MachFloat     _)   = _ILIT(8)
 380 litTag (MachDouble    _)   = _ILIT(9)
 381 litTag (MachLabel _ _ _)   = _ILIT(10)
 382 \end{code}
 383
 384         Printing
 385         ~~~~~~~~
 386 * MachX (i.e. unboxed) things are printed unadornded (e.g. 3, 'a', "foo")
 387   exceptions: MachFloat gets an initial keyword prefix.
 388
 389 \begin{code}
 390 pprLit :: Literal -> SDoc
 391 pprLit (MachChar ch)    = pprHsChar ch
 392 pprLit (MachStr s)      = pprHsString s
 393 pprLit (MachInt i)      = pprIntVal i
 394 pprLit (MachInt64 i)    = ptext (sLit "__int64") <+> integer i
 395 pprLit (MachWord w)     = ptext (sLit "__word") <+> integer w
 396 pprLit (MachWord64 w)   = ptext (sLit "__word64") <+> integer w
 397 pprLit (MachFloat f)    = ptext (sLit "__float") <+> rational f
 398 pprLit (MachDouble d)   = rational d
 399 pprLit (MachNullAddr)   = ptext (sLit "__NULL")
 400 pprLit (MachLabel l mb fod) = ptext (sLit "__label") <+> b <+> ppr fod
 401     where b = case mb of
 402               Nothing -> pprHsString l
 403               Just x  -> doubleQuotes (text (unpackFS l ++ '@':show x))
 404
 405 pprIntVal :: Integer -> SDoc
 406 -- ^ Print negative integers with parens to be sure it's unambiguous
 407 pprIntVal i | i < 0     = parens (integer i)
 408             | otherwise = integer i
 409 \end{code}
 410
 411
 412 %************************************************************************
 413 %*                                                                      *
 414 \subsection{Hashing}
 415 %*                                                                      *
 416 %************************************************************************
 417
 418 Hash values should be zero or a positive integer.  No negatives please.
 419 (They mess up the UniqFM for some reason.)
 420
 421 \begin{code}
 422 hashLiteral :: Literal -> Int
 423 hashLiteral (MachChar c)        = ord c + 1000  -- Keep it out of range of common ints
 424 hashLiteral (MachStr s)         = hashFS s
 425 hashLiteral (MachNullAddr)      = 0
 426 hashLiteral (MachInt i)         = hashInteger i
 427 hashLiteral (MachInt64 i)       = hashInteger i
 428 hashLiteral (MachWord i)        = hashInteger i
 429 hashLiteral (MachWord64 i)      = hashInteger i
 430 hashLiteral (MachFloat r)       = hashRational r
 431 hashLiteral (MachDouble r)      = hashRational r
 432 hashLiteral (MachLabel s _ _)     = hashFS s
 433
 434 hashRational :: Rational -> Int
 435 hashRational r = hashInteger (numerator r)
 436
 437 hashInteger :: Integer -> Int
 438 hashInteger i = 1 + abs (fromInteger (i `rem` 10000))
 439                 -- The 1+ is to avoid zero, which is a Bad Number
 440                 -- since we use * to combine hash values
 441
 442 hashFS :: FastString -> Int
 443 hashFS s = iBox (uniqueOfFS s)
 444 \end{code}