Re: help with GMap, dispatch, etc...

6 May 2003

      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/