%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
%
-\section[BasicLit]{@BasicLit@: Machine literals (unboxed, of course)}
+\section[Literal]{@Literal@: Machine literals (unboxed, of course)}
\begin{code}
#include "HsVersions.h"
-module BasicLit (
- BasicLit(..),
+module Literal (
+ Literal(..),
+
mkMachInt, mkMachWord,
- typeOfBasicLit, kindOfBasicLit,
- showBasicLit,
- isNoRepLit, isLitLitLit,
+ literalType, literalPrimRep,
+ showLiteral,
+ isNoRepLit, isLitLitLit
-- and to make the interface self-sufficient....
- UniType, PrimKind
) where
-import AbsPrel ( addrPrimTy, intPrimTy, floatPrimTy, doublePrimTy,
- charPrimTy, wordPrimTy,
- integerTy, rationalTy, stringTy, UniType,
- TauType(..)
- IF_ATTACK_PRAGMAS(COMMA mkListTy COMMA charTy)
- IF_ATTACK_PRAGMAS(COMMA tagOf_PrimOp)
- IF_ATTACK_PRAGMAS(COMMA pprPrimOp)
- )
-import AbsUniType ( TyCon IF_ATTACK_PRAGMAS(COMMA cmpTyCon) )
-import PrimKind ( getKindInfo ) -- ToDo: *** HACK import ****
-import CLabelInfo ( stringToC, charToC, charToEasyHaskell )
-import Outputable -- class for printing, forcing
+import Ubiq{-uitous-}
+
+-- friends:
+import PrimRep ( PrimRep(..) ) -- non-abstract
+import TysPrim ( getPrimRepInfo,
+ addrPrimTy, intPrimTy, floatPrimTy,
+ doublePrimTy, charPrimTy, wordPrimTy )
+
+-- others:
+import CStrings ( stringToC, charToC, charToEasyHaskell )
+import TysWiredIn ( integerTy, rationalTy, stringTy )
import Pretty -- pretty-printing stuff
-import PrimKind ( PrimKind(..) )
-import Util
+import PprStyle ( PprStyle(..), codeStyle )
+import Util ( panic )
\end{code}
-So-called @BasicLits@ are {\em either}:
+So-called @Literals@ are {\em either}:
\begin{itemize}
\item
An unboxed (``machine'') literal (type: @IntPrim@, @FloatPrim@, etc.),
\end{itemize}
\begin{code}
-data BasicLit
+data Literal
= MachChar Char
| MachStr FAST_STRING
| MachAddr Integer -- whatever this machine thinks is a "pointer"
| MachInt Integer -- for the numeric types, these are
- Bool -- True <=> signed (Int#); False <=> unsigned (Word#)
+ Bool -- True <=> signed (Int#); False <=> unsigned (Word#)
| MachFloat Rational
| MachDouble Rational
| MachLitLit FAST_STRING
- PrimKind
+ PrimRep
| NoRepStr FAST_STRING -- the uncommitted ones
| NoRepInteger Integer
deriving (Eq, Ord)
-- The Ord is needed for the FiniteMap used in the lookForConstructor
-- in SimplEnv. If you declared that lookForConstructor *ignores*
- -- constructor-applications with CoLitAtom args, then you could get
+ -- constructor-applications with LitArg args, then you could get
-- rid of this Ord.
-mkMachInt, mkMachWord :: Integer -> BasicLit
+mkMachInt, mkMachWord :: Integer -> Literal
mkMachInt x = MachInt x True{-signed-}
mkMachWord x = MachInt x False{-unsigned-}
\end{code}
\begin{code}
-typeOfBasicLit :: BasicLit -> UniType
-
-typeOfBasicLit (MachChar _) = charPrimTy
-typeOfBasicLit (MachStr _) = addrPrimTy
-typeOfBasicLit (MachAddr _) = addrPrimTy
-typeOfBasicLit (MachInt _ signed) = if signed then intPrimTy else wordPrimTy
-typeOfBasicLit (MachFloat _) = floatPrimTy
-typeOfBasicLit (MachDouble _) = doublePrimTy
-typeOfBasicLit (MachLitLit _ k) = case (getKindInfo k) of { (_,t,_) -> t }
-typeOfBasicLit (NoRepInteger _) = integerTy
-typeOfBasicLit (NoRepRational _)= rationalTy
-typeOfBasicLit (NoRepStr _) = stringTy
+literalType :: Literal -> Type
+
+literalType (MachChar _) = charPrimTy
+literalType (MachStr _) = addrPrimTy
+literalType (MachAddr _) = addrPrimTy
+literalType (MachInt _ signed) = if signed then intPrimTy else wordPrimTy
+literalType (MachFloat _) = floatPrimTy
+literalType (MachDouble _) = doublePrimTy
+literalType (MachLitLit _ k) = case (getPrimRepInfo k) of { (_,t,_) -> t }
+literalType (NoRepInteger _) = integerTy
+literalType (NoRepRational _)= rationalTy
+literalType (NoRepStr _) = stringTy
\end{code}
\begin{code}
-kindOfBasicLit :: BasicLit -> PrimKind
-
-kindOfBasicLit (MachChar _) = CharKind
-kindOfBasicLit (MachStr _) = AddrKind -- specifically: "char *"
-kindOfBasicLit (MachAddr _) = AddrKind
-kindOfBasicLit (MachInt _ signed) = if signed then IntKind else WordKind
-kindOfBasicLit (MachFloat _) = FloatKind
-kindOfBasicLit (MachDouble _) = DoubleKind
-kindOfBasicLit (MachLitLit _ k) = k
-kindOfBasicLit (NoRepInteger _) = panic "kindOfBasicLit:NoRepInteger"
-kindOfBasicLit (NoRepRational _)= panic "kindOfBasicLit:NoRepRational"
-kindOfBasicLit (NoRepStr _) = panic "kindOfBasicLit:NoRepString"
+literalPrimRep :: Literal -> PrimRep
+
+literalPrimRep (MachChar _) = CharRep
+literalPrimRep (MachStr _) = AddrRep -- specifically: "char *"
+literalPrimRep (MachAddr _) = AddrRep
+literalPrimRep (MachInt _ signed) = if signed then IntRep else WordRep
+literalPrimRep (MachFloat _) = FloatRep
+literalPrimRep (MachDouble _) = DoubleRep
+literalPrimRep (MachLitLit _ k) = k
+#ifdef DEBUG
+literalPrimRep (NoRepInteger _) = panic "literalPrimRep:NoRepInteger"
+literalPrimRep (NoRepRational _)= panic "literalPrimRep:NoRepRational"
+literalPrimRep (NoRepStr _) = panic "literalPrimRep:NoRepString"
+#endif
\end{code}
The boring old output stuff:
\begin{code}
ppCast :: PprStyle -> FAST_STRING -> Pretty
-ppCast (PprForC _) cast = ppPStr cast
-ppCast _ _ = ppNil
+ppCast PprForC cast = ppPStr cast
+ppCast _ _ = ppNil
-instance Outputable BasicLit where
+instance Outputable Literal where
ppr sty (MachChar ch)
= let
char_encoding
= case sty of
- PprForC _ -> charToC ch
- PprForAsm _ _ _ -> charToC ch
- PprUnfolding _ -> charToEasyHaskell ch
- _ -> [ch]
+ PprForC -> charToC ch
+ PprForAsm _ _ -> charToC ch
+ PprUnfolding -> charToEasyHaskell ch
+ _ -> [ch]
in
ppBeside (ppBesides [ppCast sty SLIT("(C_)"), ppChar '\'', ppStr char_encoding, ppChar '\''])
(if_ubxd sty)
ppr sty (MachFloat f) = ppBesides [ppCast sty SLIT("(StgFloat)"), ppRational f, if_ubxd sty]
ppr sty (MachDouble d) = ppBesides [ppRational d, if_ubxd sty, if_ubxd sty]
-#ifdef DPH
- -- I know that this thing shouldnt pop out of the compiler, but the
- -- native code generator tries to generate code to initilialise a closure
- -- with this value... (in glaExts/PreludeGlaInOut.lhs)
- ppr sty MachVoid = ppStr "0 ! {- void# -}"
-#endif {- Data Parallel Haskell -}
-
ppr sty (NoRepInteger i)
| codeStyle sty = ppInteger i
| ufStyle sty = ppCat [ppStr "_NOREP_I_", ppInteger i]
| ufStyle sty = ppBesides [ppStr "``", ppPStr s, ppStr "'' _K_ ", ppr sty k]
| otherwise = ppBesides [ppStr "``", ppPStr s, ppStr "''"]
-ufStyle (PprUnfolding _) = True
-ufStyle _ = False
+ufStyle PprUnfolding = True
+ufStyle _ = False
if_ubxd sty = if codeStyle sty then ppNil else ppChar '#'
-showBasicLit :: PprStyle -> BasicLit -> String
+showLiteral :: PprStyle -> Literal -> String
-showBasicLit sty lit = ppShow 80 (ppr sty lit)
+showLiteral sty lit = ppShow 80 (ppr sty lit)
\end{code}
projects / ghc-hetmet.git / blobdiff