Data/Typeable/Uniplate instances for GHC types

Claus Reinke claus.reinke at talk21.com
Thu Jul 17 15:30:16 EDT 2008


> (skipping redundant types) its fairly complex but doesn't touch gfoldl, 
> and most of the difficult code can be stolen from Uniplate.

>From your thesis/paper, it seems that queries, such as 'bill' in the
Paradise benchmark, are the worst offenders, performancewise, 
and applying your techniques for Uniplate to the SYB query for 
'bill' seems to achieve a similar reduction in runtime. 

'contains' is interesting, and seems to generalise directly to SYB, one
just needs to know the domains of functions - I have long wanted a way 
to specify the domain of SYB-style overloaded functions (instead of
hiding specific domains in near polymorphic types), but never considered 
IntSets of TypeRepKeys!-)

I couldn't quite figure out how to make a type-dependent CAF 
in the class instances, as your paper suggests, so I made my CAF 
at the top-level instead, a Map from TypeRepKeys to IntSets 
representing all substructure types, recursively computed from roots 
like the Company type (having to list those roots explicitly is not so
nice, presumably your approach avoids that?).

The query and scheme change only minimally, to add the domain
of the query function, and to shortcut the scheme if there are no
domain members in the substructure types:

bill = everything' (+) 0 domain (0 `mkQ` billS)
  where billS (S s) = s
        domain = singleton (getDomainKey billS)

everything' :: (r -> r -> r) -> r -> Domain -> GenericQ r -> GenericQ r
everything' k z domain f x
  | not $ IS.null $ domain `intersection` getSubs x
  = foldl k (f x) (gmapQ (everything' k z domain f) x)
  | otherwise
  = z

getSubs x = Map.findWithDefault (error ("missing key: "++show (typeOf x))) (key x) subMap
subMap = fromRoot genCom Map.empty
  where fromRoots rs map = foldl' (\m (DataBox x)->fromRoot x m) map rs

        fromRoot :: Data a => a -> Map.Map Int IntSet -> Map.Map Int IntSet
        fromRoot root map | Map.member (key root) map = map
        fromRoot root map | otherwise                 = fromRoots (contains root) map'
          where map' = Map.insert (key root) (allSubs root) map

While your optimizations are nice, your text might have
mentioned that some of them apply to SYB as well?-)

Claus



More information about the Cvs-ghc mailing list