@@ -5,6 +5,8 @@ module Language.PureScript.AST.Binders where
55
66import Prelude.Compat
77
8+ import Data.Semigroup
9+
810import Language.PureScript.AST.SourcePos
911import Language.PureScript.AST.Literals
1012import Language.PureScript.Names
@@ -61,7 +63,103 @@ data Binder
6163 -- A binder with a type annotation
6264 --
6365 | TypedBinder Type Binder
64- deriving (Show , Eq , Ord )
66+ deriving (Show )
67+
68+ instance Eq Binder where
69+ (==) NullBinder NullBinder = True
70+ (==) NullBinder _ = False
71+
72+ (==) (LiteralBinder lb) (LiteralBinder lb') = (==) lb lb'
73+ (==) LiteralBinder {} _ = False
74+
75+ (==) (VarBinder _ ident) (VarBinder _ ident') = (==) ident ident'
76+ (==) VarBinder {} _ = False
77+
78+ (==) (ConstructorBinder _ qpc bs) (ConstructorBinder _ qpc' bs') =
79+ (==) qpc qpc' && (==) bs bs'
80+ (==) ConstructorBinder {} _ = False
81+
82+ (==) (OpBinder _ qov) (OpBinder _ qov') =
83+ (==) qov qov'
84+ (==) OpBinder {} _ = False
85+
86+ (==) (BinaryNoParensBinder b1 b2 b3) (BinaryNoParensBinder b1' b2' b3') =
87+ (==) b1 b1' && (==) b2 b2' && (==) b3 b3'
88+ (==) BinaryNoParensBinder {} _ = False
89+
90+ (==) (ParensInBinder b) (ParensInBinder b') =
91+ (==) b b'
92+ (==) ParensInBinder {} _ = False
93+
94+ (==) (NamedBinder _ ident b) (NamedBinder _ ident' b') =
95+ (==) ident ident' && (==) b b'
96+ (==) NamedBinder {} _ = False
97+
98+ (==) (PositionedBinder _ comments b) (PositionedBinder _ comments' b') =
99+ (==) comments comments' && (==) b b'
100+ (==) PositionedBinder {} _ = False
101+
102+ (==) (TypedBinder ty b) (TypedBinder ty' b') =
103+ (==) ty ty' && (==) b b'
104+ (==) TypedBinder {} _ = False
105+
106+ instance Ord Binder where
107+ compare NullBinder NullBinder = EQ
108+ compare NullBinder _ = LT
109+
110+ compare (LiteralBinder lb) (LiteralBinder lb') = compare lb lb'
111+ compare LiteralBinder {} NullBinder = GT
112+ compare LiteralBinder {} _ = LT
113+
114+ compare (VarBinder _ ident) (VarBinder _ ident') = compare ident ident'
115+ compare VarBinder {} NullBinder = GT
116+ compare VarBinder {} LiteralBinder {} = GT
117+ compare VarBinder {} _ = LT
118+
119+ compare (ConstructorBinder _ qpc bs) (ConstructorBinder _ qpc' bs') =
120+ compare qpc qpc' <> compare bs bs'
121+ compare ConstructorBinder {} NullBinder = GT
122+ compare ConstructorBinder {} LiteralBinder {} = GT
123+ compare ConstructorBinder {} VarBinder {} = GT
124+ compare ConstructorBinder {} _ = LT
125+
126+ compare (OpBinder _ qov) (OpBinder _ qov') =
127+ compare qov qov'
128+ compare OpBinder {} NullBinder = GT
129+ compare OpBinder {} LiteralBinder {} = GT
130+ compare OpBinder {} VarBinder {} = GT
131+ compare OpBinder {} ConstructorBinder {} = GT
132+ compare OpBinder {} _ = LT
133+
134+ compare (BinaryNoParensBinder b1 b2 b3) (BinaryNoParensBinder b1' b2' b3') =
135+ compare b1 b1' <> compare b2 b2' <> compare b3 b3'
136+ compare BinaryNoParensBinder {} ParensInBinder {} = LT
137+ compare BinaryNoParensBinder {} NamedBinder {} = LT
138+ compare BinaryNoParensBinder {} PositionedBinder {} = LT
139+ compare BinaryNoParensBinder {} TypedBinder {} = LT
140+ compare BinaryNoParensBinder {} _ = GT
141+
142+ compare (ParensInBinder b) (ParensInBinder b') =
143+ compare b b'
144+ compare ParensInBinder {} NamedBinder {} = LT
145+ compare ParensInBinder {} PositionedBinder {} = LT
146+ compare ParensInBinder {} TypedBinder {} = LT
147+ compare ParensInBinder {} _ = GT
148+
149+ compare (NamedBinder _ ident b) (NamedBinder _ ident' b') =
150+ compare ident ident' <> compare b b'
151+ compare NamedBinder {} PositionedBinder {} = LT
152+ compare NamedBinder {} TypedBinder {} = LT
153+ compare NamedBinder {} _ = GT
154+
155+ compare (PositionedBinder _ comments b) (PositionedBinder _ comments' b') =
156+ compare comments comments' <> compare b b'
157+ compare PositionedBinder {} TypedBinder {} = LT
158+ compare PositionedBinder {} _ = GT
159+
160+ compare (TypedBinder ty b) (TypedBinder ty' b') =
161+ compare ty ty' <> compare b b'
162+ compare TypedBinder {} _ = GT
65163
66164-- |
67165-- Collect all names introduced in binders in an expression
0 commit comments