module Term.Rewriting.Definitions (
Equal (..)
, evalEqual
, Match(..)
, RRule(..)
) where
import Control.Applicative
import Data.Monoid
import Data.Foldable
import Data.Traversable
data Equal a = Equal { eqLHS :: a, eqRHS :: a }
deriving (Eq, Show)
evalEqual :: Eq a => Equal a -> Bool
evalEqual (Equal l r) = l == r
instance Functor Equal where
fmap f (Equal lhs rhs) = Equal (f lhs) (f rhs)
instance Monoid a => Monoid (Equal a) where
mempty = Equal mempty mempty
(Equal l1 r1) `mappend` (Equal l2 r2) =
Equal (l1 `mappend` l2) (r1 `mappend` r2)
instance Foldable Equal where
foldMap f (Equal l r) = f l `mappend` f r
instance Traversable Equal where
traverse f (Equal l r) = Equal <$> f l <*> f r
instance Applicative Equal where
pure x = Equal x x
(Equal fl fr) <*> (Equal l r) = Equal (fl l) (fr r)
data Match a = MatchWith { matchTerm :: a, matchPattern :: a }
deriving (Eq, Show)
instance Functor Match where
fmap f (MatchWith t p) = MatchWith (f t) (f p)
instance Monoid a => Monoid (Match a) where
mempty =
MatchWith mempty mempty
(MatchWith t1 p1) `mappend` (MatchWith t2 p2) =
MatchWith (t1 `mappend` t2) (p1 `mappend` p2)
instance Foldable Match where
foldMap f (MatchWith t p) = f t `mappend` f p
instance Traversable Match where
traverse f (MatchWith t p) = MatchWith <$> f t <*> f p
instance Applicative Match where
pure x = MatchWith x x
(MatchWith ft fp) <*> (MatchWith t p) = MatchWith (ft t) (fp p)
data RRule a = RRule a a
deriving (Show, Ord, Eq)
instance Functor RRule where
fmap f (RRule lhs rhs) = RRule (f lhs) (f rhs)
instance Monoid a => Monoid (RRule a) where
mempty = RRule mempty mempty
(RRule l1 r1) `mappend` (RRule l2 r2) =
RRule (l1 `mappend` l2) (r1 `mappend` r2)
instance Foldable RRule where
foldMap f (RRule l r) = f l `mappend` f r
instance Traversable RRule where
traverse f (RRule l r) = RRule <$> f l <*> f r
instance Applicative RRule where
pure x = RRule x x
(RRule fl fr) <*> (RRule l r) = RRule (fl l) (fr r)