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