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