1
1
mirror of https://github.com/github/semantic.git synced 2024-12-19 12:51:52 +03:00

Define Term equality via Eq1.

This commit is contained in:
Rob Rix 2017-09-08 16:55:36 +01:00
parent ea5107c484
commit d572c64b32
3 changed files with 19 additions and 8 deletions

View File

@ -231,7 +231,7 @@ firstSet = iterFreer (\ (Tracing _ assignment) _ -> case assignment of
-- | Run an assignment over an AST exhaustively.
assign :: (Bounded grammar, Ix grammar, Symbol grammar, Show grammar, Eq (ast (AST ast grammar)), Foldable ast, Functor ast)
assign :: (Bounded grammar, Ix grammar, Symbol grammar, Show grammar, Eq1 ast, Foldable ast, Functor ast)
=> Source.Source -- ^ The source for the parse tree.
-> Assignment ast grammar a -- ^ The 'Assignment to run.
-> AST ast grammar -- ^ The root of the ast.
@ -240,7 +240,7 @@ assign source assignment ast = bimap (fmap (either id show)) fst (runAssignment
{-# INLINE assign #-}
-- | Run an assignment of nodes in a grammar onto terms in a syntax over an AST exhaustively.
runAssignment :: forall grammar a ast. (Bounded grammar, Ix grammar, Symbol grammar, Eq (ast (AST ast grammar)), Foldable ast, Functor ast)
runAssignment :: forall grammar a ast. (Bounded grammar, Ix grammar, Symbol grammar, Eq1 ast, Foldable ast, Functor ast)
=> Source.Source -- ^ The source for the parse tree.
-> Assignment ast grammar a -- ^ The 'Assignment' to run.
-> State ast grammar -- ^ The current state.
@ -308,7 +308,7 @@ data State ast grammar = State
, stateNodes :: ![AST ast grammar] -- ^ The remaining nodes to assign. Note that 'children' rules recur into subterms, and thus this does not necessarily reflect all of the terms remaining to be assigned in the overall algorithm, only those “in scope.”
}
deriving instance (Eq grammar, Eq (ast (AST ast grammar))) => Eq (State ast grammar)
deriving instance (Eq grammar, Eq1 ast) => Eq (State ast grammar)
deriving instance (Show grammar, Show (ast (AST ast grammar))) => Show (State ast grammar)
makeState :: [AST ast grammar] -> State ast grammar
@ -317,7 +317,7 @@ makeState = State 0 (Info.Pos 1 1) []
-- Instances
instance (Eq grammar, Eq (ast (AST ast grammar))) => Alternative (Assignment ast grammar) where
instance (Eq grammar, Eq1 ast) => Alternative (Assignment ast grammar) where
empty :: HasCallStack => Assignment ast grammar a
empty = tracing (Alt []) `Then` return
@ -369,7 +369,7 @@ instance (Eq grammar, Eq (ast (AST ast grammar))) => Alternative (Assignment ast
many :: HasCallStack => Assignment ast grammar a -> Assignment ast grammar [a]
many a = tracing (Many a) `Then` return
instance (Eq grammar, Eq (ast (AST ast grammar)), Show grammar, Show (ast (AST ast grammar))) => Parsing (Assignment ast grammar) where
instance (Eq grammar, Eq1 ast, Show grammar, Show (ast (AST ast grammar))) => Parsing (Assignment ast grammar) where
try :: HasCallStack => Assignment ast grammar a -> Assignment ast grammar a
try = id

View File

@ -12,6 +12,7 @@ module Parser
) where
import qualified CMarkGFM
import Data.Functor.Classes (Eq1)
import Data.Ix
import Data.Record
import Data.Source as Source
@ -39,7 +40,7 @@ data Parser term where
-- | A parser producing 'AST' using a 'TS.Language'.
ASTParser :: (Bounded grammar, Enum grammar) => Ptr TS.Language -> Parser (AST [] grammar)
-- | A parser producing an à la carte term given an 'AST'-producing parser and an 'Assignment' onto 'Term's in some syntax type.
AssignmentParser :: (Bounded grammar, Ix grammar, Show grammar, TS.Symbol grammar, Syntax.Error :< fs, Eq (ast (Term ast (Node grammar))), Apply1 Foldable fs, Apply1 Functor fs, Foldable ast, Functor ast)
AssignmentParser :: (Bounded grammar, Ix grammar, Show grammar, TS.Symbol grammar, Syntax.Error :< fs, Eq1 ast, Apply1 Foldable fs, Apply1 Functor fs, Foldable ast, Functor ast)
=> Parser (Term ast (Node grammar)) -- ^ A parser producing AST.
-> Assignment ast grammar (Term (Union fs) (Record Location)) -- ^ An assignment from AST onto 'Term's.
-> Parser (Term (Union fs) (Record Location)) -- ^ A parser producing 'Term's.

View File

@ -21,6 +21,7 @@ import Control.Monad.Free
import Data.Align.Generic
import Data.Bifunctor
import Data.Functor.Both
import Data.Functor.Classes
import Data.Functor.Classes.Pretty.Generic as Pretty
import Data.Functor.Foldable
import Data.Functor.Listable
@ -106,8 +107,11 @@ instance Functor f => ComonadCofree f (Term f) where
unwrap (_ :< as) = as
{-# INLINE unwrap #-}
instance (Eq (f (Term f a)), Eq a) => Eq (Term f a) where
a1 :< f1 == a2 :< f2 = a1 == a2 && f1 == f2
instance Eq1 f => Eq1 (Term f) where
liftEq eqA = go where go (a1 :< f1) (a2 :< f2) = eqA a1 a2 && liftEq go f1 f2
instance (Eq1 f, Eq a) => Eq (Term f a) where
(==) = eq1
instance (Show (f (Term f a)), Show a) => Show (Term f a) where
showsPrec d (a :< f) = showParen (d > 5) $ showsPrec 6 a . showString " :< " . showsPrec 5 f
@ -124,3 +128,9 @@ instance (Listable1 f, Listable a) => Listable1 (TermF f a) where
instance (Functor f, Listable1 f) => Listable1 (Term f) where
liftTiers annotationTiers = go
where go = liftCons1 (liftTiers2 annotationTiers go) cofree
instance Eq1 f => Eq2 (TermF f) where
liftEq2 eqA eqB (a1 :<< f1) (a2 :<< f2) = eqA a1 a2 && liftEq eqB f1 f2
instance (Eq1 f, Eq a) => Eq1 (TermF f a) where
liftEq = liftEq2 (==)