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