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         , litFitsInChar
  20
  21         , word2IntLit, int2WordLit
  22         , narrow8IntLit, narrow16IntLit, narrow32IntLit
  23         , narrow8WordLit, narrow16WordLit, narrow32WordLit
  24         , char2IntLit, int2CharLit
  25         , float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit
  26         , nullAddrLit, float2DoubleLit, double2FloatLit
  27         ) where
  28
  29 #include "HsVersions.h"
  30
  31 import TysPrim
  32 import Type
  33 import Outputable
  34 import FastTypes
  35 import FastString
  36 import Binary
  37 import Ratio
  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 litFitsInChar :: Literal -> Bool
 289 litFitsInChar (MachInt i)
 290                          = fromInteger i <= ord minBound
 291                         && fromInteger i >= ord maxBound
 292 litFitsInChar _         = False
 293
 294 litSize :: Literal -> Int
 295 -- Used by CoreUnfold.sizeExpr
 296 litSize (MachStr str) = 1 + ((lengthFS str + 3) `div` 4)
 297         -- Every literal has size at least 1, otherwise
 298         --      f "x"
 299         -- might be too small
 300         -- [Sept03: make literal strings a bit bigger to avoid fruitless
 301         --  duplication of little strings]
 302 litSize _other        = 1
 303 \end{code}
 304
 305         Types
 306         ~~~~~
 307 \begin{code}
 308 literalType :: Literal -> Type
 309 literalType MachNullAddr    = addrPrimTy
 310 literalType (MachChar _)    = charPrimTy
 311 literalType (MachStr  _)    = addrPrimTy
 312 literalType (MachInt  _)    = intPrimTy
 313 literalType (MachWord  _)   = wordPrimTy
 314 literalType (MachInt64  _)  = int64PrimTy
 315 literalType (MachWord64  _) = word64PrimTy
 316 literalType (MachFloat _)   = floatPrimTy
 317 literalType (MachDouble _)  = doublePrimTy
 318 literalType (MachLabel _ _) = addrPrimTy
 319 \end{code}
 320
 321
 322         Comparison
 323         ~~~~~~~~~~
 324 \begin{code}
 325 cmpLit (MachChar      a)   (MachChar       b)   = a `compare` b
 326 cmpLit (MachStr       a)   (MachStr        b)   = a `compare` b
 327 cmpLit (MachNullAddr)      (MachNullAddr)       = EQ
 328 cmpLit (MachInt       a)   (MachInt        b)   = a `compare` b
 329 cmpLit (MachWord      a)   (MachWord       b)   = a `compare` b
 330 cmpLit (MachInt64     a)   (MachInt64      b)   = a `compare` b
 331 cmpLit (MachWord64    a)   (MachWord64     b)   = a `compare` b
 332 cmpLit (MachFloat     a)   (MachFloat      b)   = a `compare` b
 333 cmpLit (MachDouble    a)   (MachDouble     b)   = a `compare` b
 334 cmpLit (MachLabel     a _) (MachLabel      b _) = a `compare` b
 335 cmpLit lit1                lit2                 | litTag lit1 <# litTag lit2 = LT
 336                                                 | otherwise                  = GT
 337
 338 litTag (MachChar      _)   = _ILIT(1)
 339 litTag (MachStr       _)   = _ILIT(2)
 340 litTag (MachNullAddr)      = _ILIT(3)
 341 litTag (MachInt       _)   = _ILIT(4)
 342 litTag (MachWord      _)   = _ILIT(5)
 343 litTag (MachInt64     _)   = _ILIT(6)
 344 litTag (MachWord64    _)   = _ILIT(7)
 345 litTag (MachFloat     _)   = _ILIT(8)
 346 litTag (MachDouble    _)   = _ILIT(9)
 347 litTag (MachLabel   _ _)   = _ILIT(10)
 348 \end{code}
 349
 350         Printing
 351         ~~~~~~~~
 352 * MachX (i.e. unboxed) things are printed unadornded (e.g. 3, 'a', "foo")
 353   exceptions: MachFloat gets an initial keyword prefix.
 354
 355 \begin{code}
 356 pprLit (MachChar ch)    = pprHsChar ch
 357 pprLit (MachStr s)      = pprHsString s
 358 pprLit (MachInt i)      = pprIntVal i
 359 pprLit (MachInt64 i)    = ptext SLIT("__int64") <+> integer i
 360 pprLit (MachWord w)     = ptext SLIT("__word") <+> integer w
 361 pprLit (MachWord64 w)   = ptext SLIT("__word64") <+> integer w
 362 pprLit (MachFloat f)    = ptext SLIT("__float") <+> rational f
 363 pprLit (MachDouble d)   = rational d
 364 pprLit (MachNullAddr)   = ptext SLIT("__NULL")
 365 pprLit (MachLabel l mb) = ptext SLIT("__label") <+>
 366                              case mb of
 367                                Nothing -> pprHsString l
 368                                Just x  -> doubleQuotes (text (unpackFS l ++ '@':show x))
 369
 370 pprIntVal :: Integer -> SDoc
 371 -- Print negative integers with parens to be sure it's unambiguous
 372 pprIntVal i | i < 0     = parens (integer i)
 373             | otherwise = integer i
 374 \end{code}
 375
 376
 377 %************************************************************************
 378 %*                                                                      *
 379 \subsection{Hashing}
 380 %*                                                                      *
 381 %************************************************************************
 382
 383 Hash values should be zero or a positive integer.  No negatives please.
 384 (They mess up the UniqFM for some reason.)
 385
 386 \begin{code}
 387 hashLiteral :: Literal -> Int
 388 hashLiteral (MachChar c)        = ord c + 1000  -- Keep it out of range of common ints
 389 hashLiteral (MachStr s)         = hashFS s
 390 hashLiteral (MachNullAddr)      = 0
 391 hashLiteral (MachInt i)         = hashInteger i
 392 hashLiteral (MachInt64 i)       = hashInteger i
 393 hashLiteral (MachWord i)        = hashInteger i
 394 hashLiteral (MachWord64 i)      = hashInteger i
 395 hashLiteral (MachFloat r)       = hashRational r
 396 hashLiteral (MachDouble r)      = hashRational r
 397 hashLiteral (MachLabel s _)     = hashFS s
 398
 399 hashRational :: Rational -> Int
 400 hashRational r = hashInteger (numerator r)
 401
 402 hashInteger :: Integer -> Int
 403 hashInteger i = 1 + abs (fromInteger (i `rem` 10000))
 404                 -- The 1+ is to avoid zero, which is a Bad Number
 405                 -- since we use * to combine hash values
 406
 407 hashFS :: FastString -> Int
 408 hashFS s = iBox (uniqueOfFS s)
 409 \end{code}