blob: fcb923169d7034b3343dd6ca6dee1aa5bfdf8420 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
|
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-} -- Wrinkle in Note [Trees That Grow]
-- in module Language.Haskell.Syntax.Extension
{-
(c) The University of Glasgow 2006
(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-}
-- See Note [Language.Haskell.Syntax.* Hierarchy] for why not GHC.Hs.*
-- | Source-language literals
module Language.Haskell.Syntax.Lit where
import Language.Haskell.Syntax.Extension
import GHC.Utils.Panic (panic)
import GHC.Types.SourceText (IntegralLit, FractionalLit, SourceText, negateIntegralLit, negateFractionalLit)
import GHC.Core.Type (Type)
import GHC.Data.FastString (FastString, lexicalCompareFS)
import Data.ByteString (ByteString)
import Data.Data hiding ( Fixity )
import Data.Bool
import Data.Ord
import Data.Eq
import Data.Char
import Prelude (Integer)
{-
************************************************************************
* *
\subsection[HsLit]{Literals}
* *
************************************************************************
-}
-- Note [Literal source text] in GHC.Types.Basic for SourceText fields in
-- the following
-- Note [Trees That Grow] in Language.Haskell.Syntax.Extension for the Xxxxx
-- fields in the following
-- | Haskell Literal
data HsLit x
= HsChar (XHsChar x) {- SourceText -} Char
-- ^ Character
| HsCharPrim (XHsCharPrim x) {- SourceText -} Char
-- ^ Unboxed character
| HsString (XHsString x) {- SourceText -} FastString
-- ^ String
| HsStringPrim (XHsStringPrim x) {- SourceText -} !ByteString
-- ^ Packed bytes
| HsInt (XHsInt x) IntegralLit
-- ^ Genuinely an Int; arises from
-- "GHC.Tc.Deriv.Generate", and from TRANSLATION
| HsIntPrim (XHsIntPrim x) {- SourceText -} Integer
-- ^ literal @Int#@
| HsWordPrim (XHsWordPrim x) {- SourceText -} Integer
-- ^ literal @Word#@
| HsInt64Prim (XHsInt64Prim x) {- SourceText -} Integer
-- ^ literal @Int64#@
| HsWord64Prim (XHsWord64Prim x) {- SourceText -} Integer
-- ^ literal @Word64#@
| HsInteger (XHsInteger x) {- SourceText -} Integer Type
-- ^ Genuinely an integer; arises only
-- from TRANSLATION (overloaded
-- literals are done with HsOverLit)
| HsRat (XHsRat x) FractionalLit Type
-- ^ Genuinely a rational; arises only from
-- TRANSLATION (overloaded literals are
-- done with HsOverLit)
| HsFloatPrim (XHsFloatPrim x) FractionalLit
-- ^ Unboxed Float
| HsDoublePrim (XHsDoublePrim x) FractionalLit
-- ^ Unboxed Double
| XLit !(XXLit x)
instance Eq (HsLit x) where
(HsChar _ x1) == (HsChar _ x2) = x1==x2
(HsCharPrim _ x1) == (HsCharPrim _ x2) = x1==x2
(HsString _ x1) == (HsString _ x2) = x1==x2
(HsStringPrim _ x1) == (HsStringPrim _ x2) = x1==x2
(HsInt _ x1) == (HsInt _ x2) = x1==x2
(HsIntPrim _ x1) == (HsIntPrim _ x2) = x1==x2
(HsWordPrim _ x1) == (HsWordPrim _ x2) = x1==x2
(HsInt64Prim _ x1) == (HsInt64Prim _ x2) = x1==x2
(HsWord64Prim _ x1) == (HsWord64Prim _ x2) = x1==x2
(HsInteger _ x1 _) == (HsInteger _ x2 _) = x1==x2
(HsRat _ x1 _) == (HsRat _ x2 _) = x1==x2
(HsFloatPrim _ x1) == (HsFloatPrim _ x2) = x1==x2
(HsDoublePrim _ x1) == (HsDoublePrim _ x2) = x1==x2
_ == _ = False
-- | Haskell Overloaded Literal
data HsOverLit p
= OverLit {
ol_ext :: (XOverLit p),
ol_val :: OverLitVal}
| XOverLit
!(XXOverLit p)
-- Note [Literal source text] in GHC.Types.Basic for SourceText fields in
-- the following
-- | Overloaded Literal Value
data OverLitVal
= HsIntegral !IntegralLit -- ^ Integer-looking literals;
| HsFractional !FractionalLit -- ^ Frac-looking literals
| HsIsString !SourceText !FastString -- ^ String-looking literals
deriving Data
negateOverLitVal :: OverLitVal -> OverLitVal
negateOverLitVal (HsIntegral i) = HsIntegral (negateIntegralLit i)
negateOverLitVal (HsFractional f) = HsFractional (negateFractionalLit f)
negateOverLitVal _ = panic "negateOverLitVal: argument is not a number"
-- Comparison operations are needed when grouping literals
-- for compiling pattern-matching (module GHC.HsToCore.Match.Literal)
instance (Eq (XXOverLit p)) => Eq (HsOverLit p) where
(OverLit _ val1) == (OverLit _ val2) = val1 == val2
(XOverLit val1) == (XOverLit val2) = val1 == val2
_ == _ = panic "Eq HsOverLit"
instance Eq OverLitVal where
(HsIntegral i1) == (HsIntegral i2) = i1 == i2
(HsFractional f1) == (HsFractional f2) = f1 == f2
(HsIsString _ s1) == (HsIsString _ s2) = s1 == s2
_ == _ = False
instance (Ord (XXOverLit p)) => Ord (HsOverLit p) where
compare (OverLit _ val1) (OverLit _ val2) = val1 `compare` val2
compare (XOverLit val1) (XOverLit val2) = val1 `compare` val2
compare _ _ = panic "Ord HsOverLit"
instance Ord OverLitVal where
compare (HsIntegral i1) (HsIntegral i2) = i1 `compare` i2
compare (HsIntegral _) (HsFractional _) = LT
compare (HsIntegral _) (HsIsString _ _) = LT
compare (HsFractional f1) (HsFractional f2) = f1 `compare` f2
compare (HsFractional _) (HsIntegral _) = GT
compare (HsFractional _) (HsIsString _ _) = LT
compare (HsIsString _ s1) (HsIsString _ s2) = s1 `lexicalCompareFS` s2
compare (HsIsString _ _) (HsIntegral _) = GT
compare (HsIsString _ _) (HsFractional _) = GT
|
