-
-- | Basic operations on graphs.
--
-
-{-# OPTIONS -w #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and fix
--- any warnings in the module. See
--- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
--- for details
+{-# OPTIONS -fno-warn-missing-signatures #-}
module GraphOps (
addNode, delNode, getNode, lookupNode, modNode,
import Data.List hiding (union)
import Data.Maybe
-
-- | Lookup a node from the graph.
lookupNode
:: Uniquable k
| otherwise
= graphMapModify
- $ (\fm -> foldr (\u -> addConflictSet1 u getClass conflicts) fm
+ $ (\fm -> foldl' (\g u -> addConflictSet1 u getClass conflicts g) fm
$ uniqSetToList conflicts)
addConflictSet1 u getClass set
- = let set' = delOneFromUniqSet set u
- in adjustWithDefaultUFM
+ = case delOneFromUniqSet set u of
+ set' -> adjustWithDefaultUFM
(\node -> node { nodeConflicts = unionUniqSets set' (nodeConflicts node) } )
(newNode u (getClass u)) { nodeConflicts = set' }
u
slurpNodeConflictCount graph
= addListToUFM_C
- (\(c1, n1) (c2, n2) -> (c1, n1 + n2))
+ (\(c1, n1) (_, n2) -> (c1, n1 + n2))
emptyUFM
$ map (\node
-> let count = sizeUniqSet $ nodeConflicts node
u
+{-# INLINE adjustWithDefaultUFM #-}
adjustWithDefaultUFM
:: Uniquable k
=> (a -> a) -> a -> k
adjustWithDefaultUFM f def k map
= addToUFM_C
- (\old new -> f old)
+ (\old _ -> f old)
map
k def
-
+{-# INLINE adjustUFM #-}
adjustUFM
:: Uniquable k
=> (a -> a)
= case lookupUFM map k of
Nothing -> map
Just a -> addToUFM map k (f a)
-