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:
parent
ea5107c484
commit
d572c64b32
@ -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
|
||||
|
||||
|
@ -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.
|
||||
|
14
src/Term.hs
14
src/Term.hs
@ -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 (==)
|
||||
|
Loading…
Reference in New Issue
Block a user