ghc/compiler/basicTypes/Literal.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1998
   3 %
   4 \section[Literal]{@Literal@: Machine literals (unboxed, of course)}
   5
   6 \begin{code}
   7 module Literal
   8         ( Literal(..)           -- Exported to ParseIface
   9         , mkMachInt, mkMachWord
  10         , mkMachInt64, mkMachWord64
  11         , isLitLitLit, maybeLitLit, litSize, litIsDupable,
  12         , literalType, literalPrimRep
  13         , hashLiteral
  14
  15         , inIntRange, inWordRange, tARGET_MAX_INT, inCharRange
  16         , isZeroLit,
  17
  18         , word2IntLit, int2WordLit
  19         , narrow8IntLit, narrow16IntLit, narrow32IntLit
  20         , narrow8WordLit, narrow16WordLit, narrow32WordLit
  21         , char2IntLit, int2CharLit
  22         , float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit
  23         , nullAddrLit, float2DoubleLit, double2FloatLit
  24         ) where
  25
  26 #include "HsVersions.h"
  27
  28 import TysPrim          ( charPrimTy, addrPrimTy, floatPrimTy, doublePrimTy,
  29                           intPrimTy, wordPrimTy, int64PrimTy, word64PrimTy
  30                         )
  31 import PrimRep          ( PrimRep(..) )
  32 import TcType           ( Type, tcCmpType )
  33 import Type             ( typePrimRep )
  34 import PprType          ( pprParendType )
  35 import CStrings         ( pprFSInCStyle )
  36
  37 import Outputable
  38 import FastTypes
  39 import Util             ( thenCmp )
  40
  41 import Ratio            ( numerator )
  42 import FastString       ( uniqueOfFS, lengthFS )
  43 import Int              ( Int8,  Int16,  Int32 )
  44 import Word             ( Word8, Word16, Word32 )
  45 import Char             ( ord, chr )
  46 \end{code}
  47
  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 #if __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    Int             -- Char#        At least 31 bits
 100   | MachStr     FAST_STRING
 101
 102   | MachAddr    Integer -- Whatever this machine thinks is a "pointer"
 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   FAST_STRING             -- always an Addr#
 117
 118         -- lit-lits only work for via-C compilation, hence they
 119         -- are deprecated.  The string is emitted verbatim into
 120         -- the C file, and can therefore be any C expression,
 121         -- macro call, #defined constant etc.
 122   | MachLitLit  FAST_STRING Type        -- Type might be Addr# or Int# etc
 123 \end{code}
 124
 125 \begin{code}
 126 instance Outputable Literal where
 127     ppr lit = pprLit lit
 128
 129 instance Show Literal where
 130     showsPrec p lit = showsPrecSDoc p (ppr lit)
 131
 132 instance Eq Literal where
 133     a == b = case (a `compare` b) of { EQ -> True;   _ -> False }
 134     a /= b = case (a `compare` b) of { EQ -> False;  _ -> True  }
 135
 136 instance Ord Literal where
 137     a <= b = case (a `compare` b) of { LT -> True;  EQ -> True;  GT -> False }
 138     a <  b = case (a `compare` b) of { LT -> True;  EQ -> False; GT -> False }
 139     a >= b = case (a `compare` b) of { LT -> False; EQ -> True;  GT -> True  }
 140     a >  b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True  }
 141     compare a b = cmpLit a b
 142 \end{code}
 143
 144
 145         Construction
 146         ~~~~~~~~~~~~
 147 \begin{code}
 148 mkMachInt, mkMachWord, mkMachInt64, mkMachWord64 :: Integer -> Literal
 149
 150 mkMachInt  x   = -- ASSERT2( inIntRange x,  integer x )
 151                  -- Not true: you can write out of range Int# literals
 152                  -- For example, one can write (intToWord# 0xffff0000) to
 153                  -- get a particular Word bit-pattern, and there's no other
 154                  -- convenient way to write such literals, which is why we allow it.
 155                  MachInt x
 156 mkMachWord x   = -- ASSERT2( inWordRange x, integer x )
 157                  MachWord x
 158 mkMachInt64  x = MachInt64 x
 159 mkMachWord64 x = MachWord64 x
 160
 161 inIntRange, inWordRange :: Integer -> Bool
 162 inIntRange  x = x >= tARGET_MIN_INT && x <= tARGET_MAX_INT
 163 inWordRange x = x >= 0              && x <= tARGET_MAX_WORD
 164
 165 inCharRange :: Int -> Bool
 166 inCharRange c =  c >= 0 && c <= tARGET_MAX_CHAR
 167
 168 isZeroLit :: Literal -> Bool
 169 isZeroLit (MachInt    0) = True
 170 isZeroLit (MachInt64  0) = True
 171 isZeroLit (MachWord   0) = True
 172 isZeroLit (MachWord64 0) = True
 173 isZeroLit (MachFloat  0) = True
 174 isZeroLit (MachDouble 0) = True
 175 isZeroLit other          = False
 176 \end{code}
 177
 178         Coercions
 179         ~~~~~~~~~
 180 \begin{code}
 181 word2IntLit, int2WordLit,
 182   narrow8IntLit, narrow16IntLit, narrow32IntLit,
 183   narrow8WordLit, narrow16WordLit, narrow32WordLit,
 184   char2IntLit, int2CharLit,
 185   float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit,
 186   float2DoubleLit, double2FloatLit
 187   :: Literal -> Literal
 188
 189 word2IntLit (MachWord w)
 190   | w > tARGET_MAX_INT = MachInt (w - tARGET_MAX_WORD - 1)
 191   | otherwise          = MachInt w
 192
 193 int2WordLit (MachInt i)
 194   | i < 0     = MachWord (1 + tARGET_MAX_WORD + i)      -- (-1)  --->  tARGET_MAX_WORD
 195   | otherwise = MachWord i
 196
 197 narrow8IntLit    (MachInt  i) = MachInt  (toInteger (fromInteger i :: Int8))
 198 narrow16IntLit   (MachInt  i) = MachInt  (toInteger (fromInteger i :: Int16))
 199 narrow32IntLit   (MachInt  i) = MachInt  (toInteger (fromInteger i :: Int32))
 200 narrow8WordLit   (MachWord w) = MachWord (toInteger (fromInteger w :: Word8))
 201 narrow16WordLit  (MachWord w) = MachWord (toInteger (fromInteger w :: Word16))
 202 narrow32WordLit  (MachWord w) = MachWord (toInteger (fromInteger w :: Word32))
 203
 204 char2IntLit (MachChar c) = MachInt  (toInteger c)
 205 int2CharLit (MachInt  i) = MachChar (fromInteger i)
 206
 207 float2IntLit (MachFloat f) = MachInt   (truncate    f)
 208 int2FloatLit (MachInt   i) = MachFloat (fromInteger i)
 209
 210 double2IntLit (MachDouble f) = MachInt    (truncate    f)
 211 int2DoubleLit (MachInt   i) = MachDouble (fromInteger i)
 212
 213 float2DoubleLit (MachFloat  f) = MachDouble f
 214 double2FloatLit (MachDouble d) = MachFloat  d
 215
 216 nullAddrLit :: Literal
 217 nullAddrLit = MachAddr 0
 218 \end{code}
 219
 220         Predicates
 221         ~~~~~~~~~~
 222 \begin{code}
 223 isLitLitLit (MachLitLit _ _) = True
 224 isLitLitLit _                = False
 225
 226 maybeLitLit (MachLitLit s t) = Just (s,t)
 227 maybeLitLit _                = Nothing
 228
 229 litIsDupable :: Literal -> Bool
 230         -- True if code space does not go bad if we duplicate this literal
 231         -- False principally of strings
 232 litIsDupable (MachStr _) = False
 233 litIsDupable other       = True
 234
 235 litSize :: Literal -> Int
 236         -- used by CoreUnfold.sizeExpr
 237 litSize (MachStr str) = lengthFS str `div` 4
 238 litSize _other        = 1
 239 \end{code}
 240
 241         Types
 242         ~~~~~
 243 \begin{code}
 244 literalType :: Literal -> Type
 245 literalType (MachChar _)          = charPrimTy
 246 literalType (MachStr  _)          = addrPrimTy
 247 literalType (MachAddr _)          = addrPrimTy
 248 literalType (MachInt  _)          = intPrimTy
 249 literalType (MachWord  _)         = wordPrimTy
 250 literalType (MachInt64  _)        = int64PrimTy
 251 literalType (MachWord64  _)       = word64PrimTy
 252 literalType (MachFloat _)         = floatPrimTy
 253 literalType (MachDouble _)        = doublePrimTy
 254 literalType (MachLabel _)         = addrPrimTy
 255 literalType (MachLitLit _ ty)     = ty
 256 \end{code}
 257
 258 \begin{code}
 259 literalPrimRep :: Literal -> PrimRep
 260
 261 literalPrimRep (MachChar _)       = CharRep
 262 literalPrimRep (MachStr _)        = AddrRep  -- specifically: "char *"
 263 literalPrimRep (MachAddr  _)      = AddrRep
 264 literalPrimRep (MachInt _)        = IntRep
 265 literalPrimRep (MachWord _)       = WordRep
 266 literalPrimRep (MachInt64 _)      = Int64Rep
 267 literalPrimRep (MachWord64 _)     = Word64Rep
 268 literalPrimRep (MachFloat _)      = FloatRep
 269 literalPrimRep (MachDouble _)     = DoubleRep
 270 literalPrimRep (MachLabel _)      = AddrRep
 271 literalPrimRep (MachLitLit _ ty)  = typePrimRep ty
 272 \end{code}
 273
 274
 275         Comparison
 276         ~~~~~~~~~~
 277 \begin{code}
 278 cmpLit (MachChar      a)   (MachChar       b)   = a `compare` b
 279 cmpLit (MachStr       a)   (MachStr        b)   = a `compare` b
 280 cmpLit (MachAddr      a)   (MachAddr       b)   = a `compare` b
 281 cmpLit (MachInt       a)   (MachInt        b)   = a `compare` b
 282 cmpLit (MachWord      a)   (MachWord       b)   = a `compare` b
 283 cmpLit (MachInt64     a)   (MachInt64      b)   = a `compare` b
 284 cmpLit (MachWord64    a)   (MachWord64     b)   = a `compare` b
 285 cmpLit (MachFloat     a)   (MachFloat      b)   = a `compare` b
 286 cmpLit (MachDouble    a)   (MachDouble     b)   = a `compare` b
 287 cmpLit (MachLabel     a)   (MachLabel      b)   = a `compare` b
 288 cmpLit (MachLitLit    a b) (MachLitLit    c d)  = (a `compare` c) `thenCmp` (b `tcCmpType` d)
 289 cmpLit lit1                lit2                 | litTag lit1 <# litTag lit2 = LT
 290                                                 | otherwise                    = GT
 291
 292 litTag (MachChar      _)   = _ILIT(1)
 293 litTag (MachStr       _)   = _ILIT(2)
 294 litTag (MachAddr      _)   = _ILIT(3)
 295 litTag (MachInt       _)   = _ILIT(4)
 296 litTag (MachWord      _)   = _ILIT(5)
 297 litTag (MachInt64     _)   = _ILIT(6)
 298 litTag (MachWord64    _)   = _ILIT(7)
 299 litTag (MachFloat     _)   = _ILIT(8)
 300 litTag (MachDouble    _)   = _ILIT(9)
 301 litTag (MachLabel     _)   = _ILIT(10)
 302 litTag (MachLitLit    _ _) = _ILIT(11)
 303 \end{code}
 304
 305         Printing
 306         ~~~~~~~~
 307 * MachX (i.e. unboxed) things are printed unadornded (e.g. 3, 'a', "foo")
 308   exceptions: MachFloat and MachAddr get an initial keyword prefix
 309
 310 \begin{code}
 311 pprLit lit
 312   = getPprStyle $ \ sty ->
 313     let
 314       code_style  = codeStyle  sty
 315       iface_style = ifaceStyle sty
 316     in
 317     case lit of
 318       MachChar ch | code_style -> hcat [ptext SLIT("(C_)"), text (show ch)]
 319                   | otherwise  -> pprHsChar ch
 320
 321       MachStr s | code_style -> pprFSInCStyle s
 322                 | otherwise  -> pprHsString s
 323       -- Warning: printing MachStr in code_style assumes it contains
 324       -- only characters '\0'..'\xFF'!
 325
 326       MachInt i | code_style && i == tARGET_MIN_INT -> parens (integer (i+1) <> text "-1")
 327                                 -- Avoid a problem whereby gcc interprets
 328                                 -- the constant minInt as unsigned.
 329                 | otherwise -> pprIntVal i
 330
 331       MachInt64 i | code_style -> pprIntVal i           -- Same problem with gcc???
 332                   | otherwise -> ptext SLIT("__int64") <+> integer i
 333
 334       MachWord w | code_style -> pprHexVal w
 335                  | otherwise  -> ptext SLIT("__word") <+> integer w
 336
 337       MachWord64 w | code_style -> pprHexVal w
 338                    | otherwise  -> ptext SLIT("__word64") <+> integer w
 339
 340       MachFloat f | code_style -> ptext SLIT("(StgFloat)") <> rational f
 341                   | otherwise  -> ptext SLIT("__float") <+> rational f
 342
 343       MachDouble d | iface_style && d < 0 -> parens (rational d)
 344                    | otherwise            -> rational d
 345
 346       MachAddr p | code_style -> ptext SLIT("(void*)") <> integer p
 347                  | otherwise  -> ptext SLIT("__addr") <+> integer p
 348
 349       MachLabel l | code_style -> ptext SLIT("(&") <> ptext l <> char ')'
 350                   | otherwise  -> ptext SLIT("__label") <+> pprHsString l
 351
 352       MachLitLit s ty | code_style  -> ptext s
 353                       | otherwise   -> parens (hsep [ptext SLIT("__litlit"),
 354                                                      pprHsString s,
 355                                                      pprParendType ty])
 356
 357 pprIntVal :: Integer -> SDoc
 358 -- Print negative integers with parens to be sure it's unambiguous
 359 pprIntVal i | i < 0     = parens (integer i)
 360             | otherwise = integer i
 361
 362 pprHexVal :: Integer -> SDoc
 363 -- Print in C hex format: 0x13fa
 364 pprHexVal 0 = ptext SLIT("0x0")
 365 pprHexVal w = ptext SLIT("0x") <> go w
 366             where
 367               go 0 = empty
 368               go w = go quot <> dig
 369                    where
 370                      (quot,rem) = w `quotRem` 16
 371                      dig | rem < 10  = char (chr (fromInteger rem + ord '0'))
 372                          | otherwise = char (chr (fromInteger rem - 10 + ord 'a'))
 373 \end{code}
 374
 375
 376 %************************************************************************
 377 %*                                                                      *
 378 \subsection{Hashing}
 379 %*                                                                      *
 380 %************************************************************************
 381
 382 Hash values should be zero or a positive integer.  No negatives please.
 383 (They mess up the UniqFM for some reason.)
 384
 385 \begin{code}
 386 hashLiteral :: Literal -> Int
 387 hashLiteral (MachChar c)        = c + 1000      -- Keep it out of range of common ints
 388 hashLiteral (MachStr s)         = hashFS s
 389 hashLiteral (MachAddr i)        = hashInteger i
 390 hashLiteral (MachInt i)         = hashInteger i
 391 hashLiteral (MachInt64 i)       = hashInteger i
 392 hashLiteral (MachWord i)        = hashInteger i
 393 hashLiteral (MachWord64 i)      = hashInteger i
 394 hashLiteral (MachFloat r)       = hashRational r
 395 hashLiteral (MachDouble r)      = hashRational r
 396 hashLiteral (MachLabel s)       = hashFS s
 397 hashLiteral (MachLitLit 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 :: FAST_STRING -> Int
 408 hashFS s = iBox (uniqueOfFS s)
 409 \end{code}