Skip to content

Commit d73957d

Browse files
bitemyappkritzcreek
authored andcommitted
Skip SourceSpan in Binder Eq, Ord for faster exhaustivity check (purescript#3265)
* Skip SourceSpan in Binder Eq, Ord for faster exhaustivity check * Use Semigroup rather than sui generis function * contributors.md
1 parent 143f8f1 commit d73957d

2 files changed

Lines changed: 100 additions & 1 deletion

File tree

CONTRIBUTORS.md

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -26,6 +26,7 @@ If you would prefer to use different terms, please use the section below instead
2626
| [@balajirrao](https://github.com/balajirrao) | Balaji Rao | MIT license |
2727
| [@bbqbaron](https://github.com/bbqbaron) | Eric Loren | [MIT license](http://opensource.org/licenses/MIT) |
2828
| [@bergmark](https://github.com/bergmark) | Adam Bergmark | MIT license |
29+
| [@bitemyapp](https://github.com/bitemyapp) | Chris Allen | [MIT license](http://opensource.org/licenses/MIT) |
2930
| [@bmjames](https://github.com/bmjames) | Ben James | [MIT license](http://opensource.org/licenses/MIT) |
3031
| [@Bogdanp](https://github.com/Bogdanp) | Bogdan Paul Popa | [MIT license](http://opensource.org/licenses/MIT) |
3132
| [@brandonhamilton](https://github.com/brandonhamilton) | Brandon Hamilton | [MIT license](http://opensource.org/licenses/MIT) |

src/Language/PureScript/AST/Binders.hs

Lines changed: 99 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -5,6 +5,8 @@ module Language.PureScript.AST.Binders where
55

66
import Prelude.Compat
77

8+
import Data.Semigroup
9+
810
import Language.PureScript.AST.SourcePos
911
import Language.PureScript.AST.Literals
1012
import 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

Comments
 (0)