never executed always true always false
1 {-# LANGUAGE ConstraintKinds #-}
2 {-# LANGUAGE FlexibleContexts #-}
3 {-# LANGUAGE FlexibleInstances #-}
4 {-# LANGUAGE TypeFamilies #-}
5 {-# LANGUAGE UndecidableInstances #-} -- Wrinkle in Note [Trees That Grow]
6 -- in module Language.Haskell.Syntax.Extension
7 {-# LANGUAGE DuplicateRecordFields #-}
8 {-# LANGUAGE TypeApplications #-}
9
10 {-# OPTIONS_GHC -Wno-orphans #-} -- Outputable, OutputableBndrId
11
12 {-
13 (c) The University of Glasgow 2006
14 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
15
16 -}
17
18 -- | Source-language literals
19 module GHC.Hs.Lit
20 ( module Language.Haskell.Syntax.Lit
21 , module GHC.Hs.Lit
22 ) where
23
24 import GHC.Prelude
25
26 import {-# SOURCE #-} GHC.Hs.Expr( pprExpr )
27
28 import Language.Haskell.Syntax.Lit
29
30 import GHC.Types.SourceText
31 import GHC.Core.Type
32 import GHC.Utils.Outputable
33 import Language.Haskell.Syntax.Expr ( HsExpr )
34 import Language.Haskell.Syntax.Extension
35 import GHC.Hs.Extension
36
37 {-
38 ************************************************************************
39 * *
40 \subsection[HsLit]{Literals}
41 * *
42 ************************************************************************
43 -}
44
45 type instance XHsChar (GhcPass _) = SourceText
46 type instance XHsCharPrim (GhcPass _) = SourceText
47 type instance XHsString (GhcPass _) = SourceText
48 type instance XHsStringPrim (GhcPass _) = SourceText
49 type instance XHsInt (GhcPass _) = NoExtField
50 type instance XHsIntPrim (GhcPass _) = SourceText
51 type instance XHsWordPrim (GhcPass _) = SourceText
52 type instance XHsInt64Prim (GhcPass _) = SourceText
53 type instance XHsWord64Prim (GhcPass _) = SourceText
54 type instance XHsInteger (GhcPass _) = SourceText
55 type instance XHsRat (GhcPass _) = NoExtField
56 type instance XHsFloatPrim (GhcPass _) = NoExtField
57 type instance XHsDoublePrim (GhcPass _) = NoExtField
58 type instance XXLit (GhcPass _) = NoExtCon
59
60 data OverLitRn
61 = OverLitRn {
62 ol_rebindable :: Bool, -- Note [ol_rebindable]
63 ol_from_fun :: LIdP GhcRn -- Note [Overloaded literal witnesses]
64 }
65
66 data OverLitTc
67 = OverLitTc {
68 ol_rebindable :: Bool, -- Note [ol_rebindable]
69 ol_witness :: HsExpr GhcTc, -- Note [Overloaded literal witnesses]
70 ol_type :: Type }
71
72 {-
73 Note [Overloaded literal witnesses]
74 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
75
76 During renaming, the coercion function needed for a given HsOverLit is
77 resolved according to the current scope and RebindableSyntax (see Note
78 [ol_rebindable]). The result of this resolution *before* type checking
79 is the coercion function such as 'fromInteger' or 'fromRational',
80 stored in the ol_from_fun field of OverLitRn.
81
82 *After* type checking, the ol_witness field of the OverLitTc contains
83 the witness of the literal as HsExpr, such as (fromInteger 3) or
84 lit_78. This witness should replace the literal. Reason: it allows
85 commoning up of the fromInteger calls, which wouldn't be possible if
86 the desugarer made the application.
87
88 The ol_type in OverLitTc records the type the overloaded literal is
89 found to have.
90 -}
91
92 type instance XOverLit GhcPs = NoExtField
93 type instance XOverLit GhcRn = OverLitRn
94 type instance XOverLit GhcTc = OverLitTc
95
96 pprXOverLit :: GhcPass p -> XOverLit (GhcPass p) -> SDoc
97 pprXOverLit GhcPs noExt = ppr noExt
98 pprXOverLit GhcRn OverLitRn{ ol_from_fun = from_fun } = ppr from_fun
99 pprXOverLit GhcTc OverLitTc{ ol_witness = witness } = pprExpr witness
100
101 type instance XXOverLit (GhcPass _) = NoExtCon
102
103 overLitType :: HsOverLit GhcTc -> Type
104 overLitType (OverLit OverLitTc{ ol_type = ty } _) = ty
105
106 -- | Convert a literal from one index type to another
107 convertLit :: HsLit (GhcPass p1) -> HsLit (GhcPass p2)
108 convertLit (HsChar a x) = HsChar a x
109 convertLit (HsCharPrim a x) = HsCharPrim a x
110 convertLit (HsString a x) = HsString a x
111 convertLit (HsStringPrim a x) = HsStringPrim a x
112 convertLit (HsInt a x) = HsInt a x
113 convertLit (HsIntPrim a x) = HsIntPrim a x
114 convertLit (HsWordPrim a x) = HsWordPrim a x
115 convertLit (HsInt64Prim a x) = HsInt64Prim a x
116 convertLit (HsWord64Prim a x) = HsWord64Prim a x
117 convertLit (HsInteger a x b) = HsInteger a x b
118 convertLit (HsRat a x b) = HsRat a x b
119 convertLit (HsFloatPrim a x) = HsFloatPrim a x
120 convertLit (HsDoublePrim a x) = HsDoublePrim a x
121
122 {-
123 Note [ol_rebindable]
124 ~~~~~~~~~~~~~~~~~~~~
125 The ol_rebindable field is True if this literal is actually
126 using rebindable syntax. Specifically:
127
128 False iff ol_from_fun / ol_witness is the standard one
129 True iff ol_from_fun / ol_witness is non-standard
130
131 Equivalently it's True if
132 a) RebindableSyntax is on
133 b) the witness for fromInteger/fromRational/fromString
134 that happens to be in scope isn't the standard one
135 -}
136
137 -- Instance specific to GhcPs, need the SourceText
138 instance Outputable (HsLit (GhcPass p)) where
139 ppr (HsChar st c) = pprWithSourceText st (pprHsChar c)
140 ppr (HsCharPrim st c) = pp_st_suffix st primCharSuffix (pprPrimChar c)
141 ppr (HsString st s) = pprWithSourceText st (pprHsString s)
142 ppr (HsStringPrim st s) = pprWithSourceText st (pprHsBytes s)
143 ppr (HsInt _ i)
144 = pprWithSourceText (il_text i) (integer (il_value i))
145 ppr (HsInteger st i _) = pprWithSourceText st (integer i)
146 ppr (HsRat _ f _) = ppr f
147 ppr (HsFloatPrim _ f) = ppr f <> primFloatSuffix
148 ppr (HsDoublePrim _ d) = ppr d <> primDoubleSuffix
149 ppr (HsIntPrim st i) = pprWithSourceText st (pprPrimInt i)
150 ppr (HsWordPrim st w) = pprWithSourceText st (pprPrimWord w)
151 ppr (HsInt64Prim st i) = pp_st_suffix st primInt64Suffix (pprPrimInt64 i)
152 ppr (HsWord64Prim st w) = pp_st_suffix st primWord64Suffix (pprPrimWord64 w)
153
154 pp_st_suffix :: SourceText -> SDoc -> SDoc -> SDoc
155 pp_st_suffix NoSourceText _ doc = doc
156 pp_st_suffix (SourceText st) suffix _ = text st <> suffix
157
158 -- in debug mode, print the expression that it's resolved to, too
159 instance OutputableBndrId p
160 => Outputable (HsOverLit (GhcPass p)) where
161 ppr (OverLit {ol_val=val, ol_ext=ext})
162 = ppr val <+> (whenPprDebug (parens (pprXOverLit (ghcPass @p) ext)))
163
164 -- | pmPprHsLit pretty prints literals and is used when pretty printing pattern
165 -- match warnings. All are printed the same (i.e., without hashes if they are
166 -- primitive and not wrapped in constructors if they are boxed). This happens
167 -- mainly for too reasons:
168 -- * We do not want to expose their internal representation
169 -- * The warnings become too messy
170 pmPprHsLit :: HsLit (GhcPass x) -> SDoc
171 pmPprHsLit (HsChar _ c) = pprHsChar c
172 pmPprHsLit (HsCharPrim _ c) = pprHsChar c
173 pmPprHsLit (HsString st s) = pprWithSourceText st (pprHsString s)
174 pmPprHsLit (HsStringPrim _ s) = pprHsBytes s
175 pmPprHsLit (HsInt _ i) = integer (il_value i)
176 pmPprHsLit (HsIntPrim _ i) = integer i
177 pmPprHsLit (HsWordPrim _ w) = integer w
178 pmPprHsLit (HsInt64Prim _ i) = integer i
179 pmPprHsLit (HsWord64Prim _ w) = integer w
180 pmPprHsLit (HsInteger _ i _) = integer i
181 pmPprHsLit (HsRat _ f _) = ppr f
182 pmPprHsLit (HsFloatPrim _ f) = ppr f
183 pmPprHsLit (HsDoublePrim _ d) = ppr d