fixplate 0.1.4 → 0.1.5

raw patch · 19 files changed

+1549/−531 lines, 19 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Data/Generics/Fixplate.hs +28/−11
• Data/Generics/Fixplate/Attributes.hs +12/−6
• Data/Generics/Fixplate/Base.hs +24/−10
• Data/Generics/Fixplate/Hash.hs +104/−35
• Data/Generics/Fixplate/Hash/Class.hs +0/−99
• Data/Generics/Fixplate/Hash/FNV/FNV32.hs +0/−94
• Data/Generics/Fixplate/Hash/FNV/FNV64.hs +0/−97
• Data/Generics/Fixplate/Hash/Table.hs +0/−109
• Data/Generics/Fixplate/Misc.hs +20/−0
• Data/Generics/Fixplate/Morphisms.hs +1/−1
• Data/Generics/Fixplate/Structure.hs +0/−53
• Data/Generics/Fixplate/Tests.hs +10/−1
• Data/Generics/Fixplate/Traversals.hs +40/−1
• Data/Generics/Fixplate/Trie.hs +477/−0
• Data/Generics/Fixplate/Util/Hash/Class.hs +99/−0
• Data/Generics/Fixplate/Util/Hash/FNV/FNV32.hs +94/−0
• Data/Generics/Fixplate/Util/Hash/FNV/FNV64.hs +97/−0
• Data/Generics/Fixplate/Util/Hash/Table.hs +530/−0
• fixplate.cabal +13/−14

@@ -2,7 +2,7 @@ -- | This library provides Uniplate-style generic traversals and other recursion schemes for fixed-point types.
 -- There are many advantages of using fixed-point types instead of explicit recursion:
 --
---   * we can add attributes to the nodes of an existing tree;
+--   * we can easily add attributes to the nodes of an existing tree;
 --
 --   * there is no need for a custom type class, we can build everything on the top of
 --     'Functor', 'Foldable' and 'Traversable', for which GHC can derive the instances for us;
@@ -12,7 +12,7 @@ --   * some operations can retain the structure of the tree, instead flattening
 --     it into a list;
 --
---   * it is quite straightforward to provide a generic zipper, generic tree drawing, generic hashing, etc...
+--   * it is relatively straightforward to provide generic implementations of the zipper, tries, tree drawing, hashing, etc...
 --
 -- The main disadvantage is that it does not work well for
 -- mutually recursive data types, and that pattern matching becomes
@@ -21,7 +21,7 @@ -- Consider as an example the following simple expression language,
 -- encoded by a recursive algebraic data type:
 --
--- > Expr 
+-- > data Expr 
 -- >   = Kst Int 
 -- >   | Var String 
 -- >   | Add Expr Expr
@@ -29,7 +29,7 @@ --
 -- We can open up the recursion, and obtain a /functor/ instead:
 --
--- > Expr1 e 
+-- > data Expr1 e 
 -- >   = Kst Int 
 -- >   | Var String 
 -- >   | Add e e 
@@ -44,24 +44,42 @@ -- The functions in this library work on types like that: 'Mu'@ f@,
 -- where @f@ is a functor, and sometimes explicitely on 'Attr'@ f a@.
 -- 
--- This module re-exports most, but not all of the functionality present in the library.
+-- The organization of the modules (excluding Util.\*) is the following:
 --
--- The library should be fully Haskell98 compatible, with the exception
--- of the module "Data.Generics.Fixplate.Structure", which needs
--- the @Rank2Types@ extension. For compatibility, the functionality
--- of this module is at the moment only provided when compiled with GHC or Hugs.
+-- * "Data.Generics.Fixplate.Base" - core types and type classes
 --
+-- * "Data.Generics.Fixplate.Traversals" - Uniplate-style traversals
+--
+-- * "Data.Generics.Fixplate.Morphisms" - recursion schemes
+--
+-- * "Data.Generics.Fixplate.Attributes" - annotated trees
+--
+-- * "Data.Generics.Fixplate.Open" - functions operating on functors
+--
+-- * "Data.Generics.Fixplate.Zipper" - generic zipper
+--
+-- * "Data.Generics.Fixplate.Draw" - generic tree drawing (both ASCII and graphviz)
+-- 
+-- * "Data.Generics.Fixplate.Trie" - generic generalized tries
+--
+-- * "Data.Generics.Fixplate.Hash" - annotating trees with their hashes
+--
+-- This module re-exports the most common functionality present in the library
+-- (but not for example the zipper, tries, hashing).
+-- 
+--
+-- The library itself should be fully Haskell98 compatible; no language extensions are used.
 -- Note: to obtain 'Eq', 'Ord', 'Show', 'Read' and other instances for 
 -- fixed point types like @Mu Expr1@, consult the documentation of the
 -- 'EqF' type class (cf. the related 'OrdF', 'ShowF' and 'ReadF' classes)
 --
+
 module Data.Generics.Fixplate 
   ( module Data.Generics.Fixplate.Base
   , module Data.Generics.Fixplate.Traversals
   , module Data.Generics.Fixplate.Morphisms
   , module Data.Generics.Fixplate.Attributes
 --  , module Data.Generics.Fixplate.Zipper
-  , module Data.Generics.Fixplate.Structure
   , module Data.Generics.Fixplate.Draw
   , Functor(..) , Foldable(..) , Traversable(..)
   )
@@ -74,7 +92,6 @@ import Data.Generics.Fixplate.Morphisms
 import Data.Generics.Fixplate.Attributes
 -- import Data.Generics.Fixplate.Zipper
-import Data.Generics.Fixplate.Structure  
 import Data.Generics.Fixplate.Draw
 
 import Data.Foldable

@@ -28,8 +28,8 @@   , synthAccumL_   , synthAccumR_
   , enumerateNodes , enumerateNodes_
   -- * Resynthetising transformations
-  , synthTransform
-  , synthRewrite
+  , synthTransform  , synthTransform'
+  , synthRewrite    , synthRewrite'   
   -- * Stacking attributes
   , annZip  , annZipWith
   , annZip3 , annZipWith3  
@@ -345,8 +345,11 @@ -- | Bottom-up transformations which automatically resynthetise attributes 
 -- in case of changes.
 synthTransform :: Traversable f => (f a -> a) -> (Attr f a -> Maybe (f (Attr f a))) -> Attr f a -> Attr f a 
-synthTransform calc h0 = snd . go False where
-  synth x = Fix $ Ann (calc $ fmap attribute x) x
+synthTransform calc = synthTransform' (calc . fmap attribute)
+
+synthTransform' :: Traversable f => (f (Attr f a) -> a) -> (Attr f a -> Maybe (f (Attr f a))) -> Attr f a -> Attr f a 
+synthTransform' calc h0 = snd . go False where
+  synth x = Fix $ Ann (calc x) x
   hsynth x = case h0 (synth x) of 
     Nothing -> Nothing
     Just y  -> Just (synth y)
@@ -363,9 +366,12 @@ -- | Bottom-up transformations to normal form (applying transformation exhaustively)
 -- which automatically resynthetise attributes in case of changes.
 synthRewrite :: Traversable f => (f a -> a) -> (Attr f a -> Maybe (f (Attr f a))) -> Attr f a -> Attr f a 
-synthRewrite calc h0 = rewrite where
+synthRewrite calc = synthRewrite' (calc . fmap attribute)
+
+synthRewrite' :: Traversable f => (f (Attr f a) -> a) -> (Attr f a -> Maybe (f (Attr f a))) -> Attr f a -> Attr f a 
+synthRewrite' calc h0 = rewrite where
   rewrite = snd . go False 
-  synth x = Fix $ Ann (calc $ fmap attribute x) x
+  synth x = Fix $ Ann (calc x) x
   hsynth x = case h0 (synth x) of 
     Nothing -> Nothing
     Just y  -> Just (synth y)

@@ -22,16 +22,9 @@ -- | The fixed-point type.
 newtype Mu f = Fix { unFix :: f (Mu f) }
 
---------------------------------------------------------------------------------
--- * Attributes
-
--- | The attribute of the root node.
-attribute :: Attr f a -> a
-attribute = attr . unFix
-  
--- | A function forgetting all the attributes from an annotated tree.
-forget :: Functor f => Attr f a -> Mu f
-forget = Fix . fmap forget . unAnn . unFix
+-- | We call a tree \"atomic\" if it has no subtrees.
+isAtom :: Foldable f => Mu f -> Bool
+isAtom = null . toList . unFix
 
 --------------------------------------------------------------------------------
 -- * Annotations
@@ -46,6 +39,10 @@ -- | Annotated fixed-point type. Equivalent to @CoFree f a@
 type Attr f a = Mu (Ann f a)
 
+-- | Lifting natural transformations to annotations.
+liftAnn :: (f e -> g e) -> Ann f a e -> Ann g a e
+liftAnn trafo (Ann a x) = Ann a (trafo x)
+
 --------------------------------------------------------------------------------
 -- * Co-annotations
 
@@ -57,6 +54,23 @@ 
 -- | Categorical dual of 'Attr'. Equivalent to @Free f a@
 type CoAttr f a = Mu (CoAnn f a)
+
+-- | Lifting natural transformations to annotations.
+liftCoAnn :: (f e -> g e) -> CoAnn f a e -> CoAnn g a e
+liftCoAnn trafo x = case x of
+  Pure  x -> Pure  x
+  CoAnn t -> CoAnn (trafo t)
+
+--------------------------------------------------------------------------------
+-- * Annotated trees
+
+-- | The attribute of the root node.
+attribute :: Attr f a -> a
+attribute = attr . unFix
+  
+-- | A function forgetting all the attributes from an annotated tree.
+forget :: Functor f => Attr f a -> Mu f
+forget = Fix . fmap forget . unAnn . unFix
 
 --------------------------------------------------------------------------------
 -- * Holes

@@ -7,12 +7,12 @@ -- children directly; this way, you can also incrementally build up a hashed tree.
 --
 module Data.Generics.Fixplate.Hash
