2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
4 \section[Literal]{@Literal@: Machine literals (unboxed, of course)}
7 #include "HsVersions.h"
12 mkMachInt, mkMachWord,
13 literalType, literalPrimRep,
15 isNoRepLit, isLitLitLit
17 -- and to make the interface self-sufficient....
23 import PrimRep ( PrimRep(..) ) -- non-abstract
24 import TysPrim ( getPrimRepInfo,
25 addrPrimTy, intPrimTy, floatPrimTy,
26 doublePrimTy, charPrimTy, wordPrimTy )
29 import CStrings ( stringToC, charToC, charToEasyHaskell )
30 import TysWiredIn ( integerTy, rationalTy, stringTy )
31 import Pretty -- pretty-printing stuff
32 import PprStyle ( PprStyle(..), codeStyle )
36 So-called @Literals@ are {\em either}:
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.
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.
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#)
57 | MachLitLit FAST_STRING
60 | NoRepStr FAST_STRING -- the uncommitted ones
61 | NoRepInteger Integer
62 | NoRepRational Rational
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
70 mkMachInt, mkMachWord :: Integer -> Literal
72 mkMachInt x = MachInt x True{-signed-}
73 mkMachWord x = MachInt x False{-unsigned-}
77 isNoRepLit (NoRepStr _) = True -- these are not primitive typed!
78 isNoRepLit (NoRepInteger _) = True
79 isNoRepLit (NoRepRational _) = True
82 isLitLitLit (MachLitLit _ _) = True
87 literalType :: Literal -> Type
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
102 literalPrimRep :: Literal -> PrimRep
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
112 literalPrimRep (NoRepInteger _) = panic "literalPrimRep:NoRepInteger"
113 literalPrimRep (NoRepRational _)= panic "literalPrimRep:NoRepRational"
114 literalPrimRep (NoRepStr _) = panic "literalPrimRep:NoRepString"
118 The boring old output stuff:
120 ppCast :: PprStyle -> FAST_STRING -> Pretty
121 ppCast PprForC cast = ppPStr cast
124 instance Outputable Literal where
125 ppr sty (MachChar ch)
129 PprForC -> charToC ch
130 PprForAsm _ _ -> charToC ch
131 PprUnfolding -> charToEasyHaskell ch
134 ppBeside (ppBesides [ppCast sty SLIT("(C_)"), ppChar '\'', ppStr char_encoding, ppChar '\''])
138 = ppBeside (if codeStyle sty
139 then ppBesides [ppChar '"', ppStr (stringToC (_UNPK_ s)), ppChar '"']
140 else ppStr (show (_UNPK_ s)))
143 ppr sty (MachAddr p) = ppBesides [ppCast sty SLIT("(void*)"), ppInteger p, if_ubxd sty]
144 ppr sty (MachInt i signed)
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]
151 | not (codeStyle sty) -- we'd prefer the code to the error message
152 = ppBesides [ppInteger i, if_ubxd sty]
155 = error ("ERROR: Int " ++ show i ++ " out of range [" ++
156 show range_min ++ " .. " ++ show maxInt ++ "]\n")
158 range_min = if signed then minInt else 0
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]
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']
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']
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']
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 "''"]
183 ufStyle PprUnfolding = True
186 if_ubxd sty = if codeStyle sty then ppNil else ppChar '#'
188 showLiteral :: PprStyle -> Literal -> String
190 showLiteral sty lit = ppShow 80 (ppr sty lit)