module Data.Comp.Generic where
import Data.Comp.Term
import Data.Comp.Sum
import Data.Comp.Algebra
import Data.Comp.Automata
import Data.Foldable
import Data.Maybe
import Data.Traversable
import GHC.Exts (build)
import Control.Monad hiding (mapM)
import Prelude hiding (foldl,mapM)
getSubterm :: (Functor g, Foldable g) => [Int] -> Term g -> Maybe (Term g)
getSubterm path t = cata alg t path where
alg :: (Functor g, Foldable g) => Alg g ([Int] -> Maybe (Cxt h g a))
alg t [] = Just $ Term $ fmap ((fromJust) . ($[])) t
alg t (i:is) = case drop i (toList t) of
[] -> Nothing
x : _ -> x is
getSubterm' :: (Functor g, Foldable g) => [Int] -> Term g -> Term g
getSubterm' path t = runDownTrans trans path t where
trans :: (Functor g, Foldable g) => DownTrans g [Int] g
trans [] t = simpCxt $ fmap ($[]) t
trans (i : is) t = Hole $ (toList t !! i) is
subterms :: forall f . Foldable f => Term f -> [Term f]
subterms t = build (f t)
where f :: Term f -> (Term f -> b -> b) -> b -> b
f t cons nil = t `cons` foldl (\u s -> f s cons u) nil (unTerm t)
subterms' :: forall f g . (Foldable f, g :<: f) => Term f -> [g (Term f)]
subterms' (Term t) = build (f t)
where f :: f (Term f) -> (g (Term f) -> b -> b) -> b -> b
f t cons nil = let rest = foldl (\u (Term s) -> f s cons u) nil t
in case proj t of
Just t' -> t'`cons` rest
Nothing -> rest
transform :: (Functor f) => (Term f -> Term f) -> Term f -> Term f
transform f = run
where run = f . Term . fmap run . unTerm
transform' :: (Functor f) => (Term f -> Maybe (Term f)) -> Term f -> Term f
transform' f = transform f' where
f' t = fromMaybe t (f t)
transformM :: (Traversable f, Monad m) =>
(Term f -> m (Term f)) -> Term f -> m (Term f)
transformM f = run
where run t = f =<< liftM Term (mapM run $ unTerm t)
query :: Foldable f => (Term f -> r) -> (r -> r -> r) -> Term f -> r
query q c = run
where run i@(Term t) = foldl (\s x -> s `c` run x) (q i) t
gsize :: Foldable f => Term f -> Int
gsize = query (const 1) (+)
size :: Foldable f => Cxt h f a -> Int
size (Hole {}) = 0
size (Term t) = foldl (\s x -> s + size x) 1 t
height :: Foldable f => Cxt h f a -> Int
height (Hole {}) = 0
height (Term t) = 1 + foldl (\s x -> s `max` height x) 0 t