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         ( Literal(..)           -- Exported to ParseIface
  17         , mkMachInt, mkMachWord
  18         , mkMachInt64, mkMachWord64, mkStringLit
  19         , litSize
  20         , litIsDupable, litIsTrivial
  21         , literalType
  22         , hashLiteral
  23
  24         , inIntRange, inWordRange, tARGET_MAX_INT, inCharRange
  25         , isZeroLit
  26         , litFitsInChar
  27
  28         , word2IntLit, int2WordLit
  29         , narrow8IntLit, narrow16IntLit, narrow32IntLit
  30         , narrow8WordLit, narrow16WordLit, narrow32WordLit
  31         , char2IntLit, int2CharLit
  32         , float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit
  33         , nullAddrLit, float2DoubleLit, double2FloatLit
  34         ) where
  35
  36 #include "HsVersions.h"
  37
  38 import TysPrim
  39 import Type
  40 import Outputable
  41 import FastTypes
  42 import FastString
  43 import Binary
  44 import Ratio
  45
  46 import Data.Int
  47 import Data.Word
  48 import Data.Char
  49 \end{code}
  50
  51
  52 %************************************************************************
  53 %*                                                                      *
  54 \subsection{Sizes}
  55 %*                                                                      *
  56 %************************************************************************
  57
  58 If we're compiling with GHC (and we're not cross-compiling), then we
  59 know that minBound and maxBound :: Int are the right values for the
  60 target architecture.  Otherwise, we assume -2^31 and 2^31-1
  61 respectively (which will be wrong on a 64-bit machine).
  62
  63 \begin{code}
  64 tARGET_MIN_INT, tARGET_MAX_INT, tARGET_MAX_WORD :: Integer
  65 #ifdef __GLASGOW_HASKELL__
  66 tARGET_MIN_INT  = toInteger (minBound :: Int)
  67 tARGET_MAX_INT  = toInteger (maxBound :: Int)
  68 #else
  69 tARGET_MIN_INT = -2147483648
  70 tARGET_MAX_INT =  2147483647
  71 #endif
  72 tARGET_MAX_WORD = (tARGET_MAX_INT * 2) + 1
  73
  74 tARGET_MAX_CHAR :: Int
  75 tARGET_MAX_CHAR = 0x10ffff
  76 \end{code}
  77
  78
  79 %************************************************************************
  80 %*                                                                      *
  81 \subsection{Literals}
  82 %*                                                                      *
  83 %************************************************************************
  84
  85 So-called @Literals@ are {\em either}:
  86 \begin{itemize}
  87 \item
  88 An unboxed (``machine'') literal (type: @IntPrim@, @FloatPrim@, etc.),
  89 which is presumed to be surrounded by appropriate constructors
  90 (@mKINT@, etc.), so that the overall thing makes sense.
  91 \item
  92 An Integer, Rational, or String literal whose representation we are
  93 {\em uncommitted} about; i.e., the surrounding with constructors,
  94 function applications, etc., etc., has not yet been done.
  95 \end{itemize}
  96
  97 \begin{code}
  98 data Literal
  99   =     ------------------
 100         -- First the primitive guys
 101     MachChar    Char             -- Char#        At least 31 bits
 102
 103   | MachStr     FastString      -- A string-literal: stored and emitted
 104                                 -- UTF-8 encoded, we'll arrange to decode it
 105                                 -- at runtime.  Also emitted with a '\0'
 106                                 -- terminator.
 107
 108   | MachNullAddr                -- the NULL pointer, the only pointer value
 109                                 -- that can be represented as a Literal.
 110
 111   | MachInt     Integer         -- Int#         At least WORD_SIZE_IN_BITS bits
 112   | MachInt64   Integer         -- Int64#       At least 64 bits
 113   | MachWord    Integer         -- Word#        At least WORD_SIZE_IN_BITS bits
 114   | MachWord64  Integer         -- Word64#      At least 64 bits
 115
 116   | MachFloat   Rational
 117   | MachDouble  Rational
 118
 119         -- MachLabel is used (only) for the literal derived from a
 120         -- "foreign label" declaration.
 121         -- string argument is the name of a symbol.  This literal
 122         -- refers to the *address* of the label.
 123   | MachLabel   FastString              -- always an Addr#
 124                 (Maybe Int)             -- the size (in bytes) of the arguments
 125                                         -- the label expects. Only applicable with
 126                                         -- 'stdcall' labels.
 127                                         -- Just x => "@<x>" will be appended to label
 128                                         --           name when emitting asm.
 129 \end{code}
 130
 131 Binary instance
 132
 133 \begin{code}
 134 instance Binary Literal where
 135     put_ bh (MachChar aa)     = do putByte bh 0; put_ bh aa
 136     put_ bh (MachStr ab)      = do putByte bh 1; put_ bh ab
 137     put_ bh (MachNullAddr)    = do putByte bh 2
 138     put_ bh (MachInt ad)      = do putByte bh 3; put_ bh ad
 139     put_ bh (MachInt64 ae)    = do putByte bh 4; put_ bh ae
 140     put_ bh (MachWord af)     = do putByte bh 5; put_ bh af
 141     put_ bh (MachWord64 ag)   = do putByte bh 6; put_ bh ag
 142     put_ bh (MachFloat ah)    = do putByte bh 7; put_ bh ah
 143     put_ bh (MachDouble ai)   = do putByte bh 8; put_ bh ai
 144     put_ bh (MachLabel aj mb) = do putByte bh 9; put_ bh aj ; put_ bh mb
 145     get bh = do
 146             h <- getByte bh
 147             case h of
 148               0 -> do
 149                     aa <- get bh
 150                     return (MachChar aa)
 151               1 -> do
 152                     ab <- get bh
 153                     return (MachStr ab)
 154               2 -> do
 155                     return (MachNullAddr)
 156               3 -> do
 157                     ad <- get bh
 158                     return (MachInt ad)
 159               4 -> do
 160                     ae <- get bh
 161                     return (MachInt64 ae)
 162               5 -> do
 163                     af <- get bh
 164                     return (MachWord af)
 165               6 -> do
 166                     ag <- get bh
 167                     return (MachWord64 ag)
 168               7 -> do
 169                     ah <- get bh
 170                     return (MachFloat ah)
 171               8 -> do
 172                     ai <- get bh
 173                     return (MachDouble ai)
 174               9 -> do
 175                     aj <- get bh
 176                     mb <- get bh
 177                     return (MachLabel aj mb)
 178 \end{code}
 179
 180 \begin{code}
 181 instance Outputable Literal where
 182     ppr lit = pprLit lit
 183
 184 instance Show Literal where
 185     showsPrec p lit = showsPrecSDoc p (ppr lit)
 186
 187 instance Eq Literal where
 188     a == b = case (a `compare` b) of { EQ -> True;   _ -> False }
 189     a /= b = case (a `compare` b) of { EQ -> False;  _ -> True  }
 190
 191 instance Ord Literal where
 192     a <= b = case (a `compare` b) of { LT -> True;  EQ -> True;  GT -> False }
 193     a <  b = case (a `compare` b) of { LT -> True;  EQ -> False; GT -> False }
 194     a >= b = case (a `compare` b) of { LT -> False; EQ -> True;  GT -> True  }
 195     a >  b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True  }
 196     compare a b = cmpLit a b
 197 \end{code}
 198
 199
 200         Construction
 201         ~~~~~~~~~~~~
 202 \begin{code}
 203 mkMachInt, mkMachWord, mkMachInt64, mkMachWord64 :: Integer -> Literal
 204
 205 mkMachInt  x   = -- ASSERT2( inIntRange x,  integer x )
 206                  -- Not true: you can write out of range Int# literals
 207                  -- For example, one can write (intToWord# 0xffff0000) to
 208                  -- get a particular Word bit-pattern, and there's no other
 209                  -- convenient way to write such literals, which is why we allow it.
 210                  MachInt x
 211 mkMachWord x   = -- ASSERT2( inWordRange x, integer x )
 212                  MachWord x
 213 mkMachInt64  x = MachInt64 x
 214 mkMachWord64 x = MachWord64 x
 215
 216 mkStringLit :: String -> Literal
 217 mkStringLit s = MachStr (mkFastString s) -- stored UTF-8 encoded
 218
 219 inIntRange, inWordRange :: Integer -> Bool
 220 inIntRange  x = x >= tARGET_MIN_INT && x <= tARGET_MAX_INT
 221 inWordRange x = x >= 0              && x <= tARGET_MAX_WORD
 222
 223 inCharRange :: Char -> Bool
 224 inCharRange c =  c >= '\0' && c <= chr tARGET_MAX_CHAR
 225
 226 isZeroLit :: Literal -> Bool
 227 isZeroLit (MachInt    0) = True
 228 isZeroLit (MachInt64  0) = True
 229 isZeroLit (MachWord   0) = True
 230 isZeroLit (MachWord64 0) = True
 231 isZeroLit (MachFloat  0) = True
 232 isZeroLit (MachDouble 0) = True
 233 isZeroLit _              = False
 234 \end{code}
 235
 236         Coercions
 237         ~~~~~~~~~
 238 \begin{code}
 239 word2IntLit, int2WordLit,
 240   narrow8IntLit, narrow16IntLit, narrow32IntLit,
 241   narrow8WordLit, narrow16WordLit, narrow32WordLit,
 242   char2IntLit, int2CharLit,
 243   float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit,
 244   float2DoubleLit, double2FloatLit
 245   :: Literal -> Literal
 246
 247 word2IntLit (MachWord w)
 248   | w > tARGET_MAX_INT = MachInt (w - tARGET_MAX_WORD - 1)
 249   | otherwise          = MachInt w
 250
 251 int2WordLit (MachInt i)
 252   | i < 0     = MachWord (1 + tARGET_MAX_WORD + i)      -- (-1)  --->  tARGET_MAX_WORD
 253   | otherwise = MachWord i
 254
 255 narrow8IntLit    (MachInt  i) = MachInt  (toInteger (fromInteger i :: Int8))
 256 narrow16IntLit   (MachInt  i) = MachInt  (toInteger (fromInteger i :: Int16))
 257 narrow32IntLit   (MachInt  i) = MachInt  (toInteger (fromInteger i :: Int32))
 258 narrow8WordLit   (MachWord w) = MachWord (toInteger (fromInteger w :: Word8))
 259 narrow16WordLit  (MachWord w) = MachWord (toInteger (fromInteger w :: Word16))
 260 narrow32WordLit  (MachWord w) = MachWord (toInteger (fromInteger w :: Word32))
 261
 262 char2IntLit (MachChar c) = MachInt  (toInteger (ord c))
 263 int2CharLit (MachInt  i) = MachChar (chr (fromInteger i))
 264
 265 float2IntLit (MachFloat f) = MachInt   (truncate    f)
 266 int2FloatLit (MachInt   i) = MachFloat (fromInteger i)
 267
 268 double2IntLit (MachDouble f) = MachInt    (truncate    f)
 269 int2DoubleLit (MachInt   i) = MachDouble (fromInteger i)
 270
 271 float2DoubleLit (MachFloat  f) = MachDouble f
 272 double2FloatLit (MachDouble d) = MachFloat  d
 273
 274 nullAddrLit :: Literal
 275 nullAddrLit = MachNullAddr
 276 \end{code}
 277
 278         Predicates
 279         ~~~~~~~~~~
 280 \begin{code}
 281 litIsTrivial :: Literal -> Bool
 282 -- True if there is absolutely no penalty to duplicating the literal
 283 --      c.f. CoreUtils.exprIsTrivial
 284 -- False principally of strings
 285 litIsTrivial (MachStr _) = False
 286 litIsTrivial _           = True
 287
 288 litIsDupable :: Literal -> Bool
 289 -- True if code space does not go bad if we duplicate this literal
 290 --      c.f. CoreUtils.exprIsDupable
 291 -- Currently we treat it just like litIsTrivial
 292 litIsDupable (MachStr _) = False
 293 litIsDupable _           = True
 294
 295 litFitsInChar :: Literal -> Bool
 296 litFitsInChar (MachInt i)
 297                          = fromInteger i <= ord minBound
 298                         && fromInteger i >= ord maxBound
 299 litFitsInChar _         = False
 300
 301 litSize :: Literal -> Int
 302 -- Used by CoreUnfold.sizeExpr
 303 litSize (MachStr str) = 1 + ((lengthFS str + 3) `div` 4)
 304         -- Every literal has size at least 1, otherwise
 305         --      f "x"
 306         -- might be too small
 307         -- [Sept03: make literal strings a bit bigger to avoid fruitless
 308         --  duplication of little strings]
 309 litSize _other        = 1
 310 \end{code}
 311
 312         Types
 313         ~~~~~
 314 \begin{code}
 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) = ptext SLIT("__label") <+>
 376                              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}