diff --git a/.gitignore b/.gitignore index 13a35bd..35969d0 100644 --- a/.gitignore +++ b/.gitignore @@ -8,5 +8,6 @@ cabal-dev .hsenv .cabal-sandbox/ cabal.sandbox.config +.stack-work cabal.config TAGS diff --git a/Data/Graph/Inductive/Internal/Heap.hs b/Data/Graph/Inductive/Internal/Heap.hs index 613a522..45600c3 100644 --- a/Data/Graph/Inductive/Internal/Heap.hs +++ b/Data/Graph/Inductive/Internal/Heap.hs @@ -14,18 +14,14 @@ module Data.Graph.Inductive.Internal.Heap( import Text.Show (showListWith) -#if MIN_VERSION_containers (0,4,2) import Control.DeepSeq (NFData (..)) -#endif data Heap a b = Empty | Node a b [Heap a b] deriving (Eq, Show, Read) -#if MIN_VERSION_containers (0,4,2) instance (NFData a, NFData b) => NFData (Heap a b) where rnf Empty = () rnf (Node a b hs) = rnf a `seq` rnf b `seq` rnf hs -#endif prettyHeap :: (Show a, Show b) => Heap a b -> String prettyHeap = (`showsHeap` "") diff --git a/Data/Graph/Inductive/NodeMap.hs b/Data/Graph/Inductive/NodeMap.hs index 86db233..fbd13db 100644 --- a/Data/Graph/Inductive/NodeMap.hs +++ b/Data/Graph/Inductive/NodeMap.hs @@ -34,19 +34,15 @@ import qualified Prelude as P (map) import Data.Map (Map) import qualified Data.Map as M -#if MIN_VERSION_containers (0,4,2) import Control.DeepSeq (NFData (..)) -#endif data NodeMap a = NodeMap { map :: Map a Node, key :: Int } deriving (Eq, Show, Read) -#if MIN_VERSION_containers (0,4,2) instance (NFData a) => NFData (NodeMap a) where rnf (NodeMap mp k) = rnf mp `seq` rnf k -#endif -- | Create a new, empty mapping. new :: NodeMap a diff --git a/Data/Graph/Inductive/PatriciaTree.hs b/Data/Graph/Inductive/PatriciaTree.hs index cb47f5e..10828b5 100644 --- a/Data/Graph/Inductive/PatriciaTree.hs +++ b/Data/Graph/Inductive/PatriciaTree.hs @@ -30,12 +30,12 @@ import Data.Graph.Inductive.Graph import Control.Applicative (liftA2) import Data.IntMap (IntMap) import qualified Data.IntMap as IM +import qualified Data.IntMap.Strict as IMS import Data.List (sort) import Data.Maybe (fromMaybe) +import Data.Foldable (foldl') -#if MIN_VERSION_containers (0,4,2) import Control.DeepSeq (NFData (..)) -#endif #if __GLASGOW_HASKELL__ >= 702 import GHC.Generics (Generic) @@ -115,15 +115,15 @@ instance Graph Gr where instance DynGraph Gr where (p, v, l, s) & (Gr g) - = let !g1 = IM.insert v (fromAdj p, l, fromAdj s) g - !g2 = addSucc g1 v p - !g3 = addPred g2 v s + = let !g1 = IM.insert v (preds, l, succs) g + !g2 = addSucc g1 v preds + !g3 = addPred g2 v succs + !preds = fromAdj p + !succs = fromAdj s in Gr g3 -#if MIN_VERSION_containers (0,4,2) instance (NFData a, NFData b) => NFData (Gr a b) where rnf (Gr g) = rnf g -#endif #if MIN_VERSION_base (4,8,0) instance Bifunctor Gr where @@ -144,8 +144,8 @@ matchGr node (Gr g) -> let !g1 = IM.delete node g !p' = IM.delete node p !s' = IM.delete node s - !g2 = clearPred g1 node (IM.keys s') - !g3 = clearSucc g2 node (IM.keys p') + !g2 = clearPred g1 node s' + !g3 = clearSucc g2 node p' in (Just (toAdj p', node, label, toAdj s), Gr g3) ---------------------------------------------------------------------- @@ -220,6 +220,22 @@ toAdj = concatMap expand . IM.toList fromAdj :: Adj b -> IntMap [b] fromAdj = IM.fromListWith addLists . map (second (:[]) . swap) +data FromListCounting a = FromListCounting !Int !(IntMap a) + +getFromListCounting :: FromListCounting a -> (Int, IntMap a) +getFromListCounting (FromListCounting i m) = (i, m) +{-# INLINE getFromListCounting #-} + +fromListWithKeyCounting :: (Int -> a -> a -> a) -> [(Int, a)] -> (Int, IntMap a) +fromListWithKeyCounting f = getFromListCounting . foldl' ins (FromListCounting 0 IM.empty) + where + ins (FromListCounting i t) (k,x) = FromListCounting (i + 1) (IM.insertWithKey f k x t) +{-# INLINE fromListWithKeyCounting #-} + +fromListWithCounting :: (a -> a -> a) -> [(Int, a)] -> (Int, IntMap a) +fromListWithCounting f = fromListWithKeyCounting (\_ x y -> f x y) +{-# INLINE fromListWithCounting #-} + toContext :: Node -> Context' a b -> Context a b toContext v (ps, a, ss) = (toAdj ps, v, a, toAdj ss) @@ -238,33 +254,30 @@ addLists [a] as = a : as addLists as [a] = a : as addLists xs ys = xs ++ ys -addSucc :: GraphRep a b -> Node -> [(b, Node)] -> GraphRep a b -addSucc g _ [] = g -addSucc g v ((l, p) : rest) = addSucc g' v rest - where - g' = IM.adjust f p g - f (ps, l', ss) = (ps, l', IM.insertWith addLists v [l] ss) - - -addPred :: GraphRep a b -> Node -> [(b, Node)] -> GraphRep a b -addPred g _ [] = g -addPred g v ((l, s) : rest) = addPred g' v rest +addSucc :: forall a b . GraphRep a b -> Node -> IM.IntMap [b] -> GraphRep a b +addSucc g v = IMS.differenceWith go g where - g' = IM.adjust f s g - f (ps, l', ss) = (IM.insertWith addLists v [l] ps, l', ss) - + 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') -clearSucc :: GraphRep a b -> Node -> [Node] -> GraphRep a b -clearSucc g _ [] = g -clearSucc g v (p:rest) = clearSucc g' v rest +addPred :: forall a b . GraphRep a b -> Node -> IM.IntMap [b] -> GraphRep a b +addPred g v = IMS.differenceWith go g where - g' = IM.adjust f p g - f (ps, l, ss) = (ps, l, IM.delete v ss) + 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) +clearSucc :: forall a b x . GraphRep a b -> Node -> IM.IntMap x -> GraphRep a b +clearSucc g v = IMS.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') -clearPred :: GraphRep a b -> Node -> [Node] -> GraphRep a b -clearPred g _ [] = g -clearPred g v (s:rest) = clearPred g' v rest +clearPred :: forall a b x . GraphRep a b -> Node -> IM.IntMap x -> GraphRep a b +clearPred g v = IMS.differenceWith go g where - g' = IM.adjust f s g - f (ps, l, ss) = (IM.delete v ps, l, ss) + go :: Context' a b -> x -> Maybe (Context' a b) + go (ps, l, ss) _ = let !ps' = IM.delete v ps + in Just (ps', l, ss) diff --git a/Data/Graph/Inductive/Tree.hs b/Data/Graph/Inductive/Tree.hs index f8f9087..979162b 100644 --- a/Data/Graph/Inductive/Tree.hs +++ b/Data/Graph/Inductive/Tree.hs @@ -19,9 +19,7 @@ import Data.Map (Map) import qualified Data.Map as M import Data.Maybe (fromMaybe) -#if MIN_VERSION_containers (0,4,2) import Control.DeepSeq (NFData (..)) -#endif #if __GLASGOW_HASKELL__ >= 702 import GHC.Generics (Generic) @@ -130,10 +128,8 @@ instance DynGraph Gr where (const (error ("Node Exception, Node: "++show v))) cntxt' = (p,l,s) -#if MIN_VERSION_containers (0,4,2) instance (NFData a, NFData b) => NFData (Gr a b) where rnf (Gr g) = rnf g -#endif #if MIN_VERSION_base (4,8,0) instance Bifunctor Gr where diff --git a/fgl.cabal b/fgl.cabal index 57fe5ae..931b84b 100644 --- a/fgl.cabal +++ b/fgl.cabal @@ -24,11 +24,6 @@ source-repository head type: git location: git://github.com/haskell/fgl.git -flag containers042 { - manual: False - default: True -} - library { default-language: Haskell98 @@ -69,11 +64,8 @@ library { , transformers , array - if flag(containers042) - build-depends: containers >= 0.4.2 - , deepseq >= 1.1.0.0 && < 1.5 - else - build-depends: containers < 0.4.2 + build-depends: containers >= 0.5.0 + , deepseq >= 1.1.0.0 && < 1.5 if impl(ghc >= 7.2) && impl(ghc < 7.6) build-depends: @@ -122,23 +114,10 @@ benchmark fgl-benchmark { , microbench , deepseq - ghc-options: -Wall -O2 - -} - -benchmark fgl-benchmark { - default-language: Haskell98 - - type: exitcode-stdio-1.0 + if impl(ghc < 7.8) + build-depends: + tagged - hs-source-dirs: test - - main-is: benchmark.hs - - build-depends: fgl - , base - , microbench - - ghc-options: -Wall + ghc-options: -Wall -O2 }