Skip to content

Refactor Ord instances #3902

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
hdgarrood merged 3 commits into from
Dec 27, 2020
Merged

Refactor Ord instances #3902

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
9fc542d
Common code for Ord DeclarationRef
milesfrain Jun 26, 2020
40b7de4
Use orderOf for compareType
milesfrain Jun 26, 2020
d91b461
Shrink Binder Eq and Ord
milesfrain Jun 26, 2020
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
116 changes: 39 additions & 77 deletions lib/purescript-ast/src/Language/PureScript/AST/Binders.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -71,100 +71,62 @@ data Binder
-- the `Ord` instance was needed for the speed-up, but I did not want the `Eq`
-- to have mismatched behavior.
instance Eq Binder where
(==) NullBinder NullBinder = True
(==) NullBinder _ = False

@milesfrain milesfrain Jun 26, 2020

Copy link
Copy Markdown
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This block of changes moves all lines like these to a final:

_ == _ = 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
NullBinder == NullBinder =
True
(LiteralBinder _ lb) == (LiteralBinder _ lb') =
lb == lb'

@milesfrain milesfrain Jun 26, 2020

Copy link
Copy Markdown
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Not sure what the line-wrapping coding standard is. Could either:

  • Use one line for each expression. Lines may grow long.
  • Break after cutoff point, e.g. 80 characters. I feel this adds inconsistency to the structure.
  • Break at each assignment. What's done in this PR.

@hdgarrood hdgarrood Aug 30, 2020

Copy link
Copy Markdown
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Breaking at each assignment like you've done here looks good to me. These things aren't really consistent across the compiler codebase at the moment.

(VarBinder _ ident) == (VarBinder _ ident') =
ident == ident'
(ConstructorBinder _ qpc bs) == (ConstructorBinder _ qpc' bs') =
qpc == qpc' && bs == bs'
(OpBinder _ qov) == (OpBinder _ qov') =
qov == qov'
(BinaryNoParensBinder b1 b2 b3) == (BinaryNoParensBinder b1' b2' b3') =
b1 == b1' && b2 == b2' && b3 == b3'
(ParensInBinder b) == (ParensInBinder b') =
b == b'
(NamedBinder _ ident b) == (NamedBinder _ ident' b') =
ident == ident' && b == b'
(PositionedBinder _ comments b) == (PositionedBinder _ comments' b') =
comments == comments' && b == b'
(TypedBinder ty b) == (TypedBinder ty' b') =
ty == ty' && b == b'
_ == _ = 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 (LiteralBinder _ lb) (LiteralBinder _ lb') =
compare lb lb'
compare (VarBinder _ ident) (VarBinder _ ident') =
compare ident ident'
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
compare binder binder' =
compare (orderOf binder) (orderOf binder')
where
orderOf :: Binder -> Int
orderOf NullBinder = 0
orderOf LiteralBinder{} = 1
orderOf VarBinder{} = 2
orderOf ConstructorBinder{} = 3
orderOf OpBinder{} = 4
orderOf BinaryNoParensBinder{} = 5
orderOf ParensInBinder{} = 6
orderOf NamedBinder{} = 7
orderOf PositionedBinder{} = 8
orderOf TypedBinder{} = 9

-- |
-- Collect all names introduced in binders in an expression
Expand Down
51 changes: 14 additions & 37 deletions lib/purescript-ast/src/Language/PureScript/AST/Declarations.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -149,14 +149,18 @@ importPrim =
--
data DeclarationRef
-- |
-- A type constructor with data constructors
-- A type class

@milesfrain milesfrain Jun 26, 2020

Copy link
Copy Markdown
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Reordered to match linting order

--
= TypeRef SourceSpan (ProperName 'TypeName) (Maybe [ProperName 'ConstructorName])
= TypeClassRef SourceSpan (ProperName 'ClassName)
-- |
-- A type operator
--
| TypeOpRef SourceSpan (OpName 'TypeOpName)
-- |
-- A type constructor with data constructors
--
| TypeRef SourceSpan (ProperName 'TypeName) (Maybe [ProperName 'ConstructorName])
-- |
-- A value
--
| ValueRef SourceSpan Ident
Expand All @@ -165,10 +169,6 @@ data DeclarationRef
--
| ValueOpRef SourceSpan (OpName 'ValueOpName)
-- |
-- A type class
--
| TypeClassRef SourceSpan (ProperName 'ClassName)
-- |
-- A type class instance, created during typeclass desugaring (name, class name, instance types)
--
| TypeInstanceRef SourceSpan Ident
Expand All @@ -184,34 +184,34 @@ data DeclarationRef
deriving (Show, Generic, NFData, Serialise)

instance Eq DeclarationRef where
(TypeRef _ name dctors) == (TypeRef _ name' dctors') = name == name' && dctors == dctors'
(TypeClassRef _ name) == (TypeClassRef _ name') = name == name'
(TypeOpRef _ name) == (TypeOpRef _ name') = name == name'
(TypeRef _ name dctors) == (TypeRef _ name' dctors') = name == name' && dctors == dctors'
(ValueRef _ name) == (ValueRef _ name') = name == name'
(ValueOpRef _ name) == (ValueOpRef _ name') = name == name'
(TypeClassRef _ name) == (TypeClassRef _ name') = name == name'
(TypeInstanceRef _ name) == (TypeInstanceRef _ name') = name == name'
(ModuleRef _ name) == (ModuleRef _ name') = name == name'
(ReExportRef _ mn ref) == (ReExportRef _ mn' ref') = mn == mn' && ref == ref'
_ == _ = False

instance Ord DeclarationRef where
TypeRef _ name dctors `compare` TypeRef _ name' dctors' = compare name name' <> compare dctors dctors'
TypeClassRef _ name `compare` TypeClassRef _ name' = compare name name'
TypeOpRef _ name `compare` TypeOpRef _ name' = compare name name'
TypeRef _ name dctors `compare` TypeRef _ name' dctors' = compare name name' <> compare dctors dctors'
ValueRef _ name `compare` ValueRef _ name' = compare name name'
ValueOpRef _ name `compare` ValueOpRef _ name' = compare name name'
TypeClassRef _ name `compare` TypeClassRef _ name' = compare name name'
TypeInstanceRef _ name `compare` TypeInstanceRef _ name' = compare name name'
ModuleRef _ name `compare` ModuleRef _ name' = compare name name'
ReExportRef _ mn ref `compare` ReExportRef _ mn' ref' = compare mn mn' <> compare ref ref'
compare ref ref' =
compare (orderOf ref) (orderOf ref')
where
orderOf :: DeclarationRef -> Int
orderOf TypeRef{} = 0
orderOf TypeClassRef{} = 0
orderOf TypeOpRef{} = 1
orderOf ValueRef{} = 2
orderOf ValueOpRef{} = 3
orderOf TypeClassRef{} = 4
orderOf TypeRef{} = 2
orderOf ValueRef{} = 3
orderOf ValueOpRef{} = 4
orderOf TypeInstanceRef{} = 5
orderOf ModuleRef{} = 6
orderOf ReExportRef{} = 7
Expand All @@ -223,29 +223,6 @@ data ExportSource =
}
deriving (Eq, Ord, Show, Generic, NFData, Serialise)

-- enable sorting lists of explicitly imported refs when suggesting imports in linting, IDE, etc.
-- not an Ord because this implementation is not consistent with its Eq instance.
-- think of it as a notion of contextual, not inherent, ordering.
Comment on lines -226 to -228

@milesfrain milesfrain Jun 26, 2020

Copy link
Copy Markdown
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I don't think we need this comment anymore, since it now follows the order of the constructors.

compDecRef :: DeclarationRef -> DeclarationRef -> Ordering
compDecRef (TypeRef _ name _) (TypeRef _ name' _) = compare name name'
compDecRef (TypeOpRef _ name) (TypeOpRef _ name') = compare name name'
compDecRef (ValueRef _ ident) (ValueRef _ ident') = compare ident ident'
compDecRef (ValueOpRef _ name) (ValueOpRef _ name') = compare name name'
compDecRef (TypeClassRef _ name) (TypeClassRef _ name') = compare name name'
compDecRef (TypeInstanceRef _ ident) (TypeInstanceRef _ ident') = compare ident ident'
compDecRef (ModuleRef _ name) (ModuleRef _ name') = compare name name'
compDecRef (ReExportRef _ name _) (ReExportRef _ name' _) = compare name name'
compDecRef ref ref' = compare
(orderOf ref) (orderOf ref')
where
orderOf :: DeclarationRef -> Int
orderOf TypeClassRef{} = 0
orderOf TypeOpRef{} = 1
orderOf TypeRef{} = 2
orderOf ValueRef{} = 3
orderOf ValueOpRef{} = 4
orderOf _ = 6

declRefSourceSpan :: DeclarationRef -> SourceSpan
declRefSourceSpan (TypeRef ss _ _) = ss
declRefSourceSpan (TypeOpRef ss _) = ss
Expand Down
65 changes: 20 additions & 45 deletions lib/purescript-ast/src/Language/PureScript/Types.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -728,66 +728,41 @@ eqMaybeType _ _ = False

compareType :: Type a -> Type b -> Ordering
compareType (TUnknown _ a) (TUnknown _ a') = compare a a'
compareType (TUnknown {}) _ = LT

compareType (TypeVar _ a) (TypeVar _ a') = compare a a'
compareType (TypeVar {}) _ = LT
compareType _ (TypeVar {}) = GT

compareType (TypeLevelString _ a) (TypeLevelString _ a') = compare a a'
compareType (TypeLevelString {}) _ = LT
compareType _ (TypeLevelString {}) = GT

compareType (TypeWildcard _ a) (TypeWildcard _ a') = compare a a'
compareType (TypeWildcard {}) _ = LT
compareType _ (TypeWildcard {}) = GT

compareType (TypeConstructor _ a) (TypeConstructor _ a') = compare a a'
compareType (TypeConstructor {}) _ = LT
compareType _ (TypeConstructor {}) = GT

compareType (TypeOp _ a) (TypeOp _ a') = compare a a'
compareType (TypeOp {}) _ = LT
compareType _ (TypeOp {}) = GT

compareType (TypeApp _ a b) (TypeApp _ a' b') = compareType a a' <> compareType b b'
compareType (TypeApp {}) _ = LT
compareType _ (TypeApp {}) = GT

compareType (KindApp _ a b) (KindApp _ a' b') = compareType a a' <> compareType b b'
compareType (KindApp {}) _ = LT
compareType _ (KindApp {}) = GT

compareType (ForAll _ a b c d) (ForAll _ a' b' c' d') = compare a a' <> compareMaybeType b b' <> compareType c c' <> compare d d'

@milesfrain milesfrain Jun 26, 2020

Copy link
Copy Markdown
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Here's an example of using long lines for each expression. This is another good candidate for the above coding style question.

compareType (ForAll {}) _ = LT
compareType _ (ForAll {}) = GT

compareType (ConstrainedType _ a b) (ConstrainedType _ a' b') = compareConstraint a a' <> compareType b b'
compareType (ConstrainedType {}) _ = LT
compareType _ (ConstrainedType {}) = GT

compareType (Skolem _ a b c d) (Skolem _ a' b' c' d') = compare a a' <> compareMaybeType b b' <> compare c c' <> compare d d'
compareType (Skolem {}) _ = LT
compareType _ (Skolem {}) = GT

compareType (REmpty _) (REmpty _) = EQ
compareType (REmpty _) _ = LT
compareType _ (REmpty _) = GT

compareType (RCons _ a b c) (RCons _ a' b' c') = compare a a' <> compareType b b' <> compareType c c'
compareType (RCons {}) _ = LT
compareType _ (RCons {}) = GT

compareType (KindedType _ a b) (KindedType _ a' b') = compareType a a' <> compareType b b'
compareType (KindedType {}) _ = LT
compareType _ (KindedType {}) = GT

compareType (BinaryNoParensType _ a b c) (BinaryNoParensType _ a' b' c') = compareType a a' <> compareType b b' <> compareType c c'
compareType (BinaryNoParensType {}) _ = LT
compareType _ (BinaryNoParensType {}) = GT

compareType (ParensInType _ a) (ParensInType _ a') = compareType a a'
compareType (ParensInType {}) _ = GT
compareType typ typ' =
compare (orderOf typ) (orderOf typ')
where
orderOf :: Type a -> Int
orderOf TUnknown{} = 0
orderOf TypeVar{} = 1
orderOf TypeLevelString{} = 2
orderOf TypeWildcard{} = 3
orderOf TypeConstructor{} = 4
orderOf TypeOp{} = 5
orderOf TypeApp{} = 6
orderOf KindApp{} = 7
orderOf ForAll{} = 8
orderOf ConstrainedType{} = 9
orderOf Skolem{} = 10
orderOf REmpty{} = 11
orderOf RCons{} = 12
orderOf KindedType{} = 13
orderOf BinaryNoParensType{} = 14
orderOf ParensInType{} = 15

compareMaybeType :: Maybe (Type a) -> Maybe (Type b) -> Ordering
compareMaybeType (Just a) (Just b) = compareType a b
Expand Down
2 changes: 1 addition & 1 deletion src/Language/PureScript/Ide/Imports.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -229,7 +229,7 @@ addExplicitImport' decl moduleName qualifier imports =
-- TypeDeclaration "Maybe" + Data.Maybe (maybe) -> Data.Maybe(Maybe, maybe)
insertDeclIntoImport :: IdeDeclaration -> Import -> Import
insertDeclIntoImport decl' (Import mn (P.Explicit refs) qual) =
Import mn (P.Explicit (sortBy P.compDecRef (insertDeclIntoRefs decl' refs))) qual
Import mn (P.Explicit (sort (insertDeclIntoRefs decl' refs))) qual
insertDeclIntoImport _ is = is

insertDeclIntoRefs :: IdeDeclaration -> [P.DeclarationRef] -> [P.DeclarationRef]
Expand Down
4 changes: 2 additions & 2 deletions src/Language/PureScript/Linter/Imports.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -12,7 +12,7 @@ import Control.Monad.Writer.Class

import Data.Function (on)
import Data.Foldable (for_)
import Data.List (find, intersect, groupBy, sortBy, (\\))
import Data.List (find, intersect, groupBy, sort, sortBy, (\\))
import Data.Maybe (mapMaybe)
import Data.Monoid (Sum(..))
import Data.Traversable (forM)
Expand Down Expand Up @@ -334,7 +334,7 @@ findUsedRefs ss env mni qn names =
typesRefs
= map (flip (TypeRef ss) (Just [])) typesWithoutDctors
++ map (\(ty, ds) -> TypeRef ss ty (Just ds)) (M.toList typesWithDctors)
in sortBy compDecRef $ classRefs ++ typeOpRefs ++ typesRefs ++ valueRefs ++ valueOpRefs
in sort $ classRefs ++ typeOpRefs ++ typesRefs ++ valueRefs ++ valueOpRefs

where

Expand Down
8 changes: 4 additions & 4 deletions tests/purs/warning/DuplicateExportRef.out
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -3,7 +3,7 @@ Warning 1 of 7:
in module Main
at tests/purs/warning/DuplicateExportRef.purs:8:1 - 30:28 (line 8, column 1 - line 30, column 28)

Export list contains multiple references to type X
Export list contains multiple references to type class Y


See https://github.com/purescript/documentation/blob/master/errors/DuplicateExportRef.md for more information,
Expand All @@ -25,7 +25,7 @@ Warning 3 of 7:
in module Main
at tests/purs/warning/DuplicateExportRef.purs:8:1 - 30:28 (line 8, column 1 - line 30, column 28)

Export list contains multiple references to value fn
Export list contains multiple references to type X


See https://github.com/purescript/documentation/blob/master/errors/DuplicateExportRef.md for more information,
Expand All @@ -36,7 +36,7 @@ Warning 4 of 7:
in module Main
at tests/purs/warning/DuplicateExportRef.purs:8:1 - 30:28 (line 8, column 1 - line 30, column 28)

Export list contains multiple references to operator (!)
Export list contains multiple references to value fn


See https://github.com/purescript/documentation/blob/master/errors/DuplicateExportRef.md for more information,
Expand All @@ -47,7 +47,7 @@ Warning 5 of 7:
in module Main
at tests/purs/warning/DuplicateExportRef.purs:8:1 - 30:28 (line 8, column 1 - line 30, column 28)

Export list contains multiple references to type class Y
Export list contains multiple references to operator (!)


See https://github.com/purescript/documentation/blob/master/errors/DuplicateExportRef.md for more information,
Expand Down
Loading