Fix header locations
[ghc.git] / compiler / hsSyn / HsLit.hs
1 {-
2 (c) The University of Glasgow 2006
3 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4
5 \section[HsLit]{Abstract syntax: source-language literals}
6 -}
7
8 {-# LANGUAGE CPP, DeriveDataTypeable #-}
9 {-# LANGUAGE TypeSynonymInstances #-}
10 {-# LANGUAGE StandaloneDeriving #-}
11 {-# LANGUAGE FlexibleContexts #-}
12 {-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]
13 -- in module PlaceHolder
14 {-# LANGUAGE ConstraintKinds #-}
15 {-# LANGUAGE TypeFamilies #-}
16
17 module HsLit where
18
19 #include "HsVersions.h"
20
21 import GhcPrelude
22
23 import {-# SOURCE #-} HsExpr( HsExpr, pprExpr )
24 import BasicTypes ( IntegralLit(..),FractionalLit(..),negateIntegralLit,
25 negateFractionalLit,SourceText(..),pprWithSourceText )
26 import Type
27 import Outputable
28 import FastString
29 import HsExtension
30
31 import Data.ByteString (ByteString)
32 import Data.Data hiding ( Fixity )
33
34 {-
35 ************************************************************************
36 * *
37 \subsection[HsLit]{Literals}
38 * *
39 ************************************************************************
40 -}
41
42 -- Note [Literal source text] in BasicTypes for SourceText fields in
43 -- the following
44 -- Note [Trees that grow] in HsExtension for the Xxxxx fields in the following
45 -- | Haskell Literal
46 data HsLit x
47 = HsChar (XHsChar x) {- SourceText -} Char
48 -- ^ Character
49 | HsCharPrim (XHsCharPrim x) {- SourceText -} Char
50 -- ^ Unboxed character
51 | HsString (XHsString x) {- SourceText -} FastString
52 -- ^ String
53 | HsStringPrim (XHsStringPrim x) {- SourceText -} ByteString
54 -- ^ Packed bytes
55 | HsInt (XHsInt x) IntegralLit
56 -- ^ Genuinely an Int; arises from
57 -- @TcGenDeriv@, and from TRANSLATION
58 | HsIntPrim (XHsIntPrim x) {- SourceText -} Integer
59 -- ^ literal @Int#@
60 | HsWordPrim (XHsWordPrim x) {- SourceText -} Integer
61 -- ^ literal @Word#@
62 | HsInt64Prim (XHsInt64Prim x) {- SourceText -} Integer
63 -- ^ literal @Int64#@
64 | HsWord64Prim (XHsWord64Prim x) {- SourceText -} Integer
65 -- ^ literal @Word64#@
66 | HsInteger (XHsInteger x) {- SourceText -} Integer Type
67 -- ^ Genuinely an integer; arises only
68 -- from TRANSLATION (overloaded
69 -- literals are done with HsOverLit)
70 | HsRat (XHsRat x) FractionalLit Type
71 -- ^ Genuinely a rational; arises only from
72 -- TRANSLATION (overloaded literals are
73 -- done with HsOverLit)
74 | HsFloatPrim (XHsFloatPrim x) FractionalLit
75 -- ^ Unboxed Float
76 | HsDoublePrim (XHsDoublePrim x) FractionalLit
77 -- ^ Unboxed Double
78
79 | XLit (XXLit x)
80
81 type instance XHsChar (GhcPass _) = SourceText
82 type instance XHsCharPrim (GhcPass _) = SourceText
83 type instance XHsString (GhcPass _) = SourceText
84 type instance XHsStringPrim (GhcPass _) = SourceText
85 type instance XHsInt (GhcPass _) = NoExt
86 type instance XHsIntPrim (GhcPass _) = SourceText
87 type instance XHsWordPrim (GhcPass _) = SourceText
88 type instance XHsInt64Prim (GhcPass _) = SourceText
89 type instance XHsWord64Prim (GhcPass _) = SourceText
90 type instance XHsInteger (GhcPass _) = SourceText
91 type instance XHsRat (GhcPass _) = NoExt
92 type instance XHsFloatPrim (GhcPass _) = NoExt
93 type instance XHsDoublePrim (GhcPass _) = NoExt
94 type instance XXLit (GhcPass _) = NoExt
95
96 instance Eq (HsLit x) where
97 (HsChar _ x1) == (HsChar _ x2) = x1==x2
98 (HsCharPrim _ x1) == (HsCharPrim _ x2) = x1==x2
99 (HsString _ x1) == (HsString _ x2) = x1==x2
100 (HsStringPrim _ x1) == (HsStringPrim _ x2) = x1==x2
101 (HsInt _ x1) == (HsInt _ x2) = x1==x2
102 (HsIntPrim _ x1) == (HsIntPrim _ x2) = x1==x2
103 (HsWordPrim _ x1) == (HsWordPrim _ x2) = x1==x2
104 (HsInt64Prim _ x1) == (HsInt64Prim _ x2) = x1==x2
105 (HsWord64Prim _ x1) == (HsWord64Prim _ x2) = x1==x2
106 (HsInteger _ x1 _) == (HsInteger _ x2 _) = x1==x2
107 (HsRat _ x1 _) == (HsRat _ x2 _) = x1==x2
108 (HsFloatPrim _ x1) == (HsFloatPrim _ x2) = x1==x2
109 (HsDoublePrim _ x1) == (HsDoublePrim _ x2) = x1==x2
110 _ == _ = False
111
112 -- | Haskell Overloaded Literal
113 data HsOverLit p
114 = OverLit {
115 ol_ext :: (XOverLit p),
116 ol_val :: OverLitVal,
117 ol_witness :: HsExpr p} -- Note [Overloaded literal witnesses]
118
119 | XOverLit
120 (XXOverLit p)
121
122 data OverLitTc
123 = OverLitTc {
124 ol_rebindable :: Bool, -- Note [ol_rebindable]
125 ol_type :: Type }
126 deriving Data
127
128 type instance XOverLit GhcPs = NoExt
129 type instance XOverLit GhcRn = Bool -- Note [ol_rebindable]
130 type instance XOverLit GhcTc = OverLitTc
131
132 type instance XXOverLit (GhcPass _) = NoExt
133
134 -- Note [Literal source text] in BasicTypes for SourceText fields in
135 -- the following
136 -- | Overloaded Literal Value
137 data OverLitVal
138 = HsIntegral !IntegralLit -- ^ Integer-looking literals;
139 | HsFractional !FractionalLit -- ^ Frac-looking literals
140 | HsIsString !SourceText !FastString -- ^ String-looking literals
141 deriving Data
142
143 negateOverLitVal :: OverLitVal -> OverLitVal
144 negateOverLitVal (HsIntegral i) = HsIntegral (negateIntegralLit i)
145 negateOverLitVal (HsFractional f) = HsFractional (negateFractionalLit f)
146 negateOverLitVal _ = panic "negateOverLitVal: argument is not a number"
147
148 overLitType :: HsOverLit GhcTc -> Type
149 overLitType (OverLit (OverLitTc _ ty) _ _) = ty
150 overLitType XOverLit{} = panic "overLitType"
151
152 -- | Convert a literal from one index type to another, updating the annotations
153 -- according to the relevant 'Convertable' instance
154 convertLit :: (ConvertIdX a b) => HsLit a -> HsLit b
155 convertLit (HsChar a x) = (HsChar (convert a) x)
156 convertLit (HsCharPrim a x) = (HsCharPrim (convert a) x)
157 convertLit (HsString a x) = (HsString (convert a) x)
158 convertLit (HsStringPrim a x) = (HsStringPrim (convert a) x)
159 convertLit (HsInt a x) = (HsInt (convert a) x)
160 convertLit (HsIntPrim a x) = (HsIntPrim (convert a) x)
161 convertLit (HsWordPrim a x) = (HsWordPrim (convert a) x)
162 convertLit (HsInt64Prim a x) = (HsInt64Prim (convert a) x)
163 convertLit (HsWord64Prim a x) = (HsWord64Prim (convert a) x)
164 convertLit (HsInteger a x b) = (HsInteger (convert a) x b)
165 convertLit (HsRat a x b) = (HsRat (convert a) x b)
166 convertLit (HsFloatPrim a x) = (HsFloatPrim (convert a) x)
167 convertLit (HsDoublePrim a x) = (HsDoublePrim (convert a) x)
168 convertLit (XLit a) = (XLit (convert a))
169
170 {-
171 Note [ol_rebindable]
172 ~~~~~~~~~~~~~~~~~~~~
173 The ol_rebindable field is True if this literal is actually
174 using rebindable syntax. Specifically:
175
176 False iff ol_witness is the standard one
177 True iff ol_witness is non-standard
178
179 Equivalently it's True if
180 a) RebindableSyntax is on
181 b) the witness for fromInteger/fromRational/fromString
182 that happens to be in scope isn't the standard one
183
184 Note [Overloaded literal witnesses]
185 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
186 *Before* type checking, the HsExpr in an HsOverLit is the
187 name of the coercion function, 'fromInteger' or 'fromRational'.
188 *After* type checking, it is a witness for the literal, such as
189 (fromInteger 3) or lit_78
190 This witness should replace the literal.
191
192 This dual role is unusual, because we're replacing 'fromInteger' with
193 a call to fromInteger. Reason: it allows commoning up of the fromInteger
194 calls, which wouldn't be possible if the desugarer made the application.
195
196 The PostTcType in each branch records the type the overload literal is
197 found to have.
198 -}
199
200 -- Comparison operations are needed when grouping literals
201 -- for compiling pattern-matching (module MatchLit)
202 instance (Eq (XXOverLit p)) => Eq (HsOverLit p) where
203 (OverLit _ val1 _) == (OverLit _ val2 _) = val1 == val2
204 (XOverLit val1) == (XOverLit val2) = val1 == val2
205 _ == _ = panic "Eq HsOverLit"
206
207 instance Eq OverLitVal where
208 (HsIntegral i1) == (HsIntegral i2) = i1 == i2
209 (HsFractional f1) == (HsFractional f2) = f1 == f2
210 (HsIsString _ s1) == (HsIsString _ s2) = s1 == s2
211 _ == _ = False
212
213 instance (Ord (XXOverLit p)) => Ord (HsOverLit p) where
214 compare (OverLit _ val1 _) (OverLit _ val2 _) = val1 `compare` val2
215 compare (XOverLit val1) (XOverLit val2) = val1 `compare` val2
216 compare _ _ = panic "Ord HsOverLit"
217
218 instance Ord OverLitVal where
219 compare (HsIntegral i1) (HsIntegral i2) = i1 `compare` i2
220 compare (HsIntegral _) (HsFractional _) = LT
221 compare (HsIntegral _) (HsIsString _ _) = LT
222 compare (HsFractional f1) (HsFractional f2) = f1 `compare` f2
223 compare (HsFractional _) (HsIntegral _) = GT
224 compare (HsFractional _) (HsIsString _ _) = LT
225 compare (HsIsString _ s1) (HsIsString _ s2) = s1 `compare` s2
226 compare (HsIsString _ _) (HsIntegral _) = GT
227 compare (HsIsString _ _) (HsFractional _) = GT
228
229 -- Instance specific to GhcPs, need the SourceText
230 instance p ~ GhcPass pass => Outputable (HsLit p) where
231 ppr (HsChar st c) = pprWithSourceText st (pprHsChar c)
232 ppr (HsCharPrim st c) = pp_st_suffix st primCharSuffix (pprPrimChar c)
233 ppr (HsString st s) = pprWithSourceText st (pprHsString s)
234 ppr (HsStringPrim st s) = pprWithSourceText st (pprHsBytes s)
235 ppr (HsInt _ i)
236 = pprWithSourceText (il_text i) (integer (il_value i))
237 ppr (HsInteger st i _) = pprWithSourceText st (integer i)
238 ppr (HsRat _ f _) = ppr f
239 ppr (HsFloatPrim _ f) = ppr f <> primFloatSuffix
240 ppr (HsDoublePrim _ d) = ppr d <> primDoubleSuffix
241 ppr (HsIntPrim st i) = pprWithSourceText st (pprPrimInt i)
242 ppr (HsWordPrim st w) = pprWithSourceText st (pprPrimWord w)
243 ppr (HsInt64Prim st i) = pp_st_suffix st primInt64Suffix (pprPrimInt64 i)
244 ppr (HsWord64Prim st w) = pp_st_suffix st primWord64Suffix (pprPrimWord64 w)
245 ppr (XLit x) = ppr x
246
247 pp_st_suffix :: SourceText -> SDoc -> SDoc -> SDoc
248 pp_st_suffix NoSourceText _ doc = doc
249 pp_st_suffix (SourceText st) suffix _ = text st <> suffix
250
251 -- in debug mode, print the expression that it's resolved to, too
252 instance (p ~ GhcPass pass, OutputableBndrId p)
253 => Outputable (HsOverLit p) where
254 ppr (OverLit {ol_val=val, ol_witness=witness})
255 = ppr val <+> (whenPprDebug (parens (pprExpr witness)))
256 ppr (XOverLit x) = ppr x
257
258 instance Outputable OverLitVal where
259 ppr (HsIntegral i) = pprWithSourceText (il_text i) (integer (il_value i))
260 ppr (HsFractional f) = ppr f
261 ppr (HsIsString st s) = pprWithSourceText st (pprHsString s)
262
263 -- | pmPprHsLit pretty prints literals and is used when pretty printing pattern
264 -- match warnings. All are printed the same (i.e., without hashes if they are
265 -- primitive and not wrapped in constructors if they are boxed). This happens
266 -- mainly for too reasons:
267 -- * We do not want to expose their internal representation
268 -- * The warnings become too messy
269 pmPprHsLit :: HsLit (GhcPass x) -> SDoc
270 pmPprHsLit (HsChar _ c) = pprHsChar c
271 pmPprHsLit (HsCharPrim _ c) = pprHsChar c
272 pmPprHsLit (HsString st s) = pprWithSourceText st (pprHsString s)
273 pmPprHsLit (HsStringPrim _ s) = pprHsBytes s
274 pmPprHsLit (HsInt _ i) = integer (il_value i)
275 pmPprHsLit (HsIntPrim _ i) = integer i
276 pmPprHsLit (HsWordPrim _ w) = integer w
277 pmPprHsLit (HsInt64Prim _ i) = integer i
278 pmPprHsLit (HsWord64Prim _ w) = integer w
279 pmPprHsLit (HsInteger _ i _) = integer i
280 pmPprHsLit (HsRat _ f _) = ppr f
281 pmPprHsLit (HsFloatPrim _ f) = ppr f
282 pmPprHsLit (HsDoublePrim _ d) = ppr d
283 pmPprHsLit (XLit x) = ppr x
284
285 -- | @'hsLitNeedsParens' p l@ returns 'True' if a literal @l@ needs
286 -- to be parenthesized under precedence @p@.
287 hsLitNeedsParens :: PprPrec -> HsLit x -> Bool
288 hsLitNeedsParens p = go
289 where
290 go (HsChar {}) = False
291 go (HsCharPrim {}) = False
292 go (HsString {}) = False
293 go (HsStringPrim {}) = False
294 go (HsInt _ x) = p > topPrec && il_neg x
295 go (HsIntPrim _ x) = p > topPrec && x < 0
296 go (HsWordPrim {}) = False
297 go (HsInt64Prim _ x) = p > topPrec && x < 0
298 go (HsWord64Prim {}) = False
299 go (HsInteger _ x _) = p > topPrec && x < 0
300 go (HsRat _ x _) = p > topPrec && fl_neg x
301 go (HsFloatPrim _ x) = p > topPrec && fl_neg x
302 go (HsDoublePrim _ x) = p > topPrec && fl_neg x
303 go (XLit _) = False
304
305 -- | @'hsOverLitNeedsParens' p ol@ returns 'True' if an overloaded literal
306 -- @ol@ needs to be parenthesized under precedence @p@.
307 hsOverLitNeedsParens :: PprPrec -> HsOverLit x -> Bool
308 hsOverLitNeedsParens p (OverLit { ol_val = olv }) = go olv
309 where
310 go :: OverLitVal -> Bool
311 go (HsIntegral x) = p > topPrec && il_neg x
312 go (HsFractional x) = p > topPrec && fl_neg x
313 go (HsIsString {}) = False
314 hsOverLitNeedsParens _ (XOverLit { }) = False