A library implementation of a recursion scheme

I 'invented' a recursion scheme which is a generalization of catamorphism. When you fold a data structure with catamorphism you don't have access to subterms, only to subresults of folding:

{-# LANGUAGE DeriveFunctor #-}
import qualified Data.Map as M

newtype Fix f = Fix { unFix :: f (Fix f) }

cata :: Functor f => (f b -> b) -> Fix f -> b
cata phi = self where
    self = phi . fmap (\x -> self x) . unFix

The folding function phi has only access to the result of self x, but not to original x. So I added a joining function:

cataWithSubterm :: Functor f => (Fix f -> c -> b) -> (f b -> c) -> Fix f -> c
cataWithSubterm join phi = self
    where self = phi . fmap (\x -> join x (self x)) . unFix

Now it's possible to combine x and self x in a meaningful way, for example using (,):

data ExampleFunctor a = Var String | Application a a deriving Functor

type Subterm = Fix ExampleFunctor

type Result = M.Map String [Subterm]

varArgs :: ExampleFunctor (Subterm, Result) -> Result
varArgs a = case a of
    Var _ -> M.empty
    Application ((Fix (Var var)), _) (arg, m) -> M.insertWith (++) var [arg] m

processTerm :: (ExampleFunctor (Subterm, Result) -> Result) -> Subterm -> Result
processTerm phi term = cataWithSubterm (,) phi term     

processTerm varArgs returns for each identifier the list of actual arguments it receives on different control paths. E.g. for bar (foo 2) (foo 5) it returns fromList [("foo", [2, 5])]

Note that in this example results are combined uniformly with other results, so I expect existence of a simpler implementation using a derived instance of Data.Foldable. But in general it's not the case as phi can apply its knowledge of internal structure of ExampleFunctor to combine 'subterms' and 'subresults' in ways not possible with Foldable.

My question is: can I build processTerm using stock functions from a modern recursion schemes library such as recursion-schemes/Data.Functor.Foldable?


  • Folding such that it "eats the argument and keeps it too" is called a paramorphism. Indeed, your function can be readily expressed using recursion-schemes as

    cataWithSubterm :: Functor f => (Fix f -> b -> a) -> (f a -> b) -> Fix f -> b
    cataWithSubterm f g = para $ g . fmap (uncurry f)

    Moreover, if we supply (,) to cataWithSubterm as you did in processTerm, we get

    cataWithSubterm (,)  :: Functor f => (f (Fix f, b) -> b) -> Fix f -> b

    which is precisely para specialized for Fix:

    para                 :: Functor f => (f (Fix f, b) -> b) -> Fix f -> b