ghc/compiler/basicTypes/BasicLit.lhs

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