-  ( -- * Type classes for different hash functions
-    module Data.Generics.Fixplate.Hash.Class
-    -- * Hashed tree type
-  , HashAnn(..) , getHash , unHashAnn
+  ( -- * Hashed tree type
+    HashAnn(..) , getHash , unHashAnn
   , HashMu , topHash
   , forgetHash
+    -- * Interface to the user's hash functions
+  , HashValue(..)    
     -- * Hashing tres
   , hashTree , hashTreeWith
   , hashNode , hashNodeWith
@@ -20,8 +20,10 @@ 
 --------------------------------------------------------------------------------
 
-import Data.Generics.Fixplate.Hash.Class
+-- import Data.Generics.Fixplate.Hash.Class
 
+import Prelude as Prelude
+
 import Control.Monad ( liftM )
 import Control.Applicative ( (<$>) )
 
@@ -57,24 +59,6 @@ 
 --------------------------------------------------------------------------------
 
-{-
--- | This is a newtype so that we can define the 'Hashable' instance in Haskell98.
--- With the @FlexibleInstances@ extensions, this is not necessary.
-newtype HashableHashMu hash f = HHMu { unHHMu :: HashMu hash f } deriving (Eq,Ord,Show)
-
--- | This is a rather tricky instance, in the sense that
--- 
--- > computeHash tree /= topHash tree
---
--- Actually, the above does not even type-checks... 
--- But in practice, we would use the same type for both sides, so be careful.
---
-instance HashValue hash => Hashable (HashableHashMu hash f) where
-  hashDigest t = hashDigest (topHash (unHHMu t))
--}
-
---------------------------------------------------------------------------------
-
 instance Functor f => Functor (HashAnn hash f) where
   fmap f (HashAnn attr t) = HashAnn attr (fmap f t)
 
@@ -97,7 +81,7 @@     GT -> GT
     EQ -> compareF x1 x2
 
-instance (Eq hash, ShowF f, Show hash) => ShowF (HashAnn hash f) where
+instance (ShowF f, Show hash) => ShowF (HashAnn hash f) where
   showsPrecF d (HashAnn hash x) = showParen (d>app_prec) 
     $ showString "HashAnn " 
     . showsPrec  (app_prec+1) hash 
@@ -116,10 +100,15 @@ 
 data Void = Void ; instance Show Void where show _ = "_"
 
-{-# INLINE showDigest #-}
+{-
 showDigest :: (Functor f, ShowF f, HashValue hash) => f a -> hash -> hash
 showDigest t = hashDigest $ showF (fmap (const Void) t) 
+-}
 
+{-# INLINE showDigest #-}
+showDigest :: (Functor f, ShowF f) => HashValue hash -> f a -> hash -> hash
+showDigest hashv t = _hashString hashv $ showF (fmap (const Void) t) 
+
 --------------------------------------------------------------------------------
 
 -- | This function uses the 'ShowF' instance to compute
@@ -128,23 +117,103 @@ --
 -- However, you can also supply your own hash implementation 
 -- (which can be more efficient, for example), if you use 'hashTreeWith' instead.
-hashTree :: (Foldable f, Functor f, ShowF f, HashValue hash) => Mu f -> HashMu hash f 
-hashTree = hashTreeWith showDigest
+hashTree :: (Foldable f, Functor f, ShowF f) => HashValue hash -> Mu f -> HashMu hash f 
+hashTree hashv = hashTreeWith hashv (showDigest hashv) 
 
-hashTreeWith :: (Foldable f, Functor f, HashValue hash) => (f Hole -> hash -> hash) -> Mu f -> HashMu hash f 
-hashTreeWith user = go where
-  go (Fix x) = hashNodeWith user (fmap go x)
+hashTreeWith :: (Foldable f, Functor f) => HashValue hash -> (f Hole -> hash -> hash) -> Mu f -> HashMu hash f 
+hashTreeWith hashv user = go where
+  go (Fix x) = worker (fmap go x)
+  worker = hashNodeWith hashv user
 
 --------------------------------------------------------------------------------
 
+-- | A concrete hash implementation. We don't use type classes since 
+-- 
+--  * a hash type class does not belong to this library;
+--
+--  * we don't want to restrict the user's design space
+--
+-- Thus we simulate type classes with record types.
+--
+data HashValue hash = HashValue
+  { _emptyHash  :: hash                    -- ^ the hash of an empty byte sequence
+{-
+  , _hashWord8  :: Word8  -> hash -> hash    -- ^ digest a byte
+  , _hashWord16 :: Word16 -> hash -> hash    -- ^ digest two bytes
+  , _hashWord32 :: Word32 -> hash -> hash    -- ^ digest four bytes
+  , _hashWord64 :: Word64 -> hash -> hash    -- ^ digest eight bytes
+-}
+  , _hashChar   :: Char -> hash -> hash    -- ^ digest a (unicode) character
+  , _hashHash   :: hash -> hash -> hash    -- ^ digest a hash value 
+  }
+
+{-# INLINE _hashString #-}
+_hashString :: HashValue hash -> String -> hash -> hash
+_hashString hashv xs e = Prelude.foldr f e xs where 
+  f = _hashChar hashv
+
+{-# INLINE _computeHash #-}
+_computeHash :: HashValue hash -> [hash] -> hash 
+_computeHash hashv hs = Prelude.foldr f e hs where 
+  e = _emptyHash hashv
+  f = _hashHash  hashv
+
+{- 
+
+-- | A minimal hash implementation. For efficiency reasons, we make a distinction between
+-- this and 'HashValue' (for example if a hash function can readily digest 32 bit words, 
+-- it will be probably faster than if we feed bytes to it). 
+--
+-- The function 'makeHashValue' can be used to convert between the two.
+data ByteHashValue = ByteHashValue
+  { _minEmptyHash  :: hash                     -- ^ the hash of an empty byte sequence
+  , _minHashWord8  :: Word8 -> hash -> hash    -- ^ digest a byte
+  , _minHashBytes  :: hash -> [Word8]          -- ^ convert a hash value to a sequence of bytes
+  }
+
+makeHashValue :: ByteHashValue hash -> HashValue hash
+makeHashValue (ByteHashable empty hashWord8 hashBytes) = 
+  HashValue
+    { _emptyHash  = empty
+{-
+    , _hashWord8  = hashWord8
+    , _hashWord16 = hashWord16
+    , _hashWord32 = hashWord32
+    , _hashWord64 = hashWord64
+-}  
+    , _hashChar c = hashChar c
+    , _hashHash h = foldr (.) id (map hashWord8 $ hashBytes h)
+  }
+  where
+    hashWord32 w = hashWord8 a . hashWord8 b . hashWord8 c . hashWord8 d where
+      a = fromIntegral (255 .&. (       w   ))
+      b = fromIntegral (255 .&. (shiftR w  8))
+      c = fromIntegral (255 .&. (shiftR w 16))
+      d = fromIntegral (255 .&. (shiftR w 24)) 
+    hashWord16 w = hashWord8 a . hashWord8 b where
+      a = fromIntegral (255 .&. (       w   ))
+      b = fromIntegral (255 .&. (shiftR w  8))
+    hashWord64 w = hashWord32 a . hashWord32 b where
+      a = fromIntegral (0xffffffff .&. (       w   ))
+      b = fromIntegral (0xffffffff .&. (shiftR w 32))
+
+    -- We only use the lowest 16 bits here. This is questionable,
+    -- but typical use case is ASCII, 16 bits cover a big part of Unicode, and for byte based
+    -- hashes it is twice as fast as the more correct 32 bit version would be.
+    hashChar c = hashWord16 (fromIntegral $ ord c)
+
+-}
+
+--------------------------------------------------------------------------------
+
 -- | Build a hashed node from the children.
-hashNode :: (Foldable f, Functor f, ShowF f, HashValue hash) => f (HashMu hash f) -> HashMu hash f 
-hashNode = hashNodeWith showDigest
+hashNode :: (Foldable f, Functor f, ShowF f) => HashValue hash -> f (HashMu hash f) -> HashMu hash f 
+hashNode hashv = hashNodeWith hashv (showDigest hashv) 
 
-hashNodeWith :: (Foldable f, Functor f, HashValue hash) => (f Hole -> hash -> hash) -> f (HashMu hash f) -> HashMu hash f 
-hashNodeWith user x = Fix (HashAnn h x) where
+hashNodeWith :: (Foldable f, Functor f) => HashValue hash -> (f Hole -> hash -> hash) -> f (HashMu hash f) -> HashMu hash f 
+hashNodeWith hashv user x = Fix (HashAnn h x) where
   h  = user (fmap (const Hole) x) h0
-  h0 = computeHash $ toList $ fmap (getHash . unFix) x
+  h0 = _computeHash hashv $ toList $ fmap (getHash . unFix) x
 --  h0 = foldl' (flip hashHash) emptyHash $ toList $ fmap (getHash . unFix) x
 
 --------------------------------------------------------------------------------

@@ -1,99 +0,0 @@-
--- | Haskell98 polymorphic Hash interface
-module Data.Generics.Fixplate.Hash.Class where
-
---------------------------------------------------------------------------------
-
-import Data.Char
-import Data.Word
-import Data.Int
-import Data.Bits
-import Data.List
-
---------------------------------------------------------------------------------
-
--- | A type class for hashes.
--- Minimal complete definition: 'emptyHash', 'hashWord8', 'hashHash' and 'showHex'.
-class (Eq hash, Ord hash, Hashable hash) => HashValue hash where
-
-  hashWord8  :: Word8  -> hash -> hash
-  hashWord16 :: Word16 -> hash -> hash
-  hashWord32 :: Word32 -> hash -> hash
-  hashWord64 :: Word64 -> hash -> hash
-
-  emptyHash  :: hash
-  hashHash   :: hash -> hash -> hash
-  showHex    :: hash -> String
-
-  hashWord32 w = hashWord8 a . hashWord8 b . hashWord8 c . hashWord8 d where
-    a = fromIntegral (255 .&. (       w   ))
-    b = fromIntegral (255 .&. (shiftR w  8))
-    c = fromIntegral (255 .&. (shiftR w 16))
-    d = fromIntegral (255 .&. (shiftR w 24))
- 
-  hashWord16 w = hashWord8 a . hashWord8 b where
-    a = fromIntegral (255 .&. (       w   ))
-    b = fromIntegral (255 .&. (shiftR w  8))
-
-  hashWord64 w = hashWord32 a . hashWord32 b where
-    a = fromIntegral (0xffffffff .&. (       w   ))
-    b = fromIntegral (0xffffffff .&. (shiftR w 32))
-
---------------------------------------------------------------------------------
-
--- | A type class of hashable objects. An instance has to compute the hash for
--- /any/ hash function, using the \"base\" types (eg. Word32).
---
--- Minimal complete definition: 'hashDigest'. The default for 'computeHash' is
---
--- > computeHash x = hashDigest x emptyHash
--- 
-class Hashable a where
-  hashDigest  :: HashValue hash => a -> hash -> hash
-  computeHash :: HashValue hash => a -> hash
-
-  computeHash x = hashDigest x emptyHash
-
---------------------------------------------------------------------------------
-
-instance Hashable Word8  where hashDigest = hashWord8
-instance Hashable Word16 where hashDigest = hashWord16
-instance Hashable Word32 where hashDigest = hashWord32
-instance Hashable Word64 where hashDigest = hashWord64
-
-instance Hashable Int  where hashDigest = hashInt
-instance Hashable Word where hashDigest = hashWord
-instance Hashable Bool where hashDigest = hashBool
-instance Hashable Char where hashDigest = hashChar
-
---------------------------------------------------------------------------------
-
-instance Hashable a => Hashable [a] where
-  hashDigest xs h = foldl' (flip hashDigest) h xs
-
-instance (Hashable a, Hashable b) => Hashable (a,b) where
-  hashDigest (x,y) = hashDigest y . hashDigest x
-
-instance (Hashable a, Hashable b, Hashable c) => Hashable (a,b,c) where
-  hashDigest (x,y,z) = hashDigest z . hashDigest y . hashDigest x
-
-instance (Hashable a, Hashable b, Hashable c, Hashable d) => Hashable (a,b,c,d) where
-  hashDigest (x,y,z,w) = hashDigest w . hashDigest z . hashDigest y . hashDigest x
-
-instance (Hashable a, Hashable b, Hashable c, Hashable d, Hashable e) => Hashable (a,b,c,d,e) where
-  hashDigest (x,y,z,w,u) = hashDigest u . hashDigest w . hashDigest z . hashDigest y . hashDigest x
-
---------------------------------------------------------------------------------
-
-hashInt  :: HashValue hash => Int  -> hash -> hash
-hashWord :: HashValue hash => Word -> hash -> hash
-hashBool :: HashValue hash => Bool -> hash -> hash
-hashChar :: HashValue hash => Char -> hash -> hash
-
-hashInt  k = hashWord64 (fromIntegral k)
-hashWord k = hashWord64 (fromIntegral k)
-hashBool b = hashWord8  (if b then 255 else 0)
-hashChar c = hashWord16 (fromIntegral (ord c)) 
-
---------------------------------------------------------------------------------
-

@@ -1,94 +0,0 @@---- | 32-bit FNV-1a (Fowler-Noll-Vo) hash--{-# LANGUAGE CPP #-}-module Data.Generics.Fixplate.Hash.FNV.FNV32 -  ( FNV32(..) -  , unFNV32 -  ) -  where------------------------------------------------------------------------------------import Data.Char-import Data.Word-import Data.Bits--- import Data.Int--- import Data.List--import Data.Generics.Fixplate.Hash.Class ------------------------------------------------------------------------------------newtype FNV32 = FNV32 Word32 deriving (Eq,Ord,Show)--unFNV32 :: FNV32 -> Word32-unFNV32 (FNV32 x) = x--instance Hashable FNV32 where -  hashDigest (FNV32 w) = hashDigest w--instance HashValue FNV32 where-  emptyHash = FNV32 fnv32_offset -  hashHash (FNV32 w) = hashWord32 w-  showHex  (FNV32 w) = showHex32 w-  hashWord8  x (FNV32 w) = FNV32 (fnv32_octet  x w)-  hashWord16 x (FNV32 w) = FNV32 (fnv32_word16 x w)-  hashWord32 x (FNV32 w) = FNV32 (fnv32_word32 x w)-  hashWord64 x (FNV32 w) = FNV32 (fnv32_word64 x w)------------------------------------------------------------------------------------showHex32 :: Word32 -> String-showHex32 h = reverse $ worker 8 h where-  worker :: Int -> Word32 -> String-  worker 0 0 = []-  worker 0 _ = error "Hash/FNV32/showHex: shouldn't happen"-  worker i w = hexdigit (w .&. 15) : worker (i-1) (shiftR w 4) -  hexdigit :: Word32 -> Char-  hexdigit n-    | k>=0 && k<=9   = chr (k+48)-    | otherwise      = chr (k+55)-    where k = fromIntegral n------------------------------------------------------------------------------------- FNV-1a hash--fnv32_prime, fnv32_offset :: Word32--fnv32_prime  = 16777619   -fnv32_offset = 2166136261 --fnv32_octet :: Word8 -> Word32 -> Word32-fnv32_octet octet old = fnv32_prime * (old `xor` fromIntegral octet)------------------------------------------------------------------------------------- 32 bit--fnv32_word32 :: Word32 -> Word32 -> Word32-fnv32_word32 w = fnv32_octet a . fnv32_octet b . fnv32_octet c . fnv32_octet d where-  a = fromIntegral (255 .&. (       w   ))-  b = fromIntegral (255 .&. (shiftR w  8))-  c = fromIntegral (255 .&. (shiftR w 16))-  d = fromIntegral (255 .&. (shiftR w 24))--{--fnv32_word24 :: Word32 -> Word32 -> Word32-fnv32_word24 w = fnv32_octet a . fnv32_octet b . fnv32_octet c where-  a = fromIntegral (255 .&. (       w   ))-  b = fromIntegral (255 .&. (shiftR w  8))-  c = fromIntegral (255 .&. (shiftR w 16))--}--fnv32_word16 :: Word16 -> Word32 -> Word32-fnv32_word16 w = fnv32_octet a . fnv32_octet b where-  a = fromIntegral (255 .&. (       w   ))-  b = fromIntegral (255 .&. (shiftR w  8))--fnv32_word64 :: Word64 -> Word32 -> Word32-fnv32_word64 w = fnv32_word32 a . fnv32_word32 b where-  a = fromIntegral (0xffffffff .&. (       w   ))-  b = fromIntegral (0xffffffff .&. (shiftR w 32))-----------------------------------------------------------------------------------

@@ -1,97 +0,0 @@---- | 64-bit FNV-1a (Fowler-Noll-Vo) hash--{-# LANGUAGE CPP #-}-module Data.Generics.Fixplate.Hash.FNV.FNV64 -  ( FNV64(..) -  , unFNV64-  ) -  where------------------------------------------------------------------------------------import Data.Char-import Data.Word-import Data.Bits--- import Data.Int--- import Data.List--import Data.Generics.Fixplate.Hash.Class------------------------------------------------------------------------------------instance Hashable FNV64 where -  hashDigest (FNV64 w) = hashDigest w--instance HashValue FNV64 where-  emptyHash = FNV64 fnv64_offset -  hashHash (FNV64 w) = hashWord64 w-  showHex  (FNV64 w) = showHex64 w-  hashWord8  x (FNV64 w) = FNV64 (fnv64_octet  x w)-  hashWord16 x (FNV64 w) = FNV64 (fnv64_word16 x w)-  hashWord32 x (FNV64 w) = FNV64 (fnv64_word32 x w)-  hashWord64 x (FNV64 w) = FNV64 (fnv64_word64 x w)-  -----------------------------------------------------------------------------------newtype FNV64 = FNV64 Word64 deriving (Eq,Ord,Show)--unFNV64 :: FNV64 -> Word64-unFNV64 (FNV64 x) = x------------------------------------------------------------------------------------showHex64 :: Word64 -> String-showHex64 h = reverse $ worker 16 h where-  worker :: Int -> Word64 -> String-  worker 0 0 = []-  worker 0 _ = error "Hash/FNV64/showHex: shouldn't happen"-  worker i w = hexdigit (w .&. 15) : worker (i-1) (shiftR w 4) -  hexdigit :: Word64 -> Char-  hexdigit n-    | k>=0 && k<=9   = chr (k+48)-    | otherwise      = chr (k+55)-    where k = fromIntegral n------------------------------------------------------------------------------------- FNV-1a hash--fnv64_prime, fnv64_offset :: Word64--fnv64_prime  = 1099511628211        -fnv64_offset = 14695981039346656037 --fnv64_octet :: Word8 -> Word64 -> Word64-fnv64_octet octet old = fnv64_prime * (old `xor` fromIntegral octet)------------------------------------------------------------------------------------- 64 bit--fnv64_word32 :: Word32 -> Word64 -> Word64-fnv64_word32 w = fnv64_octet a . fnv64_octet b . fnv64_octet c . fnv64_octet d where-  a = fromIntegral (255 .&. (       w   ))-  b = fromIntegral (255 .&. (shiftR w  8))-  c = fromIntegral (255 .&. (shiftR w 16))-  d = fromIntegral (255 .&. (shiftR w 24))--{--fnv64_word24 :: Word32 -> Word64 -> Word64-fnv64_word24 w = fnv64_octet a . fnv64_octet b . fnv64_octet c where-  a = fromIntegral (255 .&. (       w   ))-  b = fromIntegral (255 .&. (shiftR w  8))-  c = fromIntegral (255 .&. (shiftR w 16))--}- -fnv64_word16 :: Word16 -> Word64 -> Word64-fnv64_word16 w = fnv64_octet a . fnv64_octet b where-  a = fromIntegral (255 .&. (       w   ))-  b = fromIntegral (255 .&. (shiftR w  8))--fnv64_word64 :: Word64 -> Word64 -> Word64-fnv64_word64 w = fnv64_word32 a . fnv64_word32 b where-  a = fromIntegral (0xffffffff .&. (       w   ))-  b = fromIntegral (0xffffffff .&. (shiftR w 32))------------------------------------------------------------------------------------

@@ -1,109 +0,0 @@-
--- | Simple hash tables, implemented as @Map hash (Map key value)@.
---
--- To be Haskell98 compatible (no multi-param type classes), when constructing 
--- a new hash table, we have to support the function computing (or just fetching, if
--- it is cached) the hash value. This function is then stored in the data type.
---
-module Data.Generics.Fixplate.Hash.Table
-  ( HashTable 
-  , getHashValue , unHashTable
-    -- * Construction and deconstruction
-  , empty , singleton
-  , fromList , toList 
-  , bag
-    -- * Membership
-  , lookup , member
-    -- * Insert
-  , insert , insertWith
-  )
-  where
-
---------------------------------------------------------------------------------
-
-import Prelude hiding ( lookup )
-
-import Data.List ( foldl' )
-
-import qualified Data.Map as Map ; import Data.Map (Map) 
--- import qualified Data.Set as Set ; import Data.Set (Set) 
-
---------------------------------------------------------------------------------
--- helper functions
-
-mapInsertWith :: Ord k => (a -> v) -> (a -> v -> v) -> k -> a -> Map k v ->  Map k v
-mapInsertWith f g k x = x `seq` Map.alter worker k where
-  worker Nothing   =          Just $! (f x)
-  worker (Just y)  = y `seq` (Just $! (g x y))
-
-mapIsSingleton :: Map k v -> Maybe (k,v)
-mapIsSingleton table = if Map.size table == 1 
-  then let [(k,v)] = Map.toList table in Just (k,v)
-  else Nothing
-
-mapIsSingleton_ :: Map k v -> Maybe v
-mapIsSingleton_ table = if Map.size table == 1 
-  then let [(_,v)] = Map.toList table in Just v
-  else Nothing
-
---------------------------------------------------------------------------------
-
---newtype HashTable hash k v = HashTable { unHashTable :: Map hash (Map k v) }
-
-data HashTable hash k v = HashTable 
-  { getHashValue :: k -> hash
-  , unHashTable  :: Map hash (Map k v) 
-  }
-
-empty :: (Ord hash, Ord k) => (k -> hash) -> HashTable hash k v
-empty gethash = HashTable gethash (Map.empty)
-
-singleton :: (Ord hash, Ord k) => (k -> hash) -> k -> v -> HashTable hash k v
-singleton gethash k v = HashTable gethash $ Map.singleton h (Map.singleton k v) where
-  h = gethash k
-
-fromList :: (Ord hash, Ord k) => (k -> hash) -> [(k,v)] -> HashTable hash k v
-fromList gethash = foldl' (\old (k,v) -> insert k v old) (empty gethash)
-
-toList :: Ord k => HashTable hash k v -> [(k,v)]
-toList (HashTable _ table) = concat [ Map.toList sub | sub <- Map.elems table ]
-
---------------------------------------------------------------------------------
-
-lookup :: (Ord hash, Ord k) => k -> HashTable hash k v -> Maybe v
-lookup key (HashTable gethash table) = 
-  case Map.lookup h table of
-    Just sub -> case mapIsSingleton_ sub of
-      Just v  -> Just v
-      Nothing -> Map.lookup key sub
-    Nothing  -> Nothing      
-  where
-    h = gethash key
-
-member :: (Ord hash, Ord k) => k -> HashTable hash k v -> Bool
-member key table = case lookup key table of
-  Just _  -> True
-  Nothing -> False
-
---------------------------------------------------------------------------------
-
-insert :: (Ord hash, Ord k) => k -> v -> HashTable hash k v -> HashTable hash k v
-insert k v (HashTable gethash table) = HashTable gethash $ mapInsertWith f g h v table where
-  h = gethash k
-  f v     = Map.singleton k v
-  g v sub = Map.insert    k v sub
-
-insertWith :: (Ord hash, Ord k) => (a -> v) -> (a -> v -> v) -> k -> a -> HashTable hash k v -> HashTable hash k v
-insertWith ff gg k x (HashTable gethash table) = HashTable gethash $ mapInsertWith f g h x table where
-  h = gethash k
-  f x     = Map.singleton k (ff x)
-  g x sub = mapInsertWith ff gg k x sub
-
---------------------------------------------------------------------------------
-
--- | Creates a multi-set from a list.
-bag :: (Ord hash, Ord k) => (k -> hash) -> [k] -> HashTable hash k Int
-bag gethash = foldl' (\old k -> insertWith id (+) k 1 old) (empty gethash)
-
---------------------------------------------------------------------------------
-

@@ -5,7 +5,12 @@ --------------------------------------------------------------------------------
 
 import Prelude hiding (mapM,mapM_)
+
+import Data.List ( sortBy , groupBy )
+import Data.Ord
+
 import Data.Traversable
+
 --import Control.Monad (liftM)
 --import Control.Monad.Trans.State
 
@@ -22,6 +27,21 @@   |  First a
   |  Both  a b
   deriving Show
+
+--------------------------------------------------------------------------------
+
+equating :: Eq b => (a -> b) -> a -> a -> Bool
+equating f x y = f x == f y
+
+groupSortOn :: Ord b => (a -> b) -> [a] -> [[a]]
+groupSortOn f xs = groupBy (equating f) $ sortBy (comparing f) xs
+
+mapGroupSortOn :: Ord b => (a -> b) -> (a -> c) -> [a] -> [(b,[c])]
+mapGroupSortOn f g = mapGroupSortOn' f (map g)
+
+mapGroupSortOn' :: Ord b => (a -> b) -> ([a] -> c) -> [a] -> [(b,c)]
+mapGroupSortOn' f g xs = map h $ groupBy (equating f) $ sortBy (comparing f) xs where
+  h ys = (f (head ys), g ys)
 
 --------------------------------------------------------------------------------
 

@@ -15,7 +15,7 @@ import Data.Char ( ord )
 import Data.List ( intercalate )
 import Test.QuickCheck
-import Data.Generics.Fixplate.Traversals
+-- import Data.Generics.Fixplate.Traversals
 import Data.Generics.Fixplate.Test.Tools
 #endif 
 

@@ -1,53 +0,0 @@--{-# LANGUAGE CPP, Rank2Types #-}---- it seems that older GHCs do not like multiple LANGUAGE pragmas?--- {- LANGUAGE CPP -}--- ifdef __GLASGOW_HASKELL__--- {- LANGUAGE Rank2Types -}--- endif---- | Changing the structure of a tree.-module Data.Generics.Fixplate.Structure -  ( NatTrafo-  , restructure-  , liftAnn-  )-  where-  -----------------------------------------------------------------------------------import Data.Generics.Fixplate.Base-------------------------------------------------------------------------------------- #ifdef __GLASGOW_HASKELL__---- | The type of natural transformations.-type NatTrafo f g = forall a. (f a -> g a)---- | Changing the structure of a tree.-restructure :: Functor f => NatTrafo f g -> Mu f -> Mu g-restructure trafo = go where-  go = Fix . trafo . fmap go . unFix---- #else  --{--data NatTrafo f g = NatTrafo (f Int) (g Int)   -- fake and opaque data type---- | Unfortunately, this function requires Rank2Types,--- thus we only provide it for GHC.-restructure :: Functor f => NatTrafo f g -> Mu f -> Mu g-restructure = error "restructure: this operation requires Rank2Types"--}---- #endif-  ------------------------------------------------------------------------------------- | Lifting natural transformations to annotations.-liftAnn :: (f e -> g e) -> Ann f a e -> Ann g a e-liftAnn trafo (Ann a x) = Ann a (trafo x)----------------------------------------------------------------------------------

@@ -1,5 +1,6 @@ 
 -- | Run all the tests
+{-# LANGUAGE CPP #-}
 module Data.Generics.Fixplate.Tests where
   
 --------------------------------------------------------------------------------
@@ -9,13 +10,17 @@ import Data.Generics.Fixplate.Morphisms
 import Data.Generics.Fixplate.Attributes
 import Data.Generics.Fixplate.Zipper
-import Data.Generics.Fixplate.Structure  
+import Data.Generics.Fixplate.Trie
 
 import Data.Generics.Fixplate.Test.Tools
 import Data.Generics.Fixplate.Test.Instances
 
 import Test.QuickCheck
 
+#ifdef WITH_UTILITY_MODULES
+import Data.Generics.Fixplate.Util.Hash.Table
+#endif
+
 --------------------------------------------------------------------------------
 
 run_all_tests :: IO ()
@@ -27,5 +32,9 @@   putStrLn "tests for Attributes..."      ; runtests_Attributes
   putStrLn "tests for zippers..."         ; runtests_Zipper
   putStrLn "tests for morphisms..."       ; runtests_Morphisms
+  putStrLn "tests for tries..."           ; runtests_Trie
+#ifdef WITH_UTILITY_MODULES
+  putStrLn "tests for hash tables..."     ; runtests_HashTable
+#endif
 
 --------------------------------------------------------------------------------

@@ -1,5 +1,28 @@ 
 -- | Uniplate-style traversals.
+--
+-- Toy example: Consider our favourite data type
+--
+-- > data Expr e 
+-- >   = Kst Int 
+-- >   | Var String 
+-- >   | Add e e 
+-- >   deriving (Eq,Show,Functor,Foldable,Traversable)
+-- >
+-- > instance ShowF Expr where showsPrecF = showsPrec
+--
+-- and write a function simplifying additions with zero:
+--
+-- > simplifyAdd :: Mu Expr -> Mu Expr
+-- > simplifyAdd = transform worker where
+-- >   worker expr = case expr of
+-- >     Fix (Add x (Fix (Kst 0))) -> x    -- 0+x = x
+-- >     Fix (Add (Fix (Kst 0)) y) -> y    -- x+0 = 0
+-- >     _ -> expr
+--
+-- Unfortunately, all these 'Fix' wrappers are rather ugly; but they are straightforward to put in,
+-- and in principle one could use Template Haskell quasi-quotation to generate patterns.
+--
 
 {-# LANGUAGE CPP #-}
 module Data.Generics.Fixplate.Traversals where
@@ -63,10 +86,11 @@     Fix y <- h x
     liftM Fix (mapM go y)
   
--- | Non-recursive top-down transformation.
+-- | Non-recursive top-down transformation. This is basically just 'fmap'.
 descend :: Functor f => (Mu f -> Mu f) -> Mu f -> Mu f 
 descend h = Fix . fmap h . unFix
 
+-- | Similarly, this is basically just 'mapM'.
 descendM :: (Traversable f, Monad m) => (Mu f -> m (Mu f)) -> Mu f -> m (Mu f)
 descendM action = liftM Fix . mapM action . unFix
 
@@ -78,7 +102,22 @@ rewriteM :: (Traversable f, Monad m) => (Mu f -> m (Maybe (Mu f))) -> Mu f -> m (Mu f)
 rewriteM h = transformM g where 
   g x = h x >>= \y -> maybe (return x) (rewriteM h) y
+
+--------------------------------------------------------------------------------
+-- * Structure change
   
+-- | Bottom-up transformation (typically \"shallow\", that is, restricted to a single level) 
+-- which can change the structure functor (actually 'transform' is a special case of this).
+restructure :: Functor f => (f (Mu g) -> g (Mu g)) -> Mu f -> Mu g
+restructure h = go where 
+  go = Fix . h . fmap go . unFix
+
+restructureM :: (Traversable f, Monad m) => (f (Mu g) -> m (g (Mu g))) -> Mu f -> m (Mu g)
+restructureM action = go where 
+  go (Fix x) = do 
+    y <- mapM go x
+    liftM Fix (action y)
+
 --------------------------------------------------------------------------------
 -- * Context
 

@@ -0,0 +1,477 @@+
+-- | Generalized tries. \"Normal\" tries encode finite maps from lists to arbitrary values, where the
+-- common prefixes are shared. Here we do the same for trees, generically.
+--
+-- See also
+--
+-- * Connelly, Morris: A generalization of the trie data structure
+--
+-- * Ralf Hinze: Generalizing Generalized Tries
+--
+-- This module should be imported qualified.
+--
+
+{-# LANGUAGE CPP #-}
+module Data.Generics.Fixplate.Trie 
+  ( Trie 
+    -- * Construction \/ deconstruction
+  , empty , singleton
+  , fromList , toList
+  , bag , universeBag
+    -- * Lookup
+  , lookup 
+    -- * Insertion \/ deletion
+  , insert , insertWith
+  , delete , update
+    -- * Set operations
+  , intersection , intersectionWith
+  , union        , unionWith
+  , difference   , differenceWith
+#ifdef WITH_QUICKCHECK
+    -- * Tests
+  , runtests_Trie
+#endif
+  ) 
+  where
+
+---------------------------------------------------------------------------------
+
+import Prelude hiding ( lookup )
+
+import Data.Generics.Fixplate.Base
+import Data.Generics.Fixplate.Open hiding ( toList )
+import Data.Generics.Fixplate.Traversals ( universe )
+
+import qualified Data.Foldable as Foldable
+import Data.Foldable hiding ( toList )
+
+import Data.Traversable as Traversable
+
+import qualified Data.Map as Map ; import Data.Map (Map)
+
+#ifdef WITH_QUICKCHECK
+import Test.QuickCheck
+import Data.Generics.Fixplate.Test.Tools
+import Data.Generics.Fixplate.Misc
+import Data.List ( sort , group , nubBy , nub , (\\) , foldl' )
+import Control.Applicative ( (<$>) )
+import Debug.Trace
+#endif
+
+---------------------------------------------------------------------------------
+
+-- | Creates a trie-multiset from a list of trees.
+bag :: (Functor f, Foldable f, OrdF f) => [Mu f] -> Trie f Int
+bag ts = Prelude.foldl worker emptyTrie ts where
+  worker trie tree = trieInsertWith id (+) tree 1 trie
+
+-- | This is equivalent to
+--
+-- > universeBag == bag . universe
+--
+-- TODO: more efficient implementation?
+universeBag :: (Functor f, Foldable f, OrdF f) => Mu f -> Trie f Int
+universeBag = bag . universe
+
+---------------------------------------------------------------------------------
+
+empty :: (Functor f, Foldable f, OrdF f) => Trie f a 
+empty = emptyTrie 
+
+singleton :: (Functor f, Foldable f, OrdF f) => Mu f -> a -> Trie f a 
+singleton = trieSingleton
+
+lookup :: (Functor f, Foldable f, OrdF f) => Mu f -> Trie f a -> Maybe a
+lookup = trieLookup 
+
+insert :: (Functor f, Foldable f, OrdF f) => Mu f -> a -> Trie f a -> Trie f a
+insert = trieInsertWith id const
+
+insertWith :: (Functor f, Foldable f, OrdF f) => (a -> b) -> (a -> b -> b) -> Mu f -> a -> Trie f b -> Trie f b
+insertWith = trieInsertWith
+
+update :: (Functor f, Foldable f, OrdF f) => (a -> Maybe a) -> Mu f -> Trie f a -> Trie f a
+update = trieUpdate
+
+delete :: (Functor f, Foldable f, OrdF f) => Mu f -> Trie f a -> Trie f a
+delete = trieUpdate (const Nothing)
+
+-- | TODO: more efficient implementation?
+fromList :: (Traversable f, OrdF f) => [(Mu f, a)] -> Trie f a
+fromList ts = Prelude.foldl worker emptyTrie ts where
+  worker trie (tree,value) = trieInsertWith id const tree value trie 
+
+toList :: (Traversable f, OrdF f) => Trie f a -> [(Mu f, a)] 
+toList = trieToList
+
+intersection :: (Functor f, Foldable f, OrdF f) => Trie f a -> Trie f b -> Trie f a
+intersection = trieIntersectionWith const
+
+intersectionWith :: (Functor f, Foldable f, OrdF f) => (a -> b -> c) -> Trie f a -> Trie f b -> Trie f c
+intersectionWith = trieIntersectionWith
+
+-- | Union is left-biased:
+--
+-- > union == unionWith const
+--
+union :: (Functor f, Foldable f, OrdF f) => Trie f a -> Trie f a -> Trie f a
+union = trieUnionWith const
+
+unionWith :: (Functor f, Foldable f, OrdF f) => (a -> a -> a) -> Trie f a -> Trie f a -> Trie f a
+unionWith = trieUnionWith
+
+difference :: (Functor f, Foldable f, OrdF f) => Trie f a -> Trie f b -> Trie f a
+difference = trieDifferenceWith (\_ _ -> Nothing)
+
+differenceWith :: (Functor f, Foldable f, OrdF f) => (a -> b -> Maybe a) -> Trie f a -> Trie f b -> Trie f a
+differenceWith = trieDifferenceWith
+
+---------------------------------------------------------------------------------
+
+-- | 'Trie' is an efficient(?) implementation of finite maps from @(Mu f)@ to an arbitrary type @v@.
+newtype Trie f v = Trie { unTrie :: Map (HoleF f) (Chain f v) }
+
+data Chain f v
+  = Value v
+  | Chain (Trie f (Chain f v))
+
+-- this is only to be able to define an Ord instance
+newtype HoleF f = HoleF { unHoleF :: f Hole }
+
+instance EqF  f => Eq  (HoleF f) where (==)    (HoleF x) (HoleF y) = equalF   x y
+instance OrdF f => Ord (HoleF f) where compare (HoleF x) (HoleF y) = compareF x y
+
+emptyTrie :: (Functor f, Foldable f, OrdF f) => Trie f v 
+emptyTrie = Trie (Map.empty)
+
+---------------------------------------------------------------------------------
+
+trieLookup :: (Functor f, Foldable f, OrdF f) => Mu f -> Trie f v -> Maybe v
+trieLookup (Fix t) (Trie trie) = 
+  case Map.lookup (HoleF s) trie of
+    Nothing    -> Nothing
+    Just chain -> chainLookup (Foldable.toList t) chain
+  where
+    s = fmap (const Hole) t
+
+chainLookup :: (Functor f, Foldable f, OrdF f) => [Mu f] -> Chain f v -> Maybe v
+chainLookup [] chain = case chain of { Value x -> Just x ; _ -> error "chainLookup: shouldn't happen #1" }
+chainLookup (k:ks) chain = case chain of
+  Chain sub -> case trieLookup k sub of
+    Just chain -> chainLookup ks chain
+    Nothing    -> Nothing
+  Value  _  -> error "chainLookup: shouldn't happen #2"
+
+---------------------------------------------------------------------------------
+
+chainSingleton :: (Functor f, Foldable f, OrdF f) => [Mu f] -> a -> Chain f a
+chainSingleton trees x = go trees where
+  go [] = Value x
+  go (t:ts) = Chain (trieSingleton t (go ts))
+
+trieSingleton :: (Functor f, Foldable f, OrdF f) => Mu f -> a -> Trie f a 
+trieSingleton (Fix t) x = Trie $ Map.singleton (HoleF s) (chainSingleton (Foldable.toList t) x) where
+  s = fmap (const Hole) t
+
+---------------------------------------------------------------------------------
+
+mapInsertWith :: Ord k => (a -> v) -> (a -> v -> v) -> k -> a -> Map k v ->  Map k v
+mapInsertWith f g k x = x `seq` Map.alter worker k where
+  worker Nothing   =          Just $! (f x)
+  worker (Just y)  = y `seq` (Just $! (g x y))
+
+trieInsertWith :: (Functor f, Foldable f, OrdF f) => (a -> b) -> (a -> b -> b) -> Mu f -> a -> Trie f b -> Trie f b
+trieInsertWith uf ug (Fix t) value (Trie trie) = Trie $ mapInsertWith wf wg (HoleF s) value trie where
+  wf z       = chainSingleton (Foldable.toList t) (uf z)
+  wg z chain = chainInsertWith uf ug (Foldable.toList t) z chain
+  s = fmap (const Hole) t
+
+chainInsertWith :: (Functor f, Foldable f, OrdF f) => (a -> b) -> (a -> b -> b) -> [Mu f] -> a -> Chain f b -> Chain f b
+chainInsertWith uf ug trees x chain = go trees chain where
+  go ts chn = case ts of
+    [] -> case chn of
+      Value y -> Value (ug x y)
+      Chain _ -> error "chainInsertWith: shouldn't happen #1" 
+    (t:ts) -> case chn of
+      Chain trie -> Chain $ trieInsertWith wf wg t x trie where
+        wf z   = chainSingleton ts (uf z)
+        wg z c = chainInsertWith uf ug ts z c
+      Value _    -> error "chainInsertWith: shouldn't happen #2" 
+
+---------------------------------------------------------------------------------
+
+trieUpdate :: (Functor f, Foldable f, OrdF f) => (a -> Maybe a) -> Mu f -> Trie f a -> Trie f a
+trieUpdate user (Fix t) (Trie trie) = Trie $ Map.update worker (HoleF s) trie where  
+  worker chain = chainUpdate user (Foldable.toList t) chain    
+  s = fmap (const Hole) t
+
+chainUpdate :: (Functor f, Foldable f, OrdF f) => (a -> Maybe a) -> [Mu f] -> Chain f a -> Maybe (Chain f a)
+chainUpdate user = go where
+  go trees chain = case trees of
+    [] -> case chain of 
+      Value x -> case user x of
+        Just y  -> Just (Value y)
+        Nothing -> Nothing
+      Chain _ -> error "chainUpdate: shouldn't happen #1" 
+    (t:ts) -> case chain of
+      Chain trie -> Just $ Chain $ trieUpdate (go ts) t trie
+      Value _    -> error "chainInsertWith: shouldn't happen #2" 
+
+---------------------------------------------------------------------------------
+
+trieToList :: (Traversable f, OrdF f) => Trie f a -> [(Mu f, a)] 
+trieToList (Trie trie) = 
+  [ (Fix (builder key ts), val)  
+  | (HoleF key, chain) <- Map.toList trie
+  , (ts, val) <- chainToList chain 
+  ]
+
+chainToList :: (Traversable f, OrdF f) => Chain f a -> [([Mu f], a)] 
+chainToList = go where
+  go chain = case chain of
+    Value x    -> [([],x)]
+    Chain trie -> 
+      [ (t:ts, val)
+      | (t ,ch ) <- trieToList trie 
+      , (ts,val) <- go ch
+      ]
+
+---------------------------------------------------------------------------------
+
+chainIntersectionWith :: (Functor f, Foldable f, OrdF f) => (a -> b -> c) -> Chain f a -> Chain f b -> Chain f c
+chainIntersectionWith f (Value x ) (Value y ) = Value (f x y)
+chainIntersectionWith f (Chain t1) (Chain t2) = Chain (trieIntersectionWith (chainIntersectionWith f) t1 t2)
+chainIntersectionWith _ _ _ = error "chainIntersectionWith: shouldn't happen"
+
+trieIntersectionWith :: (Functor f, Foldable f, OrdF f) => (a -> b -> c) -> Trie f a -> Trie f b -> Trie f c
+trieIntersectionWith f (Trie trie1) (Trie trie2) = Trie (Map.intersectionWith worker trie1 trie2) where
+  worker chain1 chain2 = chainIntersectionWith f chain1 chain2
+
+---------------------------------------------------------------------------------
+
+chainUnionWith :: (Functor f, Foldable f, OrdF f) => (a -> a -> a) -> Chain f a -> Chain f a -> Chain f a
+chainUnionWith f (Value x ) (Value y ) = Value (f x y)
+chainUnionWith f (Chain t1) (Chain t2) = Chain (trieUnionWith (chainUnionWith f) t1 t2)
+chainUnionWith _ _ _ = error "chainUnionWith: shouldn't happen"
+
+trieUnionWith :: (Functor f, Foldable f, OrdF f) => (a -> a -> a) -> Trie f a -> Trie f a -> Trie f a
+trieUnionWith f (Trie trie1) (Trie trie2) = Trie (Map.unionWith worker trie1 trie2) where
+  worker chain1 chain2 = chainUnionWith f chain1 chain2
+
+---------------------------------------------------------------------------------
+
+chainDifferenceWith :: (Functor f, Foldable f, OrdF f) => (a -> b -> Maybe a) -> Chain f a -> Chain f b -> Maybe (Chain f a)
+chainDifferenceWith f (Value x ) (Value y ) = case f x y of 
+  Just z  -> Just (Value z)
+  Nothing -> Nothing
+chainDifferenceWith f (Chain t1) (Chain t2) = Just $ Chain (trieDifferenceWith (chainDifferenceWith f) t1 t2)
+chainDifferenceWith _ _ _ = error "chainDifferenceWith: shouldn't happen"
+
+trieDifferenceWith :: (Functor f, Foldable f, OrdF f) => (a -> b -> Maybe a) -> Trie f a -> Trie f b -> Trie f a
+trieDifferenceWith f (Trie trie1) (Trie trie2) = Trie (Map.differenceWith worker trie1 trie2) where
+  worker chain1 chain2 = chainDifferenceWith f chain1 chain2
+
+---------------------------------------------------------------------------------
+-- Tests
+
+#ifdef WITH_QUICKCHECK
+
+runtests_Trie :: IO ()
+runtests_Trie = do
+  quickCheck prop_difference
+  quickCheck prop_differenceWith
+  quickCheck prop_union
+  quickCheck prop_intersection
+
+  quickCheck prop_unibag_naive
+  quickCheck prop_fromList_naive
+  quickCheck prop_bag
+  quickCheck prop_bag_b
+  quickCheck prop_fromList_toList
+  quickCheck prop_multiSetToList_b
+  quickCheck prop_insert
+  quickCheck prop_delete
+  quickCheck prop_update
+  quickCheck prop_insert_delete
+  quickCheck prop_delete_insert
+  quickCheck prop_lookup
+  quickCheck prop_lookup_notfound
+  quickCheck prop_singleton
+
+--------------------
+
+newtype Multiplicity = Multiplicity { unMultiplicity :: Int } deriving (Eq,Ord,Show)
+
+instance Arbitrary Multiplicity where
+  arbitrary = do
+    n <- choose (1, 7)
+    return (Multiplicity n)
+
+newtype MultiSet = MultiSet { unMultiSet :: [(Multiplicity, FixT Label)] } deriving (Eq,Ord,Show)
+
+instance Arbitrary MultiSet where arbitrary = MultiSet <$> arbitrary
+
+multiSetToList :: MultiSet -> [FixT Label]
+multiSetToList (MultiSet mxs) = go mxs where
+  go [] = []
+  go ((Multiplicity n, x):rest) = replicate n x ++ go rest
+
+multiSetToList_b :: MultiSet -> [FixT Label]
+multiSetToList_b (MultiSet mxs) = go mxs [] where
+  go [] [] = []
+  go [] ys = go ys []
+  go ((Multiplicity n, x):rest) ys = if n>0 
+    then x : go rest ( (Multiplicity (n-1), x) : ys )
+    else go rest ys
+
+newtype FiniteMap = FiniteMap { unFiniteMap :: [(FixT Label,Char)] } deriving (Eq,Ord,Show)
+
+instance Arbitrary FiniteMap where arbitrary = (FiniteMap . nubBy (equating fst)) <$> arbitrary
+
+type TrieT = Trie (TreeF Label) Char
+
+finiteMap :: FiniteMap -> TrieT
+finiteMap (FiniteMap fmap) = fromList fmap
+
+--------------------
+
+fromListNaive :: (Traversable f, OrdF f) => [(Mu f, a)] -> Trie f a
+fromListNaive ts = Prelude.foldl worker emptyTrie ts where
+  worker trie (tree,value) = trieInsertWith id const tree value trie 
+
+universeBagNaive :: (Functor f, Foldable f, OrdF f) => Mu f -> Trie f Int
+universeBagNaive = bag . universe
+
+mapBag :: Ord a => [a] -> Map a Int
+mapBag xs = Data.List.foldl' f Map.empty xs where
+  f old x = Map.insertWith (+) x 1 old
+
+--------------------
+    
+prop_unibag_naive :: FixT Label -> Bool
+prop_unibag_naive tree = toList (universeBag tree) == toList (universeBagNaive tree)
+
+prop_fromList_naive :: FiniteMap -> Bool
+prop_fromList_naive (FiniteMap list) = toList (fromList list) == toList (fromListNaive list)
+
+prop_bag :: MultiSet -> Bool
+prop_bag mset = (sort $ toList $ bag $ multiSetToList mset) == sort (map f $ unMultiSet mset) where
+  f (Multiplicity k, x) = (x,k)
+
+prop_bag_b :: MultiSet -> Bool
+prop_bag_b mset = (sort $ toList $ bag $ multiSetToList_b mset) == sort (map f $ unMultiSet mset) where
+  f (Multiplicity k, x) = (x,k)
+
+prop_fromList_toList :: FiniteMap -> Bool
+prop_fromList_toList (FiniteMap list) = sort (toList (fromList list)) == sort list
+
+prop_multiSetToList_b :: MultiSet -> Bool
+prop_multiSetToList_b mset = toList (bag (multiSetToList mset)) == toList (bag (multiSetToList_b mset)) 
+
+prop_insert :: FixT Label -> Char -> FiniteMap -> Bool
+prop_insert key ch (FiniteMap list) = sort (toList (insert key ch trie)) == sort ((key,ch) : toList trie) where
+  trie = fromList list
+
+prop_delete :: Int -> FiniteMap -> Bool
+prop_delete i (FiniteMap list) = (n==0) || (toList (delete key trie) == toList trie \\ [(key,value)]) where
+  trie = fromList list
+  n = length list
+  k = mod i n
+  (key,value) = list!!k
+
+prop_update :: Char -> Int -> FiniteMap -> Bool
+prop_update new i (FiniteMap list) = (n==0) || (toList (update f key trie) == replace (toList trie)) where
+  trie = fromList list
+  n = length list
+  k = mod i n
+  (key,value) = list!!k
+  replace [] = []
+  replace (this@(k,x):rest) = if k==key 
+    then case f x of 
+      Nothing -> rest
+      Just y  -> (k,y) : replace rest
+    else this : replace rest    
+  f old = if old < 'A' then Nothing else Just new
+
+prop_insert_delete :: FixT Label -> Char -> FiniteMap -> Bool
+prop_insert_delete key ch (FiniteMap list) = toList (delete key (insert key ch trie)) == toList trie where
+  trie = delete key (fromList list)   -- !
+
+prop_delete_insert :: Int -> FiniteMap -> Bool
+prop_delete_insert i (FiniteMap list) = (n==0) || (toList (insert key value (delete key trie)) == toList trie) where
+  trie = fromList list
+  n = length list
+  k = mod i n
+  (key,value) = list!!k
+
+prop_lookup :: Int -> FiniteMap -> Bool
+prop_lookup i (FiniteMap list) = (n==0) || (Just value == lookup key trie) where
+  trie = fromList list
+  n = length list
+  k = mod i n
+  (key,value) = list!!k
+
+prop_lookup_notfound :: FixT Label -> FiniteMap -> Bool
+prop_lookup_notfound key (FiniteMap list) = lookup key trie == Nothing where
+  trie = delete key (fromList list)   -- !#endif
+
+prop_singleton :: FixT Label -> Char -> Bool
+prop_singleton tree ch = toList (singleton tree ch) == [(tree,ch)]
+
+prop_intersection :: MultiSet -> Bool
+prop_intersection mset = {- trace ("--"++show n++"--") -} (itrie == imap) where
+
+  list = multiSetToList_b mset
+  n = length list
+  k = div n 3
+  l = div (2*n) 3
+  xs = take l list
+  ys = drop k list
+
+  itrie = sort $     toList $     intersectionWith (+) (   bag xs) (   bag ys)
+  imap  = sort $ Map.toList $ Map.intersectionWith (+) (mapBag xs) (mapBag ys) 
+
+prop_union :: MultiSet -> Bool
+prop_union mset = {- trace ("--"++show n++"--") -} (utrie == umap) where
+
+  list = multiSetToList_b mset
+  n = length list
+  k = div n 3
+  l = div (2*n) 3
+  xs = take l list
+  ys = drop k list
+
+  utrie = sort $     toList $     unionWith (+) (   bag xs) (   bag ys)
+  umap  = sort $ Map.toList $ Map.unionWith (+) (mapBag xs) (mapBag ys) 
+
+prop_difference :: MultiSet -> Bool
+prop_difference mset = {- trace ("--"++show [length xs , length ys, length dtrie]++"--") -} (dtrie == dmap) where
+
+  list = multiSetToList_b mset
+  n = length list
+  k = div n 3
+  l = div (2*n) 3
+  xs = take l list
+  ys = drop k list
+
+  dtrie = sort $     toList $     difference (   bag xs) (   bag ys)
+  dmap  = sort $ Map.toList $ Map.difference (mapBag xs) (mapBag ys) 
+
+prop_differenceWith :: MultiSet -> Bool
+prop_differenceWith mset = {- trace ("--"++show [length xs , length ys, length dtrie]++"--") -} (dtrie == dmap) where
+
+  list = multiSetToList_b mset
+  n = length list
+  k = div n 3
+  l = div (2*n) 3
+  xs = take l list
+  ys = drop k list
+
+  f x y = if y<=2 then Just (x+1) else Nothing
+
+  dtrie = sort $     toList $     differenceWith f (   bag xs) (   bag ys)
+  dmap  = sort $ Map.toList $ Map.differenceWith f (mapBag xs) (mapBag ys) 
+
+#endif
+
+---------------------------------------------------------------------------------

@@ -0,0 +1,99 @@+
+-- | Haskell98 polymorphic Hash interface
+module Data.Generics.Fixplate.Util.Hash.Class where
+
+--------------------------------------------------------------------------------
+
+import Data.Char
+import Data.Word
+import Data.Int
+import Data.Bits
+import Data.List
+
+--------------------------------------------------------------------------------
+
+-- | A type class for hashes.
+-- Minimal complete definition: 'emptyHash', 'hashWord8', 'hashHash' and 'showHex'.
+class (Eq hash, Ord hash, Hashable hash) => HashValue hash where
+
+  hashWord8  :: Word8  -> hash -> hash
+  hashWord16 :: Word16 -> hash -> hash
+  hashWord32 :: Word32 -> hash -> hash
+  hashWord64 :: Word64 -> hash -> hash
+
+  emptyHash  :: hash
+  hashHash   :: hash -> hash -> hash
+  showHex    :: hash -> String
+
+  hashWord32 w = hashWord8 a . hashWord8 b . hashWord8 c . hashWord8 d where
+    a = fromIntegral (255 .&. (       w   ))
+    b = fromIntegral (255 .&. (shiftR w  8))
+    c = fromIntegral (255 .&. (shiftR w 16))
+    d = fromIntegral (255 .&. (shiftR w 24))
+ 
+  hashWord16 w = hashWord8 a . hashWord8 b where
+    a = fromIntegral (255 .&. (       w   ))
+    b = fromIntegral (255 .&. (shiftR w  8))
+
+  hashWord64 w = hashWord32 a . hashWord32 b where
+    a = fromIntegral (0xffffffff .&. (       w   ))
+    b = fromIntegral (0xffffffff .&. (shiftR w 32))
+
+--------------------------------------------------------------------------------
+
+-- | A type class of hashable objects. An instance has to compute the hash for
+-- /any/ hash function, using the \"base\" types (eg. Word32).
+--
+-- Minimal complete definition: 'hashDigest'. The default for 'computeHash' is
+--
+-- > computeHash x = hashDigest x emptyHash
+-- 
+class Hashable a where
+  hashDigest  :: HashValue hash => a -> hash -> hash
+  computeHash :: HashValue hash => a -> hash
+
+  computeHash x = hashDigest x emptyHash
+
+--------------------------------------------------------------------------------
+
+instance Hashable Word8  where hashDigest = hashWord8
+instance Hashable Word16 where hashDigest = hashWord16
+instance Hashable Word32 where hashDigest = hashWord32
+instance Hashable Word64 where hashDigest = hashWord64
+
+instance Hashable Int  where hashDigest = hashInt
+instance Hashable Word where hashDigest = hashWord
+instance Hashable Bool where hashDigest = hashBool
+instance Hashable Char where hashDigest = hashChar
+
+--------------------------------------------------------------------------------
+
+instance Hashable a => Hashable [a] where
+  hashDigest xs h = foldl' (flip hashDigest) h xs
+
+instance (Hashable a, Hashable b) => Hashable (a,b) where
+  hashDigest (x,y) = hashDigest y . hashDigest x
+
+instance (Hashable a, Hashable b, Hashable c) => Hashable (a,b,c) where
+  hashDigest (x,y,z) = hashDigest z . hashDigest y . hashDigest x
+
+instance (Hashable a, Hashable b, Hashable c, Hashable d) => Hashable (a,b,c,d) where
+  hashDigest (x,y,z,w) = hashDigest w . hashDigest z . hashDigest y . hashDigest x
+
+instance (Hashable a, Hashable b, Hashable c, Hashable d, Hashable e) => Hashable (a,b,c,d,e) where
+  hashDigest (x,y,z,w,u) = hashDigest u . hashDigest w . hashDigest z . hashDigest y . hashDigest x
+
+--------------------------------------------------------------------------------
+
+hashInt  :: HashValue hash => Int  -> hash -> hash
+hashWord :: HashValue hash => Word -> hash -> hash
+hashBool :: HashValue hash => Bool -> hash -> hash
+hashChar :: HashValue hash => Char -> hash -> hash
+
+hashInt  k = hashWord64 (fromIntegral k)
+hashWord k = hashWord64 (fromIntegral k)
+hashBool b = hashWord8  (if b then 255 else 0)
+hashChar c = hashWord16 (fromIntegral (ord c)) 
+
+--------------------------------------------------------------------------------
+

@@ -0,0 +1,94 @@++-- | 32-bit FNV-1a (Fowler-Noll-Vo) hash++{-# LANGUAGE CPP #-}+module Data.Generics.Fixplate.Util.Hash.FNV.FNV32 +  ( FNV32(..) +  , unFNV32 +  ) +  where++--------------------------------------------------------------------------------++import Data.Char+import Data.Word+import Data.Bits+-- import Data.Int+-- import Data.List++import Data.Generics.Fixplate.Util.Hash.Class ++--------------------------------------------------------------------------------++newtype FNV32 = FNV32 Word32 deriving (Eq,Ord,Show)++unFNV32 :: FNV32 -> Word32+unFNV32 (FNV32 x) = x++instance Hashable FNV32 where +  hashDigest (FNV32 w) = hashDigest w++instance HashValue FNV32 where+  emptyHash = FNV32 fnv32_offset +  hashHash (FNV32 w) = hashWord32 w+  showHex  (FNV32 w) = showHex32 w+  hashWord8  x (FNV32 w) = FNV32 (fnv32_octet  x w)+  hashWord16 x (FNV32 w) = FNV32 (fnv32_word16 x w)+  hashWord32 x (FNV32 w) = FNV32 (fnv32_word32 x w)+  hashWord64 x (FNV32 w) = FNV32 (fnv32_word64 x w)++--------------------------------------------------------------------------------++showHex32 :: Word32 -> String+showHex32 h = reverse $ worker 8 h where+  worker :: Int -> Word32 -> String+  worker 0 0 = []+  worker 0 _ = error "Hash/FNV32/showHex: shouldn't happen"+  worker i w = hexdigit (w .&. 15) : worker (i-1) (shiftR w 4) +  hexdigit :: Word32 -> Char+  hexdigit n+    | k>=0 && k<=9   = chr (k+48)+    | otherwise      = chr (k+55)+    where k = fromIntegral n++--------------------------------------------------------------------------------+-- FNV-1a hash++fnv32_prime, fnv32_offset :: Word32++fnv32_prime  = 16777619   +fnv32_offset = 2166136261 ++fnv32_octet :: Word8 -> Word32 -> Word32+fnv32_octet octet old = fnv32_prime * (old `xor` fromIntegral octet)++--------------------------------------------------------------------------------+-- 32 bit++fnv32_word32 :: Word32 -> Word32 -> Word32+fnv32_word32 w = fnv32_octet a . fnv32_octet b . fnv32_octet c . fnv32_octet d where+  a = fromIntegral (255 .&. (       w   ))+  b = fromIntegral (255 .&. (shiftR w  8))+  c = fromIntegral (255 .&. (shiftR w 16))+  d = fromIntegral (255 .&. (shiftR w 24))++{-+fnv32_word24 :: Word32 -> Word32 -> Word32+fnv32_word24 w = fnv32_octet a . fnv32_octet b . fnv32_octet c where+  a = fromIntegral (255 .&. (       w   ))+  b = fromIntegral (255 .&. (shiftR w  8))+  c = fromIntegral (255 .&. (shiftR w 16))+-}++fnv32_word16 :: Word16 -> Word32 -> Word32+fnv32_word16 w = fnv32_octet a . fnv32_octet b where+  a = fromIntegral (255 .&. (       w   ))+  b = fromIntegral (255 .&. (shiftR w  8))++fnv32_word64 :: Word64 -> Word32 -> Word32+fnv32_word64 w = fnv32_word32 a . fnv32_word32 b where+  a = fromIntegral (0xffffffff .&. (       w   ))+  b = fromIntegral (0xffffffff .&. (shiftR w 32))++--------------------------------------------------------------------------------+

@@ -0,0 +1,97 @@++-- | 64-bit FNV-1a (Fowler-Noll-Vo) hash++{-# LANGUAGE CPP #-}+module Data.Generics.Fixplate.Util.Hash.FNV.FNV64 +  ( FNV64(..) +  , unFNV64+  ) +  where++--------------------------------------------------------------------------------++import Data.Char+import Data.Word+import Data.Bits+-- import Data.Int+-- import Data.List++import Data.Generics.Fixplate.Util.Hash.Class++--------------------------------------------------------------------------------++instance Hashable FNV64 where +  hashDigest (FNV64 w) = hashDigest w++instance HashValue FNV64 where+  emptyHash = FNV64 fnv64_offset +  hashHash (FNV64 w) = hashWord64 w+  showHex  (FNV64 w) = showHex64 w+  hashWord8  x (FNV64 w) = FNV64 (fnv64_octet  x w)+  hashWord16 x (FNV64 w) = FNV64 (fnv64_word16 x w)+  hashWord32 x (FNV64 w) = FNV64 (fnv64_word32 x w)+  hashWord64 x (FNV64 w) = FNV64 (fnv64_word64 x w)+  +--------------------------------------------------------------------------------++newtype FNV64 = FNV64 Word64 deriving (Eq,Ord,Show)++unFNV64 :: FNV64 -> Word64+unFNV64 (FNV64 x) = x++--------------------------------------------------------------------------------++showHex64 :: Word64 -> String+showHex64 h = reverse $ worker 16 h where+  worker :: Int -> Word64 -> String+  worker 0 0 = []+  worker 0 _ = error "Hash/FNV64/showHex: shouldn't happen"+  worker i w = hexdigit (w .&. 15) : worker (i-1) (shiftR w 4) +  hexdigit :: Word64 -> Char+  hexdigit n+    | k>=0 && k<=9   = chr (k+48)+    | otherwise      = chr (k+55)+    where k = fromIntegral n++--------------------------------------------------------------------------------+-- FNV-1a hash++fnv64_prime, fnv64_offset :: Word64++fnv64_prime  = 1099511628211        +fnv64_offset = 14695981039346656037 ++fnv64_octet :: Word8 -> Word64 -> Word64+fnv64_octet octet old = fnv64_prime * (old `xor` fromIntegral octet)++--------------------------------------------------------------------------------+-- 64 bit++fnv64_word32 :: Word32 -> Word64 -> Word64+fnv64_word32 w = fnv64_octet a . fnv64_octet b . fnv64_octet c . fnv64_octet d where+  a = fromIntegral (255 .&. (       w   ))+  b = fromIntegral (255 .&. (shiftR w  8))+  c = fromIntegral (255 .&. (shiftR w 16))+  d = fromIntegral (255 .&. (shiftR w 24))++{-+fnv64_word24 :: Word32 -> Word64 -> Word64+fnv64_word24 w = fnv64_octet a . fnv64_octet b . fnv64_octet c where+  a = fromIntegral (255 .&. (       w   ))+  b = fromIntegral (255 .&. (shiftR w  8))+  c = fromIntegral (255 .&. (shiftR w 16))+-}+ +fnv64_word16 :: Word16 -> Word64 -> Word64+fnv64_word16 w = fnv64_octet a . fnv64_octet b where+  a = fromIntegral (255 .&. (       w   ))+  b = fromIntegral (255 .&. (shiftR w  8))++fnv64_word64 :: Word64 -> Word64 -> Word64+fnv64_word64 w = fnv64_word32 a . fnv64_word32 b where+  a = fromIntegral (0xffffffff .&. (       w   ))+  b = fromIntegral (0xffffffff .&. (shiftR w 32))++--------------------------------------------------------------------------------++

@@ -0,0 +1,530 @@+
+-- | Hash tables, implemented as a structure similar to @Map hash (Map key value)]@.
+--
+-- What this data structure can also give you is a unique value (a @(hash,Int)@ pair)
+-- for each key, even during building the table: It is guaranteed to be unique 
+-- in the past and future lifetime of a single hashtable (that is, one realization 
+-- of the world-line), among all the keys appearing in that history.
+--
+-- Set operations (union, intersection) clearly break this principle; this is
+-- resolved by declaring these operations to be /left-biased/, in the sense that
+-- they retain the unique values of the left table (so @union t1 t2@ belongs to
+-- to @t1@'s world-line, but not to @t2@'s one).
+--
+-- If a key is first removed then added back again, it will get a new value.
+--
+-- To be Haskell98 compatible (no multi-param type classes), when constructing 
+-- a new hash table, we have to support the function computing (or just fetching, if
+-- it is cached) the hash value. This function is then stored in the data type.
+--
+
+{-# LANGUAGE CPP #-}
+module Data.Generics.Fixplate.Util.Hash.Table
+  ( HashTable , Bucket(..) , Leaf(..)
+  , getHashValue , unHashTable
+    -- * Construction and deconstruction
+  , empty , singleton
+  , fromList , toList 
+  , null 
+  , bag
+    -- * Membership
+  , lookup , member 
+    -- * Insertion / deletion
+  , insert , insertWith
+  , delete
+    -- * Union
+  , union , unionWith         
+  , unionsWith , unionsWith'
+    -- * Intersection
+  , intersection, intersectionWith 
+  , intersectionsWith , intersectionsWith'
+    -- * Difference
+  , difference , differenceWith
+    -- * Unique indices
+  , getUniqueIndex
+  , keysWith
+  , mapWithUniqueIndices
+#ifdef WITH_QUICKCHECK
+    -- * Tests
+  , runtests_HashTable  
+  , prop_insert       , prop_delete
+  , prop_insertDelete , prop_deleteInsert
+  , prop_insertInsert , prop_deleteDelete
+  , prop_fromListToList
+  , prop_intersection , prop_intersectionWith
+  , prop_union        , prop_unionWith
+  , prop_difference   , prop_differenceWith
+  , prop_uniqueValues
+#endif
+  ) 
+  where
+
+--------------------------------------------------------------------------------
+
+import Prelude hiding ( lookup , null )
+
+import Data.List ( foldl' )
+
+import qualified Data.Map as Map ; import Data.Map (Map) 
+-- import qualified Data.Set as Set ; import Data.Set (Set) 
+
+#ifdef WITH_QUICKCHECK
+import Test.QuickCheck
+import Test.QuickCheck.Modifiers
+import Data.Generics.Fixplate.Misc
+import Data.List ( sort , group , nubBy , nub , (\\) , foldl' , scanl )
+import Control.Monad
+import Control.Applicative ( (<$>) )
+import Debug.Trace
+#endif
+
+--------------------------------------------------------------------------------
+-- helper functions
+
+mapInsertWith :: Ord k => (a -> v) -> (a -> v -> v) -> k -> a -> Map k v ->  Map k v
+mapInsertWith f g k x = x `seq` Map.alter worker k where
+  worker Nothing   =          Just $! (f x)
+  worker (Just y)  = y `seq` (Just $! (g x y))
+
+{-
+mapIsSingleton :: Map k v -> Maybe (k,v)
+mapIsSingleton table = if Map.size table == 1 
+  then let [(k,v)] = Map.toList table in Just (k,v)
+  else Nothing
+
+mapIsSingleton_ :: Map k v -> Maybe v
+mapIsSingleton_ table = if Map.size table == 1 
+  then let [(_,v)] = Map.toList table in Just v
+  else Nothing
+-}
+
+--------------------------------------------------------------------------------
+-- buckets
+
+data Leaf v     = Leaf   {-# UNPACK #-} !Int v                    -- the index of the key, plus a value
+data Bucket k v = Bucket {-# UNPACK #-} !Int !(Map k (Leaf v))    -- the next free index, plus the elements in the bucket
+
+fromLeaf :: Leaf v -> v
+fromLeaf (Leaf _ x) = x
+
+emptyBucket :: Bucket k v
+emptyBucket = Bucket 0 (Map.empty)
+
+bucketSingleton :: k -> v -> Bucket k v
+bucketSingleton k x = Bucket 1 (Map.singleton k (Leaf 0 x))
+
+bucketInsert :: Ord k => k -> v -> Bucket k v -> Bucket k v
+bucketInsert = bucketInsertWith id const    -- not (flip const), since a -> v -> v !!!
+
+bucketInsertWith :: Ord k => (a -> v) -> (a -> v -> v) -> k -> a -> Bucket k v -> Bucket k v
+bucketInsertWith f g k x (Bucket n table) = x `seq` new where
+  new = Bucket (n+1) (Map.alter worker k table)
+  worker Nothing            =          Just $! (Leaf n (f x))
+  worker (Just (Leaf j y))  = y `seq` (Just $! (Leaf j (g x y)))
+
+{-
+bucketIsSingleton :: Bucket k v -> Maybe (k,v)
+bucketIsSingleton (Bucket _ table) = if Map.size table == 1 
+  then let [(k,Leaf _ v)] = Map.toList table in Just (k,v)
+  else Nothing
+
+bucketIsSingleton_ :: Bucket k v -> Maybe v
+bucketIsSingleton_ (Bucket _ table) = if Map.size table == 1 
+  then let [Leaf _ v] = Map.elems table in Just v
+  else Nothing
+-}
+
+--------------------------------------------------------------------------------
+
+data HashTable hash k v = HashTable 
+  { getHashValue :: k -> hash
+  , unHashTable  :: Map hash (Bucket k v) 
+  }
+
+empty :: (Ord hash, Ord k) => (k -> hash) -> HashTable hash k v
+empty gethash = HashTable gethash (Map.empty)
+
+singleton :: (Ord hash, Ord k) => (k -> hash) -> k -> v -> HashTable hash k v
+singleton gethash k v = HashTable gethash $ Map.singleton h (bucketSingleton k v) where
+  h = gethash k
+
+fromList :: (Ord hash, Ord k) => (k -> hash) -> [(k,v)] -> HashTable hash k v
+fromList gethash = foldl' (\old (k,v) -> insert k v old) (empty gethash)
+
+-- | Note that the returned list is ordered by hash, /not/ by keys like 'Data.Map'!
+toList :: Ord k => HashTable hash k v -> [(k,v)]
+toList (HashTable _ table) = 
+  [ (k,v) 
+  | Bucket _ sub  <- Map.elems table 
+  , (k, Leaf _ v) <- Map.toList sub 
+  ]
+
+null :: (Ord hash, Ord k) => HashTable hash k v -> Bool
+null t = case toList t of
+  [] -> True
+  _  -> False
+
+-- | Keys together with their associated unique values
+keysWith :: Ord k => (k -> hash -> Int -> a) -> HashTable hash k v -> [a]
+keysWith f (HashTable _ table) = 
+  [ f k hash j 
+  | (hash, Bucket _ sub) <- Map.toList table 
+  , (k, Leaf j _) <- Map.toList sub 
+  ]
+
+--------------------------------------------------------------------------------
+
+lookup :: (Ord hash, Ord k) => k -> HashTable hash k v -> Maybe v
+lookup key (HashTable gethash table) = 
+  case Map.lookup h table of
+    Just (Bucket n sub) -> case Map.lookup key sub of
+      Just (Leaf _ v) -> Just v
+      Nothing         -> Nothing
+    Nothing  -> Nothing      
+  where
+    h = gethash key
+
+-- | Look up a unique index, in the form of a @(hash,Int)@ pair, for any key.
+-- If the user-supplied function is /injective/, then the result is guaranteed to be uniquely
+-- associated to the given key in the past and future history of this table (but of
+-- course not unique among different future histories).
+--
+getUniqueIndex :: (Ord hash, Ord k) => (hash -> Int -> a) -> k -> HashTable hash k v -> Maybe a
+getUniqueIndex f key (HashTable gethash table) = 
+  case Map.lookup h table of
+    Just bucket@(Bucket _ sub) -> case Map.lookup key sub of
+      Just (Leaf j _) -> Just (f h j)
+      Nothing         -> Nothing       
+    Nothing  -> Nothing      
+  where
+    h = gethash key
+
+member :: (Ord hash, Ord k) => k -> HashTable hash k v -> Bool
+member key table = case lookup key table of
+  Just _  -> True
+  Nothing -> False
+
+--------------------------------------------------------------------------------
+
+insert :: (Ord hash, Ord k) => k -> v -> HashTable hash k v -> HashTable hash k v
+insert k v (HashTable gethash table) = HashTable gethash $ mapInsertWith f g h v table where
+  h = gethash k
+  f v     = bucketSingleton k v
+  g v sub = bucketInsert    k v sub
+
+insertWith :: (Ord hash, Ord k) => (a -> v) -> (a -> v -> v) -> k -> a -> HashTable hash k v -> HashTable hash k v
+insertWith ff gg k x (HashTable gethash table) = HashTable gethash $ mapInsertWith f g h x table where
+  h = gethash k
+  f x     = bucketSingleton k (ff x)
+  g x sub = bucketInsertWith ff gg k x sub
+
+delete :: (Ord hash, Ord k) => k -> HashTable hash k v -> HashTable hash k v
+delete k (HashTable gethash table) = HashTable gethash $ Map.alter worker h table where
+  h = gethash k
+  worker Nothing               = Nothing
+  worker (Just (Bucket n sub)) = Just $ Bucket n (Map.delete k sub)
+
+--------------------------------------------------------------------------------
+-- union
+
+-- | > union == unionWith const
+union :: (Ord hash, Ord k) => HashTable hash k a -> HashTable hash k a -> HashTable hash k a
+union = unionWith const
+
+-- | This is unsafe in the sense that the two @getHash@ functions 
+-- (supplied when the hash tables were created) must agree. The same applies for all the set operations.
+--
+-- It is also left-biased in the sense that the unique indices from the left hashtable are retained,
+-- while the unique indices from the right hashtable are /changed/.
+unionWith :: (Ord hash, Ord k) => (v -> v -> v) -> HashTable hash k v -> HashTable hash k v -> HashTable hash k v 
+unionWith g (HashTable gethash table1) (HashTable _ table2) = HashTable gethash (Map.unionWith worker table1 table2)
+  where
+    worker (Bucket n sub1) (Bucket m sub2) = Bucket (n+m) (Map.unionWith h sub1 $ Map.map offset sub2) where
+      h (Leaf i x) (Leaf _ y) = Leaf i (g x y)
+      offset       (Leaf j y) = Leaf (n+j) y
+
+-- | This is unsafe both in the above sense and also that it does not accepts the empty list (for the same reason).
+-- The result belongs to the world-line of the first table.
+unionsWith :: (Ord hash, Ord k) => (v -> v -> v) -> [HashTable hash k v] -> HashTable hash k v 
+unionsWith g tables = case tables of
+  [x]    -> x
+  []     -> error "HashTable/unionsWith: empty list"
+  xs     -> foldl1 (unionWith g) xs
+
+-- | This one accepts the empty list. The empty imput creates a new world-line.
+unionsWith' :: (Ord hash, Ord k) => (k -> hash) -> (v -> v -> v) -> [HashTable hash k v] -> HashTable hash k v 
+unionsWith' gethash g tables = case tables of
+  [x]    -> x
+  []     -> empty gethash
+  xs     -> foldl1 (unionWith g) xs
+
+--------------------------------------------------------------------------------
+-- intersection
+
+-- | > intersection == intersectionWith const
+intersection :: (Ord hash, Ord k) => HashTable hash k a -> HashTable hash k b -> HashTable hash k a
+intersection = intersectionWith const
+ 
+-- NOTE the `Map.union` and `Map.difference` here!!!!!
+-- This is necessary so that the world-line property remains true: if there is a hash present in the left table
+-- but not in the right table, then we have to put an empty bucket in the resulting table while retaining the 
+-- next unique index value). Unfortunately "Data.Map" does not have a flexible enough set operation to be used here...
+intersectionWith :: (Ord hash, Ord k) => (a -> b -> c) -> HashTable hash k a -> HashTable hash k b -> HashTable hash k c
+intersectionWith g (HashTable gethash table1) (HashTable _ table2) = 
+  HashTable gethash (Map.union a_minus_b a_cap_b) {- disjoint union -} where
+    a_cap_b   = Map.intersectionWith cap_worker table1 table2
+    a_minus_b = Map.map empty_worker (Map.difference table1 table2)
+  
+    cap_worker (Bucket n sub1) (Bucket _ sub2) = Bucket n (Map.intersectionWith h sub1 sub2) where
+      h (Leaf i x) (Leaf _ y) = Leaf i (g x y)
+
+    -- empty_worker :: Bucket k a -> Bucket k c
+    empty_worker (Bucket n sub1) = Bucket n (Map.empty)
+
+intersectionsWith :: (Ord hash, Ord k) => (v -> v -> v) -> [HashTable hash k v] -> HashTable hash k v 
+intersectionsWith g tables = case tables of
+  [x]    -> x
+  []     -> error "HashTable/intersectionWith: empty list"
+  xs     -> foldl1 (intersectionWith g) xs
+
+intersectionsWith' :: (Ord hash, Ord k) => (k -> hash) -> (v -> v -> v) -> [HashTable hash k v] -> HashTable hash k v 
+intersectionsWith' gethash g tables = case tables of
+  [x]    -> x
+  []     -> empty gethash
+  xs     -> foldl1 (intersectionWith g) xs
+
+--------------------------------------------------------------------------------
+-- difference
+
+difference :: (Ord hash, Ord k) => HashTable hash k a -> HashTable hash k b -> HashTable hash k a
+difference = differenceWith (\_ _ -> Nothing)
+
+differenceWith :: (Ord hash, Ord k) => (a -> b -> Maybe a) -> HashTable hash k a -> HashTable hash k b -> HashTable hash k a
+differenceWith g (HashTable gethash table1) (HashTable _ table2) = HashTable gethash (Map.differenceWith worker table1 table2) 
+  where
+    worker (Bucket n sub1) (Bucket _ sub2) = Just (Bucket n (Map.differenceWith h sub1 sub2)) where
+      h (Leaf i x) (Leaf _ y) = case g x y of
+        Just z  -> Just (Leaf i z)
+        Nothing -> Nothing
+  
+--------------------------------------------------------------------------------
+
+-- | Creates a multi-set from a list.
+bag :: (Ord hash, Ord k) => (k -> hash) -> [k] -> HashTable hash k Int
+bag gethash = foldl' (\old k -> insertWith id (+) k 1 old) (empty gethash)
+
+--------------------------------------------------------------------------------
+
+mapWithUniqueIndices :: (Ord hash, Ord k) => (hash -> Int -> a -> b) -> HashTable hash k a -> HashTable hash k b
+mapWithUniqueIndices user (HashTable gethash table) = HashTable gethash (Map.mapWithKey worker table) where
+  worker hash (Bucket n sub) = Bucket n (Map.map g sub) where
+    g (Leaf j x) = Leaf j (user hash j x)
+
+--------------------------------------------------------------------------------
+#ifdef WITH_QUICKCHECK
+-- * tests
+
+runtests_HashTable :: IO ()
+runtests_HashTable = do
+  quickCheck prop_insert
+  quickCheck prop_delete
+  quickCheck prop_insertDelete
+  quickCheck prop_deleteInsert
+  quickCheck prop_insertInsert
+  quickCheck prop_deleteDelete
+  quickCheck prop_fromListToList
+  quickCheck prop_intersection
+  quickCheck prop_intersectionWith
+  quickCheck prop_union
+  quickCheck prop_unionWith
+  quickCheck prop_difference
+  quickCheck prop_differenceWith
+  replicateM_ 5 $ quickCheck prop_uniqueValues
+--  quickCheck prop_
+--  quickCheck prop_
+
+-------------------------
+
+debug x y = trace ("-- " ++ show x ++ " --") y
+
+newtype Key = Key Int deriving (Eq,Ord,Show)
+
+instance (Ord k, Ord hash, Show k, Show v) => Show (HashTable hash k v) where
+  show t = "HashTable<< " ++ show (toList t) ++ " >>"
+
+instance Arbitrary Key where
+  arbitrary = do
+    n <- choose (0, 255)
+    return (Key n)
+
+newtype Hash = Hash Int deriving (Eq,Ord,Show)
+
+calcHash :: Key -> Hash 
+calcHash (Key k) = Hash (mod k 17)
+
+newtype Table v = Table (HashTable Hash Key v) deriving Show 
+
+instance Arbitrary v => Arbitrary (Table v) where
+  arbitrary = do
+    xs <- arbitrary
+    let t = fromList calcHash xs
+    {- debug (length xs) $ -}
+    return (Table t)
+
+newtype NonEmptyTable v = NonEmptyTable (HashTable Hash Key v) deriving Show 
+
+instance Arbitrary v => Arbitrary (NonEmptyTable v) where
+  arbitrary = do
+    NonEmpty xs <- arbitrary
+    let t = fromList calcHash xs
+    {- debug (length xs) $ -}
+    return (NonEmptyTable t)
+
+data Pointed v = Pointed (HashTable Hash Key v) (Key,v) deriving Show
+
+instance Arbitrary v => Arbitrary (Pointed v) where
+  arbitrary = do
+    NonEmptyTable t <- arbitrary
+    let list = toList t
+        n = length list
+    i <- choose (0,n-1)
+    let kv =list!!i
+    return (Pointed t kv)
+
+sortedToList :: Ord a => HashTable Hash Key a -> [(Key,a)]
+sortedToList = sort . toList
+
+-------------------------
+
+data Step v
+  = Insert     Key v 
+  | InsertWith Key v
+  | Delete     Key  
+  | Union      (Table v)
+  | Intersect  (Table v)
+  | Difference (Table v)
+  deriving Show
+
+instance Arbitrary v => Arbitrary (Step v) where
+  arbitrary = do
+    frequency
+      [ ( 10 , do { k<-arbitrary ; v<-arbitrary ; return (Insert     k v) } )
+      , (  5 , do { k<-arbitrary ; v<-arbitrary ; return (InsertWith k v) } )
+      , ( 10 , do { k<-arbitrary ; return (Delete k)       } )
+      , (  3 , do { t<-arbitrary ; return (Union      t  ) } )
+      , (  2 , do { t<-arbitrary ; return (Difference t  ) } )
+      , (  1 , do { t<-arbitrary ; return (Intersect  t  ) } )
+      ]
+
+newtype NoDeleteStep v = NoDeleteStep (Step v)
+
+instance Arbitrary v => Arbitrary (NoDeleteStep v) where
+  arbitrary = NoDeleteStep <$> do
+    frequency
+      [ ( 10 , do { k<-arbitrary ; v<-arbitrary ; return (Insert     k v) } )
+      , (  5 , do { k<-arbitrary ; v<-arbitrary ; return (InsertWith k v) } )
+      , (  3 , do { t<-arbitrary ;                return (Union      t  ) } )
+      ]
+
+step :: (v -> v -> v) -> Step v -> HashTable Hash Key v -> HashTable Hash Key v 
+step f step old = case step of
+  Insert     k v       -> insert          k v old
+  InsertWith k v       -> insertWith id f k v old
+  Delete     k         -> delete          k   old
+  Union      (Table t) -> union        old t
+  Intersect  (Table t) -> intersection old t
+  Difference (Table t) -> difference   old t
+
+type History v = [Step v]
+
+runHistory :: (v -> v -> v) -> History v -> HashTable Hash Key v -> [HashTable Hash Key v]
+runHistory f steps ini = scanl (flip (step f)) ini steps
+
+data U = U Hash Int deriving (Eq,Ord,Show)
+
+-------------------------
+
+prop_insert :: Key -> Char -> Table Char -> Bool
+prop_insert k v (Table table) = lookup k (insert k v table) == Just v
+
+prop_delete :: Pointed Char -> Bool
+prop_delete (Pointed table (k,_)) = lookup k (delete k table) == Nothing 
+
+prop_insertInsert :: Key -> Char -> Table Char -> Bool
+prop_insertInsert k v (Table table) = toList (insert k v table) == toList (insert k v (insert k v table))
+
+prop_deleteDelete :: Pointed Char -> Bool
+prop_deleteDelete (Pointed table (k,_)) = toList (delete k table) == toList (delete k (delete k table))
+
+prop_insertDelete :: Key -> Char -> Table Char -> Bool
+prop_insertDelete k v (Table table) = lookup k (delete k $ insert k v table) == Nothing
+
+prop_deleteInsert :: Pointed Char -> Bool
+prop_deleteInsert (Pointed table (k,v)) = lookup k (insert k v $ delete k table) == Just v 
+
+prop_fromListToList :: [(Key,Char)] -> Bool
+prop_fromListToList xs = sortedToList (fromList calcHash xs) == Map.toList (Map.fromList xs)
+
+prop_intersection :: [(Key,Char)] -> [(Key,Bool)] -> Bool
+prop_intersection xs ys = sortedToList (intersection t1 t2) == Map.toList (Map.intersection m1 m2) where
+  t1 = fromList calcHash xs
+  t2 = fromList calcHash ys
+  m1 = Map.fromList xs
+  m2 = Map.fromList ys
+
+prop_intersectionWith :: [(Key,Char)] -> [(Key,String)] -> Bool
+prop_intersectionWith xs ys = sortedToList (intersectionWith (:) t1 t2) == Map.toList (Map.intersectionWith (:) m1 m2) where
+  t1 = fromList calcHash xs
+  t2 = fromList calcHash ys
+  m1 = Map.fromList xs
+  m2 = Map.fromList ys
+
+prop_union :: [(Key,Char)] -> [(Key,Char)] -> Bool
+prop_union xs ys = sortedToList (union t1 t2) == Map.toList (Map.union m1 m2) where
+  t1 = fromList calcHash xs
+  t2 = fromList calcHash ys
+  m1 = Map.fromList xs
+  m2 = Map.fromList ys
+
+prop_unionWith :: [(Key,String)] -> [(Key,String)] -> Bool
+prop_unionWith xs ys = sortedToList (unionWith (++) t1 t2) == Map.toList (Map.unionWith (++) m1 m2) where
+  t1 = fromList calcHash xs
+  t2 = fromList calcHash ys
+  m1 = Map.fromList xs
+  m2 = Map.fromList ys
+
+prop_difference :: [(Key,Char)] -> [(Key,Bool)] -> Bool
+prop_difference xs ys = sortedToList (difference t1 t2) == Map.toList (Map.difference m1 m2) where
+  t1 = fromList calcHash xs
+  t2 = fromList calcHash ys
+  m1 = Map.fromList xs
+  m2 = Map.fromList ys
+
+prop_differenceWith :: [(Key,Char)] -> [(Key,Bool)] -> Bool
+prop_differenceWith xs ys = sortedToList (differenceWith f t1 t2) == Map.toList (Map.differenceWith f m1 m2) where
+  t1 = fromList calcHash xs
+  t2 = fromList calcHash ys
+  m1 = Map.fromList xs
+  m2 = Map.fromList ys
+  f x b = if b then Just x else Nothing
+
+-- we try to test whether values are really unique and really constant during a wordline
+prop_uniqueValues :: History Float -> Table Float -> Bool
+prop_uniqueValues history (Table initial) = areUnique && areInjective {- && ... -} where
+  worldline = runHistory (\x y -> x-y) history initial :: [HashTable Hash Key Float]
+  lists = ((flip map) worldline $ \table -> keysWith (\k h j -> (U h j, k)) table) :: [[(U,Key)]]
+
+  -- at each point in time, a single value must appear only once in the table
+  areUnique = and [ isUnique xs | xs <- lists ]
+  isUnique uks = let us = map fst uks in sort us == sort (nub us)
+
+  -- taking the whole wordline, it must be true that to a single unique value there is only a single key associated
+  -- (the opposite is not true, since a key can be deleted then reinserted, gaining a new value)
+  areInjective = and $ map test $ groupSortOn fst $ concat lists where
+    test :: [(U,Key)] -> Bool
+    test xs = (length (groupSortOn fst xs) == 1)     -- this is redundant, but hey, we are also testing the test :)
+           && (length (groupSortOn snd xs) == 1)
+ 
+
+#endif
+--------------------------------------------------------------------------------

@@ -1,6 +1,6 @@  Name:                fixplate-Version:             0.1.4+Version:             0.1.5 Synopsis:            Uniplate-style generic traversals for optionally annotated fixed-point types. Description:         Uniplate-style generic traversals for fixed-point types, which can be                        optionally annotated with attributes. We also provide recursion schemes,@@ -26,8 +26,8 @@   Description: Compile with the QuickCheck tests.    default: False -Flag withHashing-  Description: Include the generic hashing functionality+Flag withUtils+  Description: Include utility modules   default: True  Flag base4@@ -42,8 +42,9 @@     Build-Depends:       base >= 3 && < 4     cpp-options:         -DBASE_VERSION=3 -  if flag(withHashing)+  if flag(withUtils)     Build-Depends:       containers+    cpp-options:         -DWITH_UTILITY_MODULES    if flag(withQuickCheck)     Build-Depends:       QuickCheck > 2.4@@ -57,17 +58,15 @@                        Data.Generics.Fixplate.Attributes                        Data.Generics.Fixplate.Zipper                        Data.Generics.Fixplate.Draw+                       Data.Generics.Fixplate.Trie+                       Data.Generics.Fixplate.Hash -  if flag(withHashing)-    Exposed-Modules:     Data.Generics.Fixplate.Hash-                         Data.Generics.Fixplate.Hash.Class-                         Data.Generics.Fixplate.Hash.Table-                         Data.Generics.Fixplate.Hash.FNV.FNV32-                         Data.Generics.Fixplate.Hash.FNV.FNV64-                       -  if impl(ghc)||impl(hugs)                     -    Exposed-Modules:     Data.Generics.Fixplate.Structure-    cpp-options:         -DHAS_RANK2TYPES+  if flag(withUtils)+    Exposed-Modules:     +                         Data.Generics.Fixplate.Util.Hash.Class+                         Data.Generics.Fixplate.Util.Hash.Table+                         Data.Generics.Fixplate.Util.Hash.FNV.FNV32+                         Data.Generics.Fixplate.Util.Hash.FNV.FNV64    Other-Modules:       Data.Generics.Fixplate.Misc