1
1
mirror of https://github.com/github/semantic.git synced 2024-12-24 23:42:31 +03:00

Assign equality constraints

This commit is contained in:
Rick Winfrey 2018-06-08 12:02:13 -07:00
parent 780e5f295b
commit 6f8dff06f8
4 changed files with 39 additions and 2 deletions

View File

@ -45,6 +45,7 @@ type Syntax = '[
, Syntax.Deriving
, Syntax.Empty
, Syntax.Error
, Syntax.EqualityConstraint
, Syntax.Export
, Syntax.Field
, Syntax.FunctionConstructor
@ -128,10 +129,10 @@ constructorSymbol :: Assignment
constructorSymbol = makeTerm <$> symbol ConstructorSymbol <*> (Syntax.Identifier . Name.name <$> source)
context' :: Assignment
context' = makeTerm <$> symbol Context <*> children (Syntax.Context' <$> manyTerm (type' <|> contextPattern))
context' = makeTerm <$> symbol Context <*> children (Syntax.Context' <$> manyTerm expression)
contextPattern :: Assignment
contextPattern = symbol ContextPattern *> children type'
contextPattern = makeTerm <$> symbol ContextPattern <*> children (manyTerm expression)
defaultDeclaration :: Assignment
defaultDeclaration = makeTerm <$> symbol DefaultDeclaration <*> children (Syntax.DefaultDeclaration <$> manyTerm expression)
@ -139,6 +140,12 @@ defaultDeclaration = makeTerm <$> symbol DefaultDeclaration <*> children (Syntax
derivingClause :: Assignment
derivingClause = makeTerm <$> symbol Deriving <*> children (Syntax.Deriving <$> manyTerm typeConstructor)
equalityConstraint :: Assignment
equalityConstraint = makeTerm <$> symbol EqualityConstraint <*> children (Syntax.EqualityConstraint <$> equalityLhs <*> equalityRhs)
where
equalityLhs = symbol EqualityLhs *> children expression
equalityRhs = symbol EqualityRhs *> children expression
export :: Assignment
export = makeTerm <$> symbol Export <*> children (Syntax.Export <$> expressions)
@ -156,11 +163,13 @@ expressionChoices = [
, character
, comment
, context'
, contextPattern
, constructorIdentifier
, constructorOperator
, constructorSymbol
, defaultDeclaration
, derivingClause
, equalityConstraint
, float
, functionConstructor
, functionDeclaration

View File

@ -361,3 +361,13 @@ instance Ord1 DefaultDeclaration where liftCompare = genericLiftCompare
instance Show1 DefaultDeclaration where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable DefaultDeclaration
data EqualityConstraint a = EqualityConstraint { equalityConstraintLeft :: a, equalityConstraintRight :: a }
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)
instance Eq1 EqualityConstraint where liftEq = genericLiftEq
instance Ord1 EqualityConstraint where liftCompare = genericLiftCompare
instance Show1 EqualityConstraint where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable EqualityConstraint

View File

@ -1,3 +1,12 @@
bar :: a -> b -> c -> Int -> Maybe Int
bar :: a -> b -> c -> [Int] -> Maybe Int
factorial :: Num a => Show a => a -> a
f :: Ex -> Ex
f :: [Int] -> Int
f :: (Int, Int) -> Maybe Int
f :: a -> B c (D (E g ': h)) -> I [J k] (L m (N (O p ': q)))
f :: forall a. [a] -> [a]
f :: forall a b. (a, b) -> [a]
apply :: proxy c -> (forall g . c g => g a -> b) -> Union fs a -> b

View File

@ -1,2 +1,11 @@
foo :: a -> b -> c -> Int -> Maybe Int
factorial :: Num a => a -> a
g :: Ex -> Foo
g :: [Double] -> Int
g :: (Double, Int) -> Maybe Double
g :: b -> B a (D (E g ': h)) -> I [J k] (L m (O (N p ': q)))
g :: forall a. [a] -> [a]
g :: forall a b. (a, b) -> [a]
apply :: proxy d -> (forall g . d g => g a -> b) -> Union fs a -> b