algebra-dag 0.1.0.0 → 0.1.1.1

raw patch · 8 files changed

+44/−29 lines, 8 filesdep ~basesetup-changedPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• Setup.hs +1/−0
• algebra-dag.cabal +5/−2
• src/Database/Algebra/Dag.hs +21/−12
• src/Database/Algebra/Rewrite/DagRewrite.hs +0/−1
• src/Database/Algebra/Rewrite/Match.hs +0/−1
• src/Database/Algebra/Rewrite/PatternConstruction.hs +1/−2
• src/Database/Algebra/Rewrite/Properties.hs +10/−4
• src/Database/Algebra/Rewrite/Traversal.hs +6/−7

@@ -1,2 +1,3 @@ import Distribution.Simple+ main = defaultMain

@@ -2,7 +2,7 @@ Name:           algebra-dag synopsis:       Infrastructure for DAG-shaped relational algebra plans Category:       Database-Version:        0.1.0.0+Version:        0.1.1.1 Description:    This library contains infrastructure for DAG-shaped plans of relational operators.                 It offers an API for construction and modification of algebra plans and a DSL                 for specifying rewrites on plans. Examples of usage can be found in the packages@@ -16,7 +16,7 @@  library     buildable:        True-    build-depends:    base               >= 4.7 && < 5,  +    build-depends:    base               >= 4.8 && < 5,                         mtl                >= 2.1,                        containers         >= 0.5,                        template-haskell   >= 2.9, @@ -41,3 +41,6 @@     GHC-Options:       -Wall -fno-warn-orphans     other-modules:    Database.Algebra.Rewrite.PatternSyntax		       +source-repository head+    type:     git+    location: https://github.com/ulricha/algebra-dag

@@ -23,8 +23,9 @@        , replaceRoot        , collect        ) where-       + import           Control.Exception.Base+import           Data.Aeson import qualified Data.Graph.Inductive.Graph        as G import           Data.Graph.Inductive.PatriciaTree import qualified Data.Graph.Inductive.Query.DFS    as DFS@@ -44,6 +45,14 @@   , refCountMap :: NodeMap Int     -- ^ A map storing the number of parents for each node.   } +instance ToJSON a => ToJSON (AlgebraDag a) where+    toJSON dag = toJSON (nodeMap dag, rootNodes dag)++instance (FromJSON a, Operator a) => FromJSON (AlgebraDag a) where+    parseJSON v = do+        (nm, rs) <- parseJSON v+        return $ mkDag nm rs+ class (Ord a, Show a) => Operator a where     opChildren     :: a -> [AlgNode]     replaceOpChild :: a -> AlgNode -> AlgNode -> a@@ -54,7 +63,7 @@ -- nodes are not pruned if they don't have any incoming edges. initRefCount :: Operator o => [AlgNode] -> NodeMap o -> NodeMap Int initRefCount rs nm = L.foldl' incParents (IM.foldr' insertEdge IM.empty nm) (L.nub rs)-  where +  where     insertEdge op rm = L.foldl' incParents rm (L.nub $ opChildren op)     incParents rm n  = IM.insert n ((IM.findWithDefault 0 n rm) + 1) rm @@ -72,18 +81,18 @@                         , opMap = initOpMap mNormalized                         , nextNodeID = 1 + (fst $ IM.findMax mNormalized)                         }-  where +  where     mNormalized = normalizeMap rs m     g =  uncurry G.mkUGraph $ IM.foldrWithKey aux ([], []) mNormalized     aux n op (allNodes, allEdges) = (n : allNodes, es ++ allEdges)-      where +      where         es = map (\v -> (n, v)) $ opChildren op  -- | Construct an empty DAG with no root nodes. Beware: before any -- collections are performed, root nodes must be added. Otherwise, all -- nodes will be considered unreachable. emptyDag :: AlgebraDag a-emptyDag = +emptyDag =     AlgebraDag { nodeMap     = IM.empty                , opMap       = M.empty                , nextNodeID  = 1@@ -109,15 +118,15 @@     mNormalized     = normalizeMap rs (nodeMap d)      aux n op (allNodes, allEdges) = (n : allNodes, es ++ allEdges)-      where +      where         es = map (\v -> (n, v)) $ opChildren op  reachable :: Operator a => NodeMap a -> [AlgNode] -> S.Set AlgNode-reachable m rs = L.foldl' traverse S.empty rs-  where traverse :: S.Set AlgNode -> AlgNode -> S.Set AlgNode-        traverse s n = if S.member n s-                       then s-                       else L.foldl' traverse (S.insert n s) (opChildren $ lookupOp n)+reachable m rs = L.foldl' traverseDag S.empty rs+  where traverseDag :: S.Set AlgNode -> AlgNode -> S.Set AlgNode+        traverseDag s n = if S.member n s+                          then s+                          else L.foldl' traverseDag (S.insert n s) (opChildren $ lookupOp n)          lookupOp n = case IM.lookup n m of                        Just op -> op@@ -262,7 +271,7 @@              if new `elem` G.suc (graph d) parent              then d''              else addRefTo d'' new-          +      else d  -- | Returns the operator for a node.

@@ -30,7 +30,6 @@        , collect        ) where -import           Control.Applicative import           Control.Monad.State import           Control.Monad.Writer import qualified Data.IntMap                 as IM

