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