ghc/compiler/basicTypes/Const.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1998
   3 %
   4 \section[Literal]{@Literal@: Machine literals (unboxed, of course)}
   5
   6 \begin{code}
   7 module Const (
   8         Con(..),
   9         conType, conPrimRep,
  10         conOkForApp, conOkForAlt, isWHNFCon, isDataCon,
  11         conIsTrivial, conIsCheap,
  12
  13         DataCon, PrimOp,        -- For completeness
  14
  15         -- Defined here
  16         Literal(..),            -- Exported to ParseIface
  17         mkMachInt, mkMachWord,
  18         mkMachInt_safe, mkMachInt64, mkMachWord64,
  19         mkStrLit,                       -- ToDo: rm (not used anywhere)
  20         isNoRepLit, isLitLitLit,
  21         literalType, literalPrimRep
  22     ) where
  23
  24 #include "HsVersions.h"
  25
  26 import TysPrim          ( charPrimTy, addrPrimTy, floatPrimTy, doublePrimTy,
  27                           intPrimTy, wordPrimTy, int64PrimTy, word64PrimTy
  28                         )
  29 import PrimOp           ( PrimOp, primOpType, primOpIsCheap )
  30 import PrimRep          ( PrimRep(..) )
  31 import DataCon          ( DataCon, dataConType, dataConTyCon, isNullaryDataCon )
  32 import TyCon            ( isNewTyCon )
  33 import Type             ( Type, typePrimRep )
  34 import PprType          ( pprParendType )
  35 import CStrings         ( stringToC, charToC, charToEasyHaskell )
  36
  37 import Outputable
  38 import Util             ( thenCmp )
  39
  40 #if __HASKELL1__ > 4
  41 import Ratio (numerator, denominator)
  42 #endif
  43 \end{code}
  44
  45
  46 %************************************************************************
  47 %*                                                                      *
  48 \subsection{The main data type}
  49 %*                                                                      *
  50 %************************************************************************
  51
  52 \begin{code}
  53 data Con
  54   = DataCon  DataCon
  55   | Literal  Literal
  56   | PrimOp   PrimOp
  57   | DEFAULT                     -- Used in case clauses
  58   deriving (Eq, Ord)
  59
  60 -- The Ord is needed for the FiniteMap used in the lookForConstructor
  61 -- in SimplEnv.  If you declared that lookForConstructor *ignores*
  62 -- constructor-applications with LitArg args, then you could get
  63 -- rid of this Ord.
  64
  65 instance Outputable Con where
  66   ppr (DataCon dc)  = ppr dc
  67   ppr (Literal lit) = ppr lit
  68   ppr (PrimOp op)   = ppr op
  69   ppr DEFAULT       = ptext SLIT("__DEFAULT")
  70
  71 instance Show Con where
  72   showsPrec p con = showsPrecSDoc p (ppr con)
  73
  74 conType :: Con -> Type
  75 conType (DataCon dc)  = dataConType dc
  76 conType (Literal lit) = literalType lit
  77 conType (PrimOp op)   = primOpType op
  78
  79 conPrimRep :: Con -> PrimRep    -- Only data valued constants
  80 conPrimRep (DataCon dc)  = ASSERT( isNullaryDataCon dc) PtrRep
  81 conPrimRep (Literal lit) = literalPrimRep lit
  82
  83 conOkForApp, conOkForAlt :: Con -> Bool
  84
  85 -- OK for appliation site
  86 conOkForApp (DataCon dc) = not (isNewTyCon (dataConTyCon dc))
  87 conOkForApp (Literal _)  = True
  88 conOkForApp (PrimOp op)  = True
  89 conOkForApp DEFAULT      = False
  90
  91 -- OK for case alternative pattern
  92 conOkForAlt (DataCon dc)  = not (isNewTyCon (dataConTyCon dc))
  93 conOkForAlt (Literal lit) = not (isNoRepLit lit)
  94 conOkForAlt (PrimOp _)    = False
  95 conOkForAlt DEFAULT       = True
  96
  97         -- isWHNFCon is false for PrimOps, which contain work
  98         -- Ditto for newtype constructors, which can occur in the output
  99         -- of the desugarer, but which will be inlined right away thereafter
 100 isWHNFCon (DataCon dc) = not (isNewTyCon (dataConTyCon dc))
 101 isWHNFCon (Literal _)  = True
 102 isWHNFCon (PrimOp _)   = False
 103
 104 isDataCon (DataCon dc) = True
 105 isDataCon other        = False
 106
 107 -- conIsTrivial is true for constants we are unconditionally happy to duplicate
 108 -- cf CoreUtils.exprIsTrivial
 109 conIsTrivial (Literal lit) = not (isNoRepLit lit)
 110 conIsTrivial (PrimOp _)    = False
 111 conIsTrivial con           = True
 112
 113 -- conIsCheap is true for constants whose applications we are willing
 114 -- to duplicate in exchange for some modest gain.  cf CoreUtils.exprIsCheap
 115 conIsCheap (Literal lit) = not (isNoRepLit lit)
 116 conIsCheap (DataCon con) = True
 117 conIsCheap (PrimOp op)   = primOpIsCheap op
 118 \end{code}
 119
 120
 121 %************************************************************************
 122 %*                                                                      *
 123 \subsection{Literals}
 124 %*                                                                      *
 125 %************************************************************************
 126
 127 So-called @Literals@ are {\em either}:
 128 \begin{itemize}
 129 \item
 130 An unboxed (``machine'') literal (type: @IntPrim@, @FloatPrim@, etc.),
 131 which is presumed to be surrounded by appropriate constructors
 132 (@mKINT@, etc.), so that the overall thing makes sense.
 133 \item
 134 An Integer, Rational, or String literal whose representation we are
 135 {\em uncommitted} about; i.e., the surrounding with constructors,
 136 function applications, etc., etc., has not yet been done.
 137 \end{itemize}
 138
 139 \begin{code}
 140 data Literal
 141   =     ------------------
 142         -- First the primitive guys
 143     MachChar    Char
 144   | MachStr     FAST_STRING
 145
 146   | MachAddr    Integer -- Whatever this machine thinks is a "pointer"
 147
 148   | MachInt     Integer -- For the numeric types, these are
 149                 Bool    -- True <=> signed (Int#); False <=> unsigned (Word#)
 150
 151   | MachInt64   Integer -- guaranteed 64-bit versions of the above.
 152                 Bool    -- True <=> signed (Int#); False <=> unsigned (Word#)
 153
 154
 155   | MachFloat   Rational
 156   | MachDouble  Rational
 157
 158   | MachLitLit  FAST_STRING Type        -- Type might be Add# or Int# etc
 159
 160         ------------------
 161         -- The no-rep guys
 162   | NoRepStr        FAST_STRING Type    -- This Type is always String
 163   | NoRepInteger    Integer     Type    -- This Type is always Integer
 164   | NoRepRational   Rational    Type    -- This Type is always Rational
 165                         -- We keep these Types in the literal because Rational isn't
 166                         -- (currently) wired in, so we can't conjure up its type out of
 167                         -- thin air.    Integer is, so the type here is really redundant.
 168 \end{code}
 169
 170
 171 \begin{code}
 172 instance Outputable Literal where
 173     ppr lit = pprLit lit
 174
 175 instance Show Literal where
 176     showsPrec p lit = showsPrecSDoc p (ppr lit)
 177
 178 instance Eq Literal where
 179     a == b = case (a `compare` b) of { EQ -> True;   _ -> False }
 180     a /= b = case (a `compare` b) of { EQ -> False;  _ -> True  }
 181
 182 instance Ord Literal where
 183     a <= b = case (a `compare` b) of { LT -> True;  EQ -> True;  GT -> False }
 184     a <  b = case (a `compare` b) of { LT -> True;  EQ -> False; GT -> False }
 185     a >= b = case (a `compare` b) of { LT -> False; EQ -> True;  GT -> True  }
 186     a >  b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True  }
 187     compare a b = cmpLit a b
 188 \end{code}
 189
 190
 191         Construction
 192         ~~~~~~~~~~~~
 193 \begin{code}
 194 mkMachInt, mkMachWord :: Integer -> Literal
 195
 196 mkMachInt  x = MachInt x True{-signed-}
 197 mkMachWord x = MachInt x False{-unsigned-}
 198
 199 -- check if the int is within range
 200 mkMachInt_safe :: Integer -> Literal
 201 mkMachInt_safe i
 202  | out_of_range =
 203    pprPanic "mkMachInt_safe"
 204             (hsep [text "ERROR: Int ", text (show i), text "out of range",
 205                    brackets (int minInt <+> text ".." <+> int maxInt)])
 206  | otherwise = MachInt i True{-signed-}
 207  where
 208   out_of_range =
 209 --    i < fromInt minBound ||
 210     i > fromInt maxInt
 211
 212 mkMachInt64  x = MachInt64 x True{-signed-}
 213 mkMachWord64 x = MachInt64 x False{-unsigned-}
 214
 215 mkStrLit :: String -> Type -> Literal
 216 mkStrLit s ty = NoRepStr (_PK_ s) ty
 217 \end{code}
 218
 219
 220         Predicates
 221         ~~~~~~~~~~
 222 \begin{code}
 223 isNoRepLit (NoRepStr _ _)       = True -- these are not primitive typed!
 224 isNoRepLit (NoRepInteger  _ _)  = True
 225 isNoRepLit (NoRepRational _ _)  = True
 226 isNoRepLit _                    = False
 227
 228 isLitLitLit (MachLitLit _ _) = True
 229 isLitLitLit _                = False
 230 \end{code}
 231
 232         Types
 233         ~~~~~
 234 \begin{code}
 235 literalType :: Literal -> Type
 236 literalType (MachChar _)          = charPrimTy
 237 literalType (MachStr  _)          = addrPrimTy
 238 literalType (MachAddr _)          = addrPrimTy
 239 literalType (MachInt  _ signed)   = if signed then intPrimTy else wordPrimTy
 240 literalType (MachInt64  _ signed) = if signed then int64PrimTy else word64PrimTy
 241 literalType (MachFloat _)         = floatPrimTy
 242 literalType (MachDouble _)        = doublePrimTy
 243 literalType (MachLitLit _ ty)     = ty
 244 literalType (NoRepInteger  _ ty)  = ty
 245 literalType (NoRepRational _ ty)  = ty
 246 literalType (NoRepStr _ ty)       = ty
 247 \end{code}
 248
 249 \begin{code}
 250 literalPrimRep :: Literal -> PrimRep
 251
 252 literalPrimRep (MachChar _)       = CharRep
 253 literalPrimRep (MachStr _)        = AddrRep  -- specifically: "char *"
 254 literalPrimRep (MachAddr  _)      = AddrRep
 255 literalPrimRep (MachInt _ signed) = if signed then IntRep else WordRep
 256 literalPrimRep (MachInt64 _ signed) = if signed then Int64Rep else Word64Rep
 257 literalPrimRep (MachFloat _)      = FloatRep
 258 literalPrimRep (MachDouble _)     = DoubleRep
 259 literalPrimRep (MachLitLit _ ty)  = typePrimRep ty
 260 #ifdef DEBUG
 261 literalPrimRep (NoRepInteger  _ _) = panic "literalPrimRep:NoRepInteger"
 262 literalPrimRep (NoRepRational _ _) = panic "literalPrimRep:NoRepRational"
 263 literalPrimRep (NoRepStr _ _)      = panic "literalPrimRep:NoRepString"
 264 #endif
 265 \end{code}
 266
 267
 268         Comparison
 269         ~~~~~~~~~~
 270 \begin{code}
 271 cmpLit (MachChar      a)   (MachChar       b)   = a `compare` b
 272 cmpLit (MachStr       a)   (MachStr        b)   = a `compare` b
 273 cmpLit (MachAddr      a)   (MachAddr       b)   = a `compare` b
 274 cmpLit (MachInt       a b) (MachInt        c d) = (a `compare` c) `thenCmp` (b `compare` d)
 275 cmpLit (MachFloat     a)   (MachFloat      b)   = a `compare` b
 276 cmpLit (MachDouble    a)   (MachDouble     b)   = a `compare` b
 277 cmpLit (MachLitLit    a b) (MachLitLit    c d)  = (a `compare` c) `thenCmp` (b `compare` d)
 278 cmpLit (NoRepStr      a _) (NoRepStr      b _)  = a `compare` b
 279 cmpLit (NoRepInteger  a _) (NoRepInteger  b _)  = a `compare` b
 280 cmpLit (NoRepRational a _) (NoRepRational b _)  = a `compare` b
 281 cmpLit lit1                lit2                 | litTag lit1 _LT_ litTag lit2 = LT
 282                                                 | otherwise                    = GT
 283
 284 litTag (MachChar      _)   = ILIT(1)
 285 litTag (MachStr       _)   = ILIT(2)
 286 litTag (MachAddr      _)   = ILIT(3)
 287 litTag (MachInt       _ _) = ILIT(4)
 288 litTag (MachFloat     _)   = ILIT(5)
 289 litTag (MachDouble    _)   = ILIT(6)
 290 litTag (MachLitLit    _ _) = ILIT(7)
 291 litTag (NoRepStr      _ _) = ILIT(8)
 292 litTag (NoRepInteger  _ _) = ILIT(9)
 293 litTag (NoRepRational _ _) = ILIT(10)
 294 \end{code}
 295
 296         Printing
 297         ~~~~~~~~
 298 * MachX (i.e. unboxed) things are printed unadornded (e.g. 3, 'a', "foo")
 299   exceptions: MachFloat and MachAddr get an initial keyword prefix
 300
 301 * NoRep things get an initial keyword prefix (e.g. _integer_ 3)
 302
 303 \begin{code}
 304 pprLit lit
 305   = getPprStyle $ \ sty ->
 306     let
 307       code_style = codeStyle sty
 308     in
 309     case lit of
 310       MachChar ch | code_style     -> hcat [ptext SLIT("(C_)"), char '\'',
 311                                             text (charToC ch), char '\'']
 312                   | ifaceStyle sty -> char '\'' <> text (charToEasyHaskell ch) <> char '\''
 313                   | otherwise      -> text ['\'', ch, '\'']
 314
 315       MachStr s | code_style -> doubleQuotes (text (stringToC (_UNPK_ s)))
 316                 | otherwise  -> pprFSAsString s
 317
 318
 319       NoRepStr s ty | code_style -> pprPanic "NoRep in code style" (ppr lit)
 320                     | otherwise  -> ptext SLIT("__string") <+> pprFSAsString s
 321
 322       MachInt i signed | code_style && out_of_range
 323                        -> pprPanic "" (hsep [text "ERROR: Int ", text (show i),
 324                                              text "out of range",
 325                                              brackets (ppr range_min <+> text ".."
 326                                                         <+> ppr range_max)])
 327                        | otherwise -> integer i
 328
 329                        where
 330                         range_min = if signed then minInt else 0
 331                         range_max = maxInt
 332                         out_of_range = not (i >= toInteger range_min && i <= toInteger range_max)
 333
 334       MachFloat f | code_style -> ptext SLIT("(StgFloat)") <> rational f
 335                   | otherwise  -> ptext SLIT("__float") <+> rational f
 336
 337       MachDouble d -> rational d
 338
 339       MachAddr p | code_style -> ptext SLIT("(void*)") <> integer p
 340                  | otherwise  -> ptext SLIT("__addr") <+> integer p
 341
 342       NoRepInteger i _ | code_style -> pprPanic "NoRep in code style" (ppr lit)
 343                        | otherwise  -> ptext SLIT("__integer") <+> integer i
 344
 345       NoRepRational r _ | code_style -> pprPanic "NoRep in code style" (ppr lit)
 346                         | otherwise  -> hsep [ptext SLIT("__rational"), integer (numerator r),
 347                                                                         integer (denominator r)]
 348
 349       MachLitLit s ty | code_style -> ptext s
 350                       | otherwise  -> parens (hsep [ptext SLIT("__litlit"),
 351                                                     pprFSAsString s,
 352                                                     pprParendType ty])
 353 \end{code}