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