Hello community, here is the log from the commit of package ghc-fgl for openSUSE:Factory checked in at 2017-04-14 13:37:46 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-fgl (Old) and /work/SRC/openSUSE:Factory/.ghc-fgl.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-fgl" Fri Apr 14 13:37:46 2017 rev:15 rq:485125 version:5.5.3.1 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-fgl/ghc-fgl.changes 2016-08-24 10:08:13.000000000 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-fgl.new/ghc-fgl.changes 2017-04-14 13:37:48.010720491 +0200 @@ -1,0 +2,5 @@ +Tue Mar 7 11:19:16 UTC 2017 - [email protected] + +- Update to version 5.5.3.1 with cabal2obs. + +------------------------------------------------------------------- Old: ---- fgl-5.5.3.0.tar.gz New: ---- fgl-5.5.3.1.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-fgl.spec ++++++ --- /var/tmp/diff_new_pack.qopfvh/_old 2017-04-14 13:37:48.622634009 +0200 +++ /var/tmp/diff_new_pack.qopfvh/_new 2017-04-14 13:37:48.622634009 +0200 @@ -1,7 +1,7 @@ # # spec file for package ghc-fgl # -# Copyright (c) 2016 SUSE LINUX GmbH, Nuernberg, Germany. +# Copyright (c) 2017 SUSE LINUX GmbH, Nuernberg, Germany. # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -19,11 +19,11 @@ %global pkg_name fgl %bcond_with tests Name: ghc-%{pkg_name} -Version: 5.5.3.0 +Version: 5.5.3.1 Release: 0 Summary: Martin Erwig's Functional Graph Library License: BSD-3-Clause -Group: System/Libraries +Group: Development/Languages/Other Url: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz BuildRequires: ghc-Cabal-devel @@ -58,19 +58,15 @@ %prep %setup -q -n %{pkg_name}-%{version} - %build %ghc_lib_build - %install %ghc_lib_install - %check %cabal_test - %post devel %ghc_pkg_recache ++++++ fgl-5.5.3.0.tar.gz -> fgl-5.5.3.1.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/fgl-5.5.3.0/ChangeLog new/fgl-5.5.3.1/ChangeLog --- old/fgl-5.5.3.0/ChangeLog 2016-07-15 08:40:25.000000000 +0200 +++ new/fgl-5.5.3.1/ChangeLog 2017-03-03 07:01:19.000000000 +0100 @@ -1,3 +1,15 @@ +5.5.3.1 +------- + +* Hopefully clearer documentation for `&`, `Context` and the + `ufold`-based functions. + +* Thanks to David Feuer, the existing benchmark suite is now runnable + with `cabal bench`. + +* Some performance improvements for `PatriciaTree`, thanks to David + Feuer. + 5.5.3.0 ------- diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/fgl-5.5.3.0/Data/Graph/Inductive/Graph.hs new/fgl-5.5.3.1/Data/Graph/Inductive/Graph.hs --- old/fgl-5.5.3.0/Data/Graph/Inductive/Graph.hs 2016-07-15 08:40:25.000000000 +0200 +++ new/fgl-5.5.3.1/Data/Graph/Inductive/Graph.hs 2017-03-03 07:01:19.000000000 +0100 @@ -111,6 +111,9 @@ -- | Labeled links to or from a 'Node'. type Adj b = [(b,Node)] -- | Links to the 'Node', the 'Node' itself, a label, links from the 'Node'. +-- +-- In other words, this captures all information regarding the +-- specified 'Node' within a graph. type Context a b = (Adj b,Node,a,Adj b) -- Context a b "=" Context' a b "+" Node type MContext a b = Maybe (Context a b) -- | 'Graph' decomposition - the context removed from a 'Graph', and the rest @@ -176,8 +179,11 @@ class (Graph gr) => DynGraph gr where -- | Merge the 'Context' into the 'DynGraph'. -- - -- Contexts should only refer to either a Node already in a graph - -- or the node in the Context itself (for loops). + -- Context adjacencies should only refer to either a Node already + -- in a graph or the node in the Context itself (for loops). + -- + -- Behaviour is undefined if the specified 'Node' already exists + -- in the graph. (&) :: Context a b -> gr a b -> gr a b @@ -198,7 +204,7 @@ size :: (Graph gr) => gr a b -> Int size = length . labEdges --- | Fold a function over the graph. +-- | Fold a function over the graph by recursively calling 'match'. ufold :: (Graph gr) => (Context a b -> c -> c) -> c -> gr a b -> c ufold f u g | isEmpty g = u @@ -206,7 +212,7 @@ where (c,g') = matchAny g --- | Map a function over the graph. +-- | Map a function over the graph by recursively calling 'match'. gmap :: (DynGraph gr) => (Context a b -> Context c d) -> gr a b -> gr c d gmap f = ufold (\c->(f c&)) empty {-# NOINLINE [0] gmap #-} @@ -343,7 +349,7 @@ labUNodes = map (flip (,) ()) -- | Build a graph out of the contexts for which the predicate is --- true. +-- satisfied by recursively calling 'match'. gfiltermap :: DynGraph gr => (Context a b -> MContext c d) -> gr a b -> gr c d gfiltermap f = ufold (maybe id (&) . f) empty diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/fgl-5.5.3.0/Data/Graph/Inductive/PatriciaTree.hs new/fgl-5.5.3.1/Data/Graph/Inductive/PatriciaTree.hs --- old/fgl-5.5.3.0/Data/Graph/Inductive/PatriciaTree.hs 2016-07-15 08:40:25.000000000 +0200 +++ new/fgl-5.5.3.1/Data/Graph/Inductive/PatriciaTree.hs 2017-03-03 07:01:19.000000000 +0100 @@ -30,11 +30,17 @@ import Control.Applicative (liftA2) import Data.IntMap (IntMap) import qualified Data.IntMap as IM -import Data.List (sort) +import Data.List (foldl', sort) import Data.Maybe (fromMaybe) #if MIN_VERSION_containers (0,4,2) -import Control.DeepSeq (NFData (..)) +import Control.DeepSeq (NFData(..)) +#endif + +#if MIN_VERSION_containers(0,5,0) +import qualified Data.IntMap.Strict as IMS +#else +import qualified Data.IntMap as IMS #endif #if __GLASGOW_HASKELL__ >= 702 @@ -115,9 +121,11 @@ 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 + !(np, preds) = fromAdjCounting p + !(ns, succs) = fromAdjCounting s + !g2 = addSucc g1 v np preds + !g3 = addPred g2 v ns succs in Gr g3 #if MIN_VERSION_containers (0,4,2) @@ -144,8 +152,8 @@ -> 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) ---------------------------------------------------------------------- @@ -166,11 +174,11 @@ fastInsEdge :: LEdge b -> Gr a b -> Gr a b fastInsEdge (v, w, l) (Gr g) = g2 `seq` Gr g2 where - g1 = IM.adjust addSucc' v g - g2 = IM.adjust addPred' w g1 + g1 = IM.adjust addS' v g + g2 = IM.adjust addP' w g1 - addSucc' (ps, l', ss) = (ps, l', IM.insertWith addLists w [l] ss) - addPred' (ps, l', ss) = (IM.insertWith addLists v [l] ps, l', ss) + addS' (ps, l', ss) = (ps, l', IM.insertWith addLists w [l] ss) + addP' (ps, l', ss) = (IM.insertWith addLists v [l] ps, l', ss) {-# RULES "gmap/Data.Graph.Inductive.PatriciaTree" gmap = fastGMap @@ -220,6 +228,31 @@ fromAdj :: Adj b -> IntMap [b] fromAdj = IM.fromListWith addLists . map (second (:[]) . swap) +data FromListCounting a = FromListCounting !Int !(IntMap a) + deriving (Eq, Show, Read) + +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 #-} + +fromAdjCounting :: Adj b -> (Int, IntMap [b]) +fromAdjCounting = fromListWithCounting addLists . map (second (:[]) . swap) + +-- We use differenceWith to modify a graph more than bulkThreshold times, +-- and repeated insertWith otherwise. +bulkThreshold :: Int +bulkThreshold = 5 + toContext :: Node -> Context' a b -> Context a b toContext v (ps, a, ss) = (toAdj ps, v, a, toAdj ss) @@ -238,33 +271,44 @@ 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 -> Int -> IM.IntMap [b] -> GraphRep a b +addSucc g0 v numAdd xs + | numAdd < bulkThreshold = IM.foldlWithKey' go g0 xs where - g' = IM.adjust f s g - f (ps, l', ss) = (IM.insertWith addLists v [l] ps, l', ss) - - -clearSucc :: GraphRep a b -> Node -> [Node] -> GraphRep a b -clearSucc g _ [] = g -clearSucc g v (p:rest) = clearSucc g' v rest + go :: GraphRep a b -> Node -> [b] -> GraphRep a b + go g p l = IMS.adjust f p g + where f (ps, l', ss) = let !ss' = IM.insertWith (++) v l ss + in (ps, l', ss') +addSucc g v _ xs = IMS.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') + +addPred :: forall a b . GraphRep a b -> Node -> Int -> IM.IntMap [b] -> GraphRep a b +addPred g0 v numAdd xs + | numAdd < bulkThreshold = IM.foldlWithKey' go g0 xs where - g' = IM.adjust f p g - f (ps, l, ss) = (ps, l, IM.delete v ss) + go :: GraphRep a b -> Node -> [b] -> GraphRep a b + go g p l = IMS.adjust f p g + where f (ps, l', ss) = let !ps' = IM.insertWith (++) v l ps + in (ps', l', ss) +addPred g v _ xs = IMS.differenceWith go g xs + 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) +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 -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/fgl-5.5.3.0/Data/Graph/Inductive/Query/DFS.hs new/fgl-5.5.3.1/Data/Graph/Inductive/Query/DFS.hs --- old/fgl-5.5.3.0/Data/Graph/Inductive/Query/DFS.hs 2016-07-15 08:40:25.000000000 +0200 +++ new/fgl-5.5.3.1/Data/Graph/Inductive/Query/DFS.hs 2017-03-03 07:01:19.000000000 +0100 @@ -6,7 +6,7 @@ -- -- 1. An optional direction parameter, specifying which nodes to visit next. -- --- [@x@] undirectional: ignore edge direction +-- [@u@] undirectional: ignore edge direction -- [@r@] reversed: walk edges in reverse -- [@x@] user defined: speciy which paths to follow -- diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/fgl-5.5.3.0/fgl.cabal new/fgl-5.5.3.1/fgl.cabal --- old/fgl-5.5.3.0/fgl.cabal 2016-07-15 08:40:25.000000000 +0200 +++ new/fgl-5.5.3.1/fgl.cabal 2017-03-03 07:01:19.000000000 +0100 @@ -1,5 +1,5 @@ name: fgl -version: 5.5.3.0 +version: 5.5.3.1 license: BSD3 license-file: LICENSE author: Martin Erwig, Ivan Lazar Miljenovic @@ -91,7 +91,7 @@ build-depends: fgl , base , QuickCheck >= 2.8 && < 2.10 - , hspec >= 2.1 && < 2.3 + , hspec >= 2.1 && < 2.5 , containers hs-source-dirs: test @@ -106,4 +106,24 @@ ghc-options: -Wall +} + +benchmark fgl-benchmark { + default-language: Haskell98 + + type: exitcode-stdio-1.0 + + hs-source-dirs: test + + main-is: benchmark.hs + + other-modules: Data.Graph.Inductive.Proxy + + build-depends: fgl + , base + , microbench + , deepseq + + ghc-options: -Wall + } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/fgl-5.5.3.0/test/Data/Graph/Inductive/Graph/Properties.hs new/fgl-5.5.3.1/test/Data/Graph/Inductive/Graph/Properties.hs --- old/fgl-5.5.3.0/test/Data/Graph/Inductive/Graph/Properties.hs 2016-07-15 08:40:25.000000000 +0200 +++ new/fgl-5.5.3.1/test/Data/Graph/Inductive/Graph/Properties.hs 2017-03-03 07:01:19.000000000 +0100 @@ -93,14 +93,14 @@ valid_match :: (Graph gr) => gr a b -> Property valid_match g = not (isEmpty g) ==> check_match <$> elements (nodes g) where - order = noNodes g + ordr = noNodes g check_match n = maybe False check_context mc where (mc, g') = match n g check_context c = (node' c `notElem` nodes g') - && (noNodes g' == order - 1) + && (noNodes g' == ordr - 1) -- Edges were previously in the graph && all (elem (node' c) . pre g) (sucC c) && all (elem (node' c) . suc g) (preC c) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/fgl-5.5.3.0/test/benchmark.hs new/fgl-5.5.3.1/test/benchmark.hs --- old/fgl-5.5.3.0/test/benchmark.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/fgl-5.5.3.1/test/benchmark.hs 2017-03-03 07:01:19.000000000 +0100 @@ -0,0 +1,173 @@ +{- + This program should generally be run using `cabal bench` or + `stack bench`. To use `stack bench`, edit stack.yaml to include + + extra-deps: + - microbench-0.1 + + To run benchmarks manually, install microbench from + http://hackage.haskell.org/cgi-bin/hackage-scripts/package/microbench + + then run + + % ghc -O --make benchmark + % ./benchmark + [1 of 1] Compiling Main ( benchmark.hs, benchmark.o ) + Linking benchmark ... + * insNode into AVL tree: .................. + 8.877ns per iteration / 112655.53 per second. + * insNode into PATRICIA tree: ..................... + 1.788ns per iteration / 559342.86 per second. + * insEdge into AVL tree: ........... + 2833.029ns per iteration / 352.98 per second. + * insEdge into PATRICIA tree: ................... + 4.625ns per iteration / 216224.60 per second. + * gmap on AVL tree: ................ + 32.754ns per iteration / 30530.57 per second. + * gmap on PATRICIA tree: ..................... + 1.623ns per iteration / 616056.37 per second. + * nmap on AVL tree: ................ + 35.455ns per iteration / 28204.95 per second. + * nmap on PATRICIA tree: ..................... + 1.713ns per iteration / 583758.06 per second. + * emap on AVL tree: ........... + 4416.303ns per iteration / 226.43 per second. + * emap on PATRICIA tree: ................... + 4.532ns per iteration / 220663.09 per second. +-} + +{-# LANGUAGE ScopedTypeVariables #-} + +module Main (main) where + +import Control.DeepSeq +import Data.Graph.Inductive.Graph +import qualified Data.Graph.Inductive.PatriciaTree as Patricia +import Data.Graph.Inductive.Proxy +import qualified Data.Graph.Inductive.Tree as AVL +import Microbench + +main :: IO () +main = do microbench "insNode into AVL tree" insNodeAVL + microbench "insNode into PATRICIA tree" insNodePatricia + + microbench "buildFull into AVL tree 100" (buildFullAVL 100) + microbench "buildFull into AVL tree 500" (buildFullAVL 500) + microbench "buildFull into AVL tree 1000" (buildFullAVL 1000) + + microbench "buildFull into PATRICIA tree 100" (buildFullPatricia 100) + microbench "buildFull into PATRICIA tree 500" (buildFullPatricia 500) + microbench "buildFull into PATRICIA tree 1000" (buildFullPatricia 1000) + + microbench "insEdge into AVL tree" insEdgeAVL + microbench "insEdge into PATRICIA tree" insEdgePatricia + + microbench "gmap on AVL tree" gmapAVL + microbench "gmap on PATRICIA tree" gmapPatricia + + microbench "nmap on AVL tree" nmapAVL + microbench "nmap on PATRICIA tree" nmapPatricia + + microbench "emap on AVL tree" emapAVL + microbench "emap on PATRICIA tree" emapPatricia + +buildFullAVL :: Int -> Int -> () +buildFullAVL = buildFull (Proxy :: TreeP) + +insNodeAVL :: Int -> AVL.UGr +insNodeAVL = insNodes' empty + +buildFullPatricia :: Int -> Int -> () +buildFullPatricia = buildFull (Proxy :: PatriciaTreeP) + +insNodePatricia :: Int -> Patricia.UGr +insNodePatricia = insNodes' empty + +buildFull :: forall gr . (DynGraph gr, NFData (gr Int ())) + => GraphProxy gr -> Int -> Int -> () +buildFull _ sz ntimes = rnf [buildFull' i (empty :: gr Int ()) 0 sz | i <- [0..ntimes-1]] + +buildFull' :: DynGraph gr => a -> gr a () -> Int -> Int -> gr a () +buildFull' a g n limit + | n == limit = empty + | otherwise = ([((), k) | k <- [0..n-1]],n,a,[((),k) | k <- [0..n-1]]) & buildFull' a g (n + 1) limit + + +{-# INLINE insNodes' #-} +insNodes' :: DynGraph gr => gr () b -> Int -> gr () b +insNodes' g 0 = g +insNodes' g n = let [v] = newNodes 1 g + g' = insNode (v, ()) g + in + insNodes' g' (n - 1) + + +insEdgeAVL :: Int -> AVL.UGr +insEdgeAVL n = insEdges' (insNodeAVL n) n + + +insEdgePatricia :: Int -> Patricia.UGr +insEdgePatricia n = insEdges' (insNodePatricia n) n + + +{-# INLINE insEdges' #-} +insEdges' :: DynGraph gr => gr a () -> Int -> gr a () +insEdges' g 0 = g +insEdges' g n = let n' = n - 1 + g' = insEdge (0, n', ()) g + in + insEdges' g' n' + + +gmapAVL :: Int -> AVL.Gr Int () +gmapAVL n + = let g = insNodeAVL n + g' = gmap f g + f (ps, v, _, ss) = (ps, v, v, ss) + in + g' + + +gmapPatricia :: Int -> Patricia.Gr Int () +gmapPatricia n + = let g = insNodePatricia n + g' = gmap f g + f (ps, v, _, ss) = (ps, v, v, ss) + in + g' + + +nmapAVL :: Int -> AVL.Gr Int () +nmapAVL n + = let g = insNodeAVL n + g' = nmap f g + f _ = n + in + g' + + +nmapPatricia :: Int -> Patricia.Gr Int () +nmapPatricia n + = let g = insNodePatricia n + g' = nmap f g + f _ = n + in + g' + + +emapAVL :: Int -> AVL.Gr () Int +emapAVL n + = let g = insEdgeAVL n + g' = emap f g + f _ = n + in + g' + + +emapPatricia :: Int -> Patricia.Gr () Int +emapPatricia n + = let g = insEdgePatricia n + g' = emap f g + f _ = n + in + g'
