From 148ee52a5ff6f9274e1ff8247c55cb92f4f770b4 Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Tue, 12 Jun 2018 15:01:46 -0700 Subject: [PATCH] Assign prefix negation and parenthesized expressions --- src/Language/Haskell/Assignment.hs | 9 +++ src/Language/Haskell/Syntax.hs | 12 +++- ...lgebraic-datatype-declarations.diffA-B.txt | 30 ++++---- ...lgebraic-datatype-declarations.diffB-A.txt | 26 ++++--- test/fixtures/haskell/corpus/expressions.A.hs | 6 ++ test/fixtures/haskell/corpus/expressions.B.hs | 6 ++ .../haskell/corpus/expressions.diffA-B.txt | 43 ++++++++++- .../haskell/corpus/expressions.diffB-A.txt | 72 +++++++++++++++---- .../haskell/corpus/expressions.parseA.txt | 30 +++++++- .../haskell/corpus/expressions.parseB.txt | 30 +++++++- 10 files changed, 222 insertions(+), 42 deletions(-) diff --git a/src/Language/Haskell/Assignment.hs b/src/Language/Haskell/Assignment.hs index af81a1cd9..85d58b346 100644 --- a/src/Language/Haskell/Assignment.hs +++ b/src/Language/Haskell/Assignment.hs @@ -78,6 +78,7 @@ type Syntax = '[ , Syntax.Operator , Syntax.OperatorSection , Syntax.Pragma + , Syntax.PrefixNegation , Syntax.QualifiedEntityIdentifier , Syntax.QualifiedImportDeclaration , Syntax.QuotedName @@ -245,10 +246,12 @@ expressionChoices = [ , newType , operator , operatorSection + , parenthesizedExpression , parenthesizedPattern , parenthesizedTypePattern , pattern , pragma + , prefixNegation , primitiveConstructorIdentifier , primitiveVariableIdentifier , qualifiedConstructorIdentifier @@ -447,6 +450,9 @@ operatorSection = (makeTerm <$> symbol RightOperatorSection <*> children (Syntax packageQualifiedImport :: Assignment packageQualifiedImport = makeTerm <$> symbol PackageQualifiedImport <*> (Literal.TextElement <$> source) +parenthesizedExpression :: Assignment +parenthesizedExpression = symbol ParenthesizedExpression *> children expression + parenthesizedPattern :: Assignment parenthesizedPattern = symbol ParenthesizedPattern *> children expressions @@ -459,6 +465,9 @@ pattern = symbol Pattern *> children (expression) pragma :: Assignment pragma = makeTerm <$> symbol Pragma <*> (Syntax.Pragma <$> source) +prefixNegation :: Assignment +prefixNegation = makeTerm <$> symbol PrefixNegation <*> children (Syntax.PrefixNegation <$> expression) + primitiveConstructorIdentifier :: Assignment primitiveConstructorIdentifier = makeTerm <$> symbol PrimitiveConstructorIdentifier <*> (Syntax.PrimitiveConstructorIdentifier . Name.name <$> source) diff --git a/src/Language/Haskell/Syntax.hs b/src/Language/Haskell/Syntax.hs index c4b3212c3..6c7cdf661 100644 --- a/src/Language/Haskell/Syntax.hs +++ b/src/Language/Haskell/Syntax.hs @@ -524,7 +524,7 @@ instance Show1 ConstructorPattern where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ConstructorPattern --- e.g. `a <- b` in a Haskell do block +-- e.g. `a <- b` in a Haskell do block. data BindPattern a = BindPattern { bindPatternLeft :: a, bindPatternRight :: a } deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable) @@ -551,3 +551,13 @@ instance Ord1 Lambda where liftCompare = genericLiftCompare instance Show1 Lambda where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Lambda + +-- e.g. -1 or (-a) as an expression and not `-` as a variable operator. +newtype PrefixNegation a = PrefixNegation a + deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable) + +instance Eq1 PrefixNegation where liftEq = genericLiftEq +instance Ord1 PrefixNegation where liftCompare = genericLiftCompare +instance Show1 PrefixNegation where liftShowsPrec = genericLiftShowsPrec + +instance Evaluatable PrefixNegation diff --git a/test/fixtures/haskell/corpus/algebraic-datatype-declarations.diffA-B.txt b/test/fixtures/haskell/corpus/algebraic-datatype-declarations.diffA-B.txt index 576c51f44..2eff06678 100644 --- a/test/fixtures/haskell/corpus/algebraic-datatype-declarations.diffA-B.txt +++ b/test/fixtures/haskell/corpus/algebraic-datatype-declarations.diffA-B.txt @@ -62,18 +62,6 @@ ->(TypeConstructorIdentifier) } (TypeParameters) (Empty)) - (Constructor - { (ConstructorIdentifier) - ->(ConstructorIdentifier) } - (TypeParameters)) - (Constructor - { (ConstructorIdentifier) - ->(ConstructorIdentifier) } - (TypeParameters)) - (Constructor - { (ConstructorIdentifier) - ->(ConstructorIdentifier) } - (TypeParameters)) {+(Constructor {+(ConstructorIdentifier)+} {+(TypeParameters)+})+} @@ -83,6 +71,24 @@ {+(Constructor {+(ConstructorIdentifier)+} {+(TypeParameters)+})+} + {+(Constructor + {+(ConstructorIdentifier)+} + {+(TypeParameters)+})+} + {+(Constructor + {+(ConstructorIdentifier)+} + {+(TypeParameters)+})+} + {+(Constructor + {+(ConstructorIdentifier)+} + {+(TypeParameters)+})+} + {-(Constructor + {-(ConstructorIdentifier)-} + {-(TypeParameters)-})-} + {-(Constructor + {-(ConstructorIdentifier)-} + {-(TypeParameters)-})-} + {-(Constructor + {-(ConstructorIdentifier)-} + {-(TypeParameters)-})-} {-(Constructor {-(ConstructorIdentifier)-} {-(TypeParameters)-})-} diff --git a/test/fixtures/haskell/corpus/algebraic-datatype-declarations.diffB-A.txt b/test/fixtures/haskell/corpus/algebraic-datatype-declarations.diffB-A.txt index 65afcabce..4c7b58dc6 100644 --- a/test/fixtures/haskell/corpus/algebraic-datatype-declarations.diffB-A.txt +++ b/test/fixtures/haskell/corpus/algebraic-datatype-declarations.diffB-A.txt @@ -62,14 +62,15 @@ ->(TypeConstructorIdentifier) } (TypeParameters) (Empty)) - (Constructor - { (ConstructorIdentifier) - ->(ConstructorIdentifier) } - (TypeParameters)) - (Constructor - { (ConstructorIdentifier) - ->(ConstructorIdentifier) } - (TypeParameters)) + {+(Constructor + {+(ConstructorIdentifier)+} + {+(TypeParameters)+})+} + {+(Constructor + {+(ConstructorIdentifier)+} + {+(TypeParameters)+})+} + {+(Constructor + {+(ConstructorIdentifier)+} + {+(TypeParameters)+})+} (Constructor { (ConstructorIdentifier) ->(ConstructorIdentifier) } @@ -80,9 +81,12 @@ {+(Constructor {+(ConstructorIdentifier)+} {+(TypeParameters)+})+} - {+(Constructor - {+(ConstructorIdentifier)+} - {+(TypeParameters)+})+} + {-(Constructor + {-(ConstructorIdentifier)-} + {-(TypeParameters)-})-} + {-(Constructor + {-(ConstructorIdentifier)-} + {-(TypeParameters)-})-} {-(Constructor {-(ConstructorIdentifier)-} {-(TypeParameters)-})-} diff --git a/test/fixtures/haskell/corpus/expressions.A.hs b/test/fixtures/haskell/corpus/expressions.A.hs index c27f67cf8..ea9013268 100644 --- a/test/fixtures/haskell/corpus/expressions.A.hs +++ b/test/fixtures/haskell/corpus/expressions.A.hs @@ -48,3 +48,9 @@ f = \ (Just a) -> a f = \ x -> x : a : xs f = \ g a b -> g <$> a <*> b + +f = (-) +f = 1 - 1 +f = (-1) +f = (-a) +f = -(1) diff --git a/test/fixtures/haskell/corpus/expressions.B.hs b/test/fixtures/haskell/corpus/expressions.B.hs index fd2bff77e..e669468d3 100644 --- a/test/fixtures/haskell/corpus/expressions.B.hs +++ b/test/fixtures/haskell/corpus/expressions.B.hs @@ -48,3 +48,9 @@ g = \ (Just a) -> a g = \ x -> x : a : xs g = \ g a b -> g <$> a <*> b + +g = (-) +g = 1 - 1 +g = (-1) +g = (-a) +g = -(1) diff --git a/test/fixtures/haskell/corpus/expressions.diffA-B.txt b/test/fixtures/haskell/corpus/expressions.diffA-B.txt index d41e90860..165e5633c 100644 --- a/test/fixtures/haskell/corpus/expressions.diffA-B.txt +++ b/test/fixtures/haskell/corpus/expressions.diffA-B.txt @@ -385,4 +385,45 @@ (VariableIdentifier) (VariableOperator (VariableSymbol)) - (VariableIdentifier)))))))) + (VariableIdentifier)))))) + (Function + { (VariableIdentifier) + ->(VariableIdentifier) } + (Statements + (VariableOperator + (VariableSymbol)))) + (Function + { (VariableIdentifier) + ->(VariableIdentifier) } + (Statements + (InfixOperatorApp + (Integer) + (VariableOperator + (VariableSymbol)) + (Integer)))) + {+(Function + {+(VariableIdentifier)+} + {+(Statements + {+(PrefixNegation + {+(Integer)+})+})+})+} + {+(Function + {+(VariableIdentifier)+} + {+(Statements + {+(PrefixNegation + {+(VariableIdentifier)+})+})+})+} + (Function + { (VariableIdentifier) + ->(VariableIdentifier) } + (Statements + (PrefixNegation + (Integer)))) + {-(Function + {-(VariableIdentifier)-} + {-(Statements + {-(PrefixNegation + {-(VariableIdentifier)-})-})-})-} + {-(Function + {-(VariableIdentifier)-} + {-(Statements + {-(PrefixNegation + {-(Integer)-})-})-})-})) diff --git a/test/fixtures/haskell/corpus/expressions.diffB-A.txt b/test/fixtures/haskell/corpus/expressions.diffB-A.txt index 03eb66329..591ad7c81 100644 --- a/test/fixtures/haskell/corpus/expressions.diffB-A.txt +++ b/test/fixtures/haskell/corpus/expressions.diffB-A.txt @@ -327,16 +327,12 @@ {-(VariableOperator {-(VariableSymbol)-})-} {-(VariableIdentifier)-})-})-})-})) - (Function - { (VariableIdentifier) - ->(VariableIdentifier) } - (Statements + {+(Function + {+(VariableIdentifier)+} + {+(Statements {+(QualifiedConstructorIdentifier {+(ModuleIdentifier)+} - {+(ConstructorIdentifier)+})+} - {-(Lambda - {-(VariableIdentifier)-} - {-(VariableIdentifier)-})-})) + {+(ConstructorIdentifier)+})+})+})+} {+(Function {+(VariableIdentifier)+} {+(ConstructorPattern @@ -397,12 +393,13 @@ {+(VariableOperator {+(VariableSymbol)+})+} {+(VariableIdentifier)+})+})+})+})+})+} - {+(Function - {+(VariableIdentifier)+} - {+(Statements - {+(Lambda - {+(VariableIdentifier)+} - {+(VariableIdentifier)+})+})+})+} + (Function + { (VariableIdentifier) + ->(VariableIdentifier) } + (Statements + (Lambda + (VariableIdentifier) + (VariableIdentifier)))) (Function { (VariableIdentifier) ->(VariableIdentifier) } @@ -445,4 +442,49 @@ (VariableIdentifier) (VariableOperator (VariableSymbol)) - (VariableIdentifier)))))))) + (VariableIdentifier)))))) + (Function + { (VariableIdentifier) + ->(VariableIdentifier) } + (Statements + (VariableOperator + (VariableSymbol)))) + (Function + { (VariableIdentifier) + ->(VariableIdentifier) } + (Statements + (InfixOperatorApp + (Integer) + (VariableOperator + (VariableSymbol)) + (Integer)))) + {+(Function + {+(VariableIdentifier)+} + {+(Statements + {+(PrefixNegation + {+(Integer)+})+})+})+} + {+(Function + {+(VariableIdentifier)+} + {+(Statements + {+(PrefixNegation + {+(VariableIdentifier)+})+})+})+} + {+(Function + {+(VariableIdentifier)+} + {+(Statements + {+(PrefixNegation + {+(Integer)+})+})+})+} + {-(Function + {-(VariableIdentifier)-} + {-(Statements + {-(PrefixNegation + {-(Integer)-})-})-})-} + {-(Function + {-(VariableIdentifier)-} + {-(Statements + {-(PrefixNegation + {-(VariableIdentifier)-})-})-})-} + {-(Function + {-(VariableIdentifier)-} + {-(Statements + {-(PrefixNegation + {-(Integer)-})-})-})-})) diff --git a/test/fixtures/haskell/corpus/expressions.parseA.txt b/test/fixtures/haskell/corpus/expressions.parseA.txt index ddcc36a9c..d3b8a8dba 100644 --- a/test/fixtures/haskell/corpus/expressions.parseA.txt +++ b/test/fixtures/haskell/corpus/expressions.parseA.txt @@ -325,4 +325,32 @@ (VariableIdentifier) (VariableOperator (VariableSymbol)) - (VariableIdentifier)))))))) + (VariableIdentifier)))))) + (Function + (VariableIdentifier) + (Statements + (VariableOperator + (VariableSymbol)))) + (Function + (VariableIdentifier) + (Statements + (InfixOperatorApp + (Integer) + (VariableOperator + (VariableSymbol)) + (Integer)))) + (Function + (VariableIdentifier) + (Statements + (PrefixNegation + (Integer)))) + (Function + (VariableIdentifier) + (Statements + (PrefixNegation + (VariableIdentifier)))) + (Function + (VariableIdentifier) + (Statements + (PrefixNegation + (Integer)))))) diff --git a/test/fixtures/haskell/corpus/expressions.parseB.txt b/test/fixtures/haskell/corpus/expressions.parseB.txt index 856ec556b..5f782308f 100644 --- a/test/fixtures/haskell/corpus/expressions.parseB.txt +++ b/test/fixtures/haskell/corpus/expressions.parseB.txt @@ -327,4 +327,32 @@ (VariableIdentifier) (VariableOperator (VariableSymbol)) - (VariableIdentifier)))))))) + (VariableIdentifier)))))) + (Function + (VariableIdentifier) + (Statements + (VariableOperator + (VariableSymbol)))) + (Function + (VariableIdentifier) + (Statements + (InfixOperatorApp + (Integer) + (VariableOperator + (VariableSymbol)) + (Integer)))) + (Function + (VariableIdentifier) + (Statements + (PrefixNegation + (Integer)))) + (Function + (VariableIdentifier) + (Statements + (PrefixNegation + (VariableIdentifier)))) + (Function + (VariableIdentifier) + (Statements + (PrefixNegation + (Integer))))))