help with GMap, dispatch, etc...

[Ralf Laemmel]

Hal Daume III wrote:
> 
> I'm in the middle of writing a program for transforming haskell modules, a
> large amount of which is essentially renaming the HsNames inside.  It is
> *almost* sufficient for me to simply write a function:
>   transformName :: HsName -> QM HsName
> ...

Ok, here is my attempt.
Indeed, I end up using gmap as you expect. We get a nice
concise traversal at the end.

So let me first state a concrete problem for the sake
of this exercise. Consider the following nested function
definition:

f x y = x o y 
 where
  o x y = x ++ y

We would like to descend into Haskell ASTs and maintain a
stack of enclosing function names. If we print these stacks
and the encountered names, we get the following:

["f"]"f"
["f"]"x"
["f"]"y"
["f"]"x"
["f"]"o"
["f"]"y"
["o","f"]"o"
["o","f"]"x"
["o","f"]"y"
["o","f"]"x"
["o","f"]"y"

Here comes the generic programming code which does this.

I import the hssource Haskell parser stuff:

module Main where

import ParseWrap
import HsPretty
import Datatypes
import GenericLib

The main function reads the above test file.
and issues a traversal over the parsed test-file.

main = do
         sin  <- readFile "Test.hs"
         pout <- gEnvTraversal [] (parseWrap sin) 
         return ()

The traversal combines a QUERY (see isHsFunBind)
to get new names to be pushed on the stack and
a MONADIC TRANSFORMATION, which in this case 
preserves the term but prints some stuff when
it encounters HsNames (see sayHsName).

--
-- A traversal which
--  maintains an "environment" (here a list of strings)
--  uses a query to update the environment
--  otherwise uses gmap to descend into terms
--
gEnvTraversal:: Term a => [String] -> a -> IO a
gEnvTraversal s x = do
                      y <- mkM (sayHsName s) x
                      gmapM (gEnvTraversal s') y
 where
  s' = maybe s (flip (:) s) ((Nothing `mkQ` isHsFunBind) x)


-- Stop at HsName and print string argument
sayHsName :: [String] -> HsName -> IO HsName
sayHsName s x@(HsIdent y) = do 
                             putStrLn (show s ++ show y)
                             return x
sayHsName s x = return x


-- Stop at HsDecl and return name from HsFunBind term
isHsFunBind :: HsDecl -> Maybe String
isHsFunBind (HsFunBind _ (HsMatch _ (UnQual (HsIdent x)) _ _ _:_)) = Just x
isHsFunBind _ = Nothing


Observations:

- The function is monadic; see use of gmapM.
- You can easily turn the scheme underlying gEnvTraversal
into a parameterised function. (Strafunski offers such 
variations using more ugly types.)
- You could use the environment monad instead of
using an explicit argument of type [String] abbove, but
the point is here that we are not writing much code
anyway thanks to generic programming. So hiding the
fact that we have an environment-like argument is not
attractive.

Ralf

P.S.: I added this example to the gmap distribution (4.0).
http://www.cs.vu.nl/Strafunski/gmap/






> 
> (QM is the monad I'm living in at the moment)
> 
> and then simply apply a gmapM to the HsModule.
> 
> The problem is that "almost" referenced above.  Specifically, I need to do
> something special when I reach an HsFunBind in the source (basically, just
> push the local definitions into an environment held in the QM monad and
> then pop them back out when we leave).
> 
> I have a feeling such a thing should be possible, but I haven't yet
> figured out how.
> 
> My first attempt was essentially to try to do some sort of dispatch
> function using the gmap library.  To simplify, consider:
> 
> newtype Name = Name String deriving (Eq, Ord, Show)
> data Foo = Foo Name [Foo]
>          | Bar Name
>          deriving (Eq, Ord, Show)
> 
> testFoo
>   = Foo (Name "a")
>       [Foo (Name "b")
>         [Bar (Name "c"),
>          Bar (Name "d"),
>          Foo (Name "e")
>            [Bar (Name "f")],
>          Bar (Name "g")],
>        Bar (Name "h")]
> 
> with the obvious instance declarations of Term and Typeable.  Now, we want
> a function which will replace every 'Name s' with 'Name (s++s)' and, when
> we reach a 'Foo s', we want to print ">s" onenter and "<s" on exit.
> 
> we can do the first one with:
> 
> doubleName :: Name -> IO Name
> doubleName (Name s) = return (Name (s++s))
> 
> everywhereM (mkM doubleName) testFoo
> 
> which runs fine and produces the correct results.
> 
> As for the printing, I want something like:
> 
> flagFoo x
>   | x "is a Name"    = doubleName x
>   | x "is a Foo s l" = do
>     putStrLn ('>':s)
>     recurse on s and l
>     putStrLn ('<':s)
>   | otherwier        = gmapM flagFoo x
> 
> or something like that.  obviously I could do this by writing the
> recursion myself, but i'm trying to get around that.  even if i could
> write something like:
> 
> doName = doubleName
> doFoo x@(Foo s l) = do putStrLn ...; something x; putStrLn ...
> doFoo x           = something x
> 
> and then domsehting like:
> 
>   everywhereM (doName .|. doFoo) testFoo
> 
> then that woudl be fine.  I just don't want to have to write out all the
> other cases for doFoo that I don't care about, because for the real
> HsDecl, this is a *lot* of junk.
> 
> Anyone know how to solve this problem?
> 
> --
>  Hal Daume III                                   | hdaume@isi.edu
>  "Arrest this man, he talks in maths."           | www.isi.edu/~hdaume
> 
> _______________________________________________
> Haskell mailing list
> Haskell@haskell.org
> http://www.haskell.org/mailman/listinfo/haskell

-- 
Ralf Laemmel
VU & CWI, Amsterdam, The Netherlands
http://www.cs.vu.nl/~ralf/
http://www.cwi.nl/~ralf/