2 % (c) The GRASP/AQUA Project, Glasgow University, 1998
4 \section[Literal]{@Literal@: Machine literals (unboxed, of course)}
10 conOkForApp, conOkForAlt, isWHNFCon, isDataCon,
11 conIsTrivial, conIsCheap, conIsDupable, conStrictness,
14 DataCon, PrimOp, -- For completeness
17 Literal(..), -- Exported to ParseIface
18 mkMachInt, mkMachWord,
19 mkMachInt_safe, mkMachInt64, mkMachWord64,
20 mkStrLit, -- ToDo: rm (not used anywhere)
21 isNoRepLit, isLitLitLit,
22 literalType, literalPrimRep
25 #include "HsVersions.h"
27 import TysPrim ( charPrimTy, addrPrimTy, floatPrimTy, doublePrimTy,
28 intPrimTy, wordPrimTy, int64PrimTy, word64PrimTy
30 import PrimOp ( PrimOp, primOpType, primOpIsDupable,
31 primOpIsCheap, primOpStrictness, primOpOkForSpeculation )
32 import PrimRep ( PrimRep(..) )
33 import DataCon ( DataCon, dataConType, dataConTyCon, isNullaryDataCon, dataConRepStrictness )
34 import TyCon ( isNewTyCon )
35 import Type ( Type, typePrimRep )
36 import PprType ( pprParendType )
37 import Demand ( Demand )
38 import CStrings ( stringToC, charToC, charToEasyHaskell )
41 import Util ( thenCmp )
43 import Ratio ( numerator, denominator )
47 %************************************************************************
49 \subsection{The main data type}
51 %************************************************************************
58 | DEFAULT -- Used in case clauses
61 -- The Ord is needed for the FiniteMap used in the lookForConstructor
62 -- in SimplEnv. If you declared that lookForConstructor *ignores*
63 -- constructor-applications with LitArg args, then you could get
66 instance Outputable Con where
67 ppr (DataCon dc) = ppr dc
68 ppr (Literal lit) = ppr lit
69 ppr (PrimOp op) = ppr op
70 ppr DEFAULT = ptext SLIT("__DEFAULT")
72 instance Show Con where
73 showsPrec p con = showsPrecSDoc p (ppr con)
75 conType :: Con -> Type
76 conType (DataCon dc) = dataConType dc
77 conType (Literal lit) = literalType lit
78 conType (PrimOp op) = primOpType op
80 conStrictness :: Con -> ([Demand], Bool)
81 conStrictness (DataCon dc) = (dataConRepStrictness dc, False)
82 conStrictness (PrimOp op) = primOpStrictness op
83 conStrictness (Literal lit) = ([], False)
85 conPrimRep :: Con -> PrimRep -- Only data valued constants
86 conPrimRep (DataCon dc) = ASSERT( isNullaryDataCon dc) PtrRep
87 conPrimRep (Literal lit) = literalPrimRep lit
89 conOkForApp, conOkForAlt :: Con -> Bool
91 -- OK for appliation site
92 conOkForApp (DataCon dc) = not (isNewTyCon (dataConTyCon dc))
93 conOkForApp (Literal _) = True
94 conOkForApp (PrimOp op) = True
95 conOkForApp DEFAULT = False
97 -- OK for case alternative pattern
98 conOkForAlt (DataCon dc) = not (isNewTyCon (dataConTyCon dc))
99 conOkForAlt (Literal lit) = not (isNoRepLit lit)
100 conOkForAlt (PrimOp _) = False
101 conOkForAlt DEFAULT = True
103 -- isWHNFCon is false for PrimOps, which contain work
104 -- Ditto for newtype constructors, which can occur in the output
105 -- of the desugarer, but which will be inlined right away thereafter
106 isWHNFCon (DataCon dc) = not (isNewTyCon (dataConTyCon dc))
107 isWHNFCon (Literal _) = True
108 isWHNFCon (PrimOp _) = False
110 isDataCon (DataCon dc) = True
111 isDataCon other = False
113 -- conIsTrivial is true for constants we are unconditionally happy to duplicate
114 -- cf CoreUtils.exprIsTrivial
115 conIsTrivial (Literal lit) = not (isNoRepLit lit)
116 conIsTrivial (PrimOp _) = False
117 conIsTrivial con = True
119 -- conIsCheap is true for constants whose applications we are willing
120 -- to duplicate in exchange for some modest gain. cf CoreUtils.exprIsCheap
121 conIsCheap (Literal lit) = not (isNoRepLit lit)
122 conIsCheap (DataCon con) = True
123 conIsCheap (PrimOp op) = primOpIsCheap op
125 -- conIsDupable is true for constants whose applications we are willing
126 -- to duplicate in different case branches; i.e no issue about loss of
128 conIsDupable (Literal lit) = not (isNoRepLit lit)
129 conIsDupable (DataCon con) = True
130 conIsDupable (PrimOp op) = primOpIsDupable op
132 -- Similarly conOkForSpeculation
133 conOkForSpeculation (Literal lit) = True
134 conOkForSpeculation (DataCon con) = True
135 conOkForSpeculation (PrimOp op) = primOpOkForSpeculation op
139 %************************************************************************
141 \subsection{Literals}
143 %************************************************************************
145 So-called @Literals@ are {\em either}:
148 An unboxed (``machine'') literal (type: @IntPrim@, @FloatPrim@, etc.),
149 which is presumed to be surrounded by appropriate constructors
150 (@mKINT@, etc.), so that the overall thing makes sense.
152 An Integer, Rational, or String literal whose representation we are
153 {\em uncommitted} about; i.e., the surrounding with constructors,
154 function applications, etc., etc., has not yet been done.
160 -- First the primitive guys
162 | MachStr FAST_STRING
164 | MachAddr Integer -- Whatever this machine thinks is a "pointer"
166 | MachInt Integer -- For the numeric types, these are
167 Bool -- True <=> signed (Int#); False <=> unsigned (Word#)
169 | MachInt64 Integer -- guaranteed 64-bit versions of the above.
170 Bool -- True <=> signed (Int#); False <=> unsigned (Word#)
174 | MachDouble Rational
176 | MachLitLit FAST_STRING Type -- Type might be Add# or Int# etc
180 | NoRepStr FAST_STRING Type -- This Type is always String
181 | NoRepInteger Integer Type -- This Type is always Integer
182 | NoRepRational Rational Type -- This Type is always Rational
183 -- We keep these Types in the literal because Rational isn't
184 -- (currently) wired in, so we can't conjure up its type out of
185 -- thin air. Integer is, so the type here is really redundant.
190 instance Outputable Literal where
193 instance Show Literal where
194 showsPrec p lit = showsPrecSDoc p (ppr lit)
196 instance Eq Literal where
197 a == b = case (a `compare` b) of { EQ -> True; _ -> False }
198 a /= b = case (a `compare` b) of { EQ -> False; _ -> True }
200 instance Ord Literal where
201 a <= b = case (a `compare` b) of { LT -> True; EQ -> True; GT -> False }
202 a < b = case (a `compare` b) of { LT -> True; EQ -> False; GT -> False }
203 a >= b = case (a `compare` b) of { LT -> False; EQ -> True; GT -> True }
204 a > b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True }
205 compare a b = cmpLit a b
212 mkMachInt, mkMachWord :: Integer -> Literal
214 mkMachInt x = MachInt x True{-signed-}
215 mkMachWord x = MachInt x False{-unsigned-}
217 -- check if the int is within range
218 mkMachInt_safe :: Integer -> Literal
221 pprPanic "mkMachInt_safe"
222 (hsep [text "ERROR: Int ", text (show i), text "out of range",
223 brackets (int minInt <+> text ".." <+> int maxInt)])
224 | otherwise = MachInt i True{-signed-}
227 -- i < fromInt minBound ||
230 mkMachInt64 x = MachInt64 x True{-signed-}
231 mkMachWord64 x = MachInt64 x False{-unsigned-}
233 mkStrLit :: String -> Type -> Literal
234 mkStrLit s ty = NoRepStr (_PK_ s) ty
241 isNoRepLit (NoRepStr _ _) = True -- these are not primitive typed!
242 isNoRepLit (NoRepInteger _ _) = True
243 isNoRepLit (NoRepRational _ _) = True
246 isLitLitLit (MachLitLit _ _) = True
247 isLitLitLit _ = False
253 literalType :: Literal -> Type
254 literalType (MachChar _) = charPrimTy
255 literalType (MachStr _) = addrPrimTy
256 literalType (MachAddr _) = addrPrimTy
257 literalType (MachInt _ signed) = if signed then intPrimTy else wordPrimTy
258 literalType (MachInt64 _ signed) = if signed then int64PrimTy else word64PrimTy
259 literalType (MachFloat _) = floatPrimTy
260 literalType (MachDouble _) = doublePrimTy
261 literalType (MachLitLit _ ty) = ty
262 literalType (NoRepInteger _ ty) = ty
263 literalType (NoRepRational _ ty) = ty
264 literalType (NoRepStr _ ty) = ty
268 literalPrimRep :: Literal -> PrimRep
270 literalPrimRep (MachChar _) = CharRep
271 literalPrimRep (MachStr _) = AddrRep -- specifically: "char *"
272 literalPrimRep (MachAddr _) = AddrRep
273 literalPrimRep (MachInt _ signed) = if signed then IntRep else WordRep
274 literalPrimRep (MachInt64 _ signed) = if signed then Int64Rep else Word64Rep
275 literalPrimRep (MachFloat _) = FloatRep
276 literalPrimRep (MachDouble _) = DoubleRep
277 literalPrimRep (MachLitLit _ ty) = typePrimRep ty
279 literalPrimRep (NoRepInteger _ _) = panic "literalPrimRep:NoRepInteger"
280 literalPrimRep (NoRepRational _ _) = panic "literalPrimRep:NoRepRational"
281 literalPrimRep (NoRepStr _ _) = panic "literalPrimRep:NoRepString"
289 cmpLit (MachChar a) (MachChar b) = a `compare` b
290 cmpLit (MachStr a) (MachStr b) = a `compare` b
291 cmpLit (MachAddr a) (MachAddr b) = a `compare` b
292 cmpLit (MachInt a b) (MachInt c d) = (a `compare` c) `thenCmp` (b `compare` d)
293 cmpLit (MachFloat a) (MachFloat b) = a `compare` b
294 cmpLit (MachDouble a) (MachDouble b) = a `compare` b
295 cmpLit (MachLitLit a b) (MachLitLit c d) = (a `compare` c) `thenCmp` (b `compare` d)
296 cmpLit (NoRepStr a _) (NoRepStr b _) = a `compare` b
297 cmpLit (NoRepInteger a _) (NoRepInteger b _) = a `compare` b
298 cmpLit (NoRepRational a _) (NoRepRational b _) = a `compare` b
299 cmpLit lit1 lit2 | litTag lit1 _LT_ litTag lit2 = LT
302 litTag (MachChar _) = ILIT(1)
303 litTag (MachStr _) = ILIT(2)
304 litTag (MachAddr _) = ILIT(3)
305 litTag (MachInt _ _) = ILIT(4)
306 litTag (MachFloat _) = ILIT(5)
307 litTag (MachDouble _) = ILIT(6)
308 litTag (MachLitLit _ _) = ILIT(7)
309 litTag (NoRepStr _ _) = ILIT(8)
310 litTag (NoRepInteger _ _) = ILIT(9)
311 litTag (NoRepRational _ _) = ILIT(10)
316 * MachX (i.e. unboxed) things are printed unadornded (e.g. 3, 'a', "foo")
317 exceptions: MachFloat and MachAddr get an initial keyword prefix
319 * NoRep things get an initial keyword prefix (e.g. _integer_ 3)
323 = getPprStyle $ \ sty ->
325 code_style = codeStyle sty
328 MachChar ch | code_style -> hcat [ptext SLIT("(C_)"), char '\'',
329 text (charToC ch), char '\'']
330 | ifaceStyle sty -> char '\'' <> text (charToEasyHaskell ch) <> char '\''
331 | otherwise -> text ['\'', ch, '\'']
333 MachStr s | code_style -> doubleQuotes (text (stringToC (_UNPK_ s)))
334 | otherwise -> pprFSAsString s
337 NoRepStr s ty | code_style -> pprPanic "NoRep in code style" (ppr lit)
338 | otherwise -> ptext SLIT("__string") <+> pprFSAsString s
340 MachInt i signed | code_style && out_of_range
341 -> pprPanic "" (hsep [text "ERROR: Int ", text (show i),
343 brackets (ppr range_min <+> text ".."
345 -- in interface files, parenthesize raw negative ints.
346 -- this avoids problems like {-1} being interpreted
347 -- as a comment starter.
348 | ifaceStyle sty && i < 0 -> parens (integer i)
349 | otherwise -> integer i
352 range_min = if signed then minInt else 0
354 out_of_range = not (i >= toInteger range_min && i <= toInteger range_max)
356 MachFloat f | code_style -> ptext SLIT("(StgFloat)") <> rational f
357 | otherwise -> ptext SLIT("__float") <+> rational f
359 MachDouble d | ifaceStyle sty && d < 0 -> parens (rational d)
360 | otherwise -> rational d
362 MachAddr p | code_style -> ptext SLIT("(void*)") <> integer p
363 | otherwise -> ptext SLIT("__addr") <+> integer p
365 NoRepInteger i _ | code_style -> pprPanic "NoRep in code style" (ppr lit)
366 | otherwise -> ptext SLIT("__integer") <+> integer i
368 NoRepRational r _ | code_style -> pprPanic "NoRep in code style" (ppr lit)
369 | otherwise -> hsep [ptext SLIT("__rational"), integer (numerator r),
370 integer (denominator r)]
372 MachLitLit s ty | code_style -> ptext s
373 | otherwise -> parens (hsep [ptext SLIT("__litlit"),