never executed always true always false
1
2 {-# LANGUAGE ConstraintKinds #-}
3 {-# LANGUAGE DeriveDataTypeable #-}
4 {-# LANGUAGE FlexibleContexts #-}
5 {-# LANGUAGE FlexibleInstances #-}
6 {-# LANGUAGE TypeFamilies #-}
7 {-# LANGUAGE UndecidableInstances #-} -- Wrinkle in Note [Trees That Grow]
8 -- in module Language.Haskell.Syntax.Extension
9
10 {-
11 (c) The University of Glasgow 2006
12 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
13
14 -}
15
16 -- See Note [Language.Haskell.Syntax.* Hierarchy] for why not GHC.Hs.*
17
18 -- | Source-language literals
19 module Language.Haskell.Syntax.Lit where
20
21 import GHC.Prelude
22
23 import GHC.Types.Basic (PprPrec(..), topPrec )
24 import GHC.Types.SourceText
25 import GHC.Core.Type
26 import GHC.Utils.Outputable
27 import GHC.Utils.Panic
28 import GHC.Data.FastString
29 import Language.Haskell.Syntax.Extension
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 GHC.Types.Basic for SourceText fields in
43 -- the following
44 -- Note [Trees That Grow] in Language.Haskell.Syntax.Extension for the Xxxxx
45 -- fields in the following
46 -- | Haskell Literal
47 data HsLit x
48 = HsChar (XHsChar x) {- SourceText -} Char
49 -- ^ Character
50 | HsCharPrim (XHsCharPrim x) {- SourceText -} Char
51 -- ^ Unboxed character
52 | HsString (XHsString x) {- SourceText -} FastString
53 -- ^ String
54 | HsStringPrim (XHsStringPrim x) {- SourceText -} !ByteString
55 -- ^ Packed bytes
56 | HsInt (XHsInt x) IntegralLit
57 -- ^ Genuinely an Int; arises from
58 -- "GHC.Tc.Deriv.Generate", and from TRANSLATION
59 | HsIntPrim (XHsIntPrim x) {- SourceText -} Integer
60 -- ^ literal @Int#@
61 | HsWordPrim (XHsWordPrim x) {- SourceText -} Integer
62 -- ^ literal @Word#@
63 | HsInt64Prim (XHsInt64Prim x) {- SourceText -} Integer
64 -- ^ literal @Int64#@
65 | HsWord64Prim (XHsWord64Prim x) {- SourceText -} Integer
66 -- ^ literal @Word64#@
67 | HsInteger (XHsInteger x) {- SourceText -} Integer Type
68 -- ^ Genuinely an integer; arises only
69 -- from TRANSLATION (overloaded
70 -- literals are done with HsOverLit)
71 | HsRat (XHsRat x) FractionalLit Type
72 -- ^ Genuinely a rational; arises only from
73 -- TRANSLATION (overloaded literals are
74 -- done with HsOverLit)
75 | HsFloatPrim (XHsFloatPrim x) FractionalLit
76 -- ^ Unboxed Float
77 | HsDoublePrim (XHsDoublePrim x) FractionalLit
78 -- ^ Unboxed Double
79
80 | XLit !(XXLit x)
81
82 instance Eq (HsLit x) where
83 (HsChar _ x1) == (HsChar _ x2) = x1==x2
84 (HsCharPrim _ x1) == (HsCharPrim _ x2) = x1==x2
85 (HsString _ x1) == (HsString _ x2) = x1==x2
86 (HsStringPrim _ x1) == (HsStringPrim _ x2) = x1==x2
87 (HsInt _ x1) == (HsInt _ x2) = x1==x2
88 (HsIntPrim _ x1) == (HsIntPrim _ x2) = x1==x2
89 (HsWordPrim _ x1) == (HsWordPrim _ x2) = x1==x2
90 (HsInt64Prim _ x1) == (HsInt64Prim _ x2) = x1==x2
91 (HsWord64Prim _ x1) == (HsWord64Prim _ x2) = x1==x2
92 (HsInteger _ x1 _) == (HsInteger _ x2 _) = x1==x2
93 (HsRat _ x1 _) == (HsRat _ x2 _) = x1==x2
94 (HsFloatPrim _ x1) == (HsFloatPrim _ x2) = x1==x2
95 (HsDoublePrim _ x1) == (HsDoublePrim _ x2) = x1==x2
96 _ == _ = False
97
98 -- | Haskell Overloaded Literal
99 data HsOverLit p
100 = OverLit {
101 ol_ext :: (XOverLit p),
102 ol_val :: OverLitVal}
103
104 | XOverLit
105 !(XXOverLit p)
106
107 -- Note [Literal source text] in GHC.Types.Basic for SourceText fields in
108 -- the following
109 -- | Overloaded Literal Value
110 data OverLitVal
111 = HsIntegral !IntegralLit -- ^ Integer-looking literals;
112 | HsFractional !FractionalLit -- ^ Frac-looking literals
113 | HsIsString !SourceText !FastString -- ^ String-looking literals
114 deriving Data
115
116 negateOverLitVal :: OverLitVal -> OverLitVal
117 negateOverLitVal (HsIntegral i) = HsIntegral (negateIntegralLit i)
118 negateOverLitVal (HsFractional f) = HsFractional (negateFractionalLit f)
119 negateOverLitVal _ = panic "negateOverLitVal: argument is not a number"
120
121 -- Comparison operations are needed when grouping literals
122 -- for compiling pattern-matching (module GHC.HsToCore.Match.Literal)
123 instance (Eq (XXOverLit p)) => Eq (HsOverLit p) where
124 (OverLit _ val1) == (OverLit _ val2) = val1 == val2
125 (XOverLit val1) == (XOverLit val2) = val1 == val2
126 _ == _ = panic "Eq HsOverLit"
127
128 instance Eq OverLitVal where
129 (HsIntegral i1) == (HsIntegral i2) = i1 == i2
130 (HsFractional f1) == (HsFractional f2) = f1 == f2
131 (HsIsString _ s1) == (HsIsString _ s2) = s1 == s2
132 _ == _ = False
133
134 instance (Ord (XXOverLit p)) => Ord (HsOverLit p) where
135 compare (OverLit _ val1) (OverLit _ val2) = val1 `compare` val2
136 compare (XOverLit val1) (XOverLit val2) = val1 `compare` val2
137 compare _ _ = panic "Ord HsOverLit"
138
139 instance Ord OverLitVal where
140 compare (HsIntegral i1) (HsIntegral i2) = i1 `compare` i2
141 compare (HsIntegral _) (HsFractional _) = LT
142 compare (HsIntegral _) (HsIsString _ _) = LT
143 compare (HsFractional f1) (HsFractional f2) = f1 `compare` f2
144 compare (HsFractional _) (HsIntegral _) = GT
145 compare (HsFractional _) (HsIsString _ _) = LT
146 compare (HsIsString _ s1) (HsIsString _ s2) = s1 `lexicalCompareFS` s2
147 compare (HsIsString _ _) (HsIntegral _) = GT
148 compare (HsIsString _ _) (HsFractional _) = GT
149
150 instance Outputable OverLitVal where
151 ppr (HsIntegral i) = pprWithSourceText (il_text i) (integer (il_value i))
152 ppr (HsFractional f) = ppr f
153 ppr (HsIsString st s) = pprWithSourceText st (pprHsString s)
154
155 -- | @'hsLitNeedsParens' p l@ returns 'True' if a literal @l@ needs
156 -- to be parenthesized under precedence @p@.
157 hsLitNeedsParens :: PprPrec -> HsLit x -> Bool
158 hsLitNeedsParens p = go
159 where
160 go (HsChar {}) = False
161 go (HsCharPrim {}) = False
162 go (HsString {}) = False
163 go (HsStringPrim {}) = False
164 go (HsInt _ x) = p > topPrec && il_neg x
165 go (HsIntPrim _ x) = p > topPrec && x < 0
166 go (HsWordPrim {}) = False
167 go (HsInt64Prim _ x) = p > topPrec && x < 0
168 go (HsWord64Prim {}) = False
169 go (HsInteger _ x _) = p > topPrec && x < 0
170 go (HsRat _ x _) = p > topPrec && fl_neg x
171 go (HsFloatPrim _ x) = p > topPrec && fl_neg x
172 go (HsDoublePrim _ x) = p > topPrec && fl_neg x
173 go (XLit _) = False
174
175 -- | @'hsOverLitNeedsParens' p ol@ returns 'True' if an overloaded literal
176 -- @ol@ needs to be parenthesized under precedence @p@.
177 hsOverLitNeedsParens :: PprPrec -> HsOverLit x -> Bool
178 hsOverLitNeedsParens p (OverLit { ol_val = olv }) = go olv
179 where
180 go :: OverLitVal -> Bool
181 go (HsIntegral x) = p > topPrec && il_neg x
182 go (HsFractional x) = p > topPrec && fl_neg x
183 go (HsIsString {}) = False
184 hsOverLitNeedsParens _ (XOverLit { }) = False