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