Re: compositional gMap in SYB1

29 Jul 2008

      ...
Hello!
Hello again!-)
...
Claus wrote:
...
Perhaps we can combine our versions to get the best of both?
I have done so. I have committed a new version of
/comparison/SYB1_2/GMap.lhs
[for readers of libraries@: that is in the generics code repo at
http://darcs.haskell.org/generics/comparison/SYB1_2/GMap.lhs ,
look for gmap2/gmapt and comments; the topic is defining Functor
fmap generically (hence gmap) in terms of Data/Typeable]

Ah, of course! Silly me, if I had followed my own choice of
metaphor to the end, I would have known that X marks the
spot only on a map, not on the real thing (or else everyone
could find the treasure..). Your shallow, incrementally built
not-quite copy is just another representation of a map, and
since both map and X are hidden from users of the function,
everyone is happy.

That something out of nothing trick is also used in the PlateData
optimization and in my adaptation of it. The difference, apart
from choice of representation, is mainly in whether to extract
substructure placeholders/types on a type basis once per
traversal or on a value basis, incrementally.

Here is a re-run of the technique, for defining traverse in terms
of Data/Typeable. Apart from being useful for Data.Traversable
library users, the type of 'traverse id' is similar to the type of
transpose, which should interest the generics readers.

{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE RankNTypes #-}
import Control.Applicative
import Data.Generics

data X = X deriving (Data,Typeable)

traverseData :: forall f a b t . (Applicative f,Typeable1 f,Typeable a,Typeable b,
                                  Data (t a),Data (t b),Data (t X))
             => (a -> f b) -> t a -> f (t b)
traverseData f = traverseWithMap f (Dyn (undefined::t X))
  where
  traverseWithMap :: forall f a b x y .
                    (Applicative f,Typeable1 f,Typeable a,Typeable b,Data x,Data y)
                 => (a -> f b) -> Dyn -> x -> f (y)
  traverseWithMap f (Dyn t) x
    | typeOf t==typeOf X = maybe (error "traverseData: non-applicable type marked") ($x) (cast f)
    | otherwise          = rebuildWith (traverseWithMap f) t1 x
    where t1 = Dyn (fromConstr (toConstr x) `asTypeOf` t)

rebuildWith :: forall f x y . (Applicative f,Data x,Data y)
            => (forall x y . (Data x,Data y) => Dyn -> x -> f y) -> Dyn -> x -> f y
rebuildWith f (Dyn t) x = case gunfold (k f) (\g -> UnfldStateF2 (pure g) tkids kids) con of
    UnfldStateF2 a [] [] -> a
  where
  (tcon,tkids) = dynamize t
  (con,kids) = dynamize x
  k :: forall a b . (Data a)
    => (forall x y . (Data x,Data y) => Dyn -> x -> f y) -> UnfldStateF2 f (a->b) -> UnfldStateF2 f 
b
  k f (UnfldStateF2 ca (tkid:tkids) ((Dyn kid):kids)) = UnfldStateF2 (ca <*> (f tkid kid)) tkids 
kids

data UnfldStateF2 f a = UnfldStateF2 (f a) [Dyn] [Dyn]

data Dyn = forall a. Data a => Dyn a
data Kids a = Kids{growUp:: [Dyn]}

dynamize :: Data a => a -> (Constr,[Dyn])
dynamize x = (toConstr x, growUp $ gfoldl f (const (Kids [])) x)
  where f (Kids l) a = Kids (l ++ [Dyn a])

test = do
  print $ traverseData (Just . not) tuple
  print $ traverseData (Just . not) list
  traverseData print tuple >>= print
  traverseData print list >>= print
  where tuple = (True,True)
        list  = [True,True]

Btw, while the type of 'traverseData id' matches that of transpose,
its behavious doesn't quite, depending on example:

*Main> :t traverseData id
traverseData id :: (Data (t X),
                    Data (t b),
                    Data (t (f b)),
                    Typeable b,
                    Typeable1 f,
                    Applicative f) =>
                   t (f b) -> f (t b)
*Main> traverseData id [Just x|x<-[1..3]]
Just [1,2,3]
*Main> traverseData id [[1..3],[4..6]]
[[1,4],[1,5],[1,6],[2,4],[2,5],[2,6],[3,4],[3,5],[3,6]]
...
optimization: if it is determined that a structured value has no
components to map, no traversal is performed and the value is returned
as it is. That should speed things up a little. The trick is producing
something out of nothing.
That optimization is another indication of the relation to the
substructure types map building, although pleasingly different
in form (always nice to learn new tricks;-).
...
Too bad that the deadline to amend a Haskell workshop paper
has passed, and so has the deadline for the generics workshop. Perhaps
we should write a separate paper?
Sounds like a good idea. When you're back.
...
I'm afraid I would be out of town again for two weeks and so
would not be able to follow the discussion closely.
Ah, you're just trying to hide the two-week round trips for
lightspeed messages resulting from your space travels!-)

Thanks for yet another useful contribution,
Claus

Claus Reinke

tags

participants (1)