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