ghc/compiler/basicTypes/Literal.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
   3 %
   4 \section[Literal]{@Literal@: Machine literals (unboxed, of course)}
   5
   6 \begin{code}
   7 module Literal
   8        (
   9          Literal(..)
  10
  11        , mkMachInt
  12        , mkMachInt_safe
  13        , mkMachWord
  14        , literalType
  15        , literalPrimRep
  16        , showLiteral
  17        , isNoRepLit
  18        , isLitLitLit
  19        ) where
  20
  21 #include "HsVersions.h"
  22
  23 -- friends:
  24 import PrimRep          ( PrimRep(..), ppPrimRep ) -- non-abstract
  25 import TysPrim          ( getPrimRepInfo,
  26                           addrPrimTy, intPrimTy, floatPrimTy,
  27                           doublePrimTy, charPrimTy, wordPrimTy
  28                         )
  29
  30 -- others:
  31 import Type             ( Type )
  32 import CStrings         ( stringToC, charToC, charToEasyHaskell )
  33 import TysWiredIn       ( stringTy )
  34 import Outputable
  35 import Util             ( thenCmp )
  36
  37 \end{code}
  38
  39 So-called @Literals@ are {\em either}:
  40 \begin{itemize}
  41 \item
  42 An unboxed (``machine'') literal (type: @IntPrim@, @FloatPrim@, etc.),
  43 which is presumed to be surrounded by appropriate constructors
  44 (@mKINT@, etc.), so that the overall thing makes sense.
  45 \item
  46 An Integer, Rational, or String literal whose representation we are
  47 {\em uncommitted} about; i.e., the surrounding with constructors,
  48 function applications, etc., etc., has not yet been done.
  49 \end{itemize}
  50
  51 \begin{code}
  52 data Literal
  53   = MachChar    Char
  54   | MachStr     FAST_STRING
  55
  56   | MachAddr    Integer -- whatever this machine thinks is a "pointer"
  57
  58   | MachInt     Integer -- for the numeric types, these are
  59                 Bool    -- True <=> signed (Int#); False <=> unsigned (Word#)
  60
  61   | MachInt64   Integer -- guaranteed 64-bit versions of the above.
  62                 Bool    -- True <=> signed (Int#); False <=> unsigned (Word#)
  63
  64   | MachFloat   Rational
  65   | MachDouble  Rational
  66
  67   | MachLitLit  FAST_STRING
  68                 PrimRep
  69
  70   | NoRepStr        FAST_STRING
  71   | NoRepInteger    Integer  Type       -- This Type is always Integer
  72   | NoRepRational   Rational Type       -- This Type is always Rational
  73                         -- We keep these Types in the literal because Rational isn't
  74                         -- (currently) wired in, so we can't conjure up its type out of
  75                         -- thin air.    Integer is, so the type here is really redundant.
  76
  77   -- deriving (Eq, Ord): no, don't want to compare Types
  78   -- The Ord is needed for the FiniteMap used in the lookForConstructor
  79   -- in SimplEnv.  If you declared that lookForConstructor *ignores*
  80   -- constructor-applications with LitArg args, then you could get
  81   -- rid of this Ord.
  82
  83 mkMachInt, mkMachWord :: Integer -> Literal
  84
  85 mkMachInt  x = MachInt x True{-signed-}
  86 mkMachWord x = MachInt x False{-unsigned-}
  87
  88 -- check if the int is within range
  89 mkMachInt_safe :: Integer -> Literal
  90 mkMachInt_safe i
  91  | out_of_range =
  92    pprPanic "mkMachInt_safe"
  93             (hsep [text "ERROR: Int ", text (show i), text "out of range",
  94                    brackets (int minInt <+> text ".." <+> int maxInt)])
  95  | otherwise = MachInt i True{-signed-}
  96  where
  97   out_of_range =
  98 --    i < fromInt minBound ||
  99     i > fromInt maxInt
 100
 101 mkMachInt64  x = MachInt64 x True{-signed-}
 102 mkMachWord64 x = MachInt64 x False{-unsigned-}
 103
 104 cmpLit (MachChar      a)   (MachChar       b)   = a `compare` b
 105 cmpLit (MachStr       a)   (MachStr        b)   = a `compare` b
 106 cmpLit (MachAddr      a)   (MachAddr       b)   = a `compare` b
 107 cmpLit (MachInt       a b) (MachInt        c d) = (a `compare` c) `thenCmp` (b `compare` d)
 108 cmpLit (MachFloat     a)   (MachFloat      b)   = a `compare` b
 109 cmpLit (MachDouble    a)   (MachDouble     b)   = a `compare` b
 110 cmpLit (MachLitLit    a b) (MachLitLit    c d) = (a `compare` c) `thenCmp` (b `compare` d)
 111 cmpLit (NoRepStr      a)   (NoRepStr       b)   = a `compare` b
 112 cmpLit (NoRepInteger  a _) (NoRepInteger  b _) = a `compare` b
 113 cmpLit (NoRepRational a _) (NoRepRational b _) = a `compare` b
 114
 115   -- now we *know* the tags are different, so...
 116 cmpLit other_1 other_2
 117   | tag1 _LT_ tag2 = LT
 118   | otherwise      = GT
 119   where
 120     tag1 = tagof other_1
 121     tag2 = tagof other_2
 122
 123     tagof (MachChar      _)   = ILIT(1)
 124     tagof (MachStr       _)   = ILIT(2)
 125     tagof (MachAddr      _)   = ILIT(3)
 126     tagof (MachInt       _ _) = ILIT(4)
 127     tagof (MachFloat     _)   = ILIT(5)
 128     tagof (MachDouble    _)   = ILIT(6)
 129     tagof (MachLitLit    _ _) = ILIT(7)
 130     tagof (NoRepStr      _)   = ILIT(8)
 131     tagof (NoRepInteger  _ _) = ILIT(9)
 132     tagof (NoRepRational _ _) = ILIT(10)
 133
 134 instance Eq Literal where
 135     a == b = case (a `compare` b) of { EQ -> True;   _ -> False }
 136     a /= b = case (a `compare` b) of { EQ -> False;  _ -> True  }
 137
 138 instance Ord Literal where
 139     a <= b = case (a `compare` b) of { LT -> True;  EQ -> True;  GT -> False }
 140     a <  b = case (a `compare` b) of { LT -> True;  EQ -> False; GT -> False }
 141     a >= b = case (a `compare` b) of { LT -> False; EQ -> True;  GT -> True  }
 142     a >  b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True  }
 143     compare a b = cmpLit a b
 144 \end{code}
 145
 146 \begin{code}
 147 isNoRepLit (NoRepStr _)         = True -- these are not primitive typed!
 148 isNoRepLit (NoRepInteger  _ _)  = True
 149 isNoRepLit (NoRepRational _ _)  = True
 150 isNoRepLit _                    = False
 151
 152 isLitLitLit (MachLitLit _ _) = True
 153 isLitLitLit _                = False
 154 \end{code}
 155
 156 \begin{code}
 157 literalType :: Literal -> Type
 158
 159 literalType (MachChar _)        = charPrimTy
 160 literalType (MachStr  _)        = addrPrimTy
 161 literalType (MachAddr _)        = addrPrimTy
 162 literalType (MachInt  _ signed) = if signed then intPrimTy else wordPrimTy
 163 literalType (MachFloat _)       = floatPrimTy
 164 literalType (MachDouble _)      = doublePrimTy
 165 literalType (MachLitLit _ k)    = case (getPrimRepInfo k) of { (_,t,_) -> t }
 166 literalType (NoRepInteger  _ t) = t
 167 literalType (NoRepRational _ t) = t
 168 literalType (NoRepStr _)        = stringTy
 169 \end{code}
 170
 171 \begin{code}
 172 literalPrimRep :: Literal -> PrimRep
 173
 174 literalPrimRep (MachChar _)     = CharRep
 175 literalPrimRep (MachStr _)      = AddrRep  -- specifically: "char *"
 176 literalPrimRep (MachAddr  _)    = AddrRep
 177 literalPrimRep (MachInt _ signed) = if signed then IntRep else WordRep
 178 literalPrimRep (MachInt64 _ signed) = if signed then Int64Rep else Word64Rep
 179 literalPrimRep (MachFloat _)    = FloatRep
 180 literalPrimRep (MachDouble _)   = DoubleRep
 181 literalPrimRep (MachLitLit _ k) = k
 182 #ifdef DEBUG
 183 literalPrimRep (NoRepInteger  _ _) = panic "literalPrimRep:NoRepInteger"
 184 literalPrimRep (NoRepRational _ _) = panic "literalPrimRep:NoRepRational"
 185 literalPrimRep (NoRepStr _)        = panic "literalPrimRep:NoRepString"
 186 #endif
 187 \end{code}
 188
 189 The boring old output stuff:
 190 \begin{code}
 191 -- MachX (i.e. unboxed) things are printed unadornded (e.g. 3, 'a', "foo")
 192 --      exceptions: MachFloat and MachAddr get an initial keyword prefix
 193 --
 194 -- NoRep things get an initial keyword prefix (e.g. _integer_ 3)
 195
 196 instance Outputable Literal where
 197     ppr lit = pprLit lit
 198
 199 pprLit lit
 200   = getPprStyle $ \ sty ->
 201     let
 202       code_style = codeStyle sty
 203     in
 204     case lit of
 205       MachChar ch | code_style     -> hcat [ptext SLIT("(C_)"), char '\'', text (charToC ch), char '\'']
 206                   | ifaceStyle sty -> char '\'' <> text (charToEasyHaskell ch) <> char '\''
 207                   | otherwise      -> text ['\'', ch, '\'']
 208
 209       MachStr s | code_style -> doubleQuotes (text (stringToC (_UNPK_ s)))
 210                 | otherwise  -> text (show (_UNPK_ s))
 211
 212       NoRepStr s | code_style -> pprPanic "NoRep in code style" (ppr lit)
 213                  | otherwise  -> ptext SLIT("_string_") <+> text (show (_UNPK_ s))
 214
 215       MachInt i _ -> integer i
 216 {-
 217                 | code_style && out_of_range
 218                        -> pprPanic "" (hsep [text "ERROR: Int ", text (show i), text "out of range",
 219                                              brackets (ppr range_min <+> text ".." <+> ppr range_max)])
 220                        | otherwise -> integer i
 221
 222                        where
 223                         range_min = if signed then minInt else 0
 224                         range_max = maxInt
 225                         out_of_range = not (i >= toInteger range_min && i <= toInteger range_max)
 226 -}
 227
 228       MachFloat f | code_style -> ptext SLIT("(StgFloat)") <> rational f
 229                   | otherwise  -> ptext SLIT("_float_") <+> rational f
 230
 231       MachDouble d -> rational d
 232
 233       MachAddr p | code_style -> ptext SLIT("(void*)") <> integer p
 234                  | otherwise  -> ptext SLIT("_addr_") <+> integer p
 235
 236       NoRepInteger i _ | code_style -> pprPanic "NoRep in code style" (ppr lit)
 237                        | otherwise  -> ptext SLIT("_integer_") <+> integer i
 238
 239       NoRepRational r _ | code_style -> pprPanic "NoRep in code style" (ppr lit)
 240                         | otherwise  -> hsep [ptext SLIT("_rational_"), integer (numerator r),
 241                                                                         integer (denominator r)]
 242
 243       MachLitLit s k | code_style -> ptext s
 244                      | otherwise  -> hsep [ptext SLIT("_litlit_"), ppPrimRep k, text (show (_UNPK_ s))]
 245
 246 showLiteral :: Literal -> String
 247 showLiteral lit = showSDoc (ppr lit)
 248 \end{code}
 249