Skip to content

Skip SourceSpan in Binder Eq, Ord for faster exhaustivity check #3265

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
kritzcreek merged 3 commits into from
Mar 6, 2018
Merged

Skip SourceSpan in Binder Eq, Ord for faster exhaustivity check #3265

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
a2f5512
Skip SourceSpan in Binder Eq, Ord for faster exhaustivity check
bitemyapp Mar 5, 2018
d661bfa
Use Semigroup rather than sui generis function
bitemyapp Mar 5, 2018
cd49188
contributors.md
bitemyapp Mar 5, 2018
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions CONTRIBUTORS.md
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -26,6 +26,7 @@ If you would prefer to use different terms, please use the section below instead
| [@balajirrao](https://github.com/balajirrao) | Balaji Rao | MIT license |
| [@bbqbaron](https://github.com/bbqbaron) | Eric Loren | [MIT license](http://opensource.org/licenses/MIT) |
| [@bergmark](https://github.com/bergmark) | Adam Bergmark | MIT license |
| [@bitemyapp](https://github.com/bitemyapp) | Chris Allen | [MIT license](http://opensource.org/licenses/MIT) |
| [@bmjames](https://github.com/bmjames) | Ben James | [MIT license](http://opensource.org/licenses/MIT) |
| [@Bogdanp](https://github.com/Bogdanp) | Bogdan Paul Popa | [MIT license](http://opensource.org/licenses/MIT) |
| [@brandonhamilton](https://github.com/brandonhamilton) | Brandon Hamilton | [MIT license](http://opensource.org/licenses/MIT) |
Expand Down
100 changes: 99 additions & 1 deletion src/Language/PureScript/AST/Binders.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -5,6 +5,8 @@ module Language.PureScript.AST.Binders where

import Prelude.Compat

import Data.Semigroup

import Language.PureScript.AST.SourcePos
import Language.PureScript.AST.Literals
import Language.PureScript.Names
Expand Down Expand Up @@ -61,7 +63,103 @@ data Binder
-- A binder with a type annotation
--
| TypedBinder Type Binder
deriving (Show, Eq, Ord)
deriving (Show)

instance Eq Binder where
(==) NullBinder NullBinder = True
(==) NullBinder _ = False

(==) (LiteralBinder lb) (LiteralBinder lb') = (==) lb lb'
(==) LiteralBinder{} _ = False

(==) (VarBinder _ ident) (VarBinder _ ident') = (==) ident ident'
(==) VarBinder{} _ = False

(==) (ConstructorBinder _ qpc bs) (ConstructorBinder _ qpc' bs') =
(==) qpc qpc' && (==) bs bs'
(==) ConstructorBinder{} _ = False

(==) (OpBinder _ qov) (OpBinder _ qov') =
(==) qov qov'
(==) OpBinder{} _ = False

(==) (BinaryNoParensBinder b1 b2 b3) (BinaryNoParensBinder b1' b2' b3') =
(==) b1 b1' && (==) b2 b2' && (==) b3 b3'
(==) BinaryNoParensBinder{} _ = False

(==) (ParensInBinder b) (ParensInBinder b') =
(==) b b'
(==) ParensInBinder{} _ = False

(==) (NamedBinder _ ident b) (NamedBinder _ ident' b') =
(==) ident ident' && (==) b b'
(==) NamedBinder{} _ = False

(==) (PositionedBinder _ comments b) (PositionedBinder _ comments' b') =
(==) comments comments' && (==) b b'
(==) PositionedBinder{} _ = False

(==) (TypedBinder ty b) (TypedBinder ty' b') =
(==) ty ty' && (==) b b'
(==) TypedBinder{} _ = False

instance Ord Binder where
compare NullBinder NullBinder = EQ
compare NullBinder _ = LT

compare (LiteralBinder lb) (LiteralBinder lb') = compare lb lb'
compare LiteralBinder{} NullBinder = GT
compare LiteralBinder{} _ = LT

compare (VarBinder _ ident) (VarBinder _ ident') = compare ident ident'
compare VarBinder{} NullBinder = GT
compare VarBinder{} LiteralBinder{} = GT
compare VarBinder{} _ = LT

compare (ConstructorBinder _ qpc bs) (ConstructorBinder _ qpc' bs') =
compare qpc qpc' <> compare bs bs'
compare ConstructorBinder{} NullBinder = GT
compare ConstructorBinder{} LiteralBinder{} = GT
compare ConstructorBinder{} VarBinder{} = GT
compare ConstructorBinder{} _ = LT

compare (OpBinder _ qov) (OpBinder _ qov') =
compare qov qov'
compare OpBinder{} NullBinder = GT
compare OpBinder{} LiteralBinder{} = GT
compare OpBinder{} VarBinder{} = GT
compare OpBinder{} ConstructorBinder{} = GT
compare OpBinder{} _ = LT

compare (BinaryNoParensBinder b1 b2 b3) (BinaryNoParensBinder b1' b2' b3') =
compare b1 b1' <> compare b2 b2' <> compare b3 b3'
compare BinaryNoParensBinder{} ParensInBinder{} = LT
compare BinaryNoParensBinder{} NamedBinder{} = LT
compare BinaryNoParensBinder{} PositionedBinder{} = LT
compare BinaryNoParensBinder{} TypedBinder{} = LT
compare BinaryNoParensBinder{} _ = GT

compare (ParensInBinder b) (ParensInBinder b') =
compare b b'
compare ParensInBinder{} NamedBinder{} = LT
compare ParensInBinder{} PositionedBinder{} = LT
compare ParensInBinder{} TypedBinder{} = LT
compare ParensInBinder{} _ = GT

compare (NamedBinder _ ident b) (NamedBinder _ ident' b') =
compare ident ident' <> compare b b'
compare NamedBinder{} PositionedBinder{} = LT
compare NamedBinder{} TypedBinder{} = LT
compare NamedBinder{} _ = GT

compare (PositionedBinder _ comments b) (PositionedBinder _ comments' b') =
compare comments comments' <> compare b b'
compare PositionedBinder{} TypedBinder{} = LT
compare PositionedBinder{} _ = GT

compare (TypedBinder ty b) (TypedBinder ty' b') =
compare ty ty' <> compare b b'
compare TypedBinder{} _ = GT

-- |
-- Collect all names introduced in binders in an expression
Expand Down