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 #include "HsVersions.h"
   8
   9 module Literal (
  10         Literal(..),
  11
  12         mkMachInt, mkMachWord,
  13         literalType, literalPrimRep,
  14         showLiteral,
  15         isNoRepLit, isLitLitLit
  16     ) where
  17
  18 IMP_Ubiq(){-uitous-}
  19 IMPORT_1_3(Ratio)
  20
  21 -- friends:
  22 import PrimRep          ( PrimRep(..), ppPrimRep ) -- non-abstract
  23 import TysPrim          ( getPrimRepInfo,
  24                           addrPrimTy, intPrimTy, floatPrimTy,
  25                           doublePrimTy, charPrimTy, wordPrimTy )
  26
  27 -- others:
  28 import CStrings         ( stringToC, charToC, charToEasyHaskell )
  29 import TysWiredIn       ( stringTy )
  30 import Pretty           -- pretty-printing stuff
  31 import PprStyle         ( PprStyle(..), codeStyle, ifaceStyle )
  32 import Util             ( thenCmp, panic, pprPanic )
  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 instance Ord3 Literal where
  82     cmp (MachChar      a)   (MachChar      b)   = a `tcmp` b
  83     cmp (MachStr       a)   (MachStr       b)   = a `tcmp` b
  84     cmp (MachAddr      a)   (MachAddr      b)   = a `tcmp` b
  85     cmp (MachInt       a b) (MachInt       c d) = (a `tcmp` c) `thenCmp` (b `tcmp` d)
  86     cmp (MachFloat     a)   (MachFloat     b)   = a `tcmp` b
  87     cmp (MachDouble    a)   (MachDouble    b)   = a `tcmp` b
  88     cmp (MachLitLit    a b) (MachLitLit    c d) = (a `tcmp` c) `thenCmp` (b `tcmp` d)
  89     cmp (NoRepStr      a)   (NoRepStr      b)   = a `tcmp` b
  90     cmp (NoRepInteger  a _) (NoRepInteger  b _) = a `tcmp` b
  91     cmp (NoRepRational a _) (NoRepRational b _) = a `tcmp` b
  92
  93       -- now we *know* the tags are different, so...
  94     cmp other_1 other_2
  95       | tag1 _LT_ tag2 = LT_
  96       | otherwise      = GT_
  97       where
  98         tag1 = tagof other_1
  99         tag2 = tagof other_2
 100
 101         tagof (MachChar      _)   = ILIT(1)
 102         tagof (MachStr       _)   = ILIT(2)
 103         tagof (MachAddr      _)   = ILIT(3)
 104         tagof (MachInt       _ _) = ILIT(4)
 105         tagof (MachFloat     _)   = ILIT(5)
 106         tagof (MachDouble    _)   = ILIT(6)
 107         tagof (MachLitLit    _ _) = ILIT(7)
 108         tagof (NoRepStr      _)   = ILIT(8)
 109         tagof (NoRepInteger  _ _) = ILIT(9)
 110         tagof (NoRepRational _ _) = ILIT(10)
 111
 112 tcmp x y = case _tagCmp x y of { _LT -> LT_; _EQ -> EQ_; GT__ -> GT_ }
 113
 114 instance Eq Literal where
 115     a == b = case (a `cmp` b) of { EQ_ -> True;   _ -> False }
 116     a /= b = case (a `cmp` b) of { EQ_ -> False;  _ -> True  }
 117
 118 instance Ord Literal where
 119     a <= b = case (a `cmp` b) of { LT_ -> True;  EQ_ -> True;  GT__ -> False }
 120     a <  b = case (a `cmp` b) of { LT_ -> True;  EQ_ -> False; GT__ -> False }
 121     a >= b = case (a `cmp` b) of { LT_ -> False; EQ_ -> True;  GT__ -> True  }
 122     a >  b = case (a `cmp` b) of { LT_ -> False; EQ_ -> False; GT__ -> True  }
 123     _tagCmp a b = case (a `cmp` b) of { LT_ -> _LT; EQ_ -> _EQ; GT__ -> _GT }
 124 \end{code}
 125
 126 \begin{code}
 127 isNoRepLit (NoRepStr _)         = True -- these are not primitive typed!
 128 isNoRepLit (NoRepInteger  _ _)  = True
 129 isNoRepLit (NoRepRational _ _)  = True
 130 isNoRepLit _                    = False
 131
 132 isLitLitLit (MachLitLit _ _) = True
 133 isLitLitLit _                = False
 134 \end{code}
 135
 136 \begin{code}
 137 literalType :: Literal -> Type
 138
 139 literalType (MachChar _)        = charPrimTy
 140 literalType (MachStr  _)        = addrPrimTy
 141 literalType (MachAddr _)        = addrPrimTy
 142 literalType (MachInt  _ signed) = if signed then intPrimTy else wordPrimTy
 143 literalType (MachFloat _)       = floatPrimTy
 144 literalType (MachDouble _)      = doublePrimTy
 145 literalType (MachLitLit _ k)    = case (getPrimRepInfo k) of { (_,t,_) -> t }
 146 literalType (NoRepInteger  _ t) = t
 147 literalType (NoRepRational _ t) = t
 148 literalType (NoRepStr _)        = stringTy
 149 \end{code}
 150
 151 \begin{code}
 152 literalPrimRep :: Literal -> PrimRep
 153
 154 literalPrimRep (MachChar _)     = CharRep
 155 literalPrimRep (MachStr _)      = AddrRep  -- specifically: "char *"
 156 literalPrimRep (MachAddr  _)    = AddrRep
 157 literalPrimRep (MachInt _ signed) = if signed then IntRep else WordRep
 158 literalPrimRep (MachFloat _)    = FloatRep
 159 literalPrimRep (MachDouble _)   = DoubleRep
 160 literalPrimRep (MachLitLit _ k) = k
 161 #ifdef DEBUG
 162 literalPrimRep (NoRepInteger  _ _) = panic "literalPrimRep:NoRepInteger"
 163 literalPrimRep (NoRepRational _ _) = panic "literalPrimRep:NoRepRational"
 164 literalPrimRep (NoRepStr _)        = panic "literalPrimRep:NoRepString"
 165 #endif
 166 \end{code}
 167
 168 The boring old output stuff:
 169 \begin{code}
 170 ppCast :: PprStyle -> FAST_STRING -> Pretty
 171 ppCast PprForC cast = ppPStr cast
 172 ppCast _       _    = ppNil
 173
 174 -- MachX (i.e. unboxed) things are printed unadornded (e.g. 3, 'a', "foo")
 175 --      exceptions: MachFloat and MachAddr get an initial keyword prefix
 176 --
 177 -- NoRep things get an initial keyword prefix (e.g. _integer_ 3)
 178
 179 instance Outputable Literal where
 180     ppr sty (MachChar ch)
 181       = let
 182             char_encoding
 183               = case sty of
 184                   PprForC       -> charToC ch
 185                   PprForAsm _ _ -> charToC ch
 186                   PprInterface  -> charToEasyHaskell ch
 187                   _             -> [ch]
 188         in
 189         ppBesides [ppCast sty SLIT("(C_)"), ppChar '\'', ppStr char_encoding, ppChar '\'']
 190
 191     ppr sty (MachStr s)
 192       | codeStyle sty = ppBesides [ppChar '"', ppStr (stringToC (_UNPK_ s)), ppChar '"']
 193       | otherwise     = ppBesides [ppChar '"', ppPStr s, ppChar '"']
 194
 195     ppr sty lit@(NoRepStr s)
 196       | codeStyle sty = pprPanic "NoRep in code style" (ppr PprDebug lit)
 197       | otherwise     = ppBesides [ppPStr SLIT("_string_"), ppChar '"', ppPStr s,ppChar '"']
 198
 199     ppr sty (MachInt i signed)
 200       | codeStyle sty && out_of_range
 201       = panic ("ERROR: Int " ++ show i ++ " out of range [" ++
 202                 show range_min ++ " .. " ++ show range_max ++ "]\n")
 203
 204       | otherwise = ppInteger i
 205
 206       where
 207         range_min = if signed then minInt else 0
 208         range_max = maxInt
 209         out_of_range = not (i >= toInteger range_min && i <= toInteger range_max)
 210
 211     ppr sty (MachFloat f)
 212        | codeStyle sty = ppBesides [ppCast sty SLIT("(StgFloat)"), ppRational f]
 213        | otherwise     = ppBesides [ppPStr SLIT("_float_"), ppRational f]
 214
 215     ppr sty (MachDouble d) = ppRational d
 216
 217     ppr sty (MachAddr p)
 218        | codeStyle sty = ppBesides [ppCast sty SLIT("(void*)"), ppInteger p]
 219        | otherwise     = ppBesides [ppPStr SLIT("_addr_"), ppInteger p]
 220
 221     ppr sty lit@(NoRepInteger i _)
 222       | codeStyle sty  = pprPanic "NoRep in code style" (ppr PprDebug lit)
 223       | otherwise      = ppCat [ppPStr SLIT("_integer_"), ppInteger i]
 224
 225     ppr sty lit@(NoRepRational r _)
 226       | codeStyle sty = pprPanic "NoRep in code style" (ppr PprDebug lit)
 227       | otherwise     = ppCat [ppPStr SLIT("_rational_"), ppInteger (numerator r), ppInteger (denominator r)]
 228
 229     ppr sty (MachLitLit s k)
 230       | codeStyle  sty = ppPStr s
 231       | otherwise      = ppBesides [ppPStr SLIT("_litlit_ "), ppPrimRep k, ppStr " \"", ppPStr s, ppChar '"']
 232
 233 showLiteral :: PprStyle -> Literal -> String
 234 showLiteral sty lit = ppShow 80 (ppr sty lit)
 235 \end{code}
 236