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