Use bulk IntMap operations

Use `Data.IntMap.differenceWith` to implement `(&)` and `match`
for `Data.Graph.Inductive.PatriciaTree`. Instead of modifying
the graph manually, one key at a time, `differenceWith` will
efficiently partition the set of keys to be modified along the
structure of the graph. This should be considerably more efficient
when inserting or matching on well-connected nodes.

Fixes haskell#39

Data/Graph/Inductive/PatriciaTree.hs

@@ -116,10 +116,10 @@ instance Graph Gr where
 instance DynGraph Gr where
     (p, v, l, s) & (Gr g)
         = let !g1 = IM.insert v (preds, l, succs) g
-              !g2 = addSucc g1 v preds
+              !g2 = addSucc g1 v np preds
               !g3 = addPred g2 v succs
-              !preds = fromAdj p
-              !succs = fromAdj s
+              !(np, preds) = fromAdjCounting p
+              !(ns, succs) = fromAdjCounting s
           in Gr g3
 
 instance (NFData a, NFData b) => NFData (Gr a b) where
@@ -236,6 +236,9 @@ fromListWithCounting :: (a -> a -> a) -> [(Int, a)] -> (Int, IntMap a)
 fromListWithCounting f = fromListWithKeyCounting (\_ x y -> f x y)
 {-# INLINE fromListWithCounting #-}
 
+fromAdjCounting :: Adj b -> (Int, IntMap [b])
+fromAdjCounting = fromListWithCounting addLists . map (second (:[]) . swap)
+
 toContext :: Node -> Context' a b -> Context a b
 toContext v (ps, a, ss) = (toAdj ps, v, a, toAdj ss)
 
@@ -254,30 +257,33 @@ addLists [a] as  = a : as
 addLists as  [a] = a : as
 addLists xs  ys  = xs ++ ys
 
-addSucc :: forall a b . GraphRep a b -> Node -> IM.IntMap [b] -> GraphRep a b
-addSucc g v = IMS.differenceWith go g
+-- We use differenceWith to modify a graph more than bulkThreshold times,
+-- and repeated insertWith to modify fewer times.
+bulkThreshold :: Int
+bulkThreshold = 5
+
+addSucc :: forall a b . GraphRep a b -> Node -> Int -> IM.IntMap [b] -> GraphRep a b
+addSucc g v numAdd
+  | numAdd < 
+addSucc g v numAdd xs = IM.differenceWith go g xs
   where
     go :: Context' a b -> [b] -> Maybe (Context' a b)
-    go (ps, l', ss) l = let !ss' = IM.insertWith (++) v l ss
-                        in Just (ps, l', ss')
+    go (ps, l', ss) l = Just (ps, l', IM.insertWith (++) v l ss)
 
 addPred :: forall a b . GraphRep a b -> Node -> IM.IntMap [b] -> GraphRep a b
-addPred g v = IMS.differenceWith go g
+addPred g v = IM.differenceWith go g
   where
     go :: Context' a b -> [b] -> Maybe (Context' a b)
-    go (ps, l', ss) l = let !ps' = IM.insertWith (++) v l ps
-                        in Just (ps', l', ss)
+    go (ps, l', ss) l = Just (IM.insertWith (++) v l ps, l', ss)
 
 clearSucc :: forall a b x . GraphRep a b -> Node -> IM.IntMap x -> GraphRep a b
-clearSucc g v = IMS.differenceWith go g
+clearSucc g v = IM.differenceWith go g
   where
     go :: Context' a b -> x -> Maybe (Context' a b)
-    go (ps, l, ss) _ = let !ss' = IM.delete v ss
-                       in Just (ps, l, ss')
+    go (ps, l, ss) _ = Just (ps, l, IM.delete v ss)
 
 clearPred :: forall a b x . GraphRep a b -> Node -> IM.IntMap x -> GraphRep a b
-clearPred g v = IMS.differenceWith go g
+clearPred g v = IM.differenceWith go g
   where
     go :: Context' a b -> x -> Maybe (Context' a b)
-    go (ps, l, ss) _ = let !ps' = IM.delete v ps
-                       in Just (ps', l, ss)
+    go (ps, l, ss) _ = Just (IM.delete v ps, l, ss)