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