2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
4 \section[Literal]{@Literal@: Machine literals (unboxed, of course)}
21 #include "HsVersions.h"
24 import PrimRep ( PrimRep(..), ppPrimRep ) -- non-abstract
25 import TysPrim ( getPrimRepInfo,
26 addrPrimTy, intPrimTy, floatPrimTy,
27 doublePrimTy, charPrimTy, wordPrimTy
32 import CStrings ( stringToC, charToC, charToEasyHaskell )
33 import TysWiredIn ( stringTy )
35 import Util ( thenCmp )
39 So-called @Literals@ are {\em either}:
42 An unboxed (``machine'') literal (type: @IntPrim@, @FloatPrim@, etc.),
43 which is presumed to be surrounded by appropriate constructors
44 (@mKINT@, etc.), so that the overall thing makes sense.
46 An Integer, Rational, or String literal whose representation we are
47 {\em uncommitted} about; i.e., the surrounding with constructors,
48 function applications, etc., etc., has not yet been done.
56 | MachAddr Integer -- whatever this machine thinks is a "pointer"
58 | MachInt Integer -- for the numeric types, these are
59 Bool -- True <=> signed (Int#); False <=> unsigned (Word#)
61 | MachInt64 Integer -- guaranteed 64-bit versions of the above.
62 Bool -- True <=> signed (Int#); False <=> unsigned (Word#)
67 | MachLitLit FAST_STRING
70 | NoRepStr FAST_STRING
71 | NoRepInteger Integer Type -- This Type is always Integer
72 | NoRepRational Rational Type -- This Type is always Rational
73 -- We keep these Types in the literal because Rational isn't
74 -- (currently) wired in, so we can't conjure up its type out of
75 -- thin air. Integer is, so the type here is really redundant.
77 -- deriving (Eq, Ord): no, don't want to compare Types
78 -- The Ord is needed for the FiniteMap used in the lookForConstructor
79 -- in SimplEnv. If you declared that lookForConstructor *ignores*
80 -- constructor-applications with LitArg args, then you could get
83 mkMachInt, mkMachWord :: Integer -> Literal
85 mkMachInt x = MachInt x True{-signed-}
86 mkMachWord x = MachInt x False{-unsigned-}
88 -- check if the int is within range
89 mkMachInt_safe :: Integer -> Literal
92 pprPanic "mkMachInt_safe"
93 (hsep [text "ERROR: Int ", text (show i), text "out of range",
94 brackets (int minInt <+> text ".." <+> int maxInt)])
95 | otherwise = MachInt i True{-signed-}
98 -- i < fromInt minBound ||
101 mkMachInt64 x = MachInt64 x True{-signed-}
102 mkMachWord64 x = MachInt64 x False{-unsigned-}
104 cmpLit (MachChar a) (MachChar b) = a `compare` b
105 cmpLit (MachStr a) (MachStr b) = a `compare` b
106 cmpLit (MachAddr a) (MachAddr b) = a `compare` b
107 cmpLit (MachInt a b) (MachInt c d) = (a `compare` c) `thenCmp` (b `compare` d)
108 cmpLit (MachFloat a) (MachFloat b) = a `compare` b
109 cmpLit (MachDouble a) (MachDouble b) = a `compare` b
110 cmpLit (MachLitLit a b) (MachLitLit c d) = (a `compare` c) `thenCmp` (b `compare` d)
111 cmpLit (NoRepStr a) (NoRepStr b) = a `compare` b
112 cmpLit (NoRepInteger a _) (NoRepInteger b _) = a `compare` b
113 cmpLit (NoRepRational a _) (NoRepRational b _) = a `compare` b
115 -- now we *know* the tags are different, so...
116 cmpLit other_1 other_2
117 | tag1 _LT_ tag2 = LT
123 tagof (MachChar _) = ILIT(1)
124 tagof (MachStr _) = ILIT(2)
125 tagof (MachAddr _) = ILIT(3)
126 tagof (MachInt _ _) = ILIT(4)
127 tagof (MachFloat _) = ILIT(5)
128 tagof (MachDouble _) = ILIT(6)
129 tagof (MachLitLit _ _) = ILIT(7)
130 tagof (NoRepStr _) = ILIT(8)
131 tagof (NoRepInteger _ _) = ILIT(9)
132 tagof (NoRepRational _ _) = ILIT(10)
134 instance Eq Literal where
135 a == b = case (a `compare` b) of { EQ -> True; _ -> False }
136 a /= b = case (a `compare` b) of { EQ -> False; _ -> True }
138 instance Ord Literal where
139 a <= b = case (a `compare` b) of { LT -> True; EQ -> True; GT -> False }
140 a < b = case (a `compare` b) of { LT -> True; EQ -> False; GT -> False }
141 a >= b = case (a `compare` b) of { LT -> False; EQ -> True; GT -> True }
142 a > b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True }
143 compare a b = cmpLit a b
147 isNoRepLit (NoRepStr _) = True -- these are not primitive typed!
148 isNoRepLit (NoRepInteger _ _) = True
149 isNoRepLit (NoRepRational _ _) = True
152 isLitLitLit (MachLitLit _ _) = True
153 isLitLitLit _ = False
157 literalType :: Literal -> Type
159 literalType (MachChar _) = charPrimTy
160 literalType (MachStr _) = addrPrimTy
161 literalType (MachAddr _) = addrPrimTy
162 literalType (MachInt _ signed) = if signed then intPrimTy else wordPrimTy
163 literalType (MachFloat _) = floatPrimTy
164 literalType (MachDouble _) = doublePrimTy
165 literalType (MachLitLit _ k) = case (getPrimRepInfo k) of { (_,t,_) -> t }
166 literalType (NoRepInteger _ t) = t
167 literalType (NoRepRational _ t) = t
168 literalType (NoRepStr _) = stringTy
172 literalPrimRep :: Literal -> PrimRep
174 literalPrimRep (MachChar _) = CharRep
175 literalPrimRep (MachStr _) = AddrRep -- specifically: "char *"
176 literalPrimRep (MachAddr _) = AddrRep
177 literalPrimRep (MachInt _ signed) = if signed then IntRep else WordRep
178 literalPrimRep (MachInt64 _ signed) = if signed then Int64Rep else Word64Rep
179 literalPrimRep (MachFloat _) = FloatRep
180 literalPrimRep (MachDouble _) = DoubleRep
181 literalPrimRep (MachLitLit _ k) = k
183 literalPrimRep (NoRepInteger _ _) = panic "literalPrimRep:NoRepInteger"
184 literalPrimRep (NoRepRational _ _) = panic "literalPrimRep:NoRepRational"
185 literalPrimRep (NoRepStr _) = panic "literalPrimRep:NoRepString"
189 The boring old output stuff:
191 -- MachX (i.e. unboxed) things are printed unadornded (e.g. 3, 'a', "foo")
192 -- exceptions: MachFloat and MachAddr get an initial keyword prefix
194 -- NoRep things get an initial keyword prefix (e.g. _integer_ 3)
196 instance Outputable Literal where
200 = getPprStyle $ \ sty ->
202 code_style = codeStyle sty
205 MachChar ch | code_style -> hcat [ptext SLIT("(C_)"), char '\'', text (charToC ch), char '\'']
206 | ifaceStyle sty -> char '\'' <> text (charToEasyHaskell ch) <> char '\''
207 | otherwise -> text ['\'', ch, '\'']
209 MachStr s | code_style -> doubleQuotes (text (stringToC (_UNPK_ s)))
210 | otherwise -> text (show (_UNPK_ s))
212 NoRepStr s | code_style -> pprPanic "NoRep in code style" (ppr lit)
213 | otherwise -> ptext SLIT("_string_") <+> text (show (_UNPK_ s))
215 MachInt i _ -> integer i
217 | code_style && out_of_range
218 -> pprPanic "" (hsep [text "ERROR: Int ", text (show i), text "out of range",
219 brackets (ppr range_min <+> text ".." <+> ppr range_max)])
220 | otherwise -> integer i
223 range_min = if signed then minInt else 0
225 out_of_range = not (i >= toInteger range_min && i <= toInteger range_max)
228 MachFloat f | code_style -> ptext SLIT("(StgFloat)") <> rational f
229 | otherwise -> ptext SLIT("_float_") <+> rational f
231 MachDouble d -> rational d
233 MachAddr p | code_style -> ptext SLIT("(void*)") <> integer p
234 | otherwise -> ptext SLIT("_addr_") <+> integer p
236 NoRepInteger i _ | code_style -> pprPanic "NoRep in code style" (ppr lit)
237 | otherwise -> ptext SLIT("_integer_") <+> integer i
239 NoRepRational r _ | code_style -> pprPanic "NoRep in code style" (ppr lit)
240 | otherwise -> hsep [ptext SLIT("_rational_"), integer (numerator r),
241 integer (denominator r)]
243 MachLitLit s k | code_style -> ptext s
244 | otherwise -> hsep [ptext SLIT("_litlit_"), ppPrimRep k, text (show (_UNPK_ s))]
246 showLiteral :: Literal -> String
247 showLiteral lit = showSDoc (ppr lit)