Uniplate with extensible functions

[LeventErkok]

I'm curious if there's an easier/less-error-prone way to write traversals that go through a class method in Uniplate. Here's what I mean:

{-# LANGUAGE DeriveDataTypeable #-}

import Data.Data
import Data.List
import qualified Data.Generics.Uniplate.Data as G

data Name = Name String
       deriving (Data, Typeable, Eq)

data Expr = Var    Name
          | Lambda Name Expr
          | App    Expr Expr
          | Block  Stmt
       deriving (Data, Typeable)

data Stmt = StmtE Expr
           deriving (Data, Typeable)

instance Show Name where
  show (Name s) = s

instance Show Stmt where
  show (StmtE e) = '{' : show e ++ "}"

instance Show Expr where
  show (Var n)      = show n
  show (Lambda n e) = "\\" ++ show n ++ ". " ++ show e
  show (App e1 e2)  = '(' : show e1 ++ " " ++ show e2 ++ ")"
  show (Block s)    = show s

-- x (\y -> y)
x, y:: Name
x = Name "x"
y = Name "y"
e :: Expr
e = App (Block (StmtE (Var x))) (Lambda y (Var y))

test :: IO ()
test = do print e
          print $ freeVars e

---

class Data a => FreeVars a where
  freeVars :: a -> [Name]

instance FreeVars Name where
  freeVars n = [n]

instance FreeVars Stmt where
  freeVars s = nub $  concatMap freeVars (G.children   s :: [Stmt])
                   ++ concatMap freeVars (G.childrenBi s :: [Expr])

instance FreeVars Expr where
  freeVars (Var    n)   = [n]
  freeVars (Lambda n e) = filter (n /=) (freeVars e)
  freeVars e = let choice = 3
               in case choice of
                    1 -> nub $ G.universeBi e          -- [x, y]
                    2 -> G.para (\_ xs -> concat xs) e -- []
                    3 -> nub $  concatMap freeVars (G.children   e :: [Expr])
                             ++ concatMap freeVars (G.childrenBi e :: [Stmt])

Sorry, this is a wall of text; but all it really is doing is to compute free-variables in a lambda-calculus like language; pared down to demonstrate the issue.

It's the final case in freeVars for Expr that I'm concerned about. I'd really love to write it as in choice = 1, but that's wrong as it simply picks all the names. Option 2 would be nice, but it doesn't work since it only "folds" over expressions and hence misses statements. (You can run the expression test to see what I mean by changing the choice value.)

The only way I found how to write this correctly is choice = 3, i.e., extract "all" interesting subcomponents and collect the frees recursively. But this is very error prone, as I need to know that there are Stmt's inside Exprs, and if I add another kind of data, the code would break without any indication.

What's the best solution for this problem in Uniplate? I gather syb-with-class is really the way to go with this, but that doesn't really seem to be supported with GHC.Generics and I'm curious what the Uniplate solution for this sort of problem is.

[ndmitchell]

This isn't a good case for uniplate. You really want the function:

children2 :: Expr -> [Either Expr Stmt]

Where you get the children, but stopping at the first Expr OR Stmt you find, so you can continue from there. You can do such a traversal with plain SYB with something along the lines of:

everything (++) (const [] `extQ` onStmt `extQ` onExpr)
   where onStmt (x :: Stmt) = ...
             onExpr (x :: Expr) = freeVars x

Uniplate makes the simplifying assumption you only want to work on one target type. Once you mix Stmt and Expr freely that's no longer true.

[LeventErkok]

Thanks Neil. That's what I suspected. But this makes the assumption that I now that I only have Stmt and OnExpr and nohing else. This is where the syb-with-class comes into play, but it appears it isn't really supported that well anymore.

Thanks for the feedback though.