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
|
{-# LANGUAGE DeriveDataTypeable #-}
-- | Fixity
module GHC.Types.Fixity
( Fixity (..)
, FixityDirection (..)
, LexicalFixity (..)
, maxPrecedence
, minPrecedence
, defaultFixity
, negateFixity
, funTyFixity
, compareFixity
)
where
import GHC.Prelude
import GHC.Types.SourceText
import GHC.Utils.Outputable
import GHC.Utils.Binary
import Data.Data hiding (Fixity, Prefix, Infix)
data Fixity = Fixity SourceText Int FixityDirection
-- Note [Pragma source text] in "GHC.Types.SourceText"
deriving Data
instance Outputable Fixity where
ppr (Fixity _ prec dir) = hcat [ppr dir, space, int prec]
instance Eq Fixity where -- Used to determine if two fixities conflict
(Fixity _ p1 dir1) == (Fixity _ p2 dir2) = p1==p2 && dir1 == dir2
instance Binary Fixity where
put_ bh (Fixity src aa ab) = do
put_ bh src
put_ bh aa
put_ bh ab
get bh = do
src <- get bh
aa <- get bh
ab <- get bh
return (Fixity src aa ab)
------------------------
data FixityDirection
= InfixL
| InfixR
| InfixN
deriving (Eq, Data)
instance Outputable FixityDirection where
ppr InfixL = text "infixl"
ppr InfixR = text "infixr"
ppr InfixN = text "infix"
instance Binary FixityDirection where
put_ bh InfixL =
putByte bh 0
put_ bh InfixR =
putByte bh 1
put_ bh InfixN =
putByte bh 2
get bh = do
h <- getByte bh
case h of
0 -> return InfixL
1 -> return InfixR
_ -> return InfixN
------------------------
maxPrecedence, minPrecedence :: Int
maxPrecedence = 9
minPrecedence = 0
defaultFixity :: Fixity
defaultFixity = Fixity NoSourceText maxPrecedence InfixL
negateFixity, funTyFixity :: Fixity
-- Wired-in fixities
negateFixity = Fixity NoSourceText 6 InfixL -- Fixity of unary negate
funTyFixity = Fixity NoSourceText (-1) InfixR -- Fixity of '->', see #15235
{-
Consider
\begin{verbatim}
a `op1` b `op2` c
\end{verbatim}
@(compareFixity op1 op2)@ tells which way to arrange application, or
whether there's an error.
-}
compareFixity :: Fixity -> Fixity
-> (Bool, -- Error please
Bool) -- Associate to the right: a op1 (b op2 c)
compareFixity (Fixity _ prec1 dir1) (Fixity _ prec2 dir2)
= case prec1 `compare` prec2 of
GT -> left
LT -> right
EQ -> case (dir1, dir2) of
(InfixR, InfixR) -> right
(InfixL, InfixL) -> left
_ -> error_please
where
right = (False, True)
left = (False, False)
error_please = (True, False)
-- |Captures the fixity of declarations as they are parsed. This is not
-- necessarily the same as the fixity declaration, as the normal fixity may be
-- overridden using parens or backticks.
data LexicalFixity = Prefix | Infix deriving (Data,Eq)
instance Outputable LexicalFixity where
ppr Prefix = text "Prefix"
ppr Infix = text "Infix"
|
