2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
4 \section[Literal]{@Literal@: Machine literals (unboxed, of course)}
10 mkMachInt, mkMachWord,
11 literalType, literalPrimRep,
13 isNoRepLit, isLitLitLit
16 #include "HsVersions.h"
19 import PrimRep ( PrimRep(..), ppPrimRep ) -- non-abstract
20 import TysPrim ( getPrimRepInfo,
21 addrPrimTy, intPrimTy, floatPrimTy,
22 doublePrimTy, charPrimTy, wordPrimTy
27 import CStrings ( stringToC, charToC, charToEasyHaskell )
28 import TysWiredIn ( stringTy )
30 import Util ( thenCmp )
32 import GlaExts ( (<#) )
35 So-called @Literals@ are {\em either}:
38 An unboxed (``machine'') literal (type: @IntPrim@, @FloatPrim@, etc.),
39 which is presumed to be surrounded by appropriate constructors
40 (@mKINT@, etc.), so that the overall thing makes sense.
42 An Integer, Rational, or String literal whose representation we are
43 {\em uncommitted} about; i.e., the surrounding with constructors,
44 function applications, etc., etc., has not yet been done.
52 | 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#)
60 | MachLitLit FAST_STRING
63 | NoRepStr FAST_STRING
64 | NoRepInteger Integer Type -- This Type is always Integer
65 | NoRepRational Rational Type -- This Type is always Rational
66 -- We keep these Types in the literal because Rational isn't
67 -- (currently) wired in, so we can't conjure up its type out of
68 -- thin air. Integer is, so the type here is really redundant.
70 -- deriving (Eq, Ord): no, don't want to compare Types
71 -- The Ord is needed for the FiniteMap used in the lookForConstructor
72 -- in SimplEnv. If you declared that lookForConstructor *ignores*
73 -- constructor-applications with LitArg args, then you could get
76 mkMachInt, mkMachWord :: Integer -> Literal
78 mkMachInt x = MachInt x True{-signed-}
79 mkMachWord x = MachInt x False{-unsigned-}
81 cmpLit (MachChar a) (MachChar b) = a `compare` b
82 cmpLit (MachStr a) (MachStr b) = a `compare` b
83 cmpLit (MachAddr a) (MachAddr b) = a `compare` b
84 cmpLit (MachInt a b) (MachInt c d) = (a `compare` c) `thenCmp` (b `compare` d)
85 cmpLit (MachFloat a) (MachFloat b) = a `compare` b
86 cmpLit (MachDouble a) (MachDouble b) = a `compare` b
87 cmpLit (MachLitLit a b) (MachLitLit c d) = (a `compare` c) `thenCmp` (b `compare` d)
88 cmpLit (NoRepStr a) (NoRepStr b) = a `compare` b
89 cmpLit (NoRepInteger a _) (NoRepInteger b _) = a `compare` b
90 cmpLit (NoRepRational a _) (NoRepRational b _) = a `compare` b
92 -- now we *know* the tags are different, so...
93 cmpLit other_1 other_2
100 tagof (MachChar _) = ILIT(1)
101 tagof (MachStr _) = ILIT(2)
102 tagof (MachAddr _) = ILIT(3)
103 tagof (MachInt _ _) = ILIT(4)
104 tagof (MachFloat _) = ILIT(5)
105 tagof (MachDouble _) = ILIT(6)
106 tagof (MachLitLit _ _) = ILIT(7)
107 tagof (NoRepStr _) = ILIT(8)
108 tagof (NoRepInteger _ _) = ILIT(9)
109 tagof (NoRepRational _ _) = ILIT(10)
111 instance Eq Literal where
112 a == b = case (a `compare` b) of { EQ -> True; _ -> False }
113 a /= b = case (a `compare` b) of { EQ -> False; _ -> True }
115 instance Ord Literal where
116 a <= b = case (a `compare` b) of { LT -> True; EQ -> True; GT -> False }
117 a < b = case (a `compare` b) of { LT -> True; EQ -> False; GT -> False }
118 a >= b = case (a `compare` b) of { LT -> False; EQ -> True; GT -> True }
119 a > b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True }
120 compare a b = cmpLit a b
124 isNoRepLit (NoRepStr _) = True -- these are not primitive typed!
125 isNoRepLit (NoRepInteger _ _) = True
126 isNoRepLit (NoRepRational _ _) = True
129 isLitLitLit (MachLitLit _ _) = True
130 isLitLitLit _ = False
134 literalType :: Literal -> Type
136 literalType (MachChar _) = charPrimTy
137 literalType (MachStr _) = addrPrimTy
138 literalType (MachAddr _) = addrPrimTy
139 literalType (MachInt _ signed) = if signed then intPrimTy else wordPrimTy
140 literalType (MachFloat _) = floatPrimTy
141 literalType (MachDouble _) = doublePrimTy
142 literalType (MachLitLit _ k) = case (getPrimRepInfo k) of { (_,t,_) -> t }
143 literalType (NoRepInteger _ t) = t
144 literalType (NoRepRational _ t) = t
145 literalType (NoRepStr _) = stringTy
149 literalPrimRep :: Literal -> PrimRep
151 literalPrimRep (MachChar _) = CharRep
152 literalPrimRep (MachStr _) = AddrRep -- specifically: "char *"
153 literalPrimRep (MachAddr _) = AddrRep
154 literalPrimRep (MachInt _ signed) = if signed then IntRep else WordRep
155 literalPrimRep (MachFloat _) = FloatRep
156 literalPrimRep (MachDouble _) = DoubleRep
157 literalPrimRep (MachLitLit _ k) = k
159 literalPrimRep (NoRepInteger _ _) = panic "literalPrimRep:NoRepInteger"
160 literalPrimRep (NoRepRational _ _) = panic "literalPrimRep:NoRepRational"
161 literalPrimRep (NoRepStr _) = panic "literalPrimRep:NoRepString"
165 The boring old output stuff:
167 -- MachX (i.e. unboxed) things are printed unadornded (e.g. 3, 'a', "foo")
168 -- exceptions: MachFloat and MachAddr get an initial keyword prefix
170 -- NoRep things get an initial keyword prefix (e.g. _integer_ 3)
172 instance Outputable Literal where
176 = getPprStyle $ \ sty ->
178 code_style = codeStyle sty
181 MachChar ch | code_style -> hcat [ptext SLIT("(C_)"), char '\'', text (charToC ch), char '\'']
182 | ifaceStyle sty -> char '\'' <> text (charToEasyHaskell ch) <> char '\''
183 | otherwise -> text ['\'', ch, '\'']
185 MachStr s | code_style -> doubleQuotes (text (stringToC (_UNPK_ s)))
186 | otherwise -> text (show (_UNPK_ s))
188 NoRepStr s | code_style -> pprPanic "NoRep in code style" (ppr lit)
189 | otherwise -> ptext SLIT("_string_") <+> text (show (_UNPK_ s))
191 MachInt i signed | code_style && out_of_range
192 -> pprPanic "" (hsep [text "ERROR: Int ", text (show i), text "out of range",
193 brackets (ppr range_min <+> text ".." <+> ppr range_max)])
194 | otherwise -> integer i
197 range_min = if signed then minInt else 0
199 out_of_range = not (i >= toInteger range_min && i <= toInteger range_max)
201 MachFloat f | code_style -> ptext SLIT("(StgFloat)") <> rational f
202 | otherwise -> ptext SLIT("_float_") <+> rational f
204 MachDouble d -> rational d
206 MachAddr p | code_style -> ptext SLIT("(void*)") <> integer p
207 | otherwise -> ptext SLIT("_addr_") <+> integer p
209 NoRepInteger i _ | code_style -> pprPanic "NoRep in code style" (ppr lit)
210 | otherwise -> ptext SLIT("_integer_") <+> integer i
212 NoRepRational r _ | code_style -> pprPanic "NoRep in code style" (ppr lit)
213 | otherwise -> hsep [ptext SLIT("_rational_"), integer (numerator r),
214 integer (denominator r)]
216 MachLitLit s k | code_style -> ptext s
217 | otherwise -> hsep [ptext SLIT("_litlit_"), ppPrimRep k, text (show (_UNPK_ s))]
219 showLiteral :: Literal -> String
220 showLiteral lit = showSDoc (ppr lit)