ghc/compiler/basicTypes/Literal.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
   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
  17         -- and to make the interface self-sufficient....
  18     ) where
  19
  20 import Ubiq{-uitous-}
  21
  22 -- friends:
  23 import PrimRep          ( PrimRep(..) ) -- non-abstract
  24 import TysPrim          ( getPrimRepInfo,
  25                           addrPrimTy, intPrimTy, floatPrimTy,
  26                           doublePrimTy, charPrimTy, wordPrimTy )
  27
  28 -- others:
  29 import CStrings         ( stringToC, charToC, charToEasyHaskell )
  30 import TysWiredIn       ( integerTy, rationalTy, stringTy )
  31 import Pretty           -- pretty-printing stuff
  32 import PprStyle         ( PprStyle(..), codeStyle )
  33 import Util             ( panic )
  34 \end{code}
  35
  36 So-called @Literals@ are {\em either}:
  37 \begin{itemize}
  38 \item
  39 An unboxed (``machine'') literal (type: @IntPrim@, @FloatPrim@, etc.),
  40 which is presumed to be surrounded by appropriate constructors
  41 (@mKINT@, etc.), so that the overall thing makes sense.
  42 \item
  43 An Integer, Rational, or String literal whose representation we are
  44 {\em uncommitted} about; i.e., the surrounding with constructors,
  45 function applications, etc., etc., has not yet been done.
  46 \end{itemize}
  47
  48 \begin{code}
  49 data Literal
  50   = MachChar    Char
  51   | MachStr     FAST_STRING
  52   | MachAddr    Integer -- whatever this machine thinks is a "pointer"
  53   | MachInt     Integer -- for the numeric types, these are
  54                 Bool    -- True <=> signed (Int#); False <=> unsigned (Word#)
  55   | MachFloat   Rational
  56   | MachDouble  Rational
  57   | MachLitLit  FAST_STRING
  58                 PrimRep
  59
  60   | NoRepStr        FAST_STRING -- the uncommitted ones
  61   | NoRepInteger    Integer
  62   | NoRepRational   Rational
  63
  64   deriving (Eq, Ord)
  65   -- The Ord is needed for the FiniteMap used in the lookForConstructor
  66   -- in SimplEnv.  If you declared that lookForConstructor *ignores*
  67   -- constructor-applications with LitArg args, then you could get
  68   -- rid of this Ord.
  69
  70 mkMachInt, mkMachWord :: Integer -> Literal
  71
  72 mkMachInt  x = MachInt x True{-signed-}
  73 mkMachWord x = MachInt x False{-unsigned-}
  74 \end{code}
  75
  76 \begin{code}
  77 isNoRepLit (NoRepStr _)         = True -- these are not primitive typed!
  78 isNoRepLit (NoRepInteger _)     = True
  79 isNoRepLit (NoRepRational _)    = True
  80 isNoRepLit _                    = False
  81
  82 isLitLitLit (MachLitLit _ _) = True
  83 isLitLitLit _                = False
  84 \end{code}
  85
  86 \begin{code}
  87 literalType :: Literal -> Type
  88
  89 literalType (MachChar _)        = charPrimTy
  90 literalType (MachStr  _)        = addrPrimTy
  91 literalType (MachAddr _)        = addrPrimTy
  92 literalType (MachInt  _ signed) = if signed then intPrimTy else wordPrimTy
  93 literalType (MachFloat _)       = floatPrimTy
  94 literalType (MachDouble _)      = doublePrimTy
  95 literalType (MachLitLit _ k)    = case (getPrimRepInfo k) of { (_,t,_) -> t }
  96 literalType (NoRepInteger _)    = integerTy
  97 literalType (NoRepRational _)= rationalTy
  98 literalType (NoRepStr _)        = stringTy
  99 \end{code}
 100
 101 \begin{code}
 102 literalPrimRep :: Literal -> PrimRep
 103
 104 literalPrimRep (MachChar _)     = CharRep
 105 literalPrimRep (MachStr _)      = AddrRep  -- specifically: "char *"
 106 literalPrimRep (MachAddr  _)    = AddrRep
 107 literalPrimRep (MachInt _ signed) = if signed then IntRep else WordRep
 108 literalPrimRep (MachFloat _)    = FloatRep
 109 literalPrimRep (MachDouble _)   = DoubleRep
 110 literalPrimRep (MachLitLit _ k) = k
 111 #ifdef DEBUG
 112 literalPrimRep (NoRepInteger _) = panic "literalPrimRep:NoRepInteger"
 113 literalPrimRep (NoRepRational _)= panic "literalPrimRep:NoRepRational"
 114 literalPrimRep (NoRepStr _)     = panic "literalPrimRep:NoRepString"
 115 #endif
 116 \end{code}
 117
 118 The boring old output stuff:
 119 \begin{code}
 120 ppCast :: PprStyle -> FAST_STRING -> Pretty
 121 ppCast PprForC cast = ppPStr cast
 122 ppCast _       _    = ppNil
 123
 124 instance Outputable Literal where
 125     ppr sty (MachChar ch)
 126       = let
 127             char_encoding
 128               = case sty of
 129                   PprForC       -> charToC ch
 130                   PprForAsm _ _ -> charToC ch
 131                   PprUnfolding  -> charToEasyHaskell ch
 132                   _             -> [ch]
 133         in
 134         ppBeside (ppBesides [ppCast sty SLIT("(C_)"), ppChar '\'', ppStr char_encoding, ppChar '\''])
 135                  (if_ubxd sty)
 136
 137     ppr sty (MachStr s)
 138       = ppBeside (if codeStyle sty
 139                   then ppBesides [ppChar '"', ppStr (stringToC (_UNPK_ s)), ppChar '"']
 140                   else ppStr (show (_UNPK_ s)))
 141                  (if_ubxd sty)
 142
 143     ppr sty (MachAddr p) = ppBesides [ppCast sty SLIT("(void*)"), ppInteger p, if_ubxd sty]
 144     ppr sty (MachInt i signed)
 145       | codeStyle sty
 146       && ((signed     && (i >= toInteger minInt && i <= toInteger maxInt))
 147        || (not signed && (i >= toInteger 0      && i <= toInteger maxInt)))
 148       -- ToDo: Think about these ranges!
 149       = ppBesides [ppInteger i, if_ubxd sty]
 150
 151       | not (codeStyle sty) -- we'd prefer the code to the error message
 152       = ppBesides [ppInteger i, if_ubxd sty]
 153
 154       | otherwise
 155       = error ("ERROR: Int " ++ show i ++ " out of range [" ++
 156                 show range_min ++ " .. " ++ show maxInt ++ "]\n")
 157       where
 158         range_min = if signed then minInt else 0
 159
 160     ppr sty (MachFloat f)  = ppBesides [ppCast sty SLIT("(StgFloat)"), ppRational f, if_ubxd sty]
 161     ppr sty (MachDouble d) = ppBesides [ppRational d, if_ubxd sty, if_ubxd sty]
 162
 163     ppr sty (NoRepInteger i)
 164       | codeStyle sty  = ppInteger i
 165       | ufStyle sty    = ppCat [ppStr "_NOREP_I_", ppInteger i]
 166       | otherwise      = ppBesides [ppInteger i, ppChar 'I']
 167
 168     ppr sty (NoRepRational r)
 169       | ufStyle sty    = ppCat [ppStr "_NOREP_R_", ppInteger (numerator r), ppInteger (denominator r)]
 170       | codeStyle sty = panic "ppr.ForC.NoRepRational"
 171       | otherwise     = ppBesides [ppRational r,  ppChar 'R']
 172
 173     ppr sty (NoRepStr s)
 174       | codeStyle sty = ppBesides [ppStr (show (_UNPK_ s))]
 175       | ufStyle   sty = ppCat [ppStr "_NOREP_S_", ppStr (show (_UNPK_ s))]
 176       | otherwise     = ppBesides [ppStr (show (_UNPK_ s)), ppChar 'S']
 177
 178     ppr sty (MachLitLit s k)
 179       | codeStyle sty = ppPStr s
 180       | ufStyle   sty = ppBesides [ppStr "``", ppPStr s, ppStr "'' _K_ ", ppr sty k]
 181       | otherwise     = ppBesides [ppStr "``", ppPStr s, ppStr "''"]
 182
 183 ufStyle PprUnfolding = True
 184 ufStyle _            = False
 185
 186 if_ubxd sty = if codeStyle sty then ppNil else ppChar '#'
 187
 188 showLiteral :: PprStyle -> Literal -> String
 189
 190 showLiteral sty lit = ppShow 80 (ppr sty lit)
 191 \end{code}