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