@@ -18,7 +18,6 @@  import qualified Data.IntMap                 as M -import           Control.Applicative import           Control.Monad.Reader import           Control.Monad.Trans.Maybe 

@@ -2,10 +2,9 @@  module Database.Algebra.Rewrite.PatternConstruction     ( dagPatMatch-    , v +    , v     ) where -import           Control.Applicative import           Control.Monad.Writer import           Data.Maybe import           Language.Haskell.TH

@@ -20,15 +20,21 @@   put $ M.insert n p pm  -traverse :: (Show o, Operator o) => (NodeMap o -> o -> AlgNode -> NodeMap p -> p) -> AlgNode -> Inference p o ()-traverse inferWorker n = do+traverseInfer :: (Show o, Operator o)+              => (NodeMap o+              -> o+              -> AlgNode+              -> NodeMap p -> p)+              -> AlgNode+              -> Inference p o ()+traverseInfer inferWorker n = do   visited <- hasBeenVisited n   if visited     then return ()     else do       dag <- lift ask       let op = operator n dag-      mapM_ (traverse inferWorker) (opChildren op)+      mapM_ (traverseInfer inferWorker) (opChildren op)       pm <- get       putProperty n (inferWorker (nodeMap dag) op n pm) @@ -38,4 +44,4 @@                         -> AlgebraDag o                   -- ^ The DAG                         -> NodeMap p                      -- ^ The final mapping from nodes to properties inferBottomUpGeneral inferWorker dag = runReader (execStateT infer M.empty) dag-  where infer = mapM_ (traverse inferWorker) (rootNodes dag)+  where infer = mapM_ (traverseInfer inferWorker) (rootNodes dag)

@@ -7,7 +7,6 @@        , sequenceRewrites        ) where -import           Control.Applicative import           Control.Monad  import qualified Data.IntMap                         as M@@ -55,7 +54,7 @@             -> RuleSet o p e             -> Rewrite o e Bool preOrder inferAction rules =-  let traverse (changedPrev, mProps, visited) q =+  let traversePre (changedPrev, mProps, visited) q =         if q `S.member` visited         then return (changedPrev, mProps, visited)         else do@@ -87,12 +86,12 @@           props <- case mProps of             Just ps -> return ps             Nothing -> inferAction-          traverse (changedPrev, Just props, visited) c+          traversePre (changedPrev, Just props, visited) c    in do     pm <- inferAction     rs <- rootNodes-    (changed, _, _) <- foldM traverse (False, Just pm, S.empty) rs+    (changed, _, _) <- foldM traversePre (False, Just pm, S.empty) rs     return changed  {- | Map a ruleset over the nodes of a DAG in topological order. This function assumes that@@ -119,7 +118,7 @@              -> RuleSet o p e              -> Rewrite o e Bool postOrder inferAction rules =-  let traverse (changedPrev, props, visited) q =+  let traversePost (changedPrev, props, visited) q =         if q `S.member` visited         then return (changedPrev, props, visited)         else do@@ -149,12 +148,12 @@           props <- case mProps of             Just ps -> return ps             Nothing -> inferAction-          traverse (changedPrev, Just props, visited) c+          traversePost (changedPrev, Just props, visited) c    in do     pm <- inferAction     rs <- rootNodes-    (changed, _, _) <- foldM traverse (False, Just pm, S.empty) rs+    (changed, _, _) <- foldM traversePost (False, Just pm, S.empty) rs     return changed  -- | Iteratively apply a rewrite, until no further changes occur.