module ATerm.Matching
(
Binding(..)
, exactlyS
, exactlyI
, exactlyL
, exactlyA
, exactlyNamed
, contains
, containsL
, containsA
, containsChildren
, bindT
, bindL
, bindI
, bindS
, bindA
) where
import ATerm.AbstractSyntax
import qualified ATerm.Utilities as U
import Control.Monad
data Binding = BoundTerm Int
| BoundList [Int]
| BoundInt Integer
| BoundStr String
| BoundAppl Int
deriving (Eq, Read, Show, Ord)
exactly :: (MonadPlus m, Eq a) => a -> a -> m ()
exactly a b = guard (a == b) >> return ()
exactlyS :: MonadPlus m => String -> ATermTable -> m ()
exactlyS s t = case getATerm t of
ShAAppl s' [] _ -> exactly s s'
_ -> mzero
exactlyI :: MonadPlus m => Integer -> ATermTable -> m ()
exactlyI i t = case getATerm t of
ShAInt i' _ -> exactly i i'
_ -> mzero
exactlyL :: MonadPlus m => [ATermTable -> m a] -> ATermTable -> m [a]
exactlyL ms t = case getATerm t of
ShAList ls _ -> do
guard (length ms == length ls)
sequence (zipWith (\m i -> m (getATermByIndex1 i t)) ms ls)
_ -> mzero
exactlyA :: MonadPlus m => String -> [ATermTable -> m a] -> ATermTable -> m [a]
exactlyA s ms t = case getATerm t of
ShAAppl s' ls _ -> do
exactly s s'
guard (length ms == length ls)
sequence (zipWith (\m i -> U.app m t i) ms ls)
_ -> mzero
exactlyNamed :: MonadPlus m => String -> ATermTable -> m ()
exactlyNamed s t = case getATerm t of
ShAAppl s' _ _ -> exactly s s'
_ -> mzero
containsChildren :: Monad m
=> m (ATermTable -> b) -> m Int -> ATermTable -> m b
containsChildren ms is t = do
i <- is
m <- ms
return (m (getATermByIndex1 i t))
contains :: [ATermTable -> a] -> ATermTable -> [a]
contains ms t = case getATerm t of
ShAAppl _ ls _ -> containsChildren ms ls t
ShAList ls _ -> containsChildren ms ls t
_ -> mzero
containsL :: [ATermTable -> a] -> ATermTable -> [a]
containsL ms t = case getATerm t of
ShAList ls _ -> containsChildren ms ls t
_ -> mzero
containsA :: String -> [ATermTable -> a] -> ATermTable -> [a]
containsA s ams t = case getATerm t of
ShAAppl s' ls _ -> do
exactly s s'
containsChildren ams ls t
_ -> mzero
bindT :: MonadPlus m => ATermTable -> m Binding
bindT t = return (BoundTerm (getTopIndex t))
bindL :: MonadPlus m => ATermTable -> m Binding
bindL t = case getATerm t of
ShAList ls _ -> return (BoundList ls)
_ -> mzero
bindI :: MonadPlus m => ATermTable -> m Binding
bindI t = case getATerm t of
ShAInt i _ -> return (BoundInt i)
_ -> mzero
bindS :: MonadPlus m => ATermTable -> m Binding
bindS t = case getATerm t of
ShAAppl s [] [] -> return (BoundStr s)
_ -> mzero
bindA :: MonadPlus m => ATermTable -> m Binding
bindA t = case getATerm t of
ShAAppl _ _ _ -> return (BoundAppl (getTopIndex t))
_ -> mzero