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
  12         , literalType, literalPrimRep
  13         , hashLiteral
  14
  15         , inIntRange, inWordRange
  16
  17         , word2IntLit, int2WordLit, char2IntLit, int2CharLit
  18         , float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit
  19         , addr2IntLit, int2AddrLit, float2DoubleLit, double2FloatLit
  20         ) where
  21
  22 #include "HsVersions.h"
  23
  24 import TysPrim          ( charPrimTy, addrPrimTy, floatPrimTy, doublePrimTy,
  25                           intPrimTy, wordPrimTy, int64PrimTy, word64PrimTy
  26                         )
  27 import Name             ( hashName )
  28 import PrimRep          ( PrimRep(..) )
  29 import TyCon            ( isNewTyCon )
  30 import Type             ( Type, typePrimRep )
  31 import PprType          ( pprParendType )
  32 import Demand           ( Demand )
  33 import CStrings         ( charToC, charToEasyHaskell, pprFSInCStyle )
  34
  35 import Outputable
  36 import Util             ( thenCmp )
  37
  38 import Ratio            ( numerator, denominator )
  39 import FastString       ( uniqueOfFS )
  40 import Char             ( ord, chr )
  41
  42 #if __GLASGOW_HASKELL__ >= 404
  43 import GlaExts          ( fromInt )
  44 #endif
  45 \end{code}
  46
  47
  48
  49 %************************************************************************
  50 %*                                                                      *
  51 \subsection{Sizes}
  52 %*                                                                      *
  53 %************************************************************************
  54
  55 If we're compiling with GHC (and we're not cross-compiling), then we
  56 know that minBound and maxBound :: Int are the right values for the
  57 target architecture.  Otherwise, we assume -2^31 and 2^31-1
  58 respectively (which will be wrong on a 64-bit machine).
  59
  60 \begin{code}
  61 tARGET_MIN_INT, tARGET_MAX_INT, tARGET_MAX_WORD :: Integer
  62 #if __GLASGOW_HASKELL__
  63 tARGET_MIN_INT  = toInteger (minBound :: Int)
  64 tARGET_MAX_INT  = toInteger (maxBound :: Int)
  65 #else
  66 tARGET_MIN_INT = -2147483648
  67 tARGET_MAX_INT =  2147483647
  68 #endif
  69 tARGET_MAX_WORD = (tARGET_MAX_INT * 2) + 1
  70 \end{code}
  71
  72
  73 %************************************************************************
  74 %*                                                                      *
  75 \subsection{Literals}
  76 %*                                                                      *
  77 %************************************************************************
  78
  79 So-called @Literals@ are {\em either}:
  80 \begin{itemize}
  81 \item
  82 An unboxed (``machine'') literal (type: @IntPrim@, @FloatPrim@, etc.),
  83 which is presumed to be surrounded by appropriate constructors
  84 (@mKINT@, etc.), so that the overall thing makes sense.
  85 \item
  86 An Integer, Rational, or String literal whose representation we are
  87 {\em uncommitted} about; i.e., the surrounding with constructors,
  88 function applications, etc., etc., has not yet been done.
  89 \end{itemize}
  90
  91 \begin{code}
  92 data Literal
  93   =     ------------------
  94         -- First the primitive guys
  95     MachChar    Char
  96   | MachStr     FAST_STRING
  97
  98   | MachAddr    Integer -- Whatever this machine thinks is a "pointer"
  99
 100   | MachInt     Integer         -- Int#         At least 32 bits
 101   | MachInt64   Integer         -- Int64#       At least 64 bits
 102   | MachWord    Integer         -- Word#        At least 32 bits
 103   | MachWord64  Integer         -- Word64#      At least 64 bits
 104
 105   | MachFloat   Rational
 106   | MachDouble  Rational
 107
 108   | MachLitLit  FAST_STRING Type        -- Type might be Add# or Int# etc
 109 \end{code}
 110
 111 \begin{code}
 112 instance Outputable Literal where
 113     ppr lit = pprLit lit
 114
 115 instance Show Literal where
 116     showsPrec p lit = showsPrecSDoc p (ppr lit)
 117
 118 instance Eq Literal where
 119     a == b = case (a `compare` b) of { EQ -> True;   _ -> False }
 120     a /= b = case (a `compare` b) of { EQ -> False;  _ -> True  }
 121
 122 instance Ord Literal where
 123     a <= b = case (a `compare` b) of { LT -> True;  EQ -> True;  GT -> False }
 124     a <  b = case (a `compare` b) of { LT -> True;  EQ -> False; GT -> False }
 125     a >= b = case (a `compare` b) of { LT -> False; EQ -> True;  GT -> True  }
 126     a >  b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True  }
 127     compare a b = cmpLit a b
 128 \end{code}
 129
 130
 131         Construction
 132         ~~~~~~~~~~~~
 133 \begin{code}
 134 mkMachInt, mkMachWord, mkMachInt64, mkMachWord64 :: Integer -> Literal
 135
 136 mkMachInt  x   = ASSERT2( inIntRange x,  integer x ) MachInt x
 137 mkMachWord x   = ASSERT2( inWordRange x, integer x ) MachWord x
 138 mkMachInt64  x = MachInt64 x    -- Assertions?
 139 mkMachWord64 x = MachWord64 x   -- Ditto?
 140
 141 inIntRange, inWordRange :: Integer -> Bool
 142 inIntRange  x = x >= tARGET_MIN_INT && x <= tARGET_MAX_INT
 143 inWordRange x = x >= 0              && x <= tARGET_MAX_WORD
 144 \end{code}
 145
 146         Coercions
 147         ~~~~~~~~~
 148 \begin{code}
 149 word2IntLit, int2WordLit, char2IntLit, int2CharLit,
 150  float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit,
 151  addr2IntLit, int2AddrLit, float2DoubleLit, double2FloatLit :: Literal -> Literal
 152
 153 word2IntLit (MachWord w)
 154   | w > tARGET_MAX_INT = MachInt ((-1) + tARGET_MAX_WORD - w)
 155   | otherwise          = MachInt w
 156
 157 int2WordLit (MachInt i)
 158   | i < 0     = MachWord (1 + tARGET_MAX_WORD + i)      -- (-1)  --->  tARGET_MAX_WORD
 159   | otherwise = MachWord i
 160
 161 char2IntLit (MachChar c) = MachInt  (toInteger (ord c))
 162 int2CharLit (MachInt  i) = MachChar (chr (fromInteger i))
 163
 164 float2IntLit (MachFloat f) = MachInt   (truncate    f)
 165 int2FloatLit (MachInt   i) = MachFloat (fromInteger i)
 166
 167 double2IntLit (MachFloat f) = MachInt    (truncate    f)
 168 int2DoubleLit (MachInt   i) = MachDouble (fromInteger i)
 169
 170 addr2IntLit (MachAddr a) = MachInt  a
 171 int2AddrLit (MachInt  i) = MachAddr i
 172
 173 float2DoubleLit (MachFloat  f) = MachDouble f
 174 double2FloatLit (MachDouble d) = MachFloat  d
 175 \end{code}
 176
 177         Predicates
 178         ~~~~~~~~~~
 179 \begin{code}
 180 isLitLitLit (MachLitLit _ _) = True
 181 isLitLitLit _                = False
 182 \end{code}
 183
 184         Types
 185         ~~~~~
 186 \begin{code}
 187 literalType :: Literal -> Type
 188 literalType (MachChar _)          = charPrimTy
 189 literalType (MachStr  _)          = addrPrimTy
 190 literalType (MachAddr _)          = addrPrimTy
 191 literalType (MachInt  _)          = intPrimTy
 192 literalType (MachWord  _)         = wordPrimTy
 193 literalType (MachInt64  _)        = int64PrimTy
 194 literalType (MachWord64  _)       = word64PrimTy
 195 literalType (MachFloat _)         = floatPrimTy
 196 literalType (MachDouble _)        = doublePrimTy
 197 literalType (MachLitLit _ ty)     = ty
 198 \end{code}
 199
 200 \begin{code}
 201 literalPrimRep :: Literal -> PrimRep
 202
 203 literalPrimRep (MachChar _)       = CharRep
 204 literalPrimRep (MachStr _)        = AddrRep  -- specifically: "char *"
 205 literalPrimRep (MachAddr  _)      = AddrRep
 206 literalPrimRep (MachInt _)        = IntRep
 207 literalPrimRep (MachWord _)       = WordRep
 208 literalPrimRep (MachInt64 _)      = Int64Rep
 209 literalPrimRep (MachWord64 _)     = Word64Rep
 210 literalPrimRep (MachFloat _)      = FloatRep
 211 literalPrimRep (MachDouble _)     = DoubleRep
 212 literalPrimRep (MachLitLit _ ty)  = typePrimRep ty
 213 \end{code}
 214
 215
 216         Comparison
 217         ~~~~~~~~~~
 218 \begin{code}
 219 cmpLit (MachChar      a)   (MachChar       b)   = a `compare` b
 220 cmpLit (MachStr       a)   (MachStr        b)   = a `compare` b
 221 cmpLit (MachAddr      a)   (MachAddr       b)   = a `compare` b
 222 cmpLit (MachInt       a)   (MachInt        b)   = a `compare` b
 223 cmpLit (MachWord      a)   (MachWord       b)   = a `compare` b
 224 cmpLit (MachInt64     a)   (MachInt64      b)   = a `compare` b
 225 cmpLit (MachWord64    a)   (MachWord64     b)   = a `compare` b
 226 cmpLit (MachFloat     a)   (MachFloat      b)   = a `compare` b
 227 cmpLit (MachDouble    a)   (MachDouble     b)   = a `compare` b
 228 cmpLit (MachLitLit    a b) (MachLitLit    c d)  = (a `compare` c) `thenCmp` (b `compare` d)
 229 cmpLit lit1                lit2                 | litTag lit1 _LT_ litTag lit2 = LT
 230                                                 | otherwise                    = GT
 231
 232 litTag (MachChar      _)   = ILIT(1)
 233 litTag (MachStr       _)   = ILIT(2)
 234 litTag (MachAddr      _)   = ILIT(3)
 235 litTag (MachInt       _)   = ILIT(4)
 236 litTag (MachWord      _)   = ILIT(5)
 237 litTag (MachInt64     _)   = ILIT(6)
 238 litTag (MachWord64    _)   = ILIT(7)
 239 litTag (MachFloat     _)   = ILIT(8)
 240 litTag (MachDouble    _)   = ILIT(9)
 241 litTag (MachLitLit    _ _) = ILIT(10)
 242 \end{code}
 243
 244         Printing
 245         ~~~~~~~~
 246 * MachX (i.e. unboxed) things are printed unadornded (e.g. 3, 'a', "foo")
 247   exceptions: MachFloat and MachAddr get an initial keyword prefix
 248
 249 \begin{code}
 250 pprLit lit
 251   = getPprStyle $ \ sty ->
 252     let
 253       code_style = codeStyle sty
 254     in
 255     case lit of
 256       MachChar ch | code_style     -> hcat [ptext SLIT("(C_)"), char '\'',
 257                                             text (charToC ch), char '\'']
 258                   | ifaceStyle sty -> char '\'' <> text (charToEasyHaskell ch) <> char '\''
 259                   | otherwise      -> text ['\'', ch, '\'']
 260
 261       MachStr s | code_style -> pprFSInCStyle s
 262                 | otherwise  -> pprFSAsString s
 263
 264       MachInt i | code_style && i == tARGET_MIN_INT -> parens (integer (i+1) <> text "-1")
 265                                 -- Avoid a problem whereby gcc interprets
 266                                 -- the constant minInt as unsigned.
 267                 | otherwise -> pprIntVal i
 268
 269       MachInt64 i | code_style -> pprIntVal i           -- Same problem with gcc???
 270                   | otherwise -> ptext SLIT("__int64") <+> integer i
 271
 272       MachWord w | code_style -> pprHexVal w
 273                  | otherwise  -> ptext SLIT("__word") <+> integer w
 274
 275       MachWord64 w | code_style -> pprHexVal w
 276                    | otherwise  -> ptext SLIT("__word64") <+> integer w
 277
 278       MachFloat f | code_style -> ptext SLIT("(StgFloat)") <> rational f
 279                   | otherwise  -> ptext SLIT("__float") <+> rational f
 280
 281       MachDouble d | ifaceStyle sty && d < 0 -> parens (rational d)
 282                    | otherwise -> rational d
 283
 284       MachAddr p | code_style -> ptext SLIT("(void*)") <> integer p
 285                  | otherwise  -> ptext SLIT("__addr") <+> integer p
 286
 287       MachLitLit s ty | code_style -> ptext s
 288                       | otherwise  -> parens (hsep [ptext SLIT("__litlit"),
 289                                                     pprFSAsString s,
 290                                                     pprParendType ty])
 291
 292 pprIntVal :: Integer -> SDoc
 293 -- Print negative integers with parens to be sure it's unambiguous
 294 pprIntVal i | i < 0     = parens (integer i)
 295             | otherwise = integer i
 296
 297 pprHexVal :: Integer -> SDoc
 298 -- Print in C hex format: 0x13fa
 299 pprHexVal 0 = ptext SLIT("0x0")
 300 pprHexVal w = ptext SLIT("0x") <> go w
 301             where
 302               go 0 = empty
 303               go w = go quot <> dig
 304                    where
 305                      (quot,rem) = w `quotRem` 16
 306                      dig | rem < 10  = char (chr (fromInteger rem + ord '0'))
 307                          | otherwise = char (chr (fromInteger rem - 10 + ord 'a'))
 308 \end{code}
 309
 310
 311 %************************************************************************
 312 %*                                                                      *
 313 \subsection{Hashing}
 314 %*                                                                      *
 315 %************************************************************************
 316
 317 Hash values should be zero or a positive integer.  No negatives please.
 318 (They mess up the UniqFM for some reason.)
 319
 320 \begin{code}
 321 hashLiteral :: Literal -> Int
 322 hashLiteral (MachChar c)        = ord c + 1000  -- Keep it out of range of common ints
 323 hashLiteral (MachStr s)         = hashFS s
 324 hashLiteral (MachAddr i)        = hashInteger i
 325 hashLiteral (MachInt i)         = hashInteger i
 326 hashLiteral (MachInt64 i)       = hashInteger i
 327 hashLiteral (MachWord i)        = hashInteger i
 328 hashLiteral (MachWord64 i)      = hashInteger i
 329 hashLiteral (MachFloat r)       = hashRational r
 330 hashLiteral (MachDouble r)      = hashRational r
 331 hashLiteral (MachLitLit s _)    = hashFS s
 332
 333 hashRational :: Rational -> Int
 334 hashRational r = hashInteger (numerator r)
 335
 336 hashInteger :: Integer -> Int
 337 hashInteger i = 1 + abs (fromInteger (i `rem` 10000))
 338                 -- The 1+ is to avoid zero, which is a Bad Number
 339                 -- since we use * to combine hash values
 340
 341 hashFS :: FAST_STRING -> Int
 342 hashFS s = IBOX( uniqueOfFS s )
 343 \end{code}