How to define fmap in a GADT Expression?

Question

Given a simple "language":

data Expr a where
  ConstE   :: a                  -> Expr a
  FMapE    :: (b -> a) -> Expr b -> Expr a

instance Functor Expr where
    fmap = FMapE

interpret :: Expr a -> a
interpret (ConstE a) = a
interpret (FMapE f a) = f (interpret a)

From that I would like to extract a call graph, eg:

foo = fmap show . fmap (*2) $ ConstE 1

Should result in the graph Node 1 -> Node (*2) -> Node show. Ideally I'd like to store this in a Data.Graph.

What I've come up to this point is that it should be possible to use System.Mem.StableNames to identify individual nodes and store them in a HashMap (StableName (Expr a)) (Expr a).

toHashMap :: Expr a -> HashMap (StableName (Expr a)) (Expr a)
toHashMap n@ConstE = do
    sn <- makeStableName n
    return $ HashMap.singleton sn n

The problem is, that there seems to be no way to get through the FMapE nodes:

toHashMap n@(FMapE _ a) = do
    snN <- makeStableName n
    snA <- makeStableName a
    -- recurse
    hmA <- toHashMap a
    -- combine
    return $ HashMap.singleton snN n `HashMap.union` hmA

GHC will complain along the lines of this:

Couldn't match type ‘t’ with ‘b’
  because type variable ‘b’ would escape its scope
This (rigid, skolem) type variable is bound by
  a pattern with constructor
    FMapE :: forall a b. (b -> a) -> Expr b -> Expr a,
  in an equation for ‘toHashMap’

I can see that this won't match ... but I have no clue on how to make this work.

Edit

This probably boils down to writing a children function:

children :: Event a -> [Event a]
children (ConstE)    = []
children (FMapE _ a) = [a] -- doesn't match ...

For the same reason I can't uniplate on this ...

The problem is that the type variable in `Expr` differs, so you can't store them in a homogenous container that only accepts a single type (because `Expr` contains [polymorphic recursion](https://en.wikipedia.org/wiki/Polymorphic_recursion)). You will have to use a more sophisticated container. (But really though, your `Expr` type is already a graph-like data structure, why make another?) — Rufflewind, Dec 29 '14 at 16:34
@Rufflewind "why make it another?" I hope to leverage the topological sorting implemented in `Data.Graph`. But to do that I need to transform `Expr a` into `Graph something (Expr a)` or something similar. Otoh I ran into a similar problem when trying to use `uniplate` on `Exprs`. — fho, Dec 29 '14 at 16:38
You might be able to get away with using `Dynamic` to hide the type variable temporarily and then unwrap it later. Kind of a hack, but I think it'd be either that or implement your own topsort on top of `Expr` directly. — Rufflewind, Dec 29 '14 at 16:39
Don't think so, `toDyn` also requires the `b` in `FMapE` to be `Typeable` and I don't think I can set that. Maybe I really need to extend the `Expr a` type to `Expr a b`? — fho, Dec 29 '14 at 16:46
You should look into papers on `Nikola`. They do this sort of thing very nicely. — J. Abrahamson, Dec 29 '14 at 18:41
Topologically sorting `Expr` is trivial. Topologically sorting any tree and thus any AST is trivial - a postorder traversal is a topological sort of a tree. Perhaps you don't want your "language" to build trees, and instead want to build graphs. If so, you can equip your language to do so explicitly with a `Monadic` interface for building the graph or the [`Divisible` interface described in this answer](http://stackoverflow.com/a/25877310/414413) and CPS style or the continuation monad. Or you can recover a graph with [reifyGraph IO magic](http://stackoverflow.com/a/25729877/414413). — Cirdec, Dec 29 '14 at 20:45

score 1 · Answer 1 · edited May 23 '17 at 10:33

You can get a postorder traversal, which is a tolopogical sort for a tree, of a type of kind * -> * from the Uniplate1 class I've described previously.

{-# LANGUAGE RankNTypes #-}

import Control.Applicative
import Control.Monad.Identity

class Uniplate1 f where
    uniplate1 :: Applicative m => f a -> (forall b. f b -> m (f b)) -> m (f a)

    descend1 :: (forall b. f b -> f b) -> f a -> f a
    descend1 f x = runIdentity $ descendM1 (pure . f) x

    descendM1 :: Applicative m => (forall b. f b -> m (f b)) -> f a -> m (f a)
    descendM1 f a = uniplate1 a f

transform1 :: Uniplate1 f => (forall b. f b -> f b) -> f a -> f a
transform1 f = f . descend1 (transform1 f)

transform1 is a generic postorder tranformation. A generic postorder Monadic traversal of a Uniplate1 is

transformM1 :: (Uniplate1 f, Applicative m, Monad m) =>
               (forall b. f b -> m (f b)) ->
                          f a -> m (f a)
transformM1 f = (>>= f) . descendM1 (transformM1 f)

We can write a Uniplate1 instance for Expr:

instance Uniplate1 Expr where
    uniplate1 e p = case e of
        FMapE f a -> FMapE f <$> p a
        e -> pure e

We'll make a simple dump function for demonstration purposes and bypass to restore the data after a monadic effect.

dump :: Expr b -> IO ()
dump (ConstE _)  = putStrLn "ConstE"
dump (FMapE _ _) = putStrLn "FMapE"

bypass :: Monad m => (a -> m ()) -> a -> m a
bypass f x = f x >> return x

We can traverse your example in topological order

> transformM1 (bypass dump) (fmap show . fmap (*2) $ ConstE 1)
ConstE
FMapE
FMapE

Hmm ... will have to try that ... sad that this is not possible with `uniplate` and or `lens` by default. — fho, Jan 01 '15 at 13:25

How to define fmap in a GADT Expression?

Edit

1 Answers1