Hi,

I'm trying to develop a GHC plugin to transform effect handlers for free monads. I have created my own module with the free monad definitions. The goal is that if a user uses these definitions, my plugin will rewrite the handlers into a form which will allow fusion.


For a first simple example I'm trying to transform the following code:

handleNondet :: Functor g => Free (Nondet + g) a -> Free g [a]
handleNondet = \y -> case y of
    Var x -> Var [x]
    Con op -> case op of
        Inl x -> case x of
            Or l r -> (handleNondet l >>= (\ll -> handleNondet r >>= (\rr -> Var (ll ++ rr))))
        Inr x -> Con (fmap handleNondet x)


into this:

handleNondet :: Functor g => Free (Nondet + g) a -> Free g [a]
handleNondet = foldFree genNondet algNondet

genNondet :: Functor g => a -> Free g [a]
genNondet x = Var [x]

algNondet :: Functor g => (Nondet + g) (Free g [a]) -> Free g [a]
algNondet op = case op of
    Inl x -> case x of
        Or l r -> (l >>= (\ll -> r >>= (\rr -> Var (ll ++ rr))))
    Inr x -> Con x

-----------------------------------------------------------------------------------------------------------------------------------

In my module with definitions, Free, Con, Var, the (+), Inl and Inr are defined and the foldFree function is defined.
There is also a functor instance:    instance (Functor f, Functor g) => Functor (f + g)


The problem is that when trying to do this transformation in GHC Core, I only get a dictionary for the functor g, but not for Nondet or for (Nondet + g).
What is need is of the form: 
(WhatMorphism.Free.$fFunctor+
                @ Nondet @ g_a2MS Types.$fFunctorNondet $dFunctor_a2R9)

and I have access to @ Nondet, @ g_a2MS and $dFunctor_a2R9, but I don't know how to find WhatMorphism.Free.$fFunctor+ and Types.$fFunctorNondet.

I am trying to find out whether it is possible to find these dictionaries from a GHC Core plugin, or whether this has to happen in an earlier stage of the compilation. If it is possible, how would I go about it? And if it is not, where should I start looking to implement this functionality anyway?

Regards,
Yannick Boesmans