diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,27 @@
+Copyright (c) Eberhard Karls Universität Tübingen 2010
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+1. Redistributions of source code must retain the above copyright
+   notice, this list of conditions and the following disclaimer.
+2. Redistributions in binary form must reproduce the above copyright
+   notice, this list of conditions and the following disclaimer in the
+   documentation and/or other materials provided with the distribution.
+3. Neither the name of the author nor the names of his contributors
+   may be used to endorse or promote products derived from this software
+   without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+SUCH DAMAGE.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/algebra-dag.cabal b/algebra-dag.cabal
new file mode 100644
--- /dev/null
+++ b/algebra-dag.cabal
@@ -0,0 +1,43 @@
+cabal-version: >=1.8
+Name:           algebra-dag
+synopsis:       Infrastructure for DAG-shaped relational algebra plans
+Category:       Database
+Version:        0.1.0.0
+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
+                <http://hackage.haskell.org/package/DSH DSH> and 
+                <http://hackage.haskell.org/package/algebra-sql algebra-sql>
+License:        BSD3
+License-file:   LICENSE
+Author:		Alexander Ulrich
+Maintainer:	alex@etc-network.de
+Build-Type:     Simple
+
+library
+    buildable:        True
+    build-depends:    base               >= 4.7 && < 5,  
+                      mtl                >= 2.1, 
+                      containers         >= 0.5, 
+                      template-haskell   >= 2.9, 
+                      fgl                >= 5.5, 
+                      transformers       >= 0.3, 
+                      parsec             >= 3.1,
+                      aeson              >= 0.8
+
+    exposed-modules:  Database.Algebra.Dag
+                      Database.Algebra.Dag.Build
+                      Database.Algebra.Dag.Common
+
+                      Database.Algebra.Rewrite
+                      Database.Algebra.Rewrite.Match
+                      Database.Algebra.Rewrite.Traversal
+                      Database.Algebra.Rewrite.Rule
+                      Database.Algebra.Rewrite.Properties
+                      Database.Algebra.Rewrite.PatternConstruction
+                      Database.Algebra.Rewrite.DagRewrite
+
+    hs-source-dirs:   src
+    GHC-Options:       -Wall -fno-warn-orphans
+    other-modules:    Database.Algebra.Rewrite.PatternSyntax		      
+
diff --git a/src/Database/Algebra/Dag.hs b/src/Database/Algebra/Dag.hs
new file mode 100644
--- /dev/null
+++ b/src/Database/Algebra/Dag.hs
@@ -0,0 +1,285 @@
+module Database.Algebra.Dag
+       (
+         -- * The DAG data structure
+         AlgebraDag
+       , Operator(..)
+       , nodeMap
+       , rootNodes
+       , refCountMap
+       , mkDag
+       , emptyDag
+       , addRootNodes
+         -- * Query functions for topological and operator information
+       , parents
+         -- FIXME is topological sorting still necessary?
+       , topsort
+       , hasPath
+       , reachableNodesFrom
+       , operator
+         -- * DAG modification functions
+       , insert
+       , insertNoShare
+       , replaceChild
+       , replaceRoot
+       , collect
+       ) where
+       
+import           Control.Exception.Base
+import qualified Data.Graph.Inductive.Graph        as G
+import           Data.Graph.Inductive.PatriciaTree
+import qualified Data.Graph.Inductive.Query.DFS    as DFS
+import qualified Data.IntMap                       as IM
+import qualified Data.List                         as L
+import qualified Data.Map                          as M
+import qualified Data.Set                          as S
+
+import           Database.Algebra.Dag.Common
+
+data AlgebraDag a = AlgebraDag
+  { nodeMap     :: NodeMap a       -- ^ Return the nodemap of a DAG
+  , opMap       :: M.Map a AlgNode -- ^ reverse index from operators to nodeids
+  , nextNodeID  :: AlgNode         -- ^ the next node id to be used when inserting a node
+  , graph       :: UGr             -- ^ Auxilliary representation for topological information
+  , rootNodes   :: [AlgNode]       -- ^ Return the (possibly modified) list of root nodes from a DAG
+  , refCountMap :: NodeMap Int     -- ^ A map storing the number of parents for each node.
+  }
+
+class (Ord a, Show a) => Operator a where
+    opChildren     :: a -> [AlgNode]
+    replaceOpChild :: a -> AlgNode -> AlgNode -> a
+
+-- For every node, count the number of parents (or list of edges to the node).
+-- We don't consider the graph a multi-graph, so an edge (u, v) is only counted
+-- once.  We insert one virtual edge for every root node, to make sure that root
+-- 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 
+    insertEdge op rm = L.foldl' incParents rm (L.nub $ opChildren op)
+    incParents rm n  = IM.insert n ((IM.findWithDefault 0 n rm) + 1) rm
+
+initOpMap :: Ord o => NodeMap o -> M.Map o AlgNode
+initOpMap nm = IM.foldrWithKey (\n o om -> M.insert o n om) M.empty nm
+
+-- | Create a DAG from a node map of algebra operators and a list of
+-- root nodes. Nodes which are not reachable from the root nodes
+-- provided will be pruned!
+mkDag :: Operator a => NodeMap a -> [AlgNode] -> AlgebraDag a
+mkDag m rs = AlgebraDag { nodeMap = mNormalized
+                        , graph = g
+                        , rootNodes = rs
+                        , refCountMap = initRefCount rs mNormalized
+                        , opMap = initOpMap mNormalized
+                        , nextNodeID = 1 + (fst $ IM.findMax mNormalized)
+                        }
+  where 
+    mNormalized = normalizeMap rs m
+    g =  uncurry G.mkUGraph $ IM.foldrWithKey aux ([], []) mNormalized
+    aux n op (allNodes, allEdges) = (n : allNodes, es ++ allEdges)
+      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 = 
+    AlgebraDag { nodeMap     = IM.empty
+               , opMap       = M.empty
+               , nextNodeID  = 1
+               , graph       = G.mkUGraph [] []
+               , rootNodes   = []
+               , refCountMap = IM.empty
+               }
+
+-- | Add a list of root nodes to a DAG, all of which must be present
+-- in the DAG. The node map is normalized by removing all nodes which
+-- are not reachable from the root nodes.
+-- FIXME re-use graph, opmap etc, only remove pruned nodes.
+addRootNodes :: Operator a => AlgebraDag a -> [AlgNode] -> AlgebraDag a
+addRootNodes d rs = assert (all (\n -> IM.member n $ nodeMap d) rs) $
+    d { rootNodes = rs
+      , nodeMap     = mNormalized
+      , refCountMap = initRefCount rs mNormalized
+      , opMap       = initOpMap mNormalized
+      , graph       =  uncurry G.mkUGraph $ IM.foldrWithKey aux ([], []) mNormalized
+      }
+
+  where
+    mNormalized     = normalizeMap rs (nodeMap d)
+
+    aux n op (allNodes, allEdges) = (n : allNodes, es ++ allEdges)
+      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)
+
+        lookupOp n = case IM.lookup n m of
+                       Just op -> op
+                       Nothing -> error $ "node not present in map: " ++ (show n)
+
+normalizeMap :: Operator a => [AlgNode] -> NodeMap a -> NodeMap a
+normalizeMap rs m =
+  let reachableNodes = reachable m rs
+  in IM.filterWithKey (\n _ -> S.member n reachableNodes) m
+
+-- Utility functions to maintain the reference counter map and eliminate no
+-- longer referenced nodes.
+
+lookupRefCount :: AlgNode -> AlgebraDag a -> Int
+lookupRefCount n d =
+  case IM.lookup n (refCountMap d) of
+    Just c  -> c
+    Nothing -> error $ "no refcount value for node " ++ (show n)
+
+decrRefCount :: AlgebraDag a -> AlgNode -> AlgebraDag a
+decrRefCount d n =
+  let refCount = lookupRefCount n d
+      refCount' = assert (refCount /= 0) $ refCount - 1
+  in d { refCountMap = IM.insert n refCount' (refCountMap d) }
+
+-- | Delete a node from the node map and the aux graph
+-- Beware: this leaves the DAG in an inconsistent state, because
+-- reference counters have to be updated.
+delete' :: Operator a => AlgNode -> AlgebraDag a -> AlgebraDag a
+delete' n d =
+  let op     = operator n d
+      g'     = G.delNode n $ graph d
+      m'     = IM.delete n $ nodeMap d
+      rc'    = IM.delete n $ refCountMap d
+      opMap' = case M.lookup op $ opMap d of
+                 Just n' | n == n' -> M.delete op $ opMap d
+                 _                 -> opMap d
+  in d { nodeMap = m', graph = g', refCountMap = rc', opMap = opMap' }
+
+refCountSafe :: AlgNode -> AlgebraDag o -> Maybe Int
+refCountSafe n d = IM.lookup n $ refCountMap d
+
+collect :: Operator o => S.Set AlgNode -> AlgebraDag o -> AlgebraDag o
+collect collectNodes d = S.foldl' tryCollectNode d collectNodes
+  where tryCollectNode :: (Show o, Operator o) => AlgebraDag o -> AlgNode -> AlgebraDag o
+        tryCollectNode di n =
+          case refCountSafe n di of
+            Just rc -> if rc == 0
+                       then -- node is unreferenced -> collect it
+                            let cs = L.nub $ opChildren $ operator n di
+                                d' = delete' n di
+                            in L.foldl' cutEdge d' cs
+
+                       else di -- node is still referenced
+            Nothing -> di
+
+-- Cut an edge to a node reference counting wise.
+-- If the ref count becomes zero, the node is deleted and the children are
+-- traversed.
+
+cutEdge :: Operator a => AlgebraDag a -> AlgNode -> AlgebraDag a
+cutEdge d edgeTarget =
+  let d'          = decrRefCount d edgeTarget
+      newRefCount = lookupRefCount edgeTarget d'
+  in if newRefCount == 0
+     then let cs  = L.nub $ opChildren $ operator edgeTarget d'
+              d'' = delete' edgeTarget d'
+          in L.foldl' cutEdge d'' cs
+     else d'
+
+addRefTo :: AlgebraDag a -> AlgNode -> AlgebraDag a
+addRefTo d n =
+  let refCount = lookupRefCount n d
+  in d { refCountMap = IM.insert n (refCount + 1) (refCountMap d) }
+
+-- | Replace an entry in the list of root nodes with a new node. The root node must be
+-- present in the DAG.
+replaceRoot :: Operator a => AlgebraDag a -> AlgNode -> AlgNode -> AlgebraDag a
+replaceRoot d old new =
+  if old `elem` (rootNodes d)
+  then let rs'         = map doReplace $ rootNodes d
+           doReplace r = if r == old then new else r
+           d'          = d { rootNodes = rs' }
+       in -- cut the virtual edge to the old root
+          -- and insert a virtual edge to the new root
+          assert (old /= new) $ addRefTo (decrRefCount d' old) new
+  else d
+
+-- | Insert a new node into the DAG.
+insert :: Operator a => a -> AlgebraDag a -> (AlgNode, AlgebraDag a)
+insert op d =
+  -- check if an equivalent operator is already present
+  case M.lookup op $ opMap d of
+    Just n  -> (n, d)
+    -- no operator can be reused, insert a new one
+    Nothing -> insertNoShare op d
+
+-- | Insert an operator without checking if an equivalent operator is
+-- already present.
+insertNoShare :: Operator a => a -> AlgebraDag a -> (AlgNode, AlgebraDag a)
+insertNoShare op d =
+  let cs     = L.nub $ opChildren op
+      n      = nextNodeID d
+      g'     = G.insEdges (map (\c -> (n, c, ())) cs) $ G.insNode (n, ()) $ graph d
+      m'     = IM.insert n op $ nodeMap d
+      rc'    = IM.insert n 0 $ refCountMap d
+      opMap' = M.insert op n $ opMap d
+      d'     = d { nodeMap = m'
+                 , graph = g'
+                 , refCountMap = rc'
+                 , opMap = opMap'
+                 , nextNodeID = n + 1
+                 }
+  in (n, L.foldl' addRefTo d' cs)
+
+-- | Return the list of parents of a node.
+parents :: AlgNode -> AlgebraDag a -> [AlgNode]
+parents n d = G.pre (graph d) n
+
+-- | 'replaceChild n old new' replaces all links from node n to node old with links to node new.
+replaceChild :: Operator a => AlgNode -> AlgNode -> AlgNode -> AlgebraDag a -> AlgebraDag a
+replaceChild parent old new d =
+  let op = operator parent d
+  in if old `elem` opChildren op && old /= new
+     then let op' = replaceOpChild op old new
+              m'  = IM.insert parent op' $ nodeMap d
+              om' = M.insert op' parent $ M.delete op $ opMap d
+              g'  = G.insEdge (parent, new, ()) $ G.delEdge (parent, old) $ graph d
+              d'  = d { nodeMap = m', graph = g', opMap = om' }
+
+              -- Update reference counters if nodes are not simply
+              -- inserted or deleted but edges are replaced by other
+              -- edges.  We must not delete nodes before the new edges
+              -- have been taken into account. Only after that can we
+              -- certainly say that a node is no longer referenced
+              -- (edges might be replaced by themselves).
+
+              -- First, decrement refcounters for the old child
+              d'' = decrRefCount d' old
+          in -- Then, increment refcounters for the new child if the link was
+             -- not already present (we do not count multi-edges separately)
+             if new `elem` G.suc (graph d) parent
+             then d''
+             else addRefTo d'' new
+          
+     else d
+
+-- | Returns the operator for a node.
+operator :: Operator a => AlgNode -> AlgebraDag a -> a
+operator n d =
+    case IM.lookup n $ nodeMap d of
+        Just op -> op
+        Nothing -> error $ "AlgebraDag.operator: lookup failed for " ++ (show n) ++ "\n" ++ (show $ map fst $ IM.toList $ nodeMap d)
+
+-- | Return a topological ordering of all nodes which are reachable from the root nodes.
+topsort :: Operator a => AlgebraDag a -> [AlgNode]
+topsort d = DFS.topsort $ graph d
+
+-- | Return all nodes that are reachable from one node.
+reachableNodesFrom :: AlgNode -> AlgebraDag a -> S.Set AlgNode
+reachableNodesFrom n d = S.fromList $ DFS.reachable n $ graph d
+
+-- | Tests wether there is a path from the first to the second node.
+hasPath :: AlgNode -> AlgNode -> AlgebraDag a -> Bool
+hasPath a b d = b `S.member` (reachableNodesFrom a d)
diff --git a/src/Database/Algebra/Dag/Build.hs b/src/Database/Algebra/Dag/Build.hs
new file mode 100644
--- /dev/null
+++ b/src/Database/Algebra/Dag/Build.hs
@@ -0,0 +1,60 @@
+{-# LANGUAGE GADTs #-}
+
+module Database.Algebra.Dag.Build
+    ( Build
+    , runBuild
+    , tagM
+    , insert
+    , insertNoShare
+    ) where
+
+import           Control.Monad.State
+import qualified Data.IntMap                 as IM
+
+import qualified Database.Algebra.Dag        as Dag
+import           Database.Algebra.Dag.Common
+
+
+data BuildState alg = BuildState
+    { dag  :: Dag.AlgebraDag alg  -- ^ The operator DAG that is built
+    , tags :: NodeMap [Tag]       -- ^ Tags for nodes
+    }
+
+-- | The DAG builder monad, abstracted over the algebra stored in the
+-- DAG. Internally, the monad detects sharing of subgraphs via hash
+-- consing.
+type Build alg = State (BuildState alg)
+
+-- | Evaluate the monadic graph into an algebraic plan, given a loop
+-- relation.
+runBuild :: Build alg r -> (Dag.AlgebraDag alg, r, NodeMap [Tag])
+runBuild m = (dag s, r, tags s)
+  where 
+    initialBuildState = BuildState { dag = Dag.emptyDag, tags = IM.empty }
+    (r, s)            = runState m initialBuildState
+
+-- | Tag a subtree with a comment
+tag :: String -> AlgNode -> Build alg AlgNode
+tag msg c = do
+    modify $ \s -> s { tags = IM.insertWith (++) c [msg] $ tags s }
+    return c
+
+-- | Tag a subtree with a comment (monadic version)
+tagM :: String -> Build alg AlgNode -> Build alg AlgNode
+tagM s = (=<<) (tag s)
+
+-- | Insert a node into the graph construction environment, first check if the node already exists
+-- | if so return its id, otherwise insert it and return its id.
+insert :: Dag.Operator alg => alg -> Build alg AlgNode
+insert op = do
+    d <- gets dag
+    let (n, d') = Dag.insert op d
+    modify $ \s -> s { dag = d' }
+    return n
+
+insertNoShare :: Dag.Operator alg => alg -> Build alg AlgNode
+insertNoShare op = do
+    d <- gets dag
+    let (n, d') = Dag.insertNoShare op d
+    modify $ \s -> s { dag = d' }
+    return n
diff --git a/src/Database/Algebra/Dag/Common.hs b/src/Database/Algebra/Dag/Common.hs
new file mode 100644
--- /dev/null
+++ b/src/Database/Algebra/Dag/Common.hs
@@ -0,0 +1,26 @@
+{-# LANGUAGE DeriveGeneric #-}
+module Database.Algebra.Dag.Common where
+
+import qualified Data.IntMap  as IM
+import qualified Data.Map     as M
+import           GHC.Generics (Generic)
+
+import           Data.Aeson   (FromJSON, ToJSON)
+
+-- | Identifiers for DAG nodes.
+type AlgNode = Int
+
+type AlgMap alg = M.Map alg AlgNode
+type NodeMap a = IM.IntMap a
+
+type Tag = String
+
+-- | Tertiary, Binary, unary and leaf nodes of a relational algebra DAG.
+data Algebra t b u n c = TerOp t c c c
+                       | BinOp b c c
+                       | UnOp u c
+                       | NullaryOp n
+                         deriving (Ord, Eq, Show, Read, Generic)
+
+instance (ToJSON t, ToJSON b, ToJSON u, ToJSON n, ToJSON c) => ToJSON (Algebra t b u n c) where
+instance (FromJSON t, FromJSON b, FromJSON u, FromJSON n, FromJSON c) => FromJSON (Algebra t b u n c) where
diff --git a/src/Database/Algebra/Rewrite.hs b/src/Database/Algebra/Rewrite.hs
new file mode 100644
--- /dev/null
+++ b/src/Database/Algebra/Rewrite.hs
@@ -0,0 +1,21 @@
+module Database.Algebra.Rewrite
+       ( -- * DAG rewriting
+         module Database.Algebra.Rewrite.DagRewrite
+         -- * Rewrite rules
+       , module Database.Algebra.Rewrite.Rule
+         -- * DAG matching
+       , module Database.Algebra.Rewrite.Match
+         -- * DAG traversal
+       , module Database.Algebra.Rewrite.Traversal
+         -- * Property inference
+       , module Database.Algebra.Rewrite.Properties
+         -- * Pattern syntax
+       , module Database.Algebra.Rewrite.PatternConstruction
+       ) where
+
+import           Database.Algebra.Rewrite.DagRewrite
+import           Database.Algebra.Rewrite.Match
+import           Database.Algebra.Rewrite.PatternConstruction (dagPatMatch, v)
+import           Database.Algebra.Rewrite.Properties
+import           Database.Algebra.Rewrite.Rule
+import           Database.Algebra.Rewrite.Traversal
diff --git a/src/Database/Algebra/Rewrite/DagRewrite.hs b/src/Database/Algebra/Rewrite/DagRewrite.hs
new file mode 100644
--- /dev/null
+++ b/src/Database/Algebra/Rewrite/DagRewrite.hs
@@ -0,0 +1,255 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+-- | This module provides a monadic interface to rewrites on algebra DAGs.
+module Database.Algebra.Rewrite.DagRewrite
+       (
+         -- ** The Rewrite monad
+         Rewrite
+       , runRewrite
+       , initRewriteState
+       , Log
+       , logGeneral
+       , logRewrite
+       , reachableNodesFrom
+       , parents
+       , topsort
+       , operator
+       , operatorSafe
+       , rootNodes
+       , exposeDag
+       , getExtras
+       , updateExtras
+       , condRewrite
+       , insert
+       , insertNoShare
+       , replaceChild
+       , replace
+       , replaceWithNew
+       , replaceRoot
+       , infer
+       , collect
+       ) where
+
+import           Control.Applicative
+import           Control.Monad.State
+import           Control.Monad.Writer
+import qualified Data.IntMap                 as IM
+import qualified Data.Sequence               as Seq
+import qualified Data.Set                    as S
+import           Debug.Trace
+
+import qualified Database.Algebra.Dag        as Dag
+import           Database.Algebra.Dag.Common
+
+-- | Cache some topological information about the DAG.
+data Cache = Cache { cachedTopOrdering :: Maybe [AlgNode] }
+
+emptyCache :: Cache
+emptyCache = Cache Nothing
+
+data RewriteState o e = RewriteState
+  { dag            :: Dag.AlgebraDag o -- ^ The DAG itself
+  , cache          :: Cache            -- ^ Cache of some topological information
+  , extras         :: e                -- ^ Polymorphic container for whatever needs to be provided additionally.
+  , debugFlag      :: Bool             -- ^ Wether to output log messages via Debug.Trace.trace
+  , collectNodes   :: S.Set AlgNode    -- ^ List of nodes which must be checked during garbage collection
+  }
+
+-- | A Monad for DAG rewrites, parameterized over the type of algebra operators.
+newtype Rewrite o e a = R (WriterT Log (State (RewriteState o e)) a) deriving (Monad, Functor, Applicative)
+
+-- FIXME Map.findMax might call error
+initRewriteState :: (Ord o, Dag.Operator o) => Dag.AlgebraDag o -> e -> Bool -> RewriteState o e
+initRewriteState d e debug =
+    RewriteState { dag = d
+                 , cache = emptyCache
+                 , extras = e
+                 , debugFlag = debug
+                 , collectNodes = S.empty
+                 }
+
+-- | Run a rewrite action on the supplied graph. Returns the rewritten node map, the potentially
+-- modified list of root nodes, the result of the rewrite and the rewrite log.
+runRewrite :: Dag.Operator o => Rewrite o e r -> Dag.AlgebraDag o -> e -> Bool -> (Dag.AlgebraDag o, e, r, Log)
+runRewrite (R m) d e debug = (dag s, extras s, res, rewriteLog)
+  where ((res, rewriteLog), s) = runState (runWriterT m) (initRewriteState d e debug)
+
+-- | The log from a sequence of rewrite actions.
+type Log = Seq.Seq String
+
+-- FIXME unwrapR should not be necessary: just provide a type alias for the monad stack
+unwrapR :: Rewrite o e a -> WriterT Log (State (RewriteState o e)) a
+unwrapR (R m) = m
+
+invalidateCacheM :: Rewrite o e ()
+invalidateCacheM =
+  R $ do
+    s <- get
+    put $ s { cache = emptyCache }
+
+-- internal helper function
+putDag :: Dag.AlgebraDag o -> Rewrite o e ()
+putDag d =
+  R $ do
+    s <- get
+    put $ s { dag = d }
+
+putCache :: Cache -> Rewrite o e ()
+putCache c =
+  R $ do
+    s <- get
+    put $ s { cache = c }
+
+-- | Log a general message
+logGeneral :: String -> Rewrite o e ()
+logGeneral msg =  do
+  d <- R $ gets debugFlag
+  if d
+    then trace msg $ R $ tell $ Seq.singleton msg
+    else R $ tell $ Seq.singleton msg
+
+-- | Log a rewrite
+logRewrite :: String -> AlgNode -> Rewrite o e ()
+logRewrite rewrite node =
+  logGeneral $ "Triggering rewrite " ++ rewrite ++ " at node " ++ (show node)
+
+-- | Return the set of nodes that are reachable from the specified node.
+reachableNodesFrom :: AlgNode -> Rewrite o e (S.Set AlgNode)
+reachableNodesFrom n =
+  R $ do
+    d <- gets dag
+    return $ Dag.reachableNodesFrom n d
+
+-- | Return the parents of a node
+parents :: AlgNode -> Rewrite o e [AlgNode]
+parents n = R $ gets ((Dag.parents n) . dag)
+
+-- | Return a topological ordering of all reachable nodes in the DAG.
+topsort :: Dag.Operator o => Rewrite o e [AlgNode]
+topsort =
+  R $ do
+    s <- get
+    let c = cache s
+    case cachedTopOrdering c of
+      Just o -> return o
+      Nothing -> do
+        let d = dag s
+            ordering = Dag.topsort d
+        unwrapR $ putCache $ c { cachedTopOrdering = Just ordering }
+        return ordering
+
+-- | Return the operator for a node id.
+operator :: Dag.Operator o => AlgNode -> Rewrite o e o
+operator n =
+  R $ do
+    d <- gets dag
+    return $ Dag.operator n d
+
+operatorSafe :: AlgNode -> Rewrite o e (Maybe o)
+operatorSafe n =
+  R $ do
+    d <- gets dag
+    return $ IM.lookup n (Dag.nodeMap d)
+
+-- | Returns the root nodes of the DAG.
+rootNodes :: Rewrite o e [AlgNode]
+rootNodes = R $ liftM Dag.rootNodes $ liftM dag $ get
+
+-- | Exposes the current state of the DAG
+exposeDag :: Rewrite o e (Dag.AlgebraDag o)
+exposeDag = R $ gets dag
+
+getExtras :: Rewrite o e e
+getExtras = R $ gets extras
+
+-- | Preserve the effects of a rewrite only if the rewrite signals
+-- success by returning True. Otherwise, the state before the rewrite
+-- is put in place again.
+condRewrite :: Rewrite o e Bool -> Rewrite o e Bool
+condRewrite r =
+  R $ do
+      s       <- get
+      success <- unwrapR r
+      if success
+          then return success
+          else trace "Rollback" $ put s >> return success
+
+updateExtras :: e -> Rewrite o e ()
+updateExtras e =
+  R $ do
+    s <- get
+    put $ s { extras = e }
+
+-- | Insert an operator into the DAG and return its node id. If the operator is already
+-- present (same op, same children), reuse it.
+insert :: (Dag.Operator o, Show o) => o -> Rewrite o e AlgNode
+insert op =
+  R $ do
+    d <- gets dag
+    unwrapR invalidateCacheM
+    let (n, d') = Dag.insert op d
+    unwrapR $ putDag d'
+    return n
+
+-- | Insert an operator into the DAG and return its node id WITHOUT reusing an
+-- operator if it is already present.
+insertNoShare :: Dag.Operator o => o -> Rewrite o e AlgNode
+insertNoShare op =
+  R $ do
+    d <- gets dag
+    unwrapR invalidateCacheM
+    let (n, d') = Dag.insertNoShare op d
+    unwrapR $ putDag d'
+    return n
+
+-- | replaceChildM n old new replaces all links from node n to node old with links
+--   to node new
+replaceChild :: Dag.Operator o => AlgNode -> AlgNode -> AlgNode -> Rewrite o e ()
+replaceChild n old new =
+  R $ do
+    s <- get
+    unwrapR invalidateCacheM
+    unwrapR $ putDag $ Dag.replaceChild n old new $ dag s
+
+-- | replace old new replaces _all_ links to old with links to new
+replace :: Dag.Operator o => AlgNode -> AlgNode -> Rewrite o e ()
+replace old new = do
+  ps <- parents old
+  forM_ ps $ (\p -> replaceChild p old new)
+  addCollectNode old
+  R $ do s <- get
+         unwrapR $ putDag $ Dag.replaceRoot (dag s) old new
+
+-- | Creates a new node from the operator and replaces the old node with it
+-- by rewiring all links to the old node.
+replaceWithNew :: (Dag.Operator o, Show o) => AlgNode -> o -> Rewrite o e AlgNode
+replaceWithNew oldNode newOp = do
+  newNode <- insert newOp
+  replace oldNode newNode
+  return newNode
+
+-- | Apply a pure function to the DAG.
+infer :: (Dag.AlgebraDag o -> b) -> Rewrite o e b
+infer f = R $ liftM f $ gets dag
+
+addCollectNode :: AlgNode -> Rewrite o e ()
+addCollectNode n =
+  R $ do
+    s <- get
+    put $ s { collectNodes = S.insert n $ collectNodes s }
+
+collect :: (Show o, Dag.Operator o) => Rewrite o e ()
+collect =
+  R $ do
+    s <- get
+    let d' = Dag.collect (collectNodes s) (dag s)
+    put s { dag = d', collectNodes = S.empty }
+
+replaceRoot :: Dag.Operator o => AlgNode -> AlgNode -> Rewrite o e ()
+replaceRoot oldRoot newRoot =
+  R $ do
+    s <- get
+    if not $ IM.member newRoot $ Dag.nodeMap $ dag s
+      then error "replaceRootM: new root node is not present in the DAG"
+      else unwrapR $ putDag $ Dag.replaceRoot (dag s) oldRoot newRoot
+
diff --git a/src/Database/Algebra/Rewrite/Match.hs b/src/Database/Algebra/Rewrite/Match.hs
new file mode 100644
--- /dev/null
+++ b/src/Database/Algebra/Rewrite/Match.hs
@@ -0,0 +1,87 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+-- | Pattern matches on algebra plans.
+module Database.Algebra.Rewrite.Match
+    ( Match(..)
+    , runMatch
+    , getParents
+    , getOperator
+    , hasPath
+    , getRootNodes
+    , predicate
+    , try
+    , matchOp
+    , lookupExtras
+    , exposeEnv
+    , properties
+    ) where
+
+import qualified Data.IntMap                 as M
+
+import           Control.Applicative
+import           Control.Monad.Reader
+import           Control.Monad.Trans.Maybe
+
+import qualified Database.Algebra.Dag        as Dag
+import           Database.Algebra.Dag.Common
+
+data Env o p e = Env { dag :: Dag.AlgebraDag o
+                     , propMap :: NodeMap p
+                     , extras :: e }
+
+-- | The Match monad models the failing of a match and provides
+-- limited read-only access to the DAG.
+newtype Match o p e a = M (MaybeT (Reader (Env o p e)) a) deriving (Monad, Functor, Applicative)
+
+-- | Runs a match on the supplied DAG. If the Match fails, 'Nothing'
+-- is returned.  If the Match succeeds, it returns just the result.
+runMatch :: e -> Dag.AlgebraDag o -> NodeMap p -> Match o p e a -> Maybe a
+runMatch e d pm (M match) = runReader (runMaybeT match) env
+  where env = Env { dag = d, propMap = pm, extras = e }
+
+-- | Returns the parents of a node in a Match context.
+getParents :: AlgNode -> Match o p e [AlgNode]
+getParents q = do
+  M $ asks ((Dag.parents q) . dag)
+
+getOperator :: Dag.Operator o => AlgNode -> Match o p e o
+getOperator q = M $ asks ((Dag.operator q) . dag)
+
+hasPath :: AlgNode -> AlgNode -> Match o p e Bool
+hasPath q1 q2 = M $ asks ((Dag.hasPath q1 q2) . dag)
+
+getRootNodes :: Match o p e [AlgNode]
+getRootNodes = M $ asks (Dag.rootNodes . dag)
+
+-- | Fails the complete match if the predicate is False.
+predicate :: Bool -> Match o p e ()
+predicate True    = M $ return ()
+predicate False   = M $ fail ""
+
+-- | Fails the complete match if the value is Nothing
+try :: Maybe a -> Match o p e a
+try (Just x) = return x
+try Nothing  = fail ""
+
+-- | Runs the supplied Match action on the operator that belongs to
+-- the given node.
+matchOp :: Dag.Operator o => AlgNode -> (o -> Match o p e a) -> Match o p e a
+matchOp q match = M $ asks ((Dag.operator q) . dag) >>= (\o -> unwrap $ match o)
+  where unwrap (M r) = r
+
+-- | Look up the properties for a given node.
+properties :: AlgNode -> Match o p e p
+properties q = do
+  M $ do
+    pm <- asks propMap
+    case M.lookup q pm of
+      Just p -> return p
+      Nothing -> error $ "Match.properties: no properties for node " ++ (show q)
+
+lookupExtras :: Match o p e e
+lookupExtras = M $ asks extras
+
+exposeEnv :: Match o p e (Dag.AlgebraDag o, NodeMap p, e)
+exposeEnv = M $ do
+  env <- ask
+  return (dag env, propMap env, extras env)
diff --git a/src/Database/Algebra/Rewrite/PatternConstruction.hs b/src/Database/Algebra/Rewrite/PatternConstruction.hs
new file mode 100644
--- /dev/null
+++ b/src/Database/Algebra/Rewrite/PatternConstruction.hs
@@ -0,0 +1,388 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module Database.Algebra.Rewrite.PatternConstruction
+    ( dagPatMatch
+    , v 
+    ) where
+
+import           Control.Applicative
+import           Control.Monad.Writer
+import           Data.Maybe
+import           Language.Haskell.TH
+
+import           Database.Algebra.Dag
+import           Database.Algebra.Dag.Common
+import qualified Database.Algebra.Rewrite.DagRewrite    as R
+import qualified Database.Algebra.Rewrite.Match         as M
+import           Database.Algebra.Rewrite.PatternSyntax
+
+type Code a = WriterT [Q Stmt] Q a
+
+emit :: Q Stmt -> Code ()
+emit s = tell [s]
+
+matchOp :: Name
+matchOp = mkName "matchOp"
+
+opName :: Name
+opName = mkName "op__internal"
+
+terOpName :: Name
+terOpName = mkName "TerOp"
+
+binOpName :: Name
+binOpName = mkName "BinOp"
+
+unOpName :: Name
+unOpName = mkName "UnOp"
+
+nullOpName :: Name
+nullOpName = mkName "NullaryOp"
+
+failName :: Name
+failName = mkName "fail"
+
+catchAllCase :: Q Match
+catchAllCase = match wildP (normalB (appE (varE failName) (litE (stringL "")))) []
+
+data SemPattern = Bind (Q Pat, Name)
+                | NoBind
+                | NoSemantics
+
+-- case op of ... -> return _ -> fail ""
+instMatchCase :: Name           -- ^ The name of the node constructor (BinOp, UnOp, NullOp)
+                 -> [Name]      -- ^ The name of the operator constructors
+                 -> SemPattern -- ^ If the semantical pattern is not a wildcard: the name of the binding variable
+                 -> [Q Pat]     -- ^ The list of patterns matching the node children
+                 -> [Name]      -- ^ The list of variables for the children (may be empty)
+                 -> Bool        -- ^ Bind the operator name (or don't)
+                 -> Q Exp       -- ^ Returns the case expression
+instMatchCase nodeConstructor opConstructors semantics childMatchPatterns childNames bindOp =
+  caseE (varE opName) ((map opAlternative opConstructors) ++ [catchAllCase])
+  where opAlternative opConstructor = match opPattern opBody []
+          where (semPat, semName) = case semantics of
+                  Bind (p, n) -> ([p], [n])
+                  NoBind      -> ([wildP], [])
+                  NoSemantics -> ([], [])
+                opPattern = conP nodeConstructor ((conP opConstructor semPat) : childMatchPatterns)
+                opConstExp = if bindOp then [conE opConstructor] else []
+                opBody = normalB $ appE (varE (mkName "return")) (tupE $ opConstExp ++ (map varE (semName ++ childNames)))
+
+-- \op -> case op of...
+instMatchLambda :: Q Exp -> Q Exp
+instMatchLambda body = lam1E (varP opName) body
+
+instMatchExp :: Name -> Q Exp -> Q Exp
+instMatchExp nodeName matchLambda =
+  appE (appE (varE matchOp) (varE nodeName)) matchLambda
+
+-- (a, b, c) <- ...
+instBindingPattern :: Maybe (Q Pat) -> SemPattern -> [Q Pat] -> Q Pat
+instBindingPattern mOpConstPat semPat childPats = tupP patterns
+  where patterns = (maybeList mOpConstPat) ++ (semList semPat) ++ childPats
+        maybeList (Just x) = [x]
+        maybeList Nothing  = []
+
+        semList (Bind (pat, _)) = [pat]
+        semList NoBind         = []
+        semList NoSemantics    = []
+
+-- (a, b, c) <- matchOp q (\op -> case op of ...)
+instStatement :: Maybe (Q Pat) -> SemPattern -> [Q Pat] -> Q Exp -> Q Stmt
+instStatement mOpConstPat semPat childPats matchExp =
+  case (semPat, childPats) of
+    (NoBind, [])      -> noBindS matchExp
+    (NoSemantics, []) -> noBindS matchExp
+    (_, _)            -> bindS (instBindingPattern mOpConstPat semPat childPats) matchExp
+
+semPatternName :: Maybe Sem -> SemPattern
+semPatternName (Just WildS)      = NoBind
+semPatternName (Just (NamedS s)) = let name = mkName s in Bind (varP name, name)
+semPatternName Nothing           = NoSemantics
+
+instStmtWrapper :: Name              -- ^ The name of the node on which to match
+                   -> Name           -- ^ The name of the node constructor (BinOp, UnOp, NullOp)
+                   -> [Name]         -- ^ The name of the operator constructors
+                   -> Maybe (Q Pat)  -- ^ The binding name for the operator constructor
+                   -> SemPattern     -- ^ Pattern binding the semantical information (or wildcard)
+                   -> [Q Pat]        -- ^ The list of patterns matching the node children
+                   -> [Q Pat]        -- ^ The list of patterns binding the node children (may be empty)
+                   -> [Name]         -- ^ The list of variables for the children (may be empty)
+                   -> Q Stmt         -- ^ Returns the case expression
+instStmtWrapper nodeName nodeKind operNames mOpConstPat semantics childMatchPats childPats childNames =
+  let matchCase   = instMatchCase nodeKind operNames semantics childMatchPats childNames (isJust mOpConstPat)
+      matchLambda = instMatchLambda matchCase
+      matchExp    = instMatchExp nodeName matchLambda
+  in instStatement mOpConstPat semantics childPats matchExp
+
+opInfo :: Op -> (Maybe (Q Pat), [Name])
+opInfo (NamedOp bindingName opNames) = (Just $ varP $ mkName bindingName, map mkName opNames)
+opInfo (UnnamedOp opNames) = (Nothing, map mkName opNames)
+
+-- generate a list of node matching statements from an operator (tree)
+gen :: Name -> Node -> Code ()
+gen nodeName (NullP op semBinding) =
+  let semantics = semPatternName semBinding
+      (mOpConstPat, opNames) = opInfo op
+      statement = instStmtWrapper nodeName nullOpName opNames mOpConstPat semantics [] [] []
+  in emit statement
+
+gen nodeName (UnP op semBinding child) = do
+  let semantics = semPatternName semBinding
+      (mOpConstPat, opNames) = opInfo op
+
+  patAndName <- lift (childMatchPattern child)
+
+  let (matchPatterns, bindNames, bindPatterns) = splitMatchAndBind $ [patAndName]
+      statement = instStmtWrapper nodeName unOpName opNames mOpConstPat semantics matchPatterns bindPatterns bindNames
+
+  emit statement
+
+  maybeDescend child (snd patAndName)
+
+gen nodeName (BinP op semBinding child1 child2) = do
+  let semantics = semPatternName semBinding
+      (mOpConstPat, opNames) = opInfo op
+
+  leftPatAndName   <- lift (childMatchPattern child1)
+  rightPatAndName  <- lift (childMatchPattern child2)
+
+  let (matchPatterns, bindNames, bindPatterns) = splitMatchAndBind [leftPatAndName, rightPatAndName]
+      statement = instStmtWrapper nodeName binOpName opNames mOpConstPat semantics matchPatterns bindPatterns bindNames
+
+  emit statement
+
+  maybeDescend child1 (snd leftPatAndName)
+  maybeDescend child2 (snd rightPatAndName)
+
+gen nodeName (TerP op semBinding child1 child2 child3) = do
+  let semantics = semPatternName semBinding
+      (mOpConstPat, opNames) = opInfo op
+
+  patAndName1 <- lift (childMatchPattern child1)
+  patAndName2 <- lift (childMatchPattern child2)
+  patAndName3 <- lift (childMatchPattern child3)
+
+  let childPatAndNames = [patAndName1, patAndName2, patAndName3]
+      (matchPatterns, bindNames, bindPatterns) = splitMatchAndBind $ childPatAndNames
+      statement = instStmtWrapper nodeName terOpName opNames mOpConstPat semantics matchPatterns bindPatterns bindNames
+
+  emit statement
+
+  maybeDescend child1 (snd patAndName1)
+  maybeDescend child2 (snd patAndName2)
+  maybeDescend child3 (snd patAndName3)
+
+gen nodeName (HoleP holeStart subHolePat) = do
+  -- collect all binders from the sub-hole pattern in a canonical order
+  let binderNames = map mkName $ collectBinders subHolePat
+
+  -- generate a function that tries to match the sub-hole pattern at the given node
+  (patMatchFunName, patMatchFunStmt) <- lift $ genSubHoleMatch binderNames subHolePat
+  emit patMatchFunStmt
+
+  -- (nodeName, binderNames) <- searchHolePat patMatchName holeStart
+  -- Use function searchHolePat to search for a node at which the sub-hole
+  -- pattern matches.
+  let searchExpr = appE (appE (varE 'searchHolePat) (varE patMatchFunName)) (varE nodeName)
+      bindingPat = tupP [varP (mkName holeStart), listP (map varP binderNames)]
+
+  emit $ bindS bindingPat searchExpr
+
+gen nodeName (HoleEq eqNode) = do
+  emit $ noBindS $ appE (appE (varE 'searchHoleEq) (varE nodeName)) (varE $ mkName eqNode)
+
+-- Traverse a DAG (DFS, preorder) and search for a node where the given pattern applies.
+-- Returns the matching node and the list of values for the pattern's binders.
+searchHolePat :: Operator o
+                 => (AlgNode -> M.Match o p e [AlgNode])
+                 -> AlgNode
+                 -> M.Match o p e (AlgNode, [AlgNode])
+searchHolePat patMatch q = do
+  (d, p, e) <- M.exposeEnv
+  case M.runMatch e d p (patMatch q) of
+    Just nodes -> return (q, nodes)
+    Nothing    -> do
+                    children <- opChildren <$> M.getOperator q
+                    searchChildren patMatch children
+
+-- Apply searchHolePat to a list of nodes, take the first one that matches.
+searchChildren :: Operator o
+                  => (AlgNode -> M.Match o p e [AlgNode])
+                  -> [AlgNode]
+                  -> M.Match o p e (AlgNode, [AlgNode])
+searchChildren _        []     = fail "no match"
+searchChildren patMatch (q:qs) = do
+  (d, p, e) <- M.exposeEnv
+  case M.runMatch e d p(searchHolePat patMatch q) of
+    Just nodes -> return nodes
+    Nothing    -> searchChildren patMatch qs
+
+-- Search for an occurence of the node 'eqNode', starting at 'startNode'
+searchHoleEq :: Operator o => AlgNode -> AlgNode -> M.Match o p e ()
+searchHoleEq startNode eqNode =
+  if startNode == eqNode
+  then return ()
+  else do
+    (d, _, _) <- M.exposeEnv
+    children <- opChildren <$> M.getOperator startNode
+    if nodeOccurs d eqNode children
+      then return ()
+      else fail "no occurence"
+
+-- Since we only search for occurences of a particular node and no pattern matching
+-- occurs, we do not burden ourselves with the Match monad here.
+nodeOccurs :: Operator o => AlgebraDag o -> AlgNode -> [AlgNode] -> Bool
+nodeOccurs dag eqNode startNodes =
+  if eqNode `elem` startNodes
+  then True
+  else or $ map (nodeOccurs dag eqNode . opChildren . (flip operator dag)) startNodes
+
+-- | Generate a function which matches a pattern on a certain node.
+-- The generated function returns values for all binders in the pattern
+-- in the canonical order given by 'binderNames'
+-- Type of the generated function:
+--      subhole_xy :: AlgNode -> Match o [AlgNode]
+genSubHoleMatch :: [Name] -> Pattern -> Q (Name, Q Stmt)
+genSubHoleMatch binderNames pat = do
+  -- generate the code for matching the pattern
+  rootName <- newName "subNode"
+  patternStatements <- execWriterT $ gen rootName pat
+  -- return values for the binders in the proper order.
+  let returnStatement   = noBindS $ appE (varE 'return) (listE $ map varE binderNames)
+      body              = doE $ patternStatements ++ [returnStatement]
+
+  -- the function binding
+  funName <- newName "subhole"
+  let fun  = funD funName [(clause [varP rootName] (normalB body) [])]
+      stmt = letS $ [fun]
+  return (funName, stmt)
+
+{-
+semBinder :: Maybe Sem -> [Ident]
+semBinder (Just (NamedS i)) = [i]
+semBinder (Just WildS)      = []
+semBinder Nothing           = []
+-}
+
+opBinder :: Op -> [Ident]
+opBinder (NamedOp i _) = [i]
+opBinder (UnnamedOp _) = []
+
+childBinders :: Child -> [Ident]
+childBinders (NodeC n)        = collectBinders n
+childBinders WildC            = []
+childBinders (NameC i)        = [i]
+childBinders (NamedNodeC i n) = i : collectBinders n
+
+-- Collect binders in pre-order fashion from a pattern tree
+-- TODO: so far, only binders for nodes (type AlgNode) are collected. This is
+-- necessary so that we can return values for them in a list without type-specific
+-- wrappers
+collectBinders :: Node -> [Ident]
+collectBinders (TerP op _ c1 c2 c3) = opBinder op
+                                      -- ++ semBinder sem
+                                      ++ concatMap childBinders [c1, c2, c3]
+collectBinders (BinP op _ c1 c2)    = opBinder op
+                                      -- ++ semBinder sem
+                                      ++ concatMap childBinders [c1, c2]
+collectBinders (UnP op _ c)         = opBinder op
+                                      -- ++ semBinder sem
+                                      ++ childBinders c
+collectBinders (NullP op _)         = opBinder op -- ++ semBinder sem
+collectBinders (HoleP _ _)          = error "collectBinders: Holes in sub-hole patterns not supported"
+collectBinders (HoleEq _)           = []
+
+{-
+Split the list of matching patterns and binding names.
+-}
+splitMatchAndBind :: [(Q Pat, Maybe Name)] -> ([Q Pat], [Name], [Q Pat])
+splitMatchAndBind ps =
+  let (matchPatterns, mBindNames) = unzip ps
+      bindNames = catMaybes mBindNames
+  in (matchPatterns, bindNames, map varP bindNames)
+
+{-
+For every child, generate the matching pattern and - if the child
+is to be bound either with a given name or for matching on the child itself -
+the name to which it should be bound.
+
+This distinction is necessary because a child that is not to be bound
+must be matched anyway with a wildcard pattern so that the operator constructor
+has enough parameters in the match.
+-}
+childMatchPattern :: Child -> Q (Q Pat, Maybe Name)
+childMatchPattern WildC   =
+  return (wildP, Nothing)
+childMatchPattern (NameC s) =
+  let n = mkName s
+  in return (varP n, Just n)
+childMatchPattern (NodeC _) =
+  newName "child"
+  >>= (\n -> return (varP n, Just n))
+childMatchPattern (NamedNodeC s _) =
+  let n = mkName s
+  in return (varP n, Just n)
+
+recurse :: Child -> Maybe Node
+recurse WildC           = Nothing
+recurse (NameC _)       = Nothing
+recurse (NodeC o)         = Just o
+recurse (NamedNodeC _ o ) = Just o
+
+maybeDescend :: Child -> Maybe Name -> Code ()
+maybeDescend c ns =
+  case recurse c of
+    Just o   ->
+      case ns of
+        Just n   -> gen n o
+        Nothing  -> error "PatternConstruction.gen: no name for child pattern"
+    Nothing  -> return ()
+
+assembleStatements :: Q [Stmt] -> Q Exp -> Q Exp
+assembleStatements patternStatements userExpr = do
+  ps <- patternStatements
+  e <- userExpr
+
+  let us =
+        case e of
+          DoE userStatements -> userStatements
+          _ -> error "PatternConstruction.assembleStatements: no do-block supplied"
+
+      -- The call to collect
+      collectStmt = NoBindS $ VarE 'R.collect
+
+      -- Extract the returned sequence of rewrite actions and patch the
+      -- call to collect at the end
+      returnStmt = case last us of
+                     NoBindS (InfixE (Just (VarE returnName)) (VarE dollarName) (Just rewriteExpr))
+                       | dollarName == '($) && returnName == 'return    ->
+                         let rewriteExpr' = DoE [NoBindS rewriteExpr, collectStmt]
+                         in NoBindS (InfixE (Just (VarE returnName)) (VarE dollarName) (Just rewriteExpr'))
+                     s                                                  -> error $ show s
+
+      -- reassemble the user statements
+      us' = init us ++ [returnStmt]
+
+  -- Return a do block consisting of the pattern statements and the user statements.
+  return $ DoE $ ps ++ us'
+
+-- | Take a quoted variable with the root node on which to apply the pattern,
+-- a string description of the pattern and the body of the match
+-- and return the complete match statement. The body has to be a quoted ([| ...|])
+-- do-block.
+dagPatMatch :: Name -> String -> Q Exp -> Q Exp
+dagPatMatch rootName patternString userExpr = do
+
+  let pat = parsePattern patternString
+
+  -- generate the code that matches the pattern (a list of statements)
+  patternStatements <- execWriterT $ gen rootName pat
+
+  -- combine the generated pattern-matching statements with the
+  -- user-supplied additional predicates
+  assembleStatements (mapM id patternStatements) userExpr
+
+-- | Reference a variable that is bound by a pattern in a quoted match body.
+v :: String -> Q Exp
+v = dyn
diff --git a/src/Database/Algebra/Rewrite/PatternSyntax.hs b/src/Database/Algebra/Rewrite/PatternSyntax.hs
new file mode 100644
--- /dev/null
+++ b/src/Database/Algebra/Rewrite/PatternSyntax.hs
@@ -0,0 +1,172 @@
+{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}
+
+module Database.Algebra.Rewrite.PatternSyntax 
+    ( Pattern
+    , Op(..)
+    , Node(..)
+    , Child(..)
+    , Sem(..)
+    , Ident
+    , UIdent
+    , parsePattern
+    ) where
+
+import Text.ParserCombinators.Parsec
+
+{-
+
+S -> Op
+
+Node    -> (Child) Op Sem (Child)
+        |  Op Sem (Child)
+        |  Op Sem
+
+Op      -> Alternative
+        | Id @ Alternative
+        | Uid
+
+Child -> _
+      |  Op
+      |  Id = Op 
+
+Sem   -> _
+      |  Id
+
+-}
+
+type Pattern = Node
+
+data Node = TerP Op (Maybe Sem) Child Child Child
+          | BinP Op (Maybe Sem) Child Child
+          | UnP Op (Maybe Sem) Child
+          | NullP Op (Maybe Sem)
+          | HoleP Ident Node
+          | HoleEq Ident
+          deriving Show
+           
+data Child = NodeC Node
+           | WildC
+           | NameC Ident
+           | NamedNodeC Ident Node
+           deriving Show
+             
+data Sem = NamedS Ident
+         | WildS
+         deriving (Show, Eq)
+                  
+data Op = NamedOp Ident [UIdent]
+        | UnnamedOp [UIdent]
+          deriving Show
+             
+type Ident = String
+             
+type UIdent = String
+              
+pattern :: Parser Pattern
+pattern = node
+          
+node :: Parser Node
+node = do { c1 <- enclosed child
+          ; space
+          ; ops <- operator
+          ; space
+          ; info <- optionMaybe sem
+          ; c2 <- enclosed child 
+          ; return $ BinP ops info c1 c2 }
+
+       <|> try (do { ops <- operator
+                   ; space
+                   ; info <- optionMaybe sem
+                   ; c1 <- enclosed child
+                   ; space
+                   ; c2 <- enclosed child
+                   ; space
+                   ; c3 <- enclosed child
+                   ; return $ TerP ops info c1 c2 c3 })
+
+       <|> try (do { ops <- operator
+                   ; space
+                   ; info <- optionMaybe sem
+                   ; c <- enclosed child
+                   ; return $ UnP ops info c })
+
+       <|> try (do { ops <- operator
+                   ; space
+                   ; info <- optionMaybe sem
+                   ; return $ NullP ops info })
+
+       <|> try (do { string "{ }"
+                   ; space
+                   ; name <- ident
+                   ; char '='
+                   ; n <- node
+                   ; return $ HoleP name n })
+       <|> do { string "{ }"
+              ; space
+              ; string "eq"
+              ; name <- enclosed ident
+              ; return $ HoleEq name
+              }
+       
+altSep :: Parser ()
+altSep = space >> char '|' >> space >> return ()
+         
+-- [Op1 | Op2 | ...]
+altOps :: Parser [UIdent]
+altOps = do { char '['
+            ; ops <- sepBy1 uident altSep
+            ; char ']'
+            ; return ops }
+       
+operator :: Parser Op
+operator = try (do { ops <- altOps
+                   ; char '@'
+                   ; name <- ident
+                   ; return $ NamedOp name ops })
+           <|> do { ops <- altOps
+                  ; return $ UnnamedOp ops }
+           <|> do { op <- uident
+                  ; return $ UnnamedOp [op] }
+  
+enclosed :: Parser a -> Parser a
+enclosed p = do
+  char '('
+  r <- p
+  char ')'
+  return r
+
+uident :: Parser UIdent
+uident = do
+  first <- upper
+  rest <- many alphaNum
+  return $ first : rest
+
+ident :: Parser Ident
+ident = do
+  first <- lower
+  rest <- many alphaNum
+  return $ first : rest
+
+child :: Parser Child
+child = do { n <- node; return $ NodeC n }
+        <|> do { wildcard; return WildC }
+        <|> (try (do { name <- ident
+                     ; char '='
+                     ; n <- node 
+                     ; return $ NamedNodeC name n }))
+        <|> do { name <- ident; return $ NameC name }
+        
+wildcard :: Parser ()
+wildcard = do
+  char '_'
+  return ()
+           
+sem :: Parser Sem
+sem = do { s <- ident; space; return $ NamedS s }
+      <|> do { wildcard; space; return $ WildS }
+      
+parsePattern :: String -> Pattern
+parsePattern s = 
+  case parse pattern "" s of
+    Left e -> error $ "Parsing failed: " ++ (show e)
+    Right p -> p
diff --git a/src/Database/Algebra/Rewrite/Properties.hs b/src/Database/Algebra/Rewrite/Properties.hs
new file mode 100644
--- /dev/null
+++ b/src/Database/Algebra/Rewrite/Properties.hs
@@ -0,0 +1,41 @@
+module Database.Algebra.Rewrite.Properties(inferBottomUpGeneral) where
+
+import           Control.Monad.Reader
+import           Control.Monad.State
+import qualified Data.IntMap                 as M
+import           Database.Algebra.Dag
+import           Database.Algebra.Dag.Common
+
+-- | Inference of bottom up properties p over a DAG of operator type o.
+type Inference p o a = StateT (NodeMap p) (Reader (AlgebraDag o)) a
+
+hasBeenVisited :: AlgNode -> Inference p o Bool
+hasBeenVisited n = do
+  pm <- get
+  return $ M.member n pm
+
+putProperty :: AlgNode -> p -> Inference p o ()
+putProperty n p = do
+  pm <- get
+  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
+  visited <- hasBeenVisited n
+  if visited
+    then return ()
+    else do
+      dag <- lift ask
+      let op = operator n dag
+      mapM_ (traverse inferWorker) (opChildren op)
+      pm <- get
+      putProperty n (inferWorker (nodeMap dag) op n pm)
+
+-- | Infer bottom up properties with the given inference function.
+inferBottomUpGeneral :: Operator o
+                        => (NodeMap o -> o -> AlgNode -> NodeMap p -> p)  -- ^ Function that infers properties for a single node
+                        -> 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)
diff --git a/src/Database/Algebra/Rewrite/Rule.hs b/src/Database/Algebra/Rewrite/Rule.hs
new file mode 100644
--- /dev/null
+++ b/src/Database/Algebra/Rewrite/Rule.hs
@@ -0,0 +1,26 @@
+module Database.Algebra.Rewrite.Rule
+       ( Rule
+       , RuleSet
+       , applyRuleSet ) where
+
+import Database.Algebra.Dag.Common
+import Database.Algebra.Rewrite.DagRewrite
+import Database.Algebra.Rewrite.Match
+
+type Rule o p e = AlgNode -> Match o p e (Rewrite o e ())
+              
+type RuleSet o p e = [Rule o p e]
+
+-- | Try a set of rules on a node and apply the rewrite of the first
+-- rule that matches.
+applyRuleSet :: e -> NodeMap p -> RuleSet o p e -> AlgNode -> Rewrite o e Bool
+applyRuleSet e pm rules q = do
+  d <- exposeDag
+  
+  let aux []        = return False
+      aux (rule:rs) = case runMatch e d pm (rule q) of
+                          Just rewrite -> rewrite >> return True
+                          Nothing      -> aux rs
+      
+  aux rules
+  
diff --git a/src/Database/Algebra/Rewrite/Traversal.hs b/src/Database/Algebra/Rewrite/Traversal.hs
new file mode 100644
--- /dev/null
+++ b/src/Database/Algebra/Rewrite/Traversal.hs
@@ -0,0 +1,172 @@
+module Database.Algebra.Rewrite.Traversal
+       ( preOrder
+       , postOrder
+       , applyToAll
+       , topologically
+       , iteratively
+       , sequenceRewrites
+       ) where
+
+import           Control.Applicative
+import           Control.Monad
+
+import qualified Data.IntMap                         as M
+import qualified Data.Set                            as S
+
+import qualified Database.Algebra.Dag                as Dag
+import           Database.Algebra.Dag.Common
+import           Database.Algebra.Rewrite.DagRewrite
+import           Database.Algebra.Rewrite.Rule
+
+applyToAll :: Rewrite o e (NodeMap p) -> RuleSet o p e -> Rewrite o e Bool
+applyToAll inferProps rules = iterateRewrites False 0
+  where iterateRewrites anyChanges offset = do
+          -- drop the first nodes, assuming that we already visited them
+          nodes <- drop offset <$> M.keys <$> Dag.nodeMap <$> exposeDag
+
+          -- re-infer properties
+          props <- inferProps
+
+          extras <- getExtras
+
+          -- try to apply the rewrites, beginning with node at position offset
+          matchedOffset <- traverseNodes offset props extras rules nodes
+
+          case matchedOffset of
+            -- A rewrite applied at offset o -> we continue at this offset
+            Just o -> iterateRewrites True o
+            -- No rewrite applied -> report if any changes occured at all
+            Nothing -> return anyChanges
+
+traverseNodes :: Int -> NodeMap p -> e -> RuleSet o p e -> [AlgNode] -> Rewrite o e (Maybe Int)
+traverseNodes offset props extras rules nodes =
+  case nodes of
+    n : ns -> do
+      changed <- applyRuleSet extras props rules n
+      if changed
+        then return $ Just offset
+        else traverseNodes (offset + 1) props extras rules ns
+    []     -> return Nothing
+
+-- | Infer properties, then traverse the DAG in preorder fashion and apply the rule set
+-- at every node. Properties are re-inferred after every change.
+preOrder :: Dag.Operator o
+            => Rewrite o e (NodeMap p)
+            -> RuleSet o p e
+            -> Rewrite o e Bool
+preOrder inferAction rules =
+  let traverse (changedPrev, mProps, visited) q =
+        if q `S.member` visited
+        then return (changedPrev, mProps, visited)
+        else do
+          props <- case mProps of
+            Just ps -> return ps
+            Nothing -> inferAction
+
+          e <- getExtras
+          changedSelf <- applyRuleSet e props rules q
+
+
+          -- Have to be careful here: With garbage collection, the current node 'q'
+          -- might no longer be present after a rewrite.
+          mop <- operatorSafe q
+          case mop of
+            Just op -> do
+              -- the node still seems to be around, so we need to look after its children
+              let mProps' = if changedSelf then Nothing else Just props
+              let cs = Dag.opChildren op
+              (changedChild, mProps'', visited') <- foldM descend (changedSelf, mProps', visited) cs
+              let visited'' = S.insert q visited'
+              if changedChild
+                then return (True, Nothing, visited'')
+                else return (changedPrev || (changedSelf || changedChild), mProps'', visited'')
+
+            Nothing -> return (True, Nothing, visited) -- The node has been collected -> do nothing
+
+      descend (changedPrev, mProps, visited) c = do
+          props <- case mProps of
+            Just ps -> return ps
+            Nothing -> inferAction
+          traverse (changedPrev, Just props, visited) c
+
+  in do
+    pm <- inferAction
+    rs <- rootNodes
+    (changed, _, _) <- foldM traverse (False, Just pm, S.empty) rs
+    return changed
+
+{- | Map a ruleset over the nodes of a DAG in topological order. This function assumes that
+     the structur of the DAG is not changed during the rewrites. Properties are only inferred
+     once.
+-}
+topologically :: Dag.Operator o
+                 => Rewrite o e (NodeMap p)
+                 -> RuleSet o p e
+                 -> Rewrite o e Bool
+topologically inferAction rules = do
+  topoOrdering <- topsort
+  props <- inferAction
+  let rewriteNode changedPrev q = do
+        e <- getExtras
+        changed <- applyRuleSet e props rules q
+        return $ changed || changedPrev
+  foldM rewriteNode False topoOrdering where
+
+-- | Infer properties, then traverse the DAG in a postorder fashion and apply the rule set at
+-- every node. Properties are re-inferred after every change.
+postOrder :: Dag.Operator o
+             => Rewrite o e (NodeMap p)
+             -> RuleSet o p e
+             -> Rewrite o e Bool
+postOrder inferAction rules =
+  let traverse (changedPrev, props, visited) q =
+        if q `S.member` visited
+        then return (changedPrev, props, visited)
+        else do
+          op <- operator q
+          let cs = Dag.opChildren op
+          (changedChild, mProps, visited') <- foldM descend (False, props, visited) cs
+          props' <- case mProps of
+            Just ps -> return ps
+            Nothing -> inferAction
+
+          e <- getExtras
+
+          -- Check if the current node is still around after its children
+          -- have been rewritten. This should not happen regularly, but
+          -- better safe than sorry.
+          mop <- operatorSafe q
+          case mop of
+            Just _ -> do
+              changedSelf <- applyRuleSet e props' rules q
+              let visited'' = S.insert q visited'
+              if changedSelf
+                then return (True, Nothing, visited'')
+                else return (changedChild || changedPrev, Just props', visited'')
+            Nothing -> return (True, Nothing, visited)
+
+      descend (changedPrev, mProps, visited) c = do
+          props <- case mProps of
+            Just ps -> return ps
+            Nothing -> inferAction
+          traverse (changedPrev, Just props, visited) c
+
+  in do
+    pm <- inferAction
+    rs <- rootNodes
+    (changed, _, _) <- foldM traverse (False, Just pm, S.empty) rs
+    return changed
+
+-- | Iteratively apply a rewrite, until no further changes occur.
+iteratively :: Rewrite o e Bool -> Rewrite o e Bool
+iteratively rewrite = aux False
+  where aux b = do
+          changed <- rewrite
+          if changed
+            then logGeneral ">>> Iterate" >> aux True
+            else return b
+
+-- | Sequence a list of rewrites and propagate information about
+-- wether one of them applied.
+sequenceRewrites :: [Rewrite o e Bool] -> Rewrite o e Bool
+sequenceRewrites rewrites = or <$> sequence rewrites