diff --git a/DSH.cabal b/DSH.cabal
--- a/DSH.cabal
+++ b/DSH.cabal
@@ -1,50 +1,57 @@
 Name:                DSH
-Version:             0.10.0.2
+Version:             0.12.0.0
 Synopsis:            Database Supported Haskell
 Description:
-  This is a Haskell library for database-supported program execution. Using
-  this library a relational database management system (RDBMS) can be used as
-  a coprocessor for the Haskell programming language, especially for those
-  program fragments that carry out data-intensive and data-parallel
-  computations.
+  This is a Haskell library for database-supported program
+  execution. Using DSH, a relational database management
+  system (RDBMS) can be used as a coprocessor for the Haskell
+  programming language, especially for those program fragments that
+  carry out data-intensive and data-parallel computations.
   .
   Database executable program fragments can be written using the monad
-  comprehension notation [2] and list processing combinators from the Haskell
-  list prelude. Note that rather than embedding a relational language into
-  Haskell, we turn idiomatic Haskell programs into SQL queries.
+  comprehension notation [2] and list processing combinators from the
+  Haskell list prelude. Note that rather than embedding a relational
+  language into Haskell, we turn idiomatic Haskell programs into SQL
+  queries.
   .
-  DSH faithfully represents list order and nesting, and compiles the list
-  processing combinators into relational queries. The implementation avoids
-  unnecessary data transfer and context switching between the database
-  coprocessor and the Haskell runtime by ensuring that the number of generated
-  relational queries is only determined by the program fragment's type and not
-  by the database size.
+  DSH faithfully represents list order and nesting, and compiles the
+  list processing combinators into relational queries. The
+  implementation avoids unnecessary data transfer and context
+  switching between the database coprocessor and the Haskell runtime
+  by ensuring that the number of generated relational queries is only
+  determined by the program fragment's type and not by the database
+  size.
   .
-  DSH can be used to allow existing Haskell programs to operate on large scale
-  data (e.g., larger than the available heap) or query existing database
-  resident data with Haskell.
+  DSH can be used to allow existing Haskell programs to operate on
+  large scale data (e.g., larger than the available heap) or query
+  existing database resident data with Haskell.
   .
-  Note that this package is flagged experimental and therefore is not suited
-  for production use (we mean it!). This is a proof of concept implementation 
-  only. To learn more about DSH, our paper entitled as "Haskell Boards the Ferry: 
-  Database-Supported Program Execution for Haskell" [1] is a recommended reading.
-  The package includes a couple of examples that demonstrate how to use DSH.
+  Note that this package is flagged experimental and therefore is not
+  suited for production use (we mean it!). This is a proof of concept
+  implementation only. To learn more about DSH, our paper "The
+  Flatter, the Better — Query Compilation Based on the Flattening
+  Transformation." [1] is a recommended reading. The package includes
+  a couple of examples that demonstrate how to use DSH.
   .
-  In contrast to the DSH version described in [1], the current release does
-  not rely anymore on the loop-lifting compilation technique together with 
-  the Pathfinder optimizer. Instead, it brings a completely rewritten query 
-  compiler based on Guy Blelloch's flattening transformation. This approach
-  leads to a more robust compilation and produces more efficient query code.
+  The current release does not rely anymore on the loop-lifting
+  compilation technique and the Pathfinder optimizer. Instead, it
+  brings a completely rewritten query compiler based on Guy Blelloch's
+  flattening transformation. This approach leads to a more robust
+  compilation and produces more efficient query code.
   .
+  To generate actual code for a relational backend, an additional
+  backend package needs to be installed. Currently, the package
+  'dsh-sql' on Hackage provides SQL code generation for PostgreSQL.
+  .
   Please read the release notes in 'README.md'.
   .
-  1. <http://db.inf.uni-tuebingen.de/staticfiles/publications/ferryhaskell.pdf>
+  1. <http://db.inf.uni-tuebingen.de/publications/TheFlatter-theBetter-QueryCompilationBasedontheFlatteningTransformation.html>
   .
   2. <http://db.inf.uni-tuebingen.de/staticfiles/publications/haskell2011.pdf>
 
 License:             BSD3
 License-file:        LICENSE
-Author:              George Giorgidze, Alexander Ulrich, Nils Schweinsberg and Jeroen Weijers
+Author:              Alexander Ulrich, George Giorgidze, Jeroen Weijers, Nils Schweinsberg
 Maintainer:          alex@etc-network.de
 Stability:           Experimental
 Category:            Database
@@ -54,10 +61,6 @@
                      examples/Example02.hs
                      examples/Example03.hs
                      examples/dshify-tpch.sql
-                     tests/Main.hs
-		     tests/ComprehensionTests.hs
-		     tests/DSHComprehensions.hs
-		     tests/CombinatorTests.hs
                      README.md
 
 Cabal-version:       >= 1.8
@@ -67,62 +70,75 @@
   Default:     False
 
 Flag debuggraph
-  Description: Print debugging information for graph rewrites (VL, TA)
+  Description: Print debugging information for graph rewrites
   Default:     False
 
 Library
   Extensions:        CPP
-  Build-depends:     base               >= 4.7 && < 5,
-                     template-haskell   >= 2.9,
-                     containers         >= 0.5,
-                     mtl                >= 2.1,
-                     bytestring         >= 0.10,
-                     text               >= 1.1,
-                     HDBC               >= 2.3,
-                     HDBC-postgresql    >= 2.3,
-                     pretty             >= 1.1,
-                     aeson              >= 0.8,
-                     kure               >= 2.16,
-                     either             >= 4.0,
-                     semigroups         >= 0.16,
-                     ansi-wl-pprint     >= 0.6,
-                     set-monad          >= 0.1,
-                     dlist              >= 0.7,
+  Build-depends:     base                         >= 4.8 && < 5,
+                     random                       >= 1.1,
+                     process                      >= 1.2,
+                     template-haskell             >= 2.9,
+                     containers                   >= 0.5,
+                     mtl                          >= 2.1,
+                     time                         >= 1.4,
+                     bytestring                   >= 0.10,
+                     text                         >= 1.2,
+                     aeson                        >= 0.8,
+                     kure                         >= 2.16,
+                     either                       >= 4.0,
+                     semigroups                   >= 0.16,
+                     ansi-wl-pprint               >= 0.6.7.2,
+                     dlist                        >= 0.7,
+                     Decimal                      >= 0.4,
+                     QuickCheck                   >= 2.7,
+                     HUnit                        >= 1.2,
+                     test-framework               >= 0.8,
+                     test-framework-quickcheck2   >= 0.3,
+                     test-framework-hunit         >= 0.3,
+                     vector                       >= 0.10,
+                     hashable                     >= 1.2,
+                     unordered-containers         >= 0.2,
 
-                     algebra-dag        >= 0.1,
-                     algebra-sql        >= 0.1
-                     
+                     algebra-dag                  >= 0.1.1
+
   Hs-source-dirs:    src
 
   if flag(debugcomp)
     CPP-Options:     -DDEBUGCOMP
-  
+
   if flag(debuggraph)
     CPP-Options:     -DDEBUGGRAPH
 
-  GHC-Options:       -Wall -fno-warn-orphans
+  GHC-Options:       -Wall -fno-warn-orphans -fprof-auto -O2
 
   Exposed-modules:   Database.DSH
                      Database.DSH.Compiler
+                     Database.DSH.Backend
+                     Database.DSH.Tests
+                     Database.DSH.VL
+                     Database.DSH.Common.QueryPlan
+                     Database.DSH.Common.Opt
+                     Database.DSH.Common.Type
+                     Database.DSH.Common.Vector
+                     Database.DSH.Common.Lang
+                     Database.DSH.Common.Impossible
 
   Other-modules:     Database.DSH.Frontend.Internals
-                     Database.DSH.Frontend.Schema
                      Database.DSH.Frontend.Externals
                      Database.DSH.Frontend.TH
                      Database.DSH.Frontend.TupleTypes
-                     Database.DSH.Frontend.Funs
+                     Database.DSH.Frontend.Builtins
                      Database.DSH.Translate.Frontend2CL
                      Database.DSH.Execute.TH
-                     Database.DSH.Execute.Sql
-                     Database.DSH.Execute.Backend
+                     Database.DSH.Execute
+
                      Database.DSH.Common.Nat
                      Database.DSH.Common.Pretty
-                     Database.DSH.Common.Type
-                     Database.DSH.Common.Lang
-                     Database.DSH.Common.QueryPlan
                      Database.DSH.Common.RewriteM
                      Database.DSH.Common.Kure
-                     Database.DSH.Export
+                     Database.DSH.Common.TH
+
                      Database.DSH.CL.Lang
                      Database.DSH.CL.Kure
                      Database.DSH.CL.Primitives
@@ -148,7 +164,6 @@
                      Database.DSH.NKL.Kure
                      Database.DSH.NKL.Rewrite
                      Database.DSH.NKL.Primitives
-                     Database.DSH.Translate.Algebra2Query
                      Database.DSH.Translate.CL2NKL
                      Database.DSH.Translate.FKL2VL
                      Database.DSH.Translate.NKL2FKL
@@ -156,89 +171,54 @@
 
                      Database.DSH.VL.Lang
                      Database.DSH.VL.Render.Dot
-                     Database.DSH.VL.Render.JSON
-                     Database.DSH.VL.Vector
                      Database.DSH.VL.VectorAlgebra
-                     Database.DSH.VL.VectorAlgebra.TA
                      Database.DSH.VL.Vectorize
                      Database.DSH.VL.Primitives
 
-                     Database.DSH.Impossible
-
-                     Database.DSH.Optimizer.Common.Auxiliary
-                     Database.DSH.Optimizer.Common.Rewrite
-
-                     Database.DSH.Optimizer.VL.Properties.BottomUp
-                     Database.DSH.Optimizer.VL.Properties.Card
-                     Database.DSH.Optimizer.VL.Properties.Common
-                     Database.DSH.Optimizer.VL.Properties.Const
-                     Database.DSH.Optimizer.VL.Properties.Empty
-                     Database.DSH.Optimizer.VL.Properties.NonEmpty
-                     Database.DSH.Optimizer.VL.Properties.ReqColumns
-                     Database.DSH.Optimizer.VL.Properties.TopDown
-                     Database.DSH.Optimizer.VL.Properties.Types
-                     Database.DSH.Optimizer.VL.Properties.VectorType
+                     Database.DSH.VL.Opt.Properties.BottomUp
+                     Database.DSH.VL.Opt.Properties.Card
+                     Database.DSH.VL.Opt.Properties.Common
+                     Database.DSH.VL.Opt.Properties.Const
+                     Database.DSH.VL.Opt.Properties.Empty
+                     Database.DSH.VL.Opt.Properties.ReqColumns
+                     Database.DSH.VL.Opt.Properties.TopDown
+                     Database.DSH.VL.Opt.Properties.Types
+                     Database.DSH.VL.Opt.Properties.VectorType
+                     Database.DSH.VL.Opt.OptimizeVL
+                     Database.DSH.VL.Opt.Rewrite.Common
+                     Database.DSH.VL.Opt.Rewrite.Expressions
+                     Database.DSH.VL.Opt.Rewrite.PruneEmpty
+                     Database.DSH.VL.Opt.Rewrite.Redundant
+                     Database.DSH.VL.Opt.Rewrite.Aggregation
+                     Database.DSH.VL.Opt.Rewrite.Window
+                     Database.DSH.VL.Opt.Rewrite.Unused
 
-                     Database.DSH.Optimizer.TA.Properties.BottomUp
-                     Database.DSH.Optimizer.TA.Properties.TopDown
-                     Database.DSH.Optimizer.TA.Properties.Types
-                     Database.DSH.Optimizer.TA.Properties.Cols
-                     Database.DSH.Optimizer.TA.Properties.ICols
-                     Database.DSH.Optimizer.TA.Properties.Use
-                     Database.DSH.Optimizer.TA.Properties.Auxiliary
-                     Database.DSH.Optimizer.TA.Properties.Empty
-                     Database.DSH.Optimizer.TA.Properties.Card1
-                     Database.DSH.Optimizer.TA.Properties.Keys
-                     Database.DSH.Optimizer.TA.Properties.Order
-                     Database.DSH.Optimizer.TA.Properties.Const
-                     Database.DSH.Optimizer.TA.Rewrite.Basic
-                     Database.DSH.Optimizer.TA.Rewrite.Common
-                     Database.DSH.Optimizer.TA.OptimizeTA
-		     
-                     Database.DSH.Optimizer.Common.Rewrite
-                     Database.DSH.Optimizer.VL.OptimizeVL
-                     Database.DSH.Optimizer.VL.Rewrite.Common
-                     Database.DSH.Optimizer.VL.Rewrite.Expressions
-                     Database.DSH.Optimizer.VL.Rewrite.PruneEmpty
-                     Database.DSH.Optimizer.VL.Rewrite.Redundant
-                     Database.DSH.Optimizer.VL.Rewrite.Aggregation
-                     Database.DSH.Optimizer.VL.Rewrite.Window
-                     Database.DSH.Optimizer.VL.Rewrite.Unused
+                     Database.DSH.Tests.Common
+                     Database.DSH.Tests.ComprehensionTests
+                     Database.DSH.Tests.LawTests
+                     Database.DSH.Tests.CombinatorTests
+                     Database.DSH.Tests.DSHComprehensions
 
 executable vldot
     Main-is: Database/DSH/Tools/VLDotGen.hs
     GHC-Options:      -Wall -fno-warn-orphans
     hs-source-dirs:   src
-    build-depends:    base                >= 4.7 && < 5, 
-                      mtl                 >= 2.1, 
-                      pretty              >= 1.1, 
-                      aeson               >= 0.8, 
+    build-depends:    base                >= 4.8 && < 5,
+                      mtl                 >= 2.1,
+                      aeson               >= 0.8,
+                      time                >= 1.4,
                       containers          >= 0.5,
-                      template-haskell    >= 2.9, 
+                      template-haskell    >= 2.9,
                       bytestring          >= 0.10,
-                      ansi-wl-pprint      >= 0.6,
+                      Decimal             >= 0.4,
+                      ansi-wl-pprint      >= 0.6.7.2,
                       semigroups          >= 0.16,
+                      text                >= 1.2,
+                      vector              >= 0.10,
 
-                      algebra-dag          >= 0.1,
-                      algebra-sql          >= 0.1
+                      algebra-dag          >= 0.1
     GHC-Options: -Wall -fno-warn-orphans
 
-Test-Suite Flattening_TA
-    type:       exitcode-stdio-1.0
-    Hs-Source-Dirs : tests
-    Main-is:       Main.hs
-    Build-depends: base                       >= 4.7 && < 5,
-                   QuickCheck                 >= 2.4,
-                   containers                 >= 0.5,
-                   text                       >= 1.1,
-                   HDBC-postgresql            >= 2.3,
-                   HDBC                       >= 2.3,
-                   test-framework-quickcheck2 >= 0.2,
-                   test-framework-hunit       >= 0.3,
-                   test-framework             >= 0.6,
-                   HUnit                      >= 1.2,
-
-                   DSH                        >= 0.10
-    cpp-options:   -DTESTSQL
-    GHC-Options: -Wall -fno-warn-orphans
-    Extensions: CPP
+source-repository head
+    type:     git
+    location: https://github.com/ulricha/dsh
diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -1,45 +1,48 @@
 # Database-Supported Haskell (DSH)
 
-This is a Haskell library for database-supported program execution. Using
-this library a relational database management system (RDBMS) can be used as
-a coprocessor for the Haskell programming language, especially for those
-program fragments that carry out data-intensive and data-parallel
-computations.
+This is a Haskell library for database-supported program
+execution. Using DSH, a relational database management system (RDBMS)
+can be used as a coprocessor for the Haskell programming language,
+especially for those program fragments that carry out data-intensive
+and data-parallel computations.
 
 Database executable program fragments can be written using the monad
-comprehension notation [2] and list processing combinators from the Haskell
-list prelude. Note that rather than embedding a relational language into
-Haskell, we turn idiomatic Haskell programs into SQL queries.
+comprehension notation [2] and list processing combinators from the
+Haskell list prelude. Note that rather than embedding a relational
+language into Haskell, we turn idiomatic Haskell programs into SQL
+queries.
 
-DSH faithfully represents list order and nesting, and compiles the list
-processing combinators into relational queries. The implementation avoids
-unnecessary data transfer and context switching between the database
-coprocessor and the Haskell runtime by ensuring that the number of generated
-relational queries is only determined by the program fragment's type and not
-by the database size.
+DSH faithfully represents list order and nesting, and compiles the
+list processing combinators into relational queries. The
+implementation avoids unnecessary data transfer and context switching
+between the database coprocessor and the Haskell runtime by ensuring
+that the number of generated relational queries is only determined by
+the program fragment's type and not by the database size.
 
-DSH can be used to allow existing Haskell programs to operate on large scale
-data (e.g., larger than the available heap) or query existing database
-resident data with Haskell.
+DSH can be used to allow existing Haskell programs to operate on large
+scale data (e.g., larger than the available heap) or query existing
+database resident data with Haskell.
 
-Note that this package is flagged experimental and therefore is not suited
-for production use. This is a proof of concept implementation only. To learn
-more about DSH, our paper entitled as "Haskell Boards the Ferry: Database-
-Supported Program Execution for Haskell" [1] is a recommended reading. The
-package includes a couple of examples that demonstrate how to use DSH.
+Note that this package is flagged experimental and therefore is not
+suited for production use (we mean it!). This is a proof of concept
+implementation only. To learn more about DSH, our paper "The Flatter,
+the Better — Query Compilation Based on the Flattening
+Transformation." [1] is a recommended reading. The package includes a
+couple of examples that demonstrate how to use DSH.
 
-In contrast to the DSH version described in [1], the current release
-does not rely anymore on the loop-lifting compilation technique
-together with the Pathfinder optimizer. Instead, it brings a
-completely rewritten query compiler based on Guy Blelloch's flattening
-transformation. This approach leads to a more robust compilation and
-produces more efficient query code.
+The current release does not rely anymore on the loop-lifting
+compilation technique and the Pathfinder optimizer. Instead, it brings
+a completely rewritten query compiler based on Guy Blelloch's
+flattening transformation. This approach leads to a more robust
+compilation and produces more efficient query code.
 
-1. [http://db.inf.uni-tuebingen.de/staticfiles/publications/ferryhaskell.pdf](Grust
-   et al. Haskell Boards the Ferry. Database-Supported Program
-   Execution for Haskell. IFL 2010)
-2. [http://db.inf.uni-tuebingen.de/staticfiles/publications/haskell2011.pdf](Grust
-   et al. Bringing Back Monad Comprehensions. Haskell Symposium 2011).
+To generate actual code for a relational backend, an additional
+backend package needs to be installed. Currently, the package
+`dsh-sql` on Hackage provides SQL code generation for PostgreSQL.
+
+
+1. [Ulrich, Grust. The Flatter, the Better - Query Compilation Based on the Flattening Transformation. Proc. SIGMOD 2015](http://db.inf.uni-tuebingen.de/publications/TheFlatter-theBetter-QueryCompilationBasedontheFlatteningTransformation.html).
+2. [Grust et al. Bringing Back Monad Comprehensions. Haskell Symposium 2011](http://db.inf.uni-tuebingen.de/staticfiles/publications/haskell2011.pdf).
 
 # Release Notes
 
diff --git a/src/Database/DSH.hs b/src/Database/DSH.hs
--- a/src/Database/DSH.hs
+++ b/src/Database/DSH.hs
@@ -1,5 +1,4 @@
--- |  
--- This module is intended to be imported @qualified@, to avoid name clashes
+-- | This module is intended to be imported @qualified@, to avoid name clashes
 -- with "Prelude" functions. For example:
 --
 -- > import qualified Database.DSH as Q
@@ -14,15 +13,15 @@
 -- by Database.DSH.
 
 module Database.DSH
-  ( module Database.DSH.Frontend.Externals
-  , Q, QA, TA, Elim, elim, View, view, Key(..), TableHints(..), Emptiness(..)
-  , module Database.DSH.Frontend.TH
-  , module Data.String
-  , module Data.Text
-  , module Database.HDBC
-  , module Prelude
-  )
-  where
+    ( module Database.DSH.Frontend.Externals
+    , Q, QA, TA, Elim, elim, View, view, Key(..), TableHints(..), Emptiness(..)
+    , module Database.DSH.Frontend.TH
+    , module Data.String
+    , module Data.Text
+    , module Data.Decimal
+    , module Data.Time.Calendar
+    , module Prelude
+    ) where
 
 import Database.DSH.Frontend.Externals
 import Database.DSH.Frontend.Internals (Q,QA,TA,Elim,elim,View,view,Key(..),TableHints(..), Emptiness(..))
@@ -30,7 +29,8 @@
 
 import Data.String (IsString,fromString)
 import Data.Text (Text)
-import Database.HDBC
+import Data.Decimal (Decimal)
+import Data.Time.Calendar (Day)
 import Prelude hiding (
     not
   , (&&)
@@ -87,5 +87,6 @@
   , return
   , (>>=)
   , (>>)
-  , div
+  , quot
+  , rem
   )
diff --git a/src/Database/DSH/Backend.hs b/src/Database/DSH/Backend.hs
new file mode 100644
--- /dev/null
+++ b/src/Database/DSH/Backend.hs
@@ -0,0 +1,130 @@
+{-# LANGUAGE DeriveGeneric    #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE TypeFamilies     #-}
+
+-- | This module provides an abstraction over flat relational backends
+-- with respect to code generation and query execution.
+module Database.DSH.Backend
+    ( -- * Backend-indepdent composite keys
+      KeyVal(..)
+    , CompositeKey(..)
+      -- * Backend Functionality Classes
+    , Backend(..)
+    , Row(..)
+      -- * Literal scalar value expressions
+    , doubleE
+    , unitE
+    , integerE
+    , boolE
+    , charE
+    , textE
+    , decimalE
+    , dayE
+    ) where
+
+import           Data.Decimal
+import           Data.Hashable
+import           Data.Text                        (Text)
+import           Data.ByteString                  (ByteString)
+import qualified Data.Time.Calendar               as C
+import           GHC.Generics                     (Generic)
+
+import           Database.DSH.Common.QueryPlan
+import           Database.DSH.Common.Vector
+import qualified Database.DSH.Frontend.Internals  as F
+import           Database.DSH.VL.Lang             (VL)
+
+--------------------------------------------------------------------------------
+-- Backend-independent composite keys
+
+data KeyVal = KInteger !Integer
+            | KByteString !ByteString
+            | KDay !C.Day
+            deriving (Eq, Generic)
+
+newtype CompositeKey = CompositeKey { unCKey :: [KeyVal] }
+    deriving (Eq, Generic)
+
+instance Hashable C.Day where
+    hashWithSalt s d = s `hashWithSalt` (C.toGregorian d)
+
+instance Hashable KeyVal where
+
+instance Hashable CompositeKey where
+
+--------------------------------------------------------------------------------
+
+-- | An abstract backend for which we can generate code and on which
+-- flat queries can be executed.
+class (RelationalVector (BackendCode c), Row (BackendRow c)) => Backend c where
+    data BackendRow c
+    data BackendCode c
+    data BackendPlan c
+
+    -- | Execute a flat query on the backend.
+    execFlatQuery :: c -> BackendCode c -> IO [BackendRow c]
+
+    -- | Implement vector operations using the backend-specific
+    -- algebra.
+    generatePlan  :: QueryPlan VL VLDVec -> BackendPlan c
+
+    -- | Optimize the algebra plan and generate serialized backend
+    -- code
+    generateCode  :: BackendPlan c -> Shape (BackendCode c)
+
+    -- | Dump versions of the plan in JSON form to the specified file.
+    dumpPlan :: String -> Bool -> BackendPlan c -> IO FilePath
+
+    transactionally :: c -> (c -> IO a) -> IO a
+
+--------------------------------------------------------------------------------
+
+-- | Abstraction over result rows for a specific backend.
+class Row r where
+    -- | The type of single attribute values
+    data Scalar r
+
+    -- | Look up an attribute in the row
+    col        :: String -> r -> (Scalar r)
+
+    -- | Convert an attribute value to a segment descriptor value
+    descrVal   :: Scalar r -> Int
+
+    boolVal    :: Scalar r -> F.Exp Bool
+    integerVal :: Scalar r -> F.Exp Integer
+    doubleVal  :: Scalar r -> F.Exp Double
+    charVal    :: Scalar r -> F.Exp Char
+    textVal    :: Scalar r -> F.Exp Text
+    unitVal    :: Scalar r -> F.Exp ()
+    decimalVal :: Scalar r -> F.Exp Decimal
+    dayVal     :: Scalar r -> F.Exp C.Day
+
+    keyVal :: Scalar r -> KeyVal
+
+--------------------------------------------------------------------------------
+-- Constructors for literal scalar type expressions. Backends need
+-- those to construct result expressions from rows.
+
+doubleE :: Double -> F.Exp Double
+doubleE = F.DoubleE
+
+unitE :: F.Exp ()
+unitE = F.UnitE
+
+integerE :: Integer -> F.Exp Integer
+integerE = F.IntegerE
+
+boolE :: Bool -> F.Exp Bool
+boolE = F.BoolE
+
+charE :: Char -> F.Exp Char
+charE = F.CharE
+
+textE :: Text -> F.Exp Text
+textE = F.TextE
+
+dayE :: C.Day -> F.Exp C.Day
+dayE = F.DayE
+
+decimalE :: Decimal -> F.Exp Decimal
+decimalE = F.DecimalE
diff --git a/src/Database/DSH/CL/Kure.hs b/src/Database/DSH/CL/Kure.hs
--- a/src/Database/DSH/CL/Kure.hs
+++ b/src/Database/DSH/CL/Kure.hs
@@ -4,7 +4,7 @@
 {-# LANGUAGE InstanceSigs          #-}
 
 -- | Infrastructure for KURE-based rewrites on CL expressions
-   
+
 module Database.DSH.CL.Kure
     ( -- * Re-export relevant KURE modules
       module Language.KURE
@@ -12,10 +12,10 @@
 
       -- * The KURE monad
     , RewriteM, RewriteStateM, TransformC, RewriteC, LensC, freshName, freshNameT
-    
+
       -- * Setters and getters for the translation state
     , get, put, modify
-    
+
       -- * Changing between stateful and non-stateful transforms
     , statefulT, liftstateT
 
@@ -29,26 +29,25 @@
     , unopR, unopT
     , bindQualT, guardQualT, bindQualR, guardQualR
     , qualsT, qualsR, qualsemptyT, qualsemptyR
-    
+
       -- * The sum type
     , CL(..)
     ) where
-    
-       
+
+
 import           Control.Monad
-import           Data.Monoid
 import qualified Data.Map as M
 import qualified Data.Foldable as F
 import           Text.PrettyPrint.ANSI.Leijen(text)
 
 import           Language.KURE
 import           Language.KURE.Lens
-       
+
 import           Database.DSH.Common.Pretty
 import qualified Database.DSH.Common.Lang as L
 import           Database.DSH.Common.RewriteM
 import           Database.DSH.CL.Lang
-                 
+
 --------------------------------------------------------------------------------
 -- Convenience type aliases
 
@@ -92,13 +91,13 @@
 type PathC = Path CrumbC
 
 -- | The context for KURE-based CL rewrites
-data CompCtx = CompCtx { cl_bindings :: M.Map L.Ident Type 
+data CompCtx = CompCtx { cl_bindings :: M.Map L.Ident Type
                        , cl_path     :: AbsPathC
                        }
-                       
+
 instance ExtendPath CompCtx CrumbC where
     c@@n = c { cl_path = cl_path c @@ n }
-    
+
 instance ReadPath CompCtx CrumbC where
     absPath c = cl_path c
 
@@ -113,7 +112,7 @@
 bindQual :: CompCtx -> Qual -> CompCtx
 bindQual ctx (BindQ n e) = bindVar n (elemT $ typeOf e) ctx
 bindQual ctx _           = ctx
-         
+
 inScopeNames :: CompCtx -> [L.Ident]
 inScopeNames = M.keys . cl_bindings
 
@@ -149,56 +148,56 @@
 --------------------------------------------------------------------------------
 -- Congruence combinators for CL expressions
 
-tableT :: Monad m => (Type -> String -> [L.Column] -> L.TableHints -> b)
+tableT :: Monad m => (Type -> String -> L.BaseTableSchema -> b)
                   -> Transform CompCtx m Expr b
 tableT f = contextfreeT $ \expr -> case expr of
-                      Table ty n cs hs -> return $ f ty n cs hs
-                      _                -> fail "not a table node"
-{-# INLINE tableT #-}                      
-                      
+                      Table ty n schema -> return $ f ty n schema
+                      _                 -> fail "not a table node"
+{-# INLINE tableT #-}
+
 tableR :: Monad m => Rewrite CompCtx m Expr
 tableR = tableT Table
 {-# INLINE tableR #-}
-                                       
+
 appe1T :: Monad m => Transform CompCtx m Expr a
                   -> (Type -> Prim1 -> a -> b)
                   -> Transform CompCtx m Expr b
 appe1T t f = transform $ \c expr -> case expr of
-                      AppE1 ty p e -> f ty p <$> applyT t (c@@AppE1Arg) e                  
+                      AppE1 ty p e -> f ty p <$> applyT t (c@@AppE1Arg) e
                       _            -> fail "not a unary primitive application"
-{-# INLINE appe1T #-}                      
-                      
+{-# INLINE appe1T #-}
+
 appe1R :: Monad m => Rewrite CompCtx m Expr -> Rewrite CompCtx m Expr
 appe1R t = appe1T t AppE1
-{-# INLINE appe1R #-}                      
-                      
+{-# INLINE appe1R #-}
+
 appe2T :: Monad m => Transform CompCtx m Expr a1
                   -> Transform CompCtx m Expr a2
                   -> (Type -> Prim2 -> a1 -> a2 -> b)
                   -> Transform CompCtx m Expr b
 appe2T t1 t2 f = transform $ \c expr -> case expr of
-                     AppE2 ty p e1 e2 -> f ty p <$> applyT t1 (c@@AppE2Arg1) e1 
+                     AppE2 ty p e1 e2 -> f ty p <$> applyT t1 (c@@AppE2Arg1) e1
                                                 <*> applyT t2 (c@@AppE2Arg2) e2
                      _                -> fail "not a binary primitive application"
-{-# INLINE appe2T #-}                      
+{-# INLINE appe2T #-}
 
 appe2R :: Monad m => Rewrite CompCtx m Expr -> Rewrite CompCtx m Expr -> Rewrite CompCtx m Expr
 appe2R t1 t2 = appe2T t1 t2 AppE2
-{-# INLINE appe2R #-}                      
-                     
+{-# INLINE appe2R #-}
+
 binopT :: Monad m => Transform CompCtx m Expr a1
                   -> Transform CompCtx m Expr a2
                   -> (Type -> L.ScalarBinOp -> a1 -> a2 -> b)
                   -> Transform CompCtx m Expr b
 binopT t1 t2 f = transform $ \c expr -> case expr of
-                     BinOp ty op e1 e2 -> f ty op <$> applyT t1 (c@@BinOpArg1) e1 
+                     BinOp ty op e1 e2 -> f ty op <$> applyT t1 (c@@BinOpArg1) e1
                                                   <*> applyT t2 (c@@BinOpArg2) e2
                      _                 -> fail "not a binary operator application"
-{-# INLINE binopT #-}                      
+{-# INLINE binopT #-}
 
 binopR :: Monad m => Rewrite CompCtx m Expr -> Rewrite CompCtx m Expr -> Rewrite CompCtx m Expr
 binopR t1 t2 = binopT t1 t2 BinOp
-{-# INLINE binopR #-}                      
+{-# INLINE binopR #-}
 
 unopT :: Monad m => Transform CompCtx m Expr a
                  -> (Type -> L.ScalarUnOp -> a -> b)
@@ -211,61 +210,61 @@
 unopR :: Monad m => Rewrite CompCtx m Expr -> Rewrite CompCtx m Expr
 unopR t = unopT t UnOp
 {-# INLINE unopR #-}
-                     
+
 ifT :: Monad m => Transform CompCtx m Expr a1
                -> Transform CompCtx m Expr a2
                -> Transform CompCtx m Expr a3
                -> (Type -> a1 -> a2 -> a3 -> b)
                -> Transform CompCtx m Expr b
 ifT t1 t2 t3 f = transform $ \c expr -> case expr of
-                    If ty e1 e2 e3 -> f ty <$> applyT t1 (c@@IfCond) e1               
+                    If ty e1 e2 e3 -> f ty <$> applyT t1 (c@@IfCond) e1
                                            <*> applyT t2 (c@@IfThen) e2
                                            <*> applyT t3 (c@@IfElse) e3
                     _              -> fail "not an if expression"
-{-# INLINE ifT #-}                      
-                    
+{-# INLINE ifT #-}
+
 ifR :: Monad m => Rewrite CompCtx m Expr
                -> Rewrite CompCtx m Expr
                -> Rewrite CompCtx m Expr
                -> Rewrite CompCtx m Expr
-ifR t1 t2 t3 = ifT t1 t2 t3 If               
-{-# INLINE ifR #-}                      
-                    
+ifR t1 t2 t3 = ifT t1 t2 t3 If
+{-# INLINE ifR #-}
+
 litT :: Monad m => (Type -> L.Val -> b) -> Transform CompCtx m Expr b
 litT f = contextfreeT $ \expr -> case expr of
                     Lit ty v -> return $ f ty v
                     _          -> fail "not a constant"
-{-# INLINE litT #-}                      
-                    
+{-# INLINE litT #-}
+
 litR :: Monad m => Rewrite CompCtx m Expr
 litR = litT Lit
-{-# INLINE litR #-}                      
-                    
+{-# INLINE litR #-}
+
 varT :: Monad m => (Type -> L.Ident -> b) -> Transform CompCtx m Expr b
 varT f = contextfreeT $ \expr -> case expr of
                     Var ty n -> return $ f ty n
                     _        -> fail "not a variable"
-{-# INLINE varT #-}                      
-                    
+{-# INLINE varT #-}
+
 varR :: Monad m => Rewrite CompCtx m Expr
 varR = varT Var
-{-# INLINE varR #-}                      
+{-# INLINE varR #-}
 
 compT :: Monad m => Transform CompCtx m Expr a1
                  -> Transform CompCtx m (NL Qual) a2
                  -> (Type -> a1 -> a2 -> b)
                  -> Transform CompCtx m Expr b
 compT t1 t2 f = transform $ \ctx expr -> case expr of
-                    Comp ty e qs -> f ty <$> applyT t1 (F.foldl' bindQual (ctx@@CompHead) qs) e 
+                    Comp ty e qs -> f ty <$> applyT t1 (F.foldl' bindQual (ctx@@CompHead) qs) e
                                          <*> applyT t2 (ctx@@CompQuals) qs
                     _            -> fail "not a comprehension"
-{-# INLINE compT #-}                      
-                    
+{-# INLINE compT #-}
+
 compR :: Monad m => Rewrite CompCtx m Expr
                  -> Rewrite CompCtx m (NL Qual)
                  -> Rewrite CompCtx m Expr
-compR t1 t2 = compT t1 t2 Comp                 
-{-# INLINE compR #-}                      
+compR t1 t2 = compT t1 t2 Comp
+{-# INLINE compR #-}
 
 mkTupleT :: Monad m => Transform CompCtx m Expr a
                     -> (Type -> [a] -> b)
@@ -280,119 +279,119 @@
 
 letT :: Monad m => Transform CompCtx m Expr a1
                 -> Transform CompCtx m Expr a2
-                -> (Type -> L.Ident -> a1 -> a2 -> b) 
+                -> (Type -> L.Ident -> a1 -> a2 -> b)
                 -> Transform CompCtx m Expr b
 letT t1 t2 f = transform $ \c expr -> case expr of
-                 Let ty x xs e -> f ty x <$> applyT t1 (c@@LetBind) xs 
+                 Let ty x xs e -> f ty x <$> applyT t1 (c@@LetBind) xs
                                          <*> applyT t2 (bindVar x (typeOf xs) $ c@@LetBody) e
                  _             -> fail "not a let expression"
 
-letR :: Monad m => Rewrite CompCtx m Expr 
-                -> Rewrite CompCtx m Expr 
+letR :: Monad m => Rewrite CompCtx m Expr
                 -> Rewrite CompCtx m Expr
+                -> Rewrite CompCtx m Expr
 letR r1 r2 = letT r1 r2 Let
 
 --------------------------------------------------------------------------------
 -- Congruence combinators for qualifiers
 
-bindQualT :: Monad m => Transform CompCtx m Expr a 
-                     -> (L.Ident -> a -> b) 
+bindQualT :: Monad m => Transform CompCtx m Expr a
+                     -> (L.Ident -> a -> b)
                      -> Transform CompCtx m Qual b
 bindQualT t f = transform $ \ctx expr -> case expr of
                 BindQ n e -> f n <$> applyT t (ctx@@BindQualExpr) e
                 _         -> fail "not a generator"
-{-# INLINE bindQualT #-}                      
-                
+{-# INLINE bindQualT #-}
+
 bindQualR :: Monad m => Rewrite CompCtx m Expr -> Rewrite CompCtx m Qual
 bindQualR t = bindQualT t BindQ
-{-# INLINE bindQualR #-}                      
+{-# INLINE bindQualR #-}
 
-guardQualT :: Monad m => Transform CompCtx m Expr a 
-                      -> (a -> b) 
+guardQualT :: Monad m => Transform CompCtx m Expr a
+                      -> (a -> b)
                       -> Transform CompCtx m Qual b
 guardQualT t f = transform $ \ctx expr -> case expr of
                 GuardQ e -> f <$> applyT t (ctx@@GuardQualExpr) e
                 _        -> fail "not a guard"
-{-# INLINE guardQualT #-}                      
-                
+{-# INLINE guardQualT #-}
+
 guardQualR :: Monad m => Rewrite CompCtx m Expr -> Rewrite CompCtx m Qual
 guardQualR t = guardQualT t GuardQ
-{-# INLINE guardQualR #-}                      
+{-# INLINE guardQualR #-}
 
 --------------------------------------------------------------------------------
 -- Congruence combinator for a qualifier list
 
 qualsT :: Monad m => Transform CompCtx m Qual a1
                   -> Transform CompCtx m (NL Qual) a2
-                  -> (a1 -> a2 -> b) 
+                  -> (a1 -> a2 -> b)
                   -> Transform CompCtx m (NL Qual) b
 qualsT t1 t2 f = transform $ \ctx quals -> case quals of
-                   q :* qs -> f <$> applyT t1 (ctx@@QualsHead) q 
+                   q :* qs -> f <$> applyT t1 (ctx@@QualsHead) q
                                 <*> applyT t2 (bindQual (ctx@@QualsTail) q) qs
                    S _     -> fail "not a nonempty cons"
-{-# INLINE qualsT #-}                      
-                   
+{-# INLINE qualsT #-}
+
 qualsR :: Monad m => Rewrite CompCtx m Qual
                   -> Rewrite CompCtx m (NL Qual)
                   -> Rewrite CompCtx m (NL Qual)
-qualsR t1 t2 = qualsT t1 t2 (:*)                  
-{-# INLINE qualsR #-}                      
+qualsR t1 t2 = qualsT t1 t2 (:*)
+{-# INLINE qualsR #-}
 
-                   
+
 qualsemptyT :: Monad m => Transform CompCtx m Qual a
                        -> (a -> b)
                        -> Transform CompCtx m (NL Qual) b
 qualsemptyT t f = transform $ \ctx quals -> case quals of
                       S q -> f <$> applyT t (ctx@@QualsSingleton) q
                       _   -> fail "not a nonempty singleton"
-{-# INLINE qualsemptyT #-}                      
-                      
+{-# INLINE qualsemptyT #-}
+
 qualsemptyR :: Monad m => Rewrite CompCtx m Qual
                        -> Rewrite CompCtx m (NL Qual)
-qualsemptyR t = qualsemptyT t S                       
-{-# INLINE qualsemptyR #-}                      
+qualsemptyR t = qualsemptyT t S
+{-# INLINE qualsemptyR #-}
 
 --------------------------------------------------------------------------------
-       
+
 -- | The sum type of *nodes* considered for KURE traversals
 data CL = ExprCL Expr
         | QualCL Qual
         | QualsCL (NL Qual)
-        
+
 instance Pretty CL where
     pretty (ExprCL e)   = pretty e
     pretty (QualCL q)   = pretty q
     pretty (QualsCL qs) = pretty qs
-        
+
 instance Injection Expr CL where
     inject                = ExprCL
-    
+
     project (ExprCL expr) = Just expr
     project _             = Nothing
 
 instance Injection Qual CL where
     inject             = QualCL
-    
+
     project (QualCL q) = Just q
     project _          = Nothing
-    
+
 instance Injection (NL Qual) CL where
     inject               = QualsCL
-    
+
     project (QualsCL qs) = Just qs
     project _            = Nothing
 
-    
+
 -- FIXME putting an INLINE pragma on allR would propably lead to good
 -- things. However, with 7.6.3 it triggers a GHC panic.
 instance Walker CompCtx CL where
     allR :: forall m. MonadCatch m => Rewrite CompCtx m CL -> Rewrite CompCtx m CL
-    allR r = 
+    allR r =
         rewrite $ \c cl -> case cl of
             ExprCL expr -> inject <$> applyT allRexpr c expr
             QualCL q    -> inject <$> applyT allRqual c q
             QualsCL qs  -> inject <$> applyT allRquals c qs
-    
+
       where
         allRquals = readerT $ \qs -> case qs of
             S{}    -> qualsemptyR (extractR r)
@@ -417,45 +416,34 @@
             MkTuple{} -> mkTupleR (extractR r)
             Let{}     -> letR (extractR r) (extractR r)
         {-# INLINE allRexpr #-}
-            
+
 --------------------------------------------------------------------------------
 -- A Walker instance for qualifier lists so that we can use the
 -- traversal infrastructure on lists.
-   
+
 consT :: Monad m => Transform CompCtx m (NL Qual) b
                  -> (Qual -> b -> c)
                  -> Transform CompCtx m (NL Qual) c
 consT t f = transform $ \ctx nl -> case nl of
                 a :* as -> f a <$> applyT t (bindQual (ctx@@NLConsTail) a) as
                 S _     -> fail "not a nonempty cons"
-{-# INLINE consT #-}                      
-                    
-consR :: Monad m => Rewrite CompCtx m (NL Qual) 
+{-# INLINE consT #-}
+
+consR :: Monad m => Rewrite CompCtx m (NL Qual)
                  -> Rewrite CompCtx m (NL Qual)
-consR t = consT t (:*)                 
-{-# INLINE consR #-}                      
+consR t = consT t (:*)
+{-# INLINE consR #-}
 
 singletonT :: Monad m => (Qual -> c)
                       -> Transform CompCtx m (NL Qual) c
 singletonT f = contextfreeT $ \nl -> case nl of
                    S a    -> return $ f a
                    _ :* _ -> fail "not a nonempty singleton"
-{-# INLINE singletonT #-}                      
-               
+{-# INLINE singletonT #-}
+
 singletonR :: Monad m => Rewrite CompCtx m (NL Qual)
-singletonR = singletonT S                      
-{-# INLINE singletonR #-}                      
-                   
+singletonR = singletonT S
+{-# INLINE singletonR #-}
+
 instance Walker CompCtx (NL Qual) where
     allR r = consR r <+ singletonR
-    
---------------------------------------------------------------------------------
--- I find it annoying that Applicative is not a superclass of Monad.
-
-(<$>) :: Monad m => (a -> b) -> m a -> m b
-(<$>) = liftM
-{-# INLINE (<$>) #-}
-
-(<*>) :: Monad m => m (a -> b) -> m a -> m b
-(<*>) = ap
-{-# INLINE (<*>) #-}
diff --git a/src/Database/DSH/CL/Lang.hs b/src/Database/DSH/CL/Lang.hs
--- a/src/Database/DSH/CL/Lang.hs
+++ b/src/Database/DSH/CL/Lang.hs
@@ -1,9 +1,9 @@
 {-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE GADTs                 #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE PatternSynonyms       #-}
 {-# LANGUAGE StandaloneDeriving    #-}
 {-# LANGUAGE TemplateHaskell       #-}
-{-# LANGUAGE PatternSynonyms       #-}
 
 module Database.DSH.CL.Lang
     ( module Database.DSH.Common.Type
@@ -15,21 +15,19 @@
     , Prim2(..)
     ) where
 
-import           Control.Applicative          hiding (empty)
+import qualified Data.Foldable                  as F
+import           Data.List.NonEmpty             (NonEmpty ((:|)))
+import qualified Data.Traversable               as T
 
-import qualified Data.Foldable                as F
-import qualified Data.Traversable             as T
-import           Data.List.NonEmpty           (NonEmpty((:|)))
+import           Text.PrettyPrint.ANSI.Leijen   hiding ((<$>))
 
-import           Text.PrettyPrint.ANSI.Leijen hiding ((<$>))
-import qualified Text.PrettyPrint.ANSI.Leijen as PP
 import           Text.Printf
 
+import           Database.DSH.Common.Impossible
+import qualified Database.DSH.Common.Lang       as L
 import           Database.DSH.Common.Nat
-import qualified Database.DSH.Common.Lang     as L
-import           Database.DSH.Common.Type
 import           Database.DSH.Common.Pretty
-import           Database.DSH.Impossible
+import           Database.DSH.Common.Type
 
 --------------------------------------------------------------------------------
 -- A simple type of nonempty lists, used for comprehension
@@ -95,80 +93,78 @@
 -- CL primitives
 
 data Prim1 = Singleton
-           | Length 
+           | Only
+           | Length
            | Concat
            | Null
-           | Sum 
-           | Avg 
-           | The 
-           | Head 
-           | Tail
-           | Minimum 
+           | Sum
+           | Avg
+           | Minimum
            | Maximum
-           | Reverse 
-           | And 
+           | Reverse
+           | And
            | Or
-           | Init 
-           | Last 
            | Nub
-           | Number 
+           | Number
+           | Sort
+           | Group
            | Guard
-           | Reshape Integer
-           | Transpose
            | TupElem TupleIndex
-           deriving (Eq)
+           deriving (Eq, Show)
 
-instance Show Prim1 where
-  show Singleton       = "sng"
-  show Length          = "length"
-  show Concat          = "concat"
-  show Null            = "null"
-  show Sum             = "sum"
-  show Avg             = "avg"
-  show The             = "the"
-  show Head            = "head"
-  show Minimum         = "minimum"
-  show Maximum         = "maximum"
-  show Tail            = "tail"
-  show Reverse         = "reverse"
-  show And             = "and"
-  show Or              = "or"
-  show Init            = "init"
-  show Last            = "last"
-  show Nub             = "nub"
-  show Number          = "number"
-  show Guard           = "guard"
-  show Transpose       = "transpose"
-  show (Reshape n)     = printf "reshape(%d)" n
+instance Pretty Prim1 where
+  pretty Sort            = combinator $ text "sort"
+  pretty Group           = combinator $ text "group"
+  pretty Singleton       = combinator $ text "sng"
+  pretty Only            = combinator $ text "only"
+  pretty Length          = combinator $ text "length"
+  pretty Concat          = combinator $ text "concat"
+  pretty Null            = combinator $ text "null"
+  pretty Sum             = combinator $ text "sum"
+  pretty Avg             = combinator $ text "avg"
+  pretty Minimum         = combinator $ text "minimum"
+  pretty Maximum         = combinator $ text "maximum"
+  pretty Reverse         = combinator $ text "reverse"
+  pretty And             = combinator $ text "and"
+  pretty Or              = combinator $ text "or"
+  pretty Nub             = combinator $ text "nub"
+  pretty Number          = combinator $ text "number"
+  pretty Guard           = combinator $ text "guard"
   -- tuple access is pretty-printed in a special way
-  show TupElem{}       = $impossible
+  pretty TupElem{}       = $impossible
 
-data Prim2 = Sort
-           | Group
-           | Append
-           | Index
-           | Zip 
+data Prim2 = Append
+           | Zip
            | CartProduct
            | NestProduct
            | ThetaJoin (L.JoinPredicate L.JoinExpr)
            | NestJoin (L.JoinPredicate L.JoinExpr)
            | SemiJoin (L.JoinPredicate L.JoinExpr)
            | AntiJoin (L.JoinPredicate L.JoinExpr)
-           deriving (Eq)
+           deriving (Eq, Show)
 
-instance Show Prim2 where
-  show Group        = "group"
-  show Sort         = "sort"
-  show Append       = "append"
-  show Index        = "index"
-  show Zip          = "zip"
-  show CartProduct  = "⨯"
-  show NestProduct  = "▽"
-  show (ThetaJoin p) = printf "⨝_%s" (pp p)
-  show (NestJoin p)  = printf "△_%s" (pp p)
-  show (SemiJoin p)  = printf "⋉_%s" (pp p)
-  show (AntiJoin p)  = printf "▷_%s" (pp p)
+isJoinOp :: Prim2 -> Bool
+isJoinOp op =
+    case op of
+        CartProduct -> True
+        NestProduct -> True
+        ThetaJoin{} -> True
+        NestJoin{}  -> True
+        SemiJoin{}  -> True
+        AntiJoin{}  -> True
+        Append      -> False
+        Zip         -> False
 
+instance Pretty Prim2 where
+  pretty Append        = combinator $ text "append"
+  pretty Zip           = combinator $ text "zip"
+  pretty CartProduct   = join $ text "cartproduct"
+  pretty NestProduct   = join $ text "nestproduct"
+  pretty (ThetaJoin p) = join $ text $ printf "thetajoin{%s}" (pp p)
+  pretty (NestJoin p)  = join $ text $ printf "nestjoin{%s}" (pp p)
+  pretty (SemiJoin p)  = join $ text $ printf "semijoin{%s}" (pp p)
+  pretty (AntiJoin p)  = join $ text $ printf "antijoin{%s}" (pp p)
+
 --------------------------------------------------------------------------------
 -- CL expressions
 
@@ -184,7 +180,7 @@
 isBind (GuardQ _)   = False
 isBind (BindQ _ _)  = True
 
-data Expr  = Table Type String [L.Column] L.TableHints
+data Expr  = Table Type String L.BaseTableSchema
            | AppE1 Type Prim1 Expr
            | AppE2 Type Prim2 Expr Expr
            | BinOp Type L.ScalarBinOp Expr Expr
@@ -198,69 +194,59 @@
            deriving (Show)
 
 instance Pretty Expr where
-    pretty (AppE1 _ (TupElem n) e1) = 
+    pretty (AppE1 _ (TupElem n) e1) =
         parenthize e1 <> dot <> int (tupleIndex n)
-    pretty (MkTuple _ es)     = tupled $ map pretty es
-    pretty (Table _ n _ _)    = text "table" <> parens (text n)
-    pretty (AppE1 _ p1 e)     = (text $ show p1) <+> (parenthize e)
-    pretty (AppE2 _ p1 e1@(Comp _ _ _) e2) = (text $ show p1) <+> (align $ (parenthize e1) PP.<$> (parenthize e2))
-    pretty (AppE2 _ p1 e1 e2@(Comp _ _ _)) = (text $ show p1) <+> (align $ (parenthize e1) PP.<$> (parenthize e2))
-    pretty (AppE2 _ p1 e1 e2) = (text $ show p1) <+> (align $ (parenthize e1) </> (parenthize e2))
-    pretty (BinOp _ o e1 e2)  = (parenthize e1) <+> (pretty o) <+> (parenthize e2)
-    pretty (UnOp _ o e)       = pretty o <> parens (pretty e)
-    pretty (If _ c t e)       = text "if"
-                             <+> pretty c
-                             <+> text "then"
-                             <+> (parenthize t)
-                             <+> text "else"
-                             <+> (parenthize e)
+    pretty (MkTuple _ es)     = prettyTuple $ map pretty es
+    pretty (Table _ n _)      = kw (text "table") <> parens (text n)
+    pretty (AppE1 _ p1 e)     = pretty p1 <+> (parenthize e)
+    pretty (AppE2 _ p2 e1 e2)
+        | isJoinOp p2 = prettyJoin (pretty p2) (parenthize e1) (parenthize e2)
+        | otherwise   = prettyApp2 (pretty p2) (parenthize e1) (parenthize e2)
+    pretty (BinOp _ o e1 e2)
+        | L.isBinInfixOp o = prettyInfixBinOp (pretty o)
+                                              (parenthize e1)
+                                              (parenthize e2)
+        | otherwise        = prettyPrefixBinOp (pretty o)
+                                               (parenthize e1)
+                                               (parenthize e2)
+    pretty (UnOp _ o e)       = prettyUnOp (pretty o) (pretty e)
+    pretty (If _ c t e)       = prettyIf (pretty c) (pretty t) (pretty e)
     pretty (Lit _ v)          = pretty v
     pretty (Var _ s)          = text s
-
-    pretty (Comp _ e qs) = encloseSep lbracket rbracket empty docs
-                         where docs = (char ' ' <> pretty e <> char ' ') : qsDocs
-                               qsDocs =
-                                 case qs of
-                                   q :* qs' -> (char '|' <+> pretty q)
-                                               : [ char ',' <+> pretty q' | q' <- toList qs' ]
-
-                                   S q      -> [char '|' <+> pretty q]
-    pretty (Let _ x e1 e)     = 
-        align $ text "let" <+> text x <+> char '=' <+> pretty e1
-                </>
-                text "in" <+> pretty e
+    pretty (Comp _ e qs)      = prettyComp (pretty e) (map pretty $ toList qs)
+    pretty (Let _ x e1 e)     = prettyLet (text x) (pretty e1) (pretty e)
 
 parenthize :: Expr -> Doc
 parenthize e =
     case e of
         Var _ _               -> pretty e
         Lit _ _               -> pretty e
-        Table _ _ _ _         -> pretty e
+        Table _ _ _           -> pretty e
         Comp _ _ _            -> pretty e
         AppE1 _ (TupElem _) _ -> pretty e
         _                     -> parens $ pretty e
 
 instance Pretty Qual where
-    pretty (BindQ i e) = text i <+> text "<-" <+> pretty e
+    pretty (BindQ i e) = text i <+> comp (text "<-") <+> pretty e
     pretty (GuardQ e)  = pretty e
 
--- Binary relational operators are pretty-printed different from other
--- combinators
-isRelOp :: Prim2 -> Bool
-isRelOp o =
-    case o of
-        ThetaJoin _  -> True
-        NestJoin _   -> True
-        SemiJoin _   -> True
-        AntiJoin _   -> True
-        _            -> False
+-- -- Binary relational operators are pretty-printed different from other
+-- -- combinators
+-- isRelOp :: Prim2 -> Bool
+-- isRelOp o =
+--     case o of
+--         ThetaJoin _  -> True
+--         NestJoin _   -> True
+--         SemiJoin _   -> True
+--         AntiJoin _   -> True
+--         _            -> False
 
 
 
 deriving instance Eq Expr
 
 instance Typed Expr where
-    typeOf (Table t _ _ _) = t
+    typeOf (Table t _ _)   = t
     typeOf (AppE1 t _ _)   = t
     typeOf (AppE2 t _ _ _) = t
     typeOf (If t _ _ _)    = t
@@ -271,5 +257,3 @@
     typeOf (Comp t _ _)    = t
     typeOf (MkTuple t _)   = t
     typeOf (Let t _ _ _)   = t
-
-
diff --git a/src/Database/DSH/CL/Opt.hs b/src/Database/DSH/CL/Opt.hs
--- a/src/Database/DSH/CL/Opt.hs
+++ b/src/Database/DSH/CL/Opt.hs
@@ -27,7 +27,7 @@
 
 -- | Comprehension normalization rules 1 to 3.
 compNormEarlyR :: RewriteC CL
-compNormEarlyR = m_norm_1R 
+compNormEarlyR = m_norm_1R
                  <+ m_norm_2R
                  <+ m_norm_3R
                  -- Does not lead to good code. See lablog entry (24.11.2014)
@@ -35,12 +35,6 @@
                  <+ ifgeneratorR
                  <+ identityCompR
 
--- | Comprehension normalization rules 4 and 5. Beware: these rewrites
--- should propably occur late in the chain, as they might prohibit
--- semijoin/antijoin introduction
-compNormLateR :: RewriteC CL
-compNormLateR = m_norm_4R <+ m_norm_5R
-
 -- | Nestjoin/Nestproduct rewrites are applied bottom-up. Innermost
 -- nesting opportunities must be dealt with first in order to produce
 -- trees of nesting operators.
@@ -107,8 +101,10 @@
             repeatR applyOptimizationsR >+>
             postProcessR
 
+-- | Apply the default set of unnesting and decorrelation rewrites to
+-- a CL query.
 optimizeComprehensions :: Expr -> Expr
-optimizeComprehensions expr = debugOpt "CL" expr optimizedExpr
-  where
-    optimizedExpr = applyExpr (optimizeR >>> projectT) expr
-    -- optimizedExpr = applyExpr projectT expr
+optimizeComprehensions expr =
+    case applyExpr (optimizeR >>> projectT) expr of
+        Left _      -> expr
+        Right expr' -> expr'
diff --git a/src/Database/DSH/CL/Opt/AntiJoin.hs b/src/Database/DSH/CL/Opt/AntiJoin.hs
--- a/src/Database/DSH/CL/Opt/AntiJoin.hs
+++ b/src/Database/DSH/CL/Opt/AntiJoin.hs
@@ -45,8 +45,8 @@
 -- quantifier predicate. In addition, it returns a (possibly empty)
 -- list of conjuncts that only reference the inner variable and can be
 -- evaluated on the inner source.
-quantifierPredicateT :: Ident 
-                     -> Ident 
+quantifierPredicateT :: Ident
+                     -> Ident
                      -> TransformC CL (NonEmpty (JoinConjunct JoinExpr), [Expr])
 quantifierPredicateT x y = readerT $ \q -> case q of
     -- If the quantifier predicate is already negated, take its
@@ -76,16 +76,16 @@
         let e' = BinOp t (SBRelOp $ negateRelOp op) e1 e2
         q' <- constT (return e') >>> splitJoinPredT x y
         return (q' :| [], [])
-        
+
     _                          -> fail "can't handle predicate"
 
-mkUniversalQuantOnlyAntiJoinT :: (Ident, Expr) 
-                              -> (Ident, Expr) 
-                              -> Expr 
+mkUniversalQuantOnlyAntiJoinT :: (Ident, Expr)
+                              -> (Ident, Expr)
+                              -> Expr
                               -> TransformC (NL Qual) Qual
 mkUniversalQuantOnlyAntiJoinT (x, xs) (y, ys) q = do
     (qPred, nonCorrPreds) <- constT (return q) >>> injectT >>> quantifierPredicateT x y
-    
+
     let yst = typeOf ys
         yt  = elemT yst
 
@@ -138,7 +138,7 @@
         return $ S $ antijoinGen
     _ -> fail "no and pattern"
 
-mkUniversalRangeAntiJoinT :: (Ident, Expr) 
+mkUniversalRangeAntiJoinT :: (Ident, Expr)
                      -> (Ident, Expr)
                      -> NL Qual
                      -> Expr
@@ -192,7 +192,7 @@
 
     -- Filter the inner source with the range
     -- predicates. Additionally, filter it with the non-correlated
-    -- predicates extracted from the quantifier predicate.  
+    -- predicates extracted from the quantifier predicate.
     -- [ y | y <- ys, ps ++ nonCorrPreds ]
     let innerPreds = case nonCorrPreds of
                          c : cs -> appendNL ps (fromListSafe c cs)
@@ -226,7 +226,7 @@
 
 mkClass16AntiJoinT :: (Ident, Expr)
                    -> (Ident, Expr)
-                   -> NonEmpty (JoinConjunct JoinExpr) 
+                   -> NonEmpty (JoinConjunct JoinExpr)
                    -> NonEmpty (JoinConjunct JoinExpr)
                    -> [Expr]
                    -> TransformC (NL Qual) (Qual)
diff --git a/src/Database/DSH/CL/Opt/Auxiliary.hs b/src/Database/DSH/CL/Opt/Auxiliary.hs
--- a/src/Database/DSH/CL/Opt/Auxiliary.hs
+++ b/src/Database/DSH/CL/Opt/Auxiliary.hs
@@ -56,7 +56,7 @@
 import           Database.DSH.Common.Lang
 import           Database.DSH.Common.Nat
 import           Database.DSH.Common.RewriteM
-import           Database.DSH.Impossible
+import           Database.DSH.Common.Impossible
 
 -- | A version of the CompM monad in which the state contains an additional
 -- rewrite. Use case: Returning a tuplify rewrite from a traversal over the
@@ -80,13 +80,14 @@
 toJoinBinOp (SBStringOp o)  = return $ JBStringOp o
 toJoinBinOp (SBRelOp _)     = fail "toJoinBinOp: join expressions can't contain relational ops"
 toJoinBinOp (SBBoolOp _)    = fail "toJoinBinOp: join expressions can't contain boolean ops"
+toJoinBinOp (SBDateOp _)    = fail "toJoinBinOp: join expressions can't contain date ops"
 
 toJoinUnOp :: Monad m => ScalarUnOp -> m JoinUnOp
 toJoinUnOp (SUNumOp o)  = return $ JUNumOp o
 toJoinUnOp (SUCastOp o) = return $ JUCastOp o
 toJoinUnOp (SUTextOp o) = return $ JUTextOp o
 toJoinUnOp (SUBoolOp _) = fail "toJoinUnOp: join expressions can't contain boolean ops"
-toJoinUnOp SUDateOp     = $unimplemented
+toJoinUnOp (SUDateOp _) = fail "toJoinUnOp: join expressions can't contain date ops"
 
 toJoinExpr :: Ident -> TransformC Expr JoinExpr
 toJoinExpr n = do
@@ -271,7 +272,7 @@
 tupleVars :: Ident -> Type -> Type -> (Expr, Expr)
 tupleVars n t1 t2 = (v1Rep, v2Rep)
   where v     = Var pt n
-        pt    = pairT t1 t2
+        pt    = PPairT t1 t2
         v1Rep = AppE1 t1 (TupElem First) v
         v2Rep = AppE1 t2 (TupElem (Next First)) v
 
@@ -293,7 +294,7 @@
         if all (\v -> S.member v env) fvs
         then GuardQ guardExpr :* q :* qs
         else q :* go (S.insert x env) qs
-    go env (GuardQ p :* qs)      = 
+    go env (GuardQ p :* qs)      =
         if all (\v -> S.member v env) fvs
         then GuardQ guardExpr :* GuardQ p :* qs
         else GuardQ p :* go env qs
diff --git a/src/Database/DSH/CL/Opt/CompNormalization.hs b/src/Database/DSH/CL/Opt/CompNormalization.hs
--- a/src/Database/DSH/CL/Opt/CompNormalization.hs
+++ b/src/Database/DSH/CL/Opt/CompNormalization.hs
@@ -18,7 +18,6 @@
     , identityCompR
     ) where
 
-import           Control.Applicative
 import           Control.Arrow
 import           Data.Either
 import qualified Data.Map                   as M
@@ -30,7 +29,7 @@
 import qualified Database.DSH.CL.Primitives as P
 import           Database.DSH.Common.Kure
 import           Database.DSH.Common.Lang
-import           Database.DSH.Impossible
+import           Database.DSH.Common.Impossible
 
 ------------------------------------------------------------------
 -- Classical Monad Comprehension Normalization rules (Grust)
@@ -186,8 +185,8 @@
     GuardQ p :* BindQ x xs :* qs -> return $ BindQ x xs :* GuardQ p :* qs
     GuardQ p :* (S (BindQ x xs)) -> return $ BindQ x xs :* (S (GuardQ p))
     _                            -> fail "no pushable guard"
-                    
 
+
 -- | Push all guards to the end of the qualifier list to bring
 -- generators closer together.
 guardpushbackR :: RewriteC CL
@@ -202,9 +201,9 @@
 -- preparation, we push guards towards the front of the qualifier
 -- list.
 invariantguardR :: RewriteC CL
-invariantguardR = 
-    tryR guardpushfrontR 
-    >>> 
+invariantguardR =
+    tryR guardpushfrontR
+    >>>
     (promoteR $ readerT $ \expr -> case expr of
         Comp t h (GuardQ g :* qs) -> return $ inject $ P.if_ g (Comp t h qs) (P.nil t)
         Comp t h (S (GuardQ p))   -> return $ inject $ P.if_ p (P.sng h) (P.nil t)
diff --git a/src/Database/DSH/CL/Opt/FlatJoin.hs b/src/Database/DSH/CL/Opt/FlatJoin.hs
--- a/src/Database/DSH/CL/Opt/FlatJoin.hs
+++ b/src/Database/DSH/CL/Opt/FlatJoin.hs
@@ -8,7 +8,6 @@
     ( flatjoinsR
     ) where
 
-import           Control.Applicative
 import           Control.Arrow
 import qualified Data.Map                      as M
 import qualified Data.Set                      as S
diff --git a/src/Database/DSH/CL/Opt/LoopInvariant.hs b/src/Database/DSH/CL/Opt/LoopInvariant.hs
--- a/src/Database/DSH/CL/Opt/LoopInvariant.hs
+++ b/src/Database/DSH/CL/Opt/LoopInvariant.hs
@@ -2,17 +2,16 @@
 {-# LANGUAGE FlexibleContexts    #-}
 {-# LANGUAGE QuasiQuotes         #-}
 {-# LANGUAGE TemplateHaskell     #-}
-    
+
 -- | Extract loop-invariant "complex" expressions from comprehensions
 module Database.DSH.CL.Opt.LoopInvariant
   ( loopInvariantR
   ) where
 
-import           Control.Applicative
 import           Data.Maybe
 import           Data.List
 
-import           Database.DSH.Impossible
+import           Database.DSH.Common.Impossible
 import           Database.DSH.Common.Lang
 import           Database.DSH.Common.Kure
 import           Database.DSH.Common.Pretty
@@ -32,8 +31,8 @@
 traverseT :: [Ident] -> TransformC CL (Expr, PathC)
 traverseT localVars = readerT $ \expr -> case expr of
     -- We do not traverse into lambdas and comprehensions which are
-    -- nested in our current comprehension.  
-    -- 
+    -- nested in our current comprehension.
+    --
     -- FIXME technically, we could consider the generators of the
     -- nested comprehension.
     ExprCL (Comp _ _ _) -> fail "we don't traverse into comprehensions"
@@ -47,7 +46,7 @@
     ExprCL e <- idR
     -- debugPretty "complexPathT" e
     path <- snocPathToPath <$> absPathT
-    
+
     -- We are only interested in constant expressions that do not
     -- depend on variables bound by generators in the enclosing
     -- comprehension.
diff --git a/src/Database/DSH/CL/Opt/NestJoin.hs b/src/Database/DSH/CL/Opt/NestJoin.hs
--- a/src/Database/DSH/CL/Opt/NestJoin.hs
+++ b/src/Database/DSH/CL/Opt/NestJoin.hs
@@ -3,7 +3,7 @@
 {-# LANGUAGE QuasiQuotes           #-}
 {-# LANGUAGE TemplateHaskell       #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
-    
+
 -- | Deal with nested comprehensions by introducing explicit nesting
 -- operators (NestJoin, NestProduct).
 module Database.DSH.CL.Opt.NestJoin
@@ -12,7 +12,6 @@
   , nestingGenR
   ) where
 
-import           Control.Applicative((<$>))
 import           Control.Arrow
 import           Control.Monad
 
@@ -22,11 +21,11 @@
 import qualified Data.List.NonEmpty as N
 
 import           Database.DSH.Common.Lang
-import           Database.DSH.Common.Kure
 
+
 import           Database.DSH.CL.Lang
 import           Database.DSH.CL.Kure
-                 
+
 import qualified Database.DSH.CL.Primitives as P
 
 import           Database.DSH.CL.Opt.Auxiliary
@@ -65,6 +64,30 @@
     p <- snocPathToPath <$> absPathT
     return (p, NestedComp t h (y, ys) guards)
 
+-- | Search through the qualifiers of a comprehension that itself was
+-- not fit for unnesting. This traversal takes care not to touch any
+-- generator expressions that depend on preceding generators.
+searchCompQuals :: Ident -> [Ident] -> TransformC CL (PathC, NestedComp)
+searchCompQuals x qualBoundVars =
+    readerT $ \qs -> case qs of
+        QualsCL ((BindQ y ys) :* _) ->
+            (guardM (null $ (freeVars ys) `intersect` qualBoundVars)
+             >>
+             pathT [QualsHead, BindQualExpr] (searchNestedCompT x))
+            <+
+            childT QualsTail (searchCompQuals x (y : qualBoundVars))
+        QualsCL (S (BindQ _ _))    ->
+            pathT [QualsSingleton, BindQualExpr]
+                  (searchNestedCompT x)
+        -- We don't traverse into guard expressions for now. In
+        -- principle we could, but the guard would have to be
+        -- loop-invariant (i.e. do not depend on any local generators)
+        -- and that's rather unlikely.
+        QualsCL ((GuardQ _) :* _)  ->
+            childT QualsTail (searchCompQuals x qualBoundVars)
+        QualsCL (S (GuardQ _))     -> fail "don't search in guard expressions"
+        _                          -> fail "only consider qualifier lists here"
+
 -- | Traverse though an expression and search for a comprehension that
 -- is eligible for unnesting.
 searchNestedCompT :: Ident -> TransformC CL (PathC, NestedComp)
@@ -74,7 +97,9 @@
         -- qualifiers. This might not be the case if a loop-invariant
         -- guard is present and preceeds the generator. Therefore, we
         -- pre-process by pushing all guards to the back.
-        ExprCL Comp{} -> tryR guardpushbackR >>> nestedCompT x
+        ExprCL Comp{} -> (tryR guardpushbackR >>> nestedCompT x)
+                         <+
+                         childT CompQuals (searchCompQuals x [])
         ExprCL _      -> oneT $ searchNestedCompT x
         _             -> fail "only traverse through expressions"
 
@@ -104,7 +129,7 @@
     -- Generators have to be indepedent
     guardM $ x `notElem` freeVars ys
 
-    let (joinPredCandidates, nonJoinPreds) = partition (isThetaJoinPred x y) 
+    let (joinPredCandidates, nonJoinPreds) = partition (isThetaJoinPred x y)
                                                        (hGuards headComp)
 
     -- Determine which operator to use to implement the nesting. If
@@ -118,7 +143,7 @@
             -- Split the join predicate
             p'  <- constT (return p) >>> splitJoinPredT x y
             ps' <- constT (return ps) >>> mapT (splitJoinPredT x y)
-           
+
             return $ NestJoin $ JoinPred $ p' N.:| ps'
 
     -- Identify predicates which only refer to y and can be evaluated
@@ -129,21 +154,21 @@
     -- x and y and are not/can not be used as the join predicate.
     --    [ [ e x y | y <- ys, p x y, p' x y ] | x <- xs ]
     -- => [ [ e [fst y/x][snd y/y] | y <- snd x, p'[fst y/x][snd y/y] ] | x <- xs nj(p) ys ]
-  
+
     let xt       = elemT $ typeOf xs
         yt       = elemT $ typeOf ys
-        tupType  = pairT xt (listT (pairT xt yt))
+        tupType  = PPairT xt (ListT (PPairT xt yt))
         joinVar  = Var tupType x
-        
+
     -- If there are inner predicates which only refer to y,
     -- evaluate them on the right (ys) nestjoin input.
     let ys' = case fromList yPreds of
-                  Just ps -> Comp (listT yt) (Var yt y) (BindQ y ys :* fmap GuardQ ps)
+                  Just ps -> Comp (ListT yt) (Var yt y) (BindQ y ys :* fmap GuardQ ps)
                   Nothing -> ys
 
-    -- the nesting operator combining xs and ys: 
+    -- the nesting operator combining xs and ys:
     -- xs nj(p) ys
-    let xs'        = AppE2 (listT tupType) nestOp xs ys'
+    let xs'        = AppE2 (ListT tupType) nestOp xs ys'
 
     innerVar <- freshNameT []
 
@@ -187,15 +212,15 @@
 -- General rule:
 -- [ e x [ f x y | y <- ys, jp x y, p1 x, p2 x y, p3 y ] | x <- xs, p4 x ]
 -- =>
--- [ e (fst x) [ f (fst y) (snd y) 
+-- [ e (fst x) [ f (fst y) (snd y)
 --             | y <- snd x
 --             , p1 (fst y)
 --             , p2 (fst y) (snd y)
 --             ]
 -- | x <- xs △_jp [ y | y <- ys, p3 y ]
 -- ]
--- 
--- In the absence of a proper join predicate, we use the Nestproduct 
+--
+-- In the absence of a proper join predicate, we use the Nestproduct
 -- operator ▽ instead of NestJoin.
 --
 -- Predicates on the inner comprehension that only refer to y can be
@@ -218,13 +243,13 @@
     -- More precisely, we need *exactly one* generator on the
     -- comprehension
     guardM $ all isGuard qsr
-    
+
     (headCompPath, headComp) <- childT CompHead (searchNestedCompT x)
 
     (headComp', nestOp, tuplifyOuterR) <- unnestWorkerT headComp (x, xs)
 
     -- Insert the replacement for the nested comprehension.
-    
+
     -- The relative path to the comprehension to be replaced, starting
     -- from the head expression
     -- FIXME use withLocalPathT
@@ -236,25 +261,25 @@
     -- In the outer comprehension's qualifier list, x is replaced by
     -- the first pair component of the join result.
     qsr' <- constT (return $ map inject qsr)
-            >>> mapT (tryR tuplifyOuterR) 
+            >>> mapT (tryR tuplifyOuterR)
             >>> mapT projectT
 
     -- ExprCL tuplifiedHead <- constNodeT ho' >>> tryR tuplifyOuterR
 
     return $ inject $ Comp to unnestedHo (fromListSafe (BindQ x nestOp) qsr')
 
-    
+
 --------------------------------------------------------------------------------
 -- Nestjoin introduction: unnesting comprehensions from complex predicates
 
 -- | Try to unnest comprehensions from guards, which we can not unnest otherwise
 -- (e.g. by introduing semi- or antijoins).
--- 
+--
 --   [ e | qs, x <- xs, p x [ f x y | y < ys jp x y ], qs' ]
--- 
+--
 -- rewrites into
 --
---   [ e[fst x/x] | 
+--   [ e[fst x/x] |
 --   | qs
 --   , x <- xs nestjoin(jp) ys
 --   , p (fst x) [ f (fst y) (snd y) | y <- snd x ]
@@ -276,7 +301,7 @@
 unnestGuardT :: [Ident] -> (Ident, Expr) -> Expr -> TransformC CL (RewriteC CL, Expr, Expr)
 unnestGuardT localGenVars (x, xs) guardExpr = do
     -- search for an unnestable comrehension
-    (headCompPath, headComp) <- withLocalPathT 
+    (headCompPath, headComp) <- withLocalPathT
                                 $ constNodeT guardExpr >>> searchNestedCompT x
 
     -- Forbid the generator of a comprehension we want to unnest to
@@ -291,17 +316,17 @@
     (headComp', nestOp, tuplifyOuterR) <- unnestWorkerT headComp (x, xs)
 
     -- Tuplify occurences of 'x' in the guard.
-    ExprCL tuplifiedGuardExpr <- constNodeT guardExpr 
+    ExprCL tuplifiedGuardExpr <- constNodeT guardExpr
                                  >>> tryR tuplifyOuterR
 
     -- Insert the new inner comprehension into the original guard
     -- expression
-    ExprCL simplifiedGuardExpr <- constNodeT tuplifiedGuardExpr 
+    ExprCL simplifiedGuardExpr <- constNodeT tuplifiedGuardExpr
                                   >>> pathR headCompPath (constNodeT headComp')
 
 
     return (tuplifyOuterR, nestOp, simplifiedGuardExpr)
-    
+
 -- | Search for unnestable combinations of a generator and a nested
 -- guard in a qualifier list.
 unnestQualsR :: [Ident] -> Rewrite CompCtx GuardM (NL Qual)
@@ -309,8 +334,8 @@
     readerT $ \quals -> case quals of
         -- In the middle of a qualifier list
         BindQ x xs :* GuardQ p :* qs -> do
-            (tuplifyHeadR, xs', p') <- liftstateT $ constNodeT p 
-                                                    >>> 
+            (tuplifyHeadR, xs', p') <- liftstateT $ constNodeT p
+                                                    >>>
                                                     unnestGuardT localGenVars (x, xs) p
             constT $ modify (\(r, _) -> (r >>> tuplifyHeadR, Just p'))
             qs' <- liftstateT $ constNodeT qs >>> tuplifyHeadR >>> projectT
@@ -318,8 +343,8 @@
 
         -- At the end of a qualifier list
         BindQ x xs :* (S (GuardQ p)) -> do
-            (tuplifyHeadR, xs', p') <- liftstateT $ constNodeT p 
-                                                    >>> 
+            (tuplifyHeadR, xs', p') <- liftstateT $ constNodeT p
+                                                    >>>
                                                     unnestGuardT localGenVars (x, xs) p
             constT $ modify (\(r, _) -> (r >>> tuplifyHeadR, Just p'))
             return $ S $ BindQ x xs'
@@ -328,7 +353,7 @@
 -- | Trigger the search for unnesting opportunities in the qualifier
 -- list and tuplify comprehension head and remaining qualifiers on
 -- success.
--- 
+--
 -- Note: In contrast to e.g. flat join introduction, we can't merge
 -- the complete guard into the operator. The non-comprehension part
 -- remains. We handle this by including the succesfully unnested and
@@ -336,11 +361,11 @@
 -- success.
 unnestGuardR :: [Expr] -> [Expr] -> TransformC CL (CL, [Expr], [Expr])
 unnestGuardR candGuards failedGuards = do
-    Comp t _ qs      <- promoteT idR 
+    Comp t _ qs      <- promoteT idR
     let localGenVars = concatMap (either ((: []) . fst) (const [])) $ map fromQual $ toList qs
     let unnestR = anytdR (promoteR $ unnestQualsR localGenVars) >>> projectT
     ((tuplifyVarR, Just guardExpr), qs') <- statefulT (idR, Nothing) $ childT CompQuals unnestR
-                                       
+
     h'               <- childT CompHead tuplifyVarR >>> projectT
     let tuplifyM e = constNodeT e >>> tuplifyVarR >>> projectT
     candGuards'      <- mapM tuplifyM candGuards
@@ -373,7 +398,7 @@
 -- provided that
 -- (a) g is complex/expensive
 -- (b) g contains a comprehension
--- 
+--
 -- The original comprehension produces a collection for every rule of
 -- the outer collection xs and then directly performs an action on all
 -- elements of the inner collections. The problem here is that the
@@ -385,7 +410,7 @@
 -- Other forms of unnesting
 
 isComplexExpr :: Expr -> Bool
-isComplexExpr e = 
+isComplexExpr e =
     case e of
         Comp{}         -> True
         If{}           -> True
@@ -407,7 +432,7 @@
         e <- promoteT idR
         guardM $ isComplexExpr e
         return ()
-        
+
 -- | If a inner comprehension iterates over a complex function of the
 -- outer element, pull the function out. The motivation of this
 -- rewrite is the following: f is work performed in the head for every
@@ -415,22 +440,22 @@
 -- for every x), but it moves the work out of the head. This might
 -- enable subsequent rewrites to move f out of the head of other
 -- enclosing comprehensions as well (model use case: dft).
--- 
--- [ [ e x y | y <- f x ] | x <- xs ] 
--- => [ [ f [x/fst z] y | y <- snd z ] | z <- zip xs [ f x | x <- xs ] ] 
--- 
+--
+-- [ [ e x y | y <- f x ] | x <- xs ]
+-- => [ [ f [x/fst z] y | y <- snd z ] | z <- zip xs [ f x | x <- xs ] ]
+--
 -- provided that f is "complex".
--- 
+--
 -- We need the zip to provide the correlation between one x and the
--- group produced by f for this particular x. 
--- 
+-- group produced by f for this particular x.
+--
 -- Note: This rule is actually a special case of the inverse M-Norm-3
 -- rule provided above.
 zipCorrelatedR :: RewriteC CL
 zipCorrelatedR = do
     Comp to (Comp ti e (S (BindQ y f))) (S (BindQ x xs)) <- promoteT idR
-    
-    let fvs = freeVars e 
+
+    let fvs = freeVars e
     guardM $ x `elem` fvs && y `elem` fvs
 
     guardM $ x `elem` freeVars f
@@ -440,9 +465,9 @@
 
     z <- freshNameT [y]
 
-    let genComp = Comp (listT $ typeOf f) f (S $ BindQ x xs)
+    let genComp = Comp (ListT $ typeOf f) f (S $ BindQ x xs)
         zipGen  = P.zip xs genComp
-        zt      = elemT $ typeOf zipGen 
+        zt      = elemT $ typeOf zipGen
         zv      = Var zt z
 
     ExprCL f' <- constNodeT e >>> substR x (P.fst zv)
@@ -459,14 +484,14 @@
 -- generator of an inner comprehension, such that the generator
 -- depends on the outer variable and the inner comprehension can not
 -- be unnested.
--- 
+--
 -- In this case, perform the inverse rewrite to M-Norm-3: Nest the
 -- generator expression into the outer comprehension
--- 
+--
 -- [ [ e y | y <- g x ] | x <- xs ]
 -- =>
 -- [ [ e y | y <- z ] | z <- [ g x | x <- xs ] ]
--- 
+--
 -- provided that g contains at least one unnestable comprehension
 --
 -- Important: This is the dual rewrite to M-Norm-3. An unconditional
@@ -475,7 +500,7 @@
 nestingGenR :: RewriteC CL
 nestingGenR = do
     Comp  to (Comp ti e (S (BindQ y g))) (S (BindQ x xs)) <- promoteT idR
-    
+
     -- Generator expression g should depend on x (otherwise we could
     -- unnest directly
     guardM $ x `elem` freeVars g
@@ -489,7 +514,7 @@
     let gty = typeOf g
 
     let innerComp = Comp ti e (S (BindQ y (Var gty z)))
-        genComp   = Comp (listT gty) g (S (BindQ x xs))
+        genComp   = Comp (ListT gty) g (S (BindQ x xs))
         outerComp = Comp to innerComp (S (BindQ z genComp))
 
     return $ inject outerComp
diff --git a/src/Database/DSH/CL/Opt/Normalize.hs b/src/Database/DSH/CL/Opt/Normalize.hs
--- a/src/Database/DSH/CL/Opt/Normalize.hs
+++ b/src/Database/DSH/CL/Opt/Normalize.hs
@@ -3,11 +3,11 @@
 {-# LANGUAGE QuasiQuotes         #-}
 {-# LANGUAGE TemplateHaskell     #-}
 {-# LANGUAGE PatternSynonyms     #-}
-    
+
 -- | Normalize patterns from source programs (not to be confused with
 -- comprehension normalization)
 module Database.DSH.CL.Opt.Normalize
-  ( normalizeOnceR 
+  ( normalizeOnceR
   , normalizeExprR
   ) where
 
@@ -16,8 +16,8 @@
 import qualified Data.Foldable              as F
 import qualified Data.Traversable           as T
 import           Data.Monoid
-       
-import           Database.DSH.Impossible
+
+import           Database.DSH.Common.Impossible
 import           Database.DSH.Common.Lang
 import           Database.DSH.CL.Lang
 import           Database.DSH.CL.Kure
@@ -39,15 +39,15 @@
     splitR = do
         (GuardQ (BinOp _ (SBBoolOp Conj) p1 p2)) :* qs <- idR
         return $ GuardQ p1 :* GuardQ p2 :* qs
-    
+
     splitEndR :: RewriteC (NL Qual)
     splitEndR = do
         (S (GuardQ (BinOp _ (SBBoolOp Conj) p1 p2))) <- idR
         return $ GuardQ p1 :* (S $ GuardQ p2)
-        
+
 normalizeOnceR :: RewriteC CL
 normalizeOnceR = repeatR $ anytdR $ promoteR splitConjunctsR
-    
+
 --------------------------------------------------------------------------------
 -- Simple normalization rewrites that are interleaved with other rewrites.
 
@@ -77,7 +77,7 @@
 notExistsR = promoteT $ readerT $ \e -> case e of
     -- With range predicates
     PNot (POr (Comp t q (BindQ y ys :* ps))) -> do
-    
+
         -- All remaining qualifiers have to be guards.
         void $ constT $ T.mapM fromGuard ps
 
@@ -94,22 +94,22 @@
 -- 0 == length xs => null xs
 zeroLengthR :: RewriteC CL
 zeroLengthR = promoteT $ readerT $ \e -> case e of
-    PEq (PLength xs) (Lit _ (IntV 0)) -> return $ inject $ P.null xs
-    PEq (Lit _ (IntV 0)) (PLength xs) -> return $ inject $ P.null xs
+    PEq (PLength xs) (Lit _ (ScalarV (IntV 0))) -> return $ inject $ P.null xs
+    PEq (Lit _ (ScalarV (IntV 0))) (PLength xs) -> return $ inject $ P.null xs
     _                                 -> fail "no match"
 
--- null [ _ | x <- xs, p1, p2, ... ] 
+-- null [ _ | x <- xs, p1, p2, ... ]
 -- => and [ not (p1 && p2 && ...) | x <- xs ]
 comprehensionNullR :: RewriteC CL
 comprehensionNullR = do
     PNull (Comp _ _ (BindQ x xs :* guards)) <- promoteT idR
-    
+
     -- We need exactly one generator and at least one guard.
     guardExprs           <- constT $ T.mapM fromGuard guards
 
     -- Merge all guards into a conjunctive form
     let conjPred = P.not $ F.foldl1 P.conj guardExprs
-    return $ inject $ P.and $ Comp (listT boolT) conjPred (S $ BindQ x xs)
+    return $ inject $ P.and $ Comp (ListT PBoolT) conjPred (S $ BindQ x xs)
 
 -- not $ null [ _ | x <- xs, ps ]
 -- =>
@@ -119,7 +119,7 @@
 notNullR :: RewriteC CL
 notNullR = do
     PNot (PAnd (Comp _ (PNot p) (S (BindQ x xs)))) <- promoteT idR
-    return $ inject $ P.or (Comp (listT boolT) p (S (BindQ x xs)))
+    return $ inject $ P.or (Comp (ListT PBoolT) p (S (BindQ x xs)))
 
 --------------------------------------------------------------------------------
 -- Inline let bindings
@@ -156,7 +156,7 @@
     ExprCL (Var _ n) | n == v          -> return 1
     ExprCL (Var _ _) | otherwise       -> return 0
 
-    ExprCL (Let _ n _ _) | n == v      -> promoteT $ letT (constT $ return 0) 
+    ExprCL (Let _ n _ _) | n == v      -> promoteT $ letT (constT $ return 0)
                                                           (extractT $ countVarRefT v)
                                                           (\_ _ c1 c2 -> c1 + c2)
     ExprCL (Let _ _ _ _) | otherwise   -> promoteT $ letT (extractT $ countVarRefT v)
diff --git a/src/Database/DSH/CL/Opt/PartialEval.hs b/src/Database/DSH/CL/Opt/PartialEval.hs
--- a/src/Database/DSH/CL/Opt/PartialEval.hs
+++ b/src/Database/DSH/CL/Opt/PartialEval.hs
@@ -2,12 +2,12 @@
 {-# LANGUAGE FlexibleContexts    #-}
 {-# LANGUAGE QuasiQuotes         #-}
 {-# LANGUAGE TemplateHaskell     #-}
-    
+
 -- | Support rewrites (partial evaluation, house cleaning)
 module Database.DSH.CL.Opt.PartialEval
   ( partialEvalR
   ) where
-  
+
 import           Database.DSH.Common.Nat
 import           Database.DSH.Common.Lang
 import           Database.DSH.CL.Lang
@@ -21,7 +21,7 @@
 -- pair (fst x) (snd x) => x
 identityPairR :: RewriteC CL
 identityPairR = do
-    MkTuple _ [ AppE1 _ (TupElem First)  v@(Var tupleTy x) 
+    MkTuple _ [ AppE1 _ (TupElem First)  v@(Var tupleTy x)
               , AppE1 _ (TupElem (Next First)) (Var _ x')
               ] <- promoteT idR
 
@@ -71,7 +71,7 @@
     return $ inject xs
 
 partialEvalR :: RewriteC CL
-partialEvalR = 
+partialEvalR =
     readerT $ \cl -> case cl of
         ExprCL AppE1{}   -> tupleElemR <+ literalSingletonR
         ExprCL MkTuple{} -> identityPairR <+ literalTupleR
diff --git a/src/Database/DSH/CL/Opt/PredPushdown.hs b/src/Database/DSH/CL/Opt/PredPushdown.hs
--- a/src/Database/DSH/CL/Opt/PredPushdown.hs
+++ b/src/Database/DSH/CL/Opt/PredPushdown.hs
@@ -8,16 +8,16 @@
   ( predpushdownR
   ) where
 
-import           Control.Applicative
 import           Control.Arrow
-import qualified Data.List.NonEmpty       as N
-import qualified Data.Set                 as S
+import qualified Data.List.NonEmpty            as N
+import qualified Data.Set                      as S
 
-import           Database.DSH.Common.Lang
-import           Database.DSH.Common.Nat
 import           Database.DSH.CL.Kure
 import           Database.DSH.CL.Lang
 import           Database.DSH.CL.Opt.Auxiliary
+import qualified Database.DSH.CL.Primitives    as P
+import           Database.DSH.Common.Lang
+import           Database.DSH.Common.Nat
 
 --------------------------------------------------------------------------------
 -- Auxiliary functions
@@ -163,21 +163,18 @@
 -- in its original form.
 pushSortInputR :: Ident -> Expr -> RewriteC CL
 pushSortInputR x p = do
-    AppE2 t Sort xs (Comp st se (S (BindQ x' xs'))) <- promoteT idR
+    AppE1 t Sort xs <- promoteT idR
 
-    -- FIXME this compares whole terms in an uncontrolled way and
-    -- could be too expensive.
-    guardM $ xs == xs'
-    guardM $ x == x'
+    let xst    = typeOf xs
+        xt     = elemT xt
+        genVar = Var xt x
 
-    let xst = typeOf xs
-        xt  = elemT xt
-        -- We reuse the generator variable for the filter comprehension
-        xsFiltered = Comp xst (Var xt x) (BindQ x xs :* S (GuardQ p))
-        ssFiltered = Comp st se (BindQ x' xs' :* S (GuardQ p))
+    ExprCL p' <- constT (return $ inject p) >>> substR x (P.fst genVar)
 
-    return $ inject $ AppE2 t Sort xsFiltered ssFiltered
+    let restrictedInput = Comp xst genVar (BindQ x xs :* S (GuardQ p'))
 
+    return $ inject $ AppE1 t Sort restrictedInput
+
 --------------------------------------------------------------------------
 -- Take remaining comprehension guards and try to push them into the
 -- generator. This might be accomplished by either merging it into a
@@ -208,7 +205,7 @@
         ExprCL (AppE2 _ (AntiJoin _) _ _)  -> pushLeftR x p
 
         -- Sorting commutes with selection
-        ExprCL (AppE2 _ Sort _ _)          -> pushSortInputR x p
+        ExprCL (AppE1 _ Sort _)            -> pushSortInputR x p
         _                                  -> fail "expression does not allow predicate pushing"
 
 pushQualsR :: RewriteC CL
diff --git a/src/Database/DSH/CL/Opt/SemiJoin.hs b/src/Database/DSH/CL/Opt/SemiJoin.hs
--- a/src/Database/DSH/CL/Opt/SemiJoin.hs
+++ b/src/Database/DSH/CL/Opt/SemiJoin.hs
@@ -20,7 +20,7 @@
 -- Introduce semi joins (existential quantification)
 
 pattern POr xs <- AppE1 _ Or xs
-pattern PTrue = Lit BoolT (BoolV True)
+pattern PTrue = Lit PBoolT (ScalarV (BoolV True))
 
 existentialQualR :: RewriteC (NL Qual)
 existentialQualR = readerT $ \quals -> case quals of
@@ -59,7 +59,7 @@
 
         semijoinGen <- mkExistentialSemiJoinT (x, xs) (y, ys) (Just q) Nothing
         return $ S semijoinGen
-    
+
     -- Existential quantifier with range and quantifier predicates
     -- [ ... | ..., x <- xs, or [ True | y <- ys, ps ], ... ]
     BindQ x xs :* (GuardQ (POr (Comp _ q (BindQ y ys :* ps)))) :* qs -> do
@@ -80,7 +80,7 @@
 
     _ -> fail "no match"
 
-mkExistentialSemiJoinT :: (Ident, Expr) 
+mkExistentialSemiJoinT :: (Ident, Expr)
                        -> (Ident, Expr)
                        -> Maybe Expr
                        -> Maybe (NL Qual)
@@ -102,10 +102,10 @@
 
     -- We demand at least one predicate expression
     guardM $ not $ null allExprs
-        
+
     -- Separate those guards that can be evaluated just on the
     -- inner generator
-    let (innerGuards, corrGuards) = partition (\e -> freeVars e == [y]) 
+    let (innerGuards, corrGuards) = partition (\e -> freeVars e == [y])
                                               allExprs
 
     let ys' = case innerGuards of
@@ -118,7 +118,7 @@
     case corrPreds of
         cp : cps -> return $ BindQ x $ P.semijoin xs ys' (JoinPred $ cp :| cps)
         _        -> fail "there have to be correlation predicates for a semijoin"
- 
+
 
 
 existentialQualsR :: RewriteC (NL Qual)
diff --git a/src/Database/DSH/CL/Primitives.hs b/src/Database/DSH/CL/Primitives.hs
--- a/src/Database/DSH/CL/Primitives.hs
+++ b/src/Database/DSH/CL/Primitives.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE TemplateHaskell #-}
 
 -- | Smart constructors for CL primitives
@@ -5,14 +6,16 @@
 
 import qualified Prelude                    as P
 
+import           Data.Decimal
 import qualified Data.List                  as List
+import qualified Data.Text                  as T
+import qualified Data.Time.Calendar         as C
 import           Text.Printf
 
 import           Database.DSH.CL.Lang
 import qualified Database.DSH.Common.Lang   as L
 import           Database.DSH.Common.Nat
 import           Database.DSH.Common.Pretty
-import           Database.DSH.Impossible
 
 tyErr :: P.String -> a
 tyErr comb = P.error P.$ printf "CL.Primitives type error in %s" comb
@@ -21,7 +24,7 @@
 tyErrShow comb ts = P.error (printf "CL.Primitives type error in %s: %s" comb (P.show P.$ P.map pp ts))
 
 if_ :: Expr -> Expr -> Expr -> Expr
-if_ c t e = if BoolT P.== typeOf c
+if_ c t e = if PBoolT P.== typeOf c
             then If (typeOf t) c t e
             else tyErr "if_"
 
@@ -32,27 +35,27 @@
 length :: Expr -> Expr
 length e = let t = typeOf e
            in if isList t
-              then AppE1 intT Length e
+              then AppE1 PIntT Length e
               else tyErr "length"
 
 null :: Expr -> Expr
 null e =
     if isList t
-    then AppE1 boolT Null e
+    then AppE1 PBoolT Null e
     else tyErr "null"
 
   where t = typeOf e
 
 and :: Expr -> Expr
 and e = let t = typeOf e
-         in if listT boolT P.== t
-            then AppE1 boolT And e
+         in if ListT PBoolT P.== t
+            then AppE1 PBoolT And e
             else tyErrShow "and" [t]
 
 or :: Expr -> Expr
 or e = let t = typeOf e
-         in if listT boolT P.== t
-            then AppE1 boolT Or e
+         in if ListT PBoolT P.== t
+            then AppE1 PBoolT Or e
             else tyErr "or"
 
 concat :: Expr -> Expr
@@ -61,29 +64,18 @@
                then AppE1 (unliftType t) Concat e
                else tyErr "concat"
 
--- reshape :: [a] -> [[a]]
-reshape :: P.Integer -> Expr -> Expr
-reshape n e =
-    let t = typeOf e
-    in AppE1 (ListT t) (Reshape n) e
-
--- transpose :: [[a]] -> [[a]]
-transpose :: Expr -> Expr
-transpose e =
-    let t = typeOf e
-    in AppE1 t Transpose e
-
 sum :: Expr -> Expr
 sum e = let (ListT t) = typeOf e
          in if isNum t
                 then AppE1 t Sum e
                 else tyErr "sum"
 
+
 avg :: Expr -> Expr
-avg e = let (ListT t) = typeOf e
-         in if isNum t
-                then AppE1 doubleT Avg e
-                else tyErr "avg"
+avg e = case typeOf e of
+            ListT PDoubleT  -> AppE1 PDoubleT Avg e
+            ListT PDecimalT -> AppE1 PDecimalT Avg e
+            _              -> tyErr "avg"
 
 minimum :: Expr -> Expr
 minimum e = let (ListT t) = typeOf e
@@ -97,36 +89,16 @@
                  then AppE1 t Maximum e
                  else tyErr "maximum"
 
-the :: Expr -> Expr
-the e = let (ListT t) = typeOf e
-         in AppE1 t The e
-
-head :: Expr -> Expr
-head e = let (ListT t) = typeOf e
-          in AppE1 t Head e
-
-last :: Expr -> Expr
-last e = let (ListT t) = typeOf e
-          in AppE1 t Last e
-
-tail :: Expr -> Expr
-tail e = let (ListT t) = typeOf e
-          in AppE1 (ListT t) Tail e
-
 nub :: Expr -> Expr
 nub e = let (ListT t) = typeOf e
          in AppE1 (ListT t) Nub e
 
 number :: Expr -> Expr
 number e = let (ListT t) = typeOf e
-           in AppE1 (ListT (pairT t IntT )) Number e
+           in AppE1 (ListT (PPairT t PIntT )) Number e
 
 guard :: Expr -> Expr
-guard e = AppE1 (listT UnitT) Guard e
-
-init :: Expr -> Expr
-init e = let (ListT t) = typeOf e
-        in AppE1 (ListT t) Init e
+guard e = AppE1 (ListT PUnitT) Guard e
 
 tupElem :: TupleIndex -> Expr -> Expr
 tupElem f e =
@@ -142,16 +114,16 @@
 singleGenComp :: Expr -> L.Ident -> Expr -> Expr
 singleGenComp bodyExp v gen =
     let bodyTy = typeOf bodyExp
-    in Comp (listT bodyTy) bodyExp (S P.$ BindQ v gen)
+    in Comp (ListT bodyTy) bodyExp (S P.$ BindQ v gen)
 
-group :: Expr -> Expr -> Expr
-group xs gs = let ListT xt  = typeOf xs
-                  ListT grt = typeOf gs
-                  rt        = ListT (TupleT [grt, ListT xt])
-              in AppE2 rt Group xs gs
+group :: Expr -> Expr
+group xs = let ListT (TupleT [xt, grt]) = typeOf xs
+               rt                       = ListT (TupleT [grt, ListT xt])
+           in AppE1 rt Group xs
 
-sort :: Expr -> Expr -> Expr
-sort xs ss = AppE2 (typeOf xs) Sort xs ss
+sort :: Expr -> Expr
+sort xs = let ListT (TupleT [xt, _]) = typeOf xs
+          in AppE1 (ListT xt) Sort xs
 
 pair :: Expr -> Expr -> Expr
 pair a b = tuple [a, b]
@@ -169,32 +141,28 @@
                     then AppE2 t1 Append e1 e2
                     else tyErr "append"
 
-index :: Expr -> Expr -> Expr
-index e1 e2 = let ListT t = typeOf e1
-                  t2 = typeOf e2
-                in if intT P.== t2
-                    then AppE2 t Index e1 e2
-                    else tyErr "index"
-
 sng :: Expr -> Expr
-sng e = AppE1 (listT P.$ typeOf e) Singleton e
+sng e = AppE1 (ListT P.$ typeOf e) Singleton e
 
+only :: Expr -> Expr
+only e = AppE1 (elemT (typeOf e)) Only e
+
 zip :: Expr -> Expr -> Expr
 zip e1 e2 = let ListT t1' = typeOf e1
                 ListT t2' = typeOf e2
-             in AppE2 (listT P.$ pairT t1' t2') Zip e1 e2
+             in AppE2 (ListT P.$ PPairT t1' t2') Zip e1 e2
 
 var :: Type -> P.String -> Expr
 var = Var
 
-table :: Type -> P.String -> [L.Column] -> L.TableHints -> Expr
+table :: Type -> P.String -> L.BaseTableSchema -> Expr
 table = Table
 
 cond :: Expr -> Expr -> Expr -> Expr
 cond eb et ee = let tb = typeOf eb
                     tt = typeOf et
                     te = typeOf ee
-                 in if tb P.== boolT P.&& tt P.== te
+                 in if tb P.== PBoolT P.&& tt P.== te
                       then If te eb et ee
                       else tyErr "cond"
 
@@ -207,19 +175,19 @@
 cartproduct :: Expr -> Expr -> Expr
 cartproduct xs ys = AppE2 resType CartProduct xs ys
   where
-    resType  = listT P.$ pairT (elemT P.$ typeOf xs) (typeOf ys)
+    resType  = ListT P.$ PPairT (elemT P.$ typeOf xs) (typeOf ys)
 
 nestjoin :: Expr -> Expr -> L.JoinPredicate L.JoinExpr -> Expr
 nestjoin xs ys p = AppE2 resType (NestJoin p) xs ys
   where
-    resType  = listT P.$ pairT (elemT P.$ typeOf xs) (typeOf ys)
+    resType  = ListT P.$ PPairT (elemT P.$ typeOf xs) (typeOf ys)
 
 thetajoin :: Expr -> Expr -> L.JoinPredicate L.JoinExpr -> Expr
 thetajoin xs ys p = AppE2 rt (ThetaJoin p) xs ys
   where
     xst = typeOf xs
     yst = typeOf ys
-    rt  = listT (pairT (elemT xst) (elemT yst))
+    rt  = ListT (PPairT (elemT xst) (elemT yst))
 
 semijoin :: Expr -> Expr -> L.JoinPredicate L.JoinExpr -> Expr
 semijoin xs ys p = AppE2 xst (SemiJoin p) xs ys
@@ -235,20 +203,26 @@
 -- Literal value constructors
 
 unit :: Expr
-unit = Lit unitT L.UnitV
+unit = Lit PUnitT (L.ScalarV L.UnitV)
 
 int :: P.Int -> Expr
-int i = Lit intT (L.IntV i)
+int i = Lit PIntT (L.ScalarV (L.IntV i))
 
 bool :: P.Bool -> Expr
-bool b = Lit boolT (L.BoolV b)
+bool b = Lit PBoolT (L.ScalarV (L.BoolV b))
 
-string :: P.String -> Expr
-string s = Lit stringT (L.StringV s)
+string :: T.Text -> Expr
+string s = Lit PStringT (L.ScalarV (L.StringV s))
 
 double :: P.Double -> Expr
-double d = Lit doubleT (L.DoubleV d)
+double d = Lit PDoubleT (L.ScalarV (L.DoubleV d))
 
+decimal :: Decimal -> Expr
+decimal d = Lit PDecimalT (L.ScalarV (L.DecimalV d))
+
+day :: C.Day -> Expr
+day d = Lit PDateT (L.ScalarV (L.DateV d))
+
 nil :: Type -> Expr
 nil t = Lit t (L.ListV [])
 
@@ -266,17 +240,30 @@
 scalarUnOp op e =
     let t = typeOf e
     in case (op, t) of
-           (L.SUNumOp _, DoubleT)                 -> UnOp t op e
-           (L.SUBoolOp _, BoolT)                  -> UnOp BoolT op e
-           (L.SUCastOp L.CastDouble, _) | isNum t -> UnOp DoubleT op e
-           (L.SUTextOp L.SubString{}, StringT)    -> UnOp StringT op e
-           (L.SUDateOp, _)                        -> $unimplemented
-           (_, _)                                 -> P.error err
+           (L.SUNumOp _, PDoubleT)                  -> UnOp t op e
+           (L.SUBoolOp _, PBoolT)                   -> UnOp PBoolT op e
+           (L.SUCastOp L.CastDouble, _) | isNum t  -> UnOp PDoubleT op e
+           (L.SUCastOp L.CastDecimal, _) | isNum t -> UnOp PDecimalT op e
+           (L.SUTextOp L.SubString{}, PStringT)     -> UnOp PStringT op e
+           (L.SUDateOp _, PDateT)                   -> UnOp PIntT op e
+           (_, _)                                  -> P.error err
                where err = printf "CL.Primitives.scalarUnOp: %s" (P.show (op, t))
 
 castDouble :: Expr -> Expr
 castDouble = scalarUnOp (L.SUCastOp L.CastDouble)
 
+castDecimal :: Expr -> Expr
+castDecimal = scalarUnOp (L.SUCastOp L.CastDecimal)
+
+dateDay :: Expr -> Expr
+dateDay = scalarUnOp (L.SUDateOp L.DateDay)
+
+dateMonth :: Expr -> Expr
+dateMonth = scalarUnOp (L.SUDateOp L.DateMonth)
+
+dateYear :: Expr -> Expr
+dateYear = scalarUnOp (L.SUDateOp L.DateYear)
+
 not :: Expr -> Expr
 not = scalarUnOp (L.SUBoolOp L.Not)
 
@@ -310,20 +297,36 @@
 substring :: P.Integer -> P.Integer -> Expr -> Expr
 substring f t = scalarUnOp (L.SUTextOp P.$ L.SubString f t)
 
----------------------------------------------------------------------------------------
+---------------------------------------------------------------------------------
 -- Smart constructors for scalar binary operators
 
+-- | Type checking for binary operators
 scalarBinOp :: L.ScalarBinOp -> Expr -> Expr -> Expr
 scalarBinOp op e1 e2 =
-    let t1 = typeOf e1
-        t2 = typeOf e2
-    in case (op, t1, t2) of
-           (L.SBNumOp _, _, _) | t1 P.== t2 P.&& isNum t1 P.&& isNum t2 -> BinOp t1 op e1 e2
-           (L.SBRelOp _, _, _) | t1 P.== t2                             -> BinOp BoolT op e1 e2
-           (L.SBBoolOp _, BoolT, BoolT)                                 -> BinOp BoolT op e1 e2
-           (L.SBStringOp L.Like, StringT, StringT)                      -> BinOp BoolT op e1 e2
-           _                                                            -> P.error err
-               where err = printf "CL.Primitives.scalarBinOp: %s" (P.show (op, t1, t2))
+    case (op, t1, t2) of
+        (L.SBNumOp _, _, _)
+            | t1 P.== t2 P.&& isNum t1 P.&& isNum t2 -> BinOp t1 op e1 e2
+        (L.SBRelOp _, _, _)
+            | t1 P.== t2                             -> BinOp PBoolT op e1 e2
+        (L.SBBoolOp _, PBoolT, PBoolT)               -> BinOp PBoolT op e1 e2
+        (L.SBStringOp L.Like, PStringT, PStringT)    -> BinOp PBoolT op e1 e2
+        (L.SBDateOp L.AddDays, PIntT, PDateT)        -> BinOp PDateT op e1 e2
+        (L.SBDateOp L.SubDays, PIntT, PDateT)        -> BinOp PDateT op e1 e2
+        (L.SBDateOp L.DiffDays, PDateT, PDateT)      -> BinOp PIntT op e1 e2
+        _                                            ->
+            P.error P.$ printf "CL.Primitives.scalarBinOp: %s" (P.show (op, t1, t2))
+  where
+    t1 = typeOf e1
+    t2 = typeOf e2
+
+addDays :: Expr -> Expr -> Expr
+addDays = scalarBinOp (L.SBDateOp L.AddDays)
+
+subDays :: Expr -> Expr -> Expr
+subDays = scalarBinOp (L.SBDateOp L.SubDays)
+
+diffDays :: Expr -> Expr -> Expr
+diffDays = scalarBinOp (L.SBDateOp L.DiffDays)
 
 add :: Expr -> Expr -> Expr
 add = scalarBinOp (L.SBNumOp L.Add)
diff --git a/src/Database/DSH/Common/Impossible.hs b/src/Database/DSH/Common/Impossible.hs
new file mode 100644
--- /dev/null
+++ b/src/Database/DSH/Common/Impossible.hs
@@ -0,0 +1,19 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module Database.DSH.Common.Impossible (impossible, unimplemented) where
+
+import qualified Language.Haskell.TH as TH
+
+impossible :: TH.ExpQ
+impossible = do
+  loc <- TH.location
+  let pos =  (TH.loc_filename loc, fst (TH.loc_start loc), snd (TH.loc_start loc))
+  let message = "DSH: Impossible happened at " ++ show pos
+  return (TH.AppE (TH.VarE 'error) (TH.LitE (TH.StringL message)))
+
+unimplemented :: TH.ExpQ
+unimplemented = do
+  loc <- TH.location
+  let pos =  (TH.loc_filename loc, fst (TH.loc_start loc), snd (TH.loc_start loc))
+  let message = "DSH: Unimplemented at " ++ show pos
+  return (TH.AppE (TH.VarE 'error) (TH.LitE (TH.StringL message)))
diff --git a/src/Database/DSH/Common/Kure.hs b/src/Database/DSH/Common/Kure.hs
--- a/src/Database/DSH/Common/Kure.hs
+++ b/src/Database/DSH/Common/Kure.hs
@@ -48,8 +48,8 @@
 #endif
 
 debugOpt :: Pretty e => String -> e -> Either String e -> e
-debugOpt stage origExpr mExpr = 
 #ifdef DEBUGCOMP
+debugOpt stage origExpr mExpr =
     trace (showOrig origExpr)
     $ either (flip trace origExpr) (\e -> trace (showOpt e) e) mExpr
 
@@ -63,6 +63,7 @@
     showOpt :: Pretty e => e -> String
     showOpt e = padSep (printf "Optimized Query (%s)" stage) ++ pp e ++ padSep ""
 #else
+debugOpt _stage origExpr mExpr =
     either (const origExpr) id mExpr
 #endif
 
diff --git a/src/Database/DSH/Common/Lang.hs b/src/Database/DSH/Common/Lang.hs
--- a/src/Database/DSH/Common/Lang.hs
+++ b/src/Database/DSH/Common/Lang.hs
@@ -1,18 +1,21 @@
-{-# LANGUAGE GADTs           #-}
-{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE GADTs                #-}
+{-# LANGUAGE TemplateHaskell      #-}
+{-# LANGUAGE TypeSynonymInstances #-}
 
 module Database.DSH.Common.Lang where
 
 import           Data.Aeson
 import           Data.Aeson.TH
+import           Data.Decimal
 import qualified Data.List.NonEmpty           as N
-import           Text.PrettyPrint.ANSI.Leijen
+import qualified Data.Text                    as T
+import qualified Data.Time.Calendar           as C
+import           Text.PrettyPrint.ANSI.Leijen hiding ((<$>))
 import           Text.Printf
 
-import           Database.DSH.Common.Type
-import           Database.DSH.Impossible
-
 import           Database.DSH.Common.Nat
+import           Database.DSH.Common.Type
 
 instance ToJSON a => ToJSON (N.NonEmpty a) where
     toJSON (n N.:| nl) = toJSON (n, nl)
@@ -24,25 +27,43 @@
 -- Common types for backend expressions
 
 -- | Basic values in both FKL and NKL.
-data Val where
-    ListV   :: [Val] -> Val
-    IntV    :: Int -> Val
-    BoolV   :: Bool -> Val
-    StringV :: String -> Val
-    DoubleV :: Double -> Val
-    TupleV  :: [Val] -> Val
-    UnitV   :: Val
-    deriving (Eq, Ord, Show)
+data Val = ListV    [Val]
+         | TupleV   [Val]
+         | ScalarV  ScalarVal
+         deriving (Eq, Ord, Show)
 
+instance ToJSON Decimal where
+    toJSON = toJSON . show
+
+instance FromJSON Decimal where
+    parseJSON s = read <$> parseJSON s
+
+instance FromJSON C.Day where
+    parseJSON o = (\(y, m, d) -> C.fromGregorian y m d) <$> parseJSON o
+
+instance ToJSON C.Day where
+    toJSON = toJSON . C.toGregorian
+
+data ScalarVal = IntV      Int
+               | BoolV     Bool
+               | StringV   T.Text
+               | DoubleV   Double
+               | DecimalV  Decimal
+               | DateV     C.Day
+               | UnitV
+               deriving (Eq, Ord, Show)
+
+$(deriveJSON defaultOptions ''ScalarVal)
+
 newtype ColName = ColName String deriving (Eq, Ord, Show)
 
 $(deriveJSON defaultOptions ''ColName)
 
 -- | Typed table columns
-type Column = (ColName, Type)
+type Column = (ColName, ScalarType)
 
 -- | Table keys
-newtype Key = Key [ColName] deriving (Eq, Ord, Show)
+newtype Key = Key (N.NonEmpty ColName) deriving (Eq, Ord, Show)
 
 $(deriveJSON defaultOptions ''Key)
 
@@ -53,13 +74,14 @@
 
 $(deriveJSON defaultOptions ''Emptiness)
 
--- | Catalog information hints that users may give to DSH
-data TableHints = TableHints
-    { keysHint     :: [Key]
-    , nonEmptyHint :: Emptiness
+-- | Information about base tables
+data BaseTableSchema = BaseTableSchema
+    { tableCols     :: N.NonEmpty Column
+    , tableKeys     :: N.NonEmpty Key
+    , tableNonEmpty :: Emptiness
     } deriving (Eq, Ord, Show)
 
-$(deriveJSON defaultOptions ''TableHints)
+$(deriveJSON defaultOptions ''BaseTableSchema)
 
 -- | Identifiers
 type Ident = String
@@ -69,6 +91,7 @@
 -- Scalar operators
 
 data UnCastOp = CastDouble
+              | CastDecimal
                 deriving (Show, Eq, Ord)
 
 $(deriveJSON defaultOptions ''UnCastOp)
@@ -96,11 +119,18 @@
 
 $(deriveJSON defaultOptions ''UnTextOp)
 
+data UnDateOp = DateDay
+              | DateMonth
+              | DateYear
+              deriving (Show, Eq, Ord)
+
+$(deriveJSON defaultOptions ''UnDateOp)
+
 data ScalarUnOp = SUNumOp UnNumOp
                 | SUBoolOp UnBoolOp
                 | SUCastOp UnCastOp
                 | SUTextOp UnTextOp
-                | SUDateOp
+                | SUDateOp UnDateOp
                 deriving (Show, Eq, Ord)
 
 $(deriveJSON defaultOptions ''ScalarUnOp)
@@ -135,11 +165,19 @@
 
 $(deriveJSON defaultOptions ''BinStringOp)
 
+data BinDateOp = AddDays
+               | SubDays
+               | DiffDays
+               deriving (Show, Eq, Ord)
+
+$(deriveJSON defaultOptions ''BinDateOp)
+
 -- FIXME this would be a good fit for PatternSynonyms
 data ScalarBinOp = SBNumOp BinNumOp
                  | SBRelOp BinRelOp
                  | SBBoolOp BinBoolOp
                  | SBStringOp BinStringOp
+                 | SBDateOp BinDateOp
                  deriving (Show, Eq, Ord)
 
 $(deriveJSON defaultOptions ''ScalarBinOp)
@@ -206,12 +244,17 @@
 
 instance Pretty Val where
     pretty (ListV xs)    = list $ map pretty xs
+    pretty (TupleV vs)   = tupled $ map pretty vs
+    pretty (ScalarV v)   = pretty v
+
+instance Pretty ScalarVal where
     pretty (IntV i)      = int i
     pretty (BoolV b)     = bool b
-    pretty (StringV s)   = dquotes $ string s
+    pretty (StringV t)   = dquotes $ string $ T.unpack t
     pretty (DoubleV d)   = double d
+    pretty (DecimalV d)  = text $ show d
     pretty UnitV         = text "()"
-    pretty (TupleV vs)   = tupled $ map pretty vs
+    pretty (DateV d)     = text $ C.showGregorian d
 
 instance Pretty BinRelOp where
     pretty Eq  = text "=="
@@ -235,6 +278,21 @@
     pretty Conj = text "&&"
     pretty Disj = text "||"
 
+
+instance Pretty BinDateOp where
+    pretty AddDays  = text "addDays"
+    pretty SubDays  = text "subDays"
+    pretty DiffDays = text "diffDays"
+
+isBinInfixOp :: ScalarBinOp -> Bool
+isBinInfixOp op =
+    case op of
+        SBNumOp{}    -> True
+        SBRelOp{}    -> True
+        SBBoolOp{}   -> True
+        SBStringOp{} -> False
+        SBDateOp{}   -> False
+
 instance Pretty UnNumOp where
     pretty Sin  = text "sin"
     pretty Cos  = text "cos"
@@ -247,8 +305,14 @@
     pretty ATan = text "atan"
 
 instance Pretty UnCastOp where
-    pretty CastDouble = text "double"
+    pretty CastDouble  = text "double"
+    pretty CastDecimal = text "decimal"
 
+instance Pretty UnDateOp where
+    pretty DateDay   = text "dateDay"
+    pretty DateMonth = text "dateMonth"
+    pretty DateYear  = text "dateYear"
+
 instance Pretty JoinUnOp where
     pretty (JUNumOp o)  = pretty o
     pretty (JUCastOp o) = pretty o
@@ -267,17 +331,17 @@
         parenthize e1 <> dot <> int (tupleIndex i)
 
 instance Pretty e => Pretty (JoinConjunct e) where
-    pretty (JoinConjunct e1 op e2) = parens $ pretty e1 <+> pretty op <+> pretty e2
+    pretty (JoinConjunct e1 op e2) = pretty e1 <+> pretty op <+> pretty e2
 
 instance Pretty e => Pretty (JoinPredicate e) where
-    pretty (JoinPred ps) = list $ map pretty $ N.toList ps
-
+    pretty (JoinPred ps) = hcat $ punctuate (text " && ") $ map pretty $ N.toList ps
 
 instance Pretty ScalarBinOp where
     pretty (SBNumOp o)    = pretty o
     pretty (SBRelOp o)    = pretty o
     pretty (SBBoolOp o)   = pretty o
     pretty (SBStringOp o) = pretty o
+    pretty (SBDateOp o)   = pretty o
 
 instance Pretty UnBoolOp where
     pretty Not = text "not"
@@ -286,7 +350,7 @@
     pretty (SUNumOp op)  = pretty op
     pretty (SUBoolOp op) = pretty op
     pretty (SUCastOp op) = pretty op
-    pretty SUDateOp      = $unimplemented
+    pretty (SUDateOp op) = pretty op
     pretty (SUTextOp op) = pretty op
 
 instance Pretty UnTextOp where
diff --git a/src/Database/DSH/Common/Nat.hs b/src/Database/DSH/Common/Nat.hs
--- a/src/Database/DSH/Common/Nat.hs
+++ b/src/Database/DSH/Common/Nat.hs
@@ -5,6 +5,16 @@
 -- | Natural numbers that encode lifting levels
 data Nat = Zero | Succ Nat deriving (Show, Eq)
 
+instance Ord Nat where
+    Zero    <= Succ _  = True
+    Succ n1 <= Succ n2 = n1 <= n2
+    _       <= _       = False
+
+(.-) :: Nat -> Nat -> Maybe Nat
+n1      .- Zero    = Just n1
+Succ n1 .- Succ n2 = n1 .- n2
+Zero    .- Succ _  = Nothing
+
 intFromNat :: Nat -> Int
 intFromNat Zero     = 0
 intFromNat (Succ n) = 1 + intFromNat n
@@ -16,7 +26,7 @@
 tupleIndex First    = 1
 tupleIndex (Next f) = 1 + tupleIndex f
 
-intIndex :: Int -> TupleIndex 
+intIndex :: Int -> TupleIndex
 intIndex i = assert (i >= 1) $
     if i > 1
     then Next $ (intIndex $ i - 1)
diff --git a/src/Database/DSH/Common/Opt.hs b/src/Database/DSH/Common/Opt.hs
new file mode 100644
--- /dev/null
+++ b/src/Database/DSH/Common/Opt.hs
@@ -0,0 +1,86 @@
+-- | Common code for DAG-based algebra optimizers.
+module Database.DSH.Common.Opt
+    ( module Database.Algebra.Rewrite.Match
+    , module Database.Algebra.Rewrite.PatternConstruction
+    , module Database.Algebra.Rewrite.Properties
+    , module Database.Algebra.Rewrite.Rule
+    , module Database.Algebra.Rewrite.Traversal
+    , replaceRoot
+    , replaceWithNew
+    , replace
+    , R.Rewrite
+    , R.runRewrite
+    , R.initRewriteState
+    , R.Log
+    , R.logGeneral
+    , R.logRewrite
+    , R.parents
+    , R.topsort
+    , R.operator
+    , R.rootNodes
+    , R.exposeDag
+    , R.getExtras
+    , R.condRewrite
+    , R.updateExtras
+    , R.insert
+    , R.insertNoShare
+    , R.replaceChild
+    , R.infer
+    , R.collect
+    , lookupUnsafe
+    ) where
+
+import qualified Data.IntMap as M
+
+import qualified Database.Algebra.Dag                          as D
+import           Database.Algebra.Dag.Common
+import qualified Database.Algebra.Rewrite.DagRewrite           as R
+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
+
+import           Database.DSH.Common.QueryPlan
+import           Database.DSH.Common.Vector
+
+--------------------------------------------------------------
+-- Versions of rewrite combinators that maintain the Shape
+-- description of the query structure.
+
+-- | Replace a root node while maintaining the query structure
+-- information.
+replaceRoot :: (DagVector v, D.Operator o) => AlgNode -> AlgNode -> R.Rewrite o (Shape v) ()
+replaceRoot oldRoot newRoot = do
+    sh <- R.getExtras
+    R.updateExtras $ updateShape oldRoot newRoot sh
+    R.replaceRoot oldRoot newRoot
+
+-- | Replace a node with a new operator while mainting the query
+-- structure information.
+replaceWithNew :: (D.Operator o, Show o, DagVector v)
+               => AlgNode -> o -> R.Rewrite o (Shape v) AlgNode
+replaceWithNew oldNode newOp = do
+    sh <- R.getExtras
+    newNode <- R.replaceWithNew oldNode newOp
+    R.updateExtras $ updateShape oldNode newNode sh
+    return newNode
+
+-- | Replace a node with another node while maintaining the query
+-- structure information.
+replace :: (DagVector v, D.Operator o)
+        => AlgNode -> AlgNode -> R.Rewrite o (Shape v) ()
+replace oldNode newNode = do
+    sh <- R.getExtras
+    R.replace oldNode newNode
+    R.updateExtras $ updateShape oldNode newNode sh
+
+--------------------------------------------------------------------------------
+
+-- | Perform a map lookup and fail with the given error string if the key
+-- is not present
+lookupUnsafe :: Show a => M.IntMap a -> String -> Int -> a
+lookupUnsafe m s u =
+    case M.lookup u m of
+        Just p -> p
+        Nothing -> error $ s ++ " " ++ (show u) ++ " in " ++ (show m)
diff --git a/src/Database/DSH/Common/Pretty.hs b/src/Database/DSH/Common/Pretty.hs
--- a/src/Database/DSH/Common/Pretty.hs
+++ b/src/Database/DSH/Common/Pretty.hs
@@ -1,9 +1,121 @@
-module Database.DSH.Common.Pretty 
+module Database.DSH.Common.Pretty
   ( pp
   , Pretty, pretty
+  , combinator, join, comp, super, sub, forget, kw, dist, restrict
+  , prettyJoin, prettyComp, prettyApp2, prettyUnOp
+  , prettyInfixBinOp, prettyPrefixBinOp, prettyLet, prettyIf
+  , prettyTuple
   ) where
 
-import Text.PrettyPrint.ANSI.Leijen
+import           Text.PrettyPrint.ANSI.Leijen hiding ((<$>))
+import qualified Text.PrettyPrint.ANSI.Leijen as P
 
 pp :: Pretty a => a -> String
-pp a = (displayS $ renderPretty 0.9 120 $ pretty a) ""
+pp a = (displayS $ renderPretty 0.9 140 $ pretty a) ""
+
+--------------------------------------------------------------------------------
+-- Highlighting of various syntactical elements
+
+combinator :: Doc -> Doc
+combinator = dullyellow
+
+kw :: Doc -> Doc
+kw = bold
+
+join :: Doc -> Doc
+join = yellow
+
+comp :: Doc -> Doc
+comp = red
+
+tuple :: Doc -> Doc
+tuple = green
+
+super :: Doc -> Doc
+super = red
+
+sub :: Doc -> Doc
+sub = red
+
+forget :: Doc -> Doc
+forget = blue
+
+restrict :: Doc -> Doc
+restrict = magenta
+
+dist :: Doc -> Doc
+dist = cyan
+
+--------------------------------------------------------------------------------
+-- Pretty-printing of various syntactical elements
+
+prettyIf :: Doc -> Doc -> Doc -> Doc
+prettyIf c t e =
+    group $ align $ kw (text "if") <+> c
+                    P.<$> kw (text "then") <+> t
+                    P.<$> kw (text "else") <+> e
+
+prettyLet :: Doc -> Doc -> Doc -> Doc
+prettyLet x e1 e2 =
+    group $ align $ (kw (text "let") <+> x <+> kw (char '=') <+> e1)
+                    P.<$>
+                    kw (text "in") <+> e2
+
+
+prettyTuple :: [Doc] -> Doc
+prettyTuple es =
+    case es of
+        [] -> left <+> right
+        [e] -> left <+> e <+> right
+        (e1:e2:es') ->
+            align $ cat $ [left <+> e1]
+                          ++
+                          (map (tuple comma <+>) $ init (e2 : es'))
+                          ++
+                          [tuple comma <+> last (e2 : es') <> space]
+                          ++
+                          [right]
+
+  where
+    left  = tuple lparen
+    right = tuple rparen
+
+prettyComp :: Doc -> [Doc] -> Doc
+prettyComp headExpr quals
+    = case quals of
+        []  -> left <+> headExpr <+> right
+        (q:qs) ->
+            -- We have to insert spaces after the head expression (for
+            -- '|') and after the last qualifier (for '|') for the
+            -- case of the comprehension being rendered on one line.
+            let qsDocs = comp (char '|') <+> q : map (comp comma <+>) qs
+            in align $ cat $ (left <+> headExpr <> space)
+                             :
+                             (init qsDocs)
+                             ++
+                             [last qsDocs <> space]
+                             ++
+                             [right]
+  where
+    left   = comp lbracket
+    right  = comp rbracket
+
+prettyJoin :: Doc -> Doc -> Doc -> Doc
+prettyJoin op xs ys =
+    group $ hang 4 $ op P.<$> (vsep [xs, ys])
+
+prettyApp2 :: Doc -> Doc -> Doc -> Doc
+prettyApp2 op xs ys =
+    group $ op <+> (align $ xs P.<$> ys)
+
+prettyUnOp :: Doc -> Doc -> Doc
+prettyUnOp op x =
+    op <+> x
+
+prettyInfixBinOp :: Doc -> Doc -> Doc -> Doc
+prettyInfixBinOp op x y =
+    group $ (align $ x P.<$> op P.<$> y)
+
+prettyPrefixBinOp :: Doc -> Doc -> Doc -> Doc
+prettyPrefixBinOp op x y =
+    group $ op <+> (align $ x P.<$> y)
diff --git a/src/Database/DSH/Common/QueryPlan.hs b/src/Database/DSH/Common/QueryPlan.hs
--- a/src/Database/DSH/Common/QueryPlan.hs
+++ b/src/Database/DSH/Common/QueryPlan.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE InstanceSigs    #-}
 {-# LANGUAGE TemplateHaskell #-}
 
 -- | A QueryPlan describes the computation of the top-level query
@@ -5,81 +6,102 @@
 -- result's structure is encoded by the individual queries.
 module Database.DSH.Common.QueryPlan where
 
+import           Data.Aeson
 import           Data.Aeson.TH
+import qualified Data.ByteString.Lazy.Char8  as BL
+import qualified Data.Foldable               as F
+import qualified Data.Traversable            as T
 
 import           Database.Algebra.Dag
 import           Database.Algebra.Dag.Common
 
-import           Database.DSH.VL.Vector
+import           Database.DSH.Common.Vector
 
 -- | A Layout describes the tuple structure of values encoded by
 -- one particular query from a bundle.
-data Layout q = LCol Int
+data Layout q = LCol
               | LNest q (Layout q)
               | LTuple [Layout q]
               deriving (Show, Read)
 
+instance Functor Layout where
+    fmap _ LCol          = LCol
+    fmap f (LNest q lyt) = LNest (f q) (fmap f lyt)
+    fmap f (LTuple lyts) = LTuple (fmap (fmap f) lyts)
+
+instance F.Foldable Layout where
+    foldr _ z LCol          = z
+    foldr f z (LNest q lyt) = f q (F.foldr f z lyt)
+    foldr f z (LTuple lyts) = F.foldr (\l b -> F.foldr f b l) z lyts
+
+instance T.Traversable Layout where
+    traverse _ LCol          = pure LCol
+    traverse f (LNest q lyt) = LNest <$> f q <*> T.traverse f lyt
+    traverse f (LTuple lyts) = LTuple <$> T.traverse (T.traverse f) lyts
+
 -- | A Shape describes the structure of the result produced by a
 -- bundle of nested queries. 'q' is the type of individual vectors,
 -- e.g. plan entry nodes or rendered database code. On the top level
 -- we distinguish between a single value and a proper vector with more
 -- than one element.
-data Shape q = VShape q (Layout q)  -- | A regular vector shape
-             | SShape q (Layout q)  -- | A shape for a singleton vector
+data Shape q = VShape q (Layout q)  -- ^ A regular vector shape
+             | SShape q (Layout q)  -- ^ A shape for a singleton vector
              deriving (Show, Read)
 
+instance Functor Shape where
+    fmap f (VShape q lyt) = VShape (f q) (fmap f lyt)
+    fmap f (SShape q lyt) = SShape (f q) (fmap f lyt)
+
+instance F.Foldable Shape where
+    foldr f z (VShape q lyt) = f q (F.foldr f z lyt)
+    foldr f z (SShape q lyt) = f q (F.foldr f z lyt)
+
+instance T.Traversable Shape where
+    traverse f (VShape q lyt) = VShape <$> f q <*> T.traverse f lyt
+    traverse f (SShape q lyt) = SShape <$> f q <*> T.traverse f lyt
+
 $(deriveJSON defaultOptions ''Layout)
 $(deriveJSON defaultOptions ''Shape)
 
--- | Extract all plan root nodes stored in the layout
-layoutNodes :: DagVector v => Layout v -> [AlgNode]
-layoutNodes (LCol _)      = []
-layoutNodes (LNest v lyt) = vectorNodes v ++ layoutNodes lyt
-layoutNodes (LTuple lyts) = concatMap layoutNodes lyts
-
 -- | Extract all plan root nodes stored in the shape
 shapeNodes :: DagVector v => Shape v -> [AlgNode]
-shapeNodes (VShape v lyt) = vectorNodes v ++ layoutNodes lyt
-shapeNodes (SShape v lyt) = vectorNodes v ++ layoutNodes lyt
+shapeNodes shape = F.foldMap (\v -> vectorNodes v) shape
 
 -- | Replace a node in a top shape with another node.
 updateShape :: DagVector v => AlgNode -> AlgNode -> Shape v -> Shape v
-updateShape old new shape =
-    case shape of
-        VShape dbv lyt -> VShape (updateVector old new dbv) (updateLayout lyt)
-        SShape dbv lyt -> SShape (updateVector old new dbv) (updateLayout lyt)
-
-  where
-    updateLayout (LNest dbv lyt) = LNest (updateVector old new dbv) (updateLayout lyt)
-    updateLayout (LTuple lyts)   = LTuple (map updateLayout lyts)
-    updateLayout l               = l
+updateShape old new shape = fmap (updateVector old new) shape
 
+-- | Determine the number of relational attributes needed in a vector.
 columnsInLayout :: Layout q -> Int
-columnsInLayout (LCol _)      = 1
+columnsInLayout LCol          = 1
 columnsInLayout (LNest _ _)   = 0
 columnsInLayout (LTuple lyts) = sum $ map columnsInLayout lyts
 
-isOuterMost :: AlgNode -> Shape NDVec -> Bool
-isOuterMost n (VShape (ADVec n' _) _) = n == n'
-isOuterMost n (SShape (ADVec n' _) _) = n == n'
-
 -- | A query plan consists of a DAG over some algebra and information about the
 -- shape of the query.
-data QueryPlan a v =
-  QueryPlan { queryDag   :: AlgebraDag a
-            , queryShape :: Shape v
-            , queryTags  :: NodeMap [Tag]
-            }
+data QueryPlan a v = QueryPlan
+    { queryDag   :: AlgebraDag a
+    , queryShape :: Shape v
+    , queryTags  :: NodeMap [Tag]
+    }
 
 -- | Construct a query plan from the operator map and the description
 -- of the result shape.
-mkQueryPlan :: (Operator a, DagVector v) 
-            => AlgebraDag a 
-            -> Shape v 
-            -> NodeMap [Tag] 
+mkQueryPlan :: (Operator a, DagVector v)
+            => AlgebraDag a
+            -> Shape v
+            -> NodeMap [Tag]
             -> QueryPlan a v
 mkQueryPlan dag shape tagMap =
   QueryPlan { queryDag   = addRootNodes dag (shapeNodes shape)
             , queryShape = shape
-            , queryTags  = tagMap 
+            , queryTags  = tagMap
             }
+
+-- | Export a query plan to two files. One file (.plan) contains the
+-- DAG for compability with algebra-* dot generators. The other file
+-- contains the shape information.
+exportPlan :: (ToJSON a, ToJSON v) => String -> QueryPlan a v -> IO ()
+exportPlan prefix plan = do
+    BL.writeFile (prefix ++ ".plan") (encode $ queryDag plan)
+    BL.writeFile (prefix ++ ".shape") (encode $ queryShape plan)
diff --git a/src/Database/DSH/Common/RewriteM.hs b/src/Database/DSH/Common/RewriteM.hs
--- a/src/Database/DSH/Common/RewriteM.hs
+++ b/src/Database/DSH/Common/RewriteM.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE TypeSynonymInstances #-}
 {-# LANGUAGE InstanceSigs         #-}
 
+-- | The Rewrite monad for KURE-based rewriting systems in DSH.
 module Database.DSH.Common.RewriteM
     ( RewriteM
     , RewriteStateM
@@ -15,9 +16,7 @@
     , liftstate
     ) where
 
-import Control.Applicative
 import Control.Monad
-       
 import Language.KURE
 
 import Database.DSH.Common.Lang
@@ -41,17 +40,17 @@
   return = returnM
   (>>=)  = bindM
   fail   = failM
-  
+
 returnM :: a -> RewriteM s a
 returnM a = RewriteM (\n -> (n, Right a))
 {-# INLINE returnM #-}
-  
+
 bindM :: RewriteM s a -> (a -> RewriteM s b) -> RewriteM s b
 bindM (RewriteM f) gg = RewriteM $ \ n -> case f n of
                                     (n', Left msg) -> (n', Left msg)
                                     (n', Right a)  -> compM (gg a) n'
-{-# INLINE bindM #-}                                    
-                                    
+{-# INLINE bindM #-}
+
 failM :: String -> RewriteM s a
 failM msg = RewriteM (\n -> (n, Left msg))
 {-# INLINE failM #-}
@@ -63,7 +62,7 @@
 catchRewriteM (RewriteM st) f = RewriteM $ \ n -> case st n of
                                         (n', Left msg) -> compM (f msg) n'
                                         (n', Right a)  -> (n', Right a)
-{-# INLINE catchRewriteM #-}                                        
+{-# INLINE catchRewriteM #-}
 
 
 instance Functor (RewriteM s) where
@@ -84,7 +83,7 @@
                   if v `elem` vs
                     then freshName vs
                     else return v
-                    
+
 suggestName' :: RewriteStateM s Ident
 suggestName' = RewriteM (\(n, s) -> ((n+1, s), Right ("v" ++ show n)))
 
@@ -93,7 +92,7 @@
                    if v `elem` vs
                      then freshNameS vs
                      else return v
-                     
+
 get :: RewriteStateM s s
 get = RewriteM $ \(i, s) -> ((i, s), Right s)
 {-# INLINE get #-}
@@ -107,26 +106,11 @@
 {-# INLINE modify #-}
 
 stateful :: s -> RewriteStateM s a -> RewriteM Int (s, a)
-stateful s ma = RewriteM $ \i -> 
+stateful s ma = RewriteM $ \i ->
                case runRewriteM' (i, s) ma of
                    ((i', _), Left msg) -> (i', Left msg)
                    ((i', s'), Right a) -> (i', Right (s', a))
-                   
+
 liftstate :: RewriteM Int a -> RewriteStateM s a
 liftstate ma = RewriteM $ \(i, s) -> let (i', a) = runRewriteM' i ma
                                   in ((i', s), a)
-                   
-
--- runRewriteM' (i, s) (ma :: RewriteM (Int, s) a) :: ((i', s'), 
-
-{-
-type FooM s = StateT s RewriteM
-
--- automatic due to StateT
--- instance Monad ...
-
-instance MonadCatch (FooM s) where
-    ma `catchM` f = StateT $ \s ->
-                        let (ka, s') = runStateT ma s
-                        in runRewriteM (return . return) undefined ka
--}                        
diff --git a/src/Database/DSH/Common/TH.hs b/src/Database/DSH/Common/TH.hs
new file mode 100644
--- /dev/null
+++ b/src/Database/DSH/Common/TH.hs
@@ -0,0 +1,15 @@
+-- | Helper functions for TH code
+module Database.DSH.Common.TH
+    ( nameTyApp
+    , equalConstrTy
+    ) where
+
+import Language.Haskell.TH
+
+-- | Apply a named type constructor to a type
+nameTyApp :: Name -> Type -> Type
+nameTyApp className tyVar = AppT (ConT className) tyVar
+
+-- | Construct a type that expresses an equality constraint.
+equalConstrTy :: Type -> Type -> Type
+equalConstrTy t1 t2 = AppT (AppT EqualityT t1) t2
diff --git a/src/Database/DSH/Common/Type.hs b/src/Database/DSH/Common/Type.hs
--- a/src/Database/DSH/Common/Type.hs
+++ b/src/Database/DSH/Common/Type.hs
@@ -2,9 +2,12 @@
 {-# LANGUAGE TypeSynonymInstances   #-}
 {-# LANGUAGE MultiParamTypeClasses  #-}
 {-# LANGUAGE TemplateHaskell        #-}
+{-# LANGUAGE PatternSynonyms        #-}
 
-module Database.DSH.Common.Type 
+-- | Types for backend languages.
+module Database.DSH.Common.Type
     ( isNum
+    , scalarType
     , isList
     , elemT
     , tupleElemT
@@ -18,75 +21,92 @@
     , liftType
     , liftTypeN
     , Type(..)
-    , intT
-    , boolT
-    , unitT
-    , stringT
-    , doubleT
-    , listT
-    , pairT
+    , ScalarType(..)
+    , pattern PIntT
+    , pattern PBoolT
+    , pattern PUnitT
+    , pattern PStringT
+    , pattern PDoubleT
+    , pattern PDecimalT
+    , pattern PDateT
+    , pattern PPairT
     , Typed (..)
     ) where
 
+import Debug.Trace
+
+import Data.Aeson.TH
+
 import Text.PrettyPrint.ANSI.Leijen
 
-import Database.DSH.Impossible
+import Database.DSH.Common.Impossible
 import Database.DSH.Common.Pretty
 import Database.DSH.Common.Nat
-  
-instance Pretty Type where 
+
+instance Pretty Type where
+    pretty (ListT t)     = brackets $ pretty t
+    pretty (TupleT ts)   = tupled $ map pretty ts
+    pretty (ScalarT t)   = pretty t
+
+instance Pretty ScalarType where
     pretty IntT          = text "Int"
+    pretty DecimalT      = text "Decimal"
     pretty BoolT         = text "Bool"
     pretty DoubleT       = text "Double"
     pretty StringT       = text "String"
     pretty UnitT         = text "()"
-    pretty (ListT t)     = brackets $ pretty t
-    pretty (TupleT ts)   = tupled $ map pretty ts
+    pretty DateT         = text "Date"
 
 -- | We use the following type language to type the various
 -- intermediate languages.
-data Type  = IntT 
-           | BoolT 
-           | DoubleT
-           | StringT 
-           | UnitT 
-           | ListT Type
+data Type  = ListT Type
            | TupleT [Type]
+           | ScalarT ScalarType
            deriving (Show, Eq, Ord)
 
+
+data ScalarType  = IntT
+                 | BoolT
+                 | DoubleT
+                 | StringT
+                 | UnitT
+                 | DecimalT
+                 | DateT
+                 deriving (Show, Eq, Ord)
+
+
+-- | Is the (scalar) type numeric?
 isNum :: Type -> Bool
-isNum IntT        = True
-isNum DoubleT     = True
-isNum BoolT       = False
-isNum StringT     = False
-isNum UnitT       = False
 isNum (ListT _)   = False
 isNum (TupleT _)  = False
-      
-intT :: Type
-intT = IntT
-
-stringT :: Type
-stringT = StringT
-
-doubleT :: Type
-doubleT = DoubleT
+isNum (ScalarT IntT)        = True
+isNum (ScalarT DoubleT)     = True
+isNum (ScalarT DecimalT)    = True
+isNum (ScalarT BoolT)       = False
+isNum (ScalarT StringT)     = False
+isNum (ScalarT UnitT)       = False
+isNum (ScalarT DateT)       = False
 
-boolT :: Type
-boolT = BoolT
+scalarType :: Type -> Maybe ScalarType
+scalarType (ScalarT t) = Just t
+scalarType _           = Nothing
 
-unitT :: Type
-unitT = UnitT
+--------------------------------------------------------------------------------
+-- Smart constructors and deconstructors.
 
-listT :: Type -> Type
-listT = ListT
+pattern PIntT     = ScalarT IntT
+pattern PStringT  = ScalarT StringT
+pattern PDoubleT  = ScalarT DoubleT
+pattern PDecimalT = ScalarT DecimalT
+pattern PBoolT    = ScalarT BoolT
+pattern PDateT    = ScalarT DateT
+pattern PUnitT    = ScalarT UnitT
 
-pairT :: Type -> Type -> Type
-pairT t1 t2 = TupleT [t1, t2]
+pattern PPairT t1 t2 = TupleT [t1, t2]
 
 isList :: Type -> Bool
 isList (ListT _) = True
-isList _        = False
+isList _         = False
 
 elemT :: Type -> Type
 elemT (ListT t) = t
@@ -98,7 +118,7 @@
 
 tupleElemTypes :: Type -> [Type]
 tupleElemTypes (TupleT ts) = ts
-tupleElemTypes _           = $impossible
+tupleElemTypes t           = trace (show t) $ $impossible
 
 listDepth :: Type -> Int
 listDepth (ListT t1) = 1 + listDepth t1
@@ -113,7 +133,7 @@
 sndT _                = error "Type is not a pair type"
 
 extractShape :: Type -> Type -> Type
-extractShape (ListT t1) = \x -> listT $ extractShape t1 x
+extractShape (ListT t1) = \x -> ListT $ extractShape t1 x
 extractShape _          = \x -> x
 
 liftTypeN :: Nat -> Type -> Type
@@ -121,7 +141,7 @@
 liftTypeN (Succ n) t = liftTypeN n $ liftType t
 
 liftType :: Type -> Type
-liftType t = listT t 
+liftType t = ListT t
 
 unliftTypeN :: Nat -> Type -> Type
 unliftTypeN Zero t     = t
@@ -131,5 +151,13 @@
 unliftType (ListT t1) = t1
 unliftType t          = error $ "Type: " ++ pp t ++ " cannot be unlifted."
 
+--------------------------------------------------------------------------------
+
+-- | Typed terms
 class Typed a where
   typeOf :: a -> Type
+
+--------------------------------------------------------------------------------
+-- Aeson instances for JSON serialization
+
+$(deriveJSON defaultOptions ''ScalarType)
diff --git a/src/Database/DSH/Common/Vector.hs b/src/Database/DSH/Common/Vector.hs
new file mode 100644
--- /dev/null
+++ b/src/Database/DSH/Common/Vector.hs
@@ -0,0 +1,106 @@
+{-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE TemplateHaskell      #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+
+-- | This module defines the kinds of vectors that occur in VL
+-- programs.
+module Database.DSH.Common.Vector
+    ( DBCol
+    , ColName
+    , RelationalVector(..)
+    , DagVector
+    , vectorNodes
+    , updateVector
+    , ADVec(..)
+    , VLDVec(..)
+    , NDVec
+    , VLRVec(..)
+    , VLKVec(..)
+    , VLSVec(..)
+    , VLFVec(..)
+    ) where
+
+import           Data.Aeson.TH
+import qualified Data.Vector                 as V
+
+import           Database.Algebra.Dag.Common
+
+import           Database.DSH.VL.Lang
+
+type ColName = String
+
+--------------------------------------------------------------------------------
+-- Abstractions over data vectors
+
+-- | Concrete encodings of data vectors explicitly represent ordering
+-- and segment information in relational columns.
+class RelationalVector v where
+    rvKeyCols :: v -> [ColName]
+    rvRefCols :: v -> [ColName]
+    rvItemCols :: v -> V.Vector ColName
+
+-- | Common properties of data vectors that are represented by a DAG
+-- plan of operators.
+class DagVector v where
+    -- | Return all graph nodes which represent the vector.
+    vectorNodes :: v -> [AlgNode]
+
+    -- | Replace a node in the vector
+    updateVector :: AlgNode -> AlgNode -> v -> v
+
+--------------------------------------------------------------------------------
+-- Simple data vectors
+
+-- | Data vectors. A data vector references a result in an algebra DAG
+-- and stores the number of payload columns that it has. 'ADVec'
+-- abstracts over the type of references into the graph.
+data ADVec r = ADVec r [DBCol]
+    deriving (Show, Read)
+
+-- | Data vectors that reference single nodes in an algebra graph
+--  (used for X100 with an n-ary storage model).
+type NDVec = ADVec AlgNode
+
+instance DagVector NDVec where
+    vectorNodes (ADVec q _) = [q]
+
+    updateVector n1 n2 (ADVec q cols)
+        | q == n1   = ADVec n2 cols
+        | otherwise = ADVec q cols
+
+--------------------------------------------------------------------------------
+-- Abstract vector types for vectorization
+
+-- | A VL data vector references an operator in a VL DAG.
+newtype VLDVec = VLDVec AlgNode
+    deriving (Show, Read)
+
+instance DagVector VLDVec where
+    vectorNodes (VLDVec q) = [q]
+
+    updateVector n1 n2 (VLDVec q)
+        | q == n1   = VLDVec n2
+        | otherwise = VLDVec q
+
+-- | Replication vectors. A @NRVec@ simply references a node in an
+-- algebra Dag.
+newtype VLRVec = VLRVec AlgNode
+
+-- | Rekeying vectors. A @NKVec@ simply references a node in an algebra
+-- Dag.
+newtype VLKVec = VLKVec AlgNode
+
+-- | Filtering vectors. A @NFVec@ simply references a node in an algebra
+-- Dag.
+newtype VLFVec = VLFVec AlgNode
+
+-- | Sorting vectors. A @NSVec@ simply references a node in an algebra
+-- Dag.
+newtype VLSVec = VLSVec AlgNode
+
+$(deriveJSON defaultOptions ''ADVec)
+$(deriveJSON defaultOptions ''VLRVec)
+$(deriveJSON defaultOptions ''VLKVec)
+$(deriveJSON defaultOptions ''VLSVec)
+$(deriveJSON defaultOptions ''VLFVec)
+$(deriveJSON defaultOptions ''VLDVec)
diff --git a/src/Database/DSH/Compiler.hs b/src/Database/DSH/Compiler.hs
--- a/src/Database/DSH/Compiler.hs
+++ b/src/Database/DSH/Compiler.hs
@@ -1,132 +1,215 @@
-{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE ExplicitForAll      #-}
+{-# LANGUAGE FlexibleContexts    #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell     #-}
 
 -- | Compilation, execution and introspection of queries
 module Database.DSH.Compiler
-  ( -- * Executing queries
-    runQ
-    -- * Debug functions
-  , debugQ
-  , debugVL
-  , debugVLOpt
-  , debugTA
-  , debugTAOpt
-  , runPrint
-  ) where
+    ( -- * Executing queries
+      runQ
+      -- * Debugging and benchmarking queries
+    , debugQ
+    , codeQ
+    , vectorPlanQ
+    , showComprehensionsQ
+    , showComprehensionsOptQ
+    , showDesugaredQ
+    , showDesugaredOptQ
+    , showLiftedQ
+    , showLiftedOptQ
+    , showFlattenedQ
+    , showFlattenedOptQ
+    , showVectorizedQ
+    , showVectorizedOptQ
+    ) where
 
-import           Control.Applicative
 import           Control.Arrow
-import qualified Database.HDBC.PostgreSQL                 as H
+import           Control.Monad
+import qualified Data.Foldable                      as F
+import           System.Process
+import           System.Random
+import           Text.Printf
 
 import           Database.DSH.Translate.Frontend2CL
-import           Database.DSH.Execute.Sql
 
-import qualified Database.DSH.VL.Lang                     as VL
-import           Database.DSH.VL.Vector
-import           Database.DSH.NKL.Rewrite
-import qualified Database.DSH.CL.Lang                     as CL
+import           Database.DSH.Backend
+import qualified Database.DSH.CL.Lang               as CL
 import           Database.DSH.CL.Opt
+import           Database.DSH.Common.Pretty
 import           Database.DSH.Common.QueryPlan
-import           Database.DSH.Export
+import           Database.DSH.Common.Vector
+import           Database.DSH.Execute
+import           Database.DSH.FKL.Rewrite
 import           Database.DSH.Frontend.Internals
-import           Database.DSH.Optimizer.TA.OptimizeTA
-import           Database.DSH.Optimizer.VL.OptimizeVL
-import           Database.DSH.Frontend.Schema
-import           Database.DSH.Translate.Algebra2Query
+import           Database.DSH.NKL.Rewrite
 import           Database.DSH.Translate.CL2NKL
 import           Database.DSH.Translate.FKL2VL
 import           Database.DSH.Translate.NKL2FKL
-import           Database.DSH.Translate.VL2Algebra
+import qualified Database.DSH.VL.Lang               as VL
+import           Database.DSH.VL.Opt.OptimizeVL
 
 --------------------------------------------------------------------------------
--- Different versions of the flattening compiler pipeline
 
--- | Backend-agnostic part of the pipeline.
-commonPipeline :: CL.Expr -> QueryPlan VL.VL VLDVec
-commonPipeline =
-    optimizeComprehensions
-    >>> desugarComprehensions
-    >>> optimizeNKL
-    >>> flatTransform
-    >>> specializeVectorOps
+-- | The backend-independent part of the compiler.
+compileQ :: CL.Expr -> QueryPlan VL.VL VLDVec
+compileQ = optimizeComprehensions >>>
+           desugarComprehensions  >>>
+           optimizeNKL            >>>
+           flatTransform          >>>
+           specializeVectorOps
 
-nkl2Sql :: CL.Expr -> Shape (BackendCode SqlBackend)
-nkl2Sql =
-    commonPipeline
-    >>> optimizeVLDefault
-    >>> implementVectorOpsPF
-    >>> optimizeTA
-    >>> generateSqlQueries
+-- | Compile a query and execute it on a given backend connection.
+runQ :: forall a c.
+        (Backend c,QA a)
+     => c -> Q a -> IO a
+runQ c (Q q) = do
+    let ty = reify (undefined :: Rep a)
+    let cl = toComprehensions q
+    let vl = compileQ cl
+    let bp = generatePlan $ optimizeVLDefault vl
+    let bc = generateCode bp
+    frExp <$> execQueryBundle c bc ty
 
-nkl2TAFile :: String -> CL.Expr -> IO ()
-nkl2TAFile prefix =
-    commonPipeline
-    >>> optimizeVLDefault
-    >>> implementVectorOpsPF
-    >>> (exportTAPlan prefix)
+--------------------------------------------------------------------------------
 
-nkl2TAFileOpt :: String -> CL.Expr -> IO ()
-nkl2TAFileOpt prefix =
-    commonPipeline
-    >>> optimizeVLDefault
-    >>> implementVectorOpsPF
-    >>> optimizeTA
-    >>> exportTAPlan (prefix ++ "_opt")
+-- | Compile a query and dump intermediate plans to files.
+debugQ :: forall a c.(Backend c, QA a)
+       => String
+       -> c
+       -> Q a
+       -> IO ()
+debugQ prefix _ (Q q) = do
+    let cl = toComprehensions q
+    let vl = compileQ cl
+    let vlOpt = optimizeVLDefault vl
+    exportPlan (prefix ++ "_vl") vl
+    exportPlan (prefix ++ "_vl_opt") vlOpt
+    let bp = generatePlan vlOpt :: BackendPlan c
+    void $ dumpPlan prefix False bp
+    void $ dumpPlan prefix True bp
 
-nkl2VLFile :: String -> CL.Expr -> IO ()
-nkl2VLFile prefix = commonPipeline >>> exportVLPlan prefix
+vectorPlanQ :: forall a. QA a
+            => Q a
+            -> QueryPlan VL.VL VLDVec
+vectorPlanQ (Q q) =
+    optimizeVLDefault $ compileQ $ toComprehensions q
 
-nkl2VLFileOpt :: String -> CL.Expr -> IO ()
-nkl2VLFileOpt prefix =
-    commonPipeline
-    >>> optimizeVLDefault
-    >>> exportVLPlan (prefix ++ "_opt")
+-- | Compile a query to the actual backend code that will be executed
+-- (for benchmarking purposes).
+codeQ :: forall a c.(Backend c, QA a)
+      => c
+      -> Q a
+      -> [BackendCode c]
+codeQ _ (Q q) =
+    let vl    = optimizeVLDefault $ compileQ $ toComprehensions q
+        plan  = generatePlan vl :: BackendPlan c
+        shape = generateCode plan :: Shape (BackendCode c)
+    in F.foldr (:) [] shape
 
 --------------------------------------------------------------------------------
--- Functions for executing and debugging DSH queries via the Flattening backend
 
--- | Run a query on a SQL backend
-runQ :: QA a => H.Connection -> Q a -> IO a
-runQ conn (Q q) = do
-    let ty = reify (undefined :: a)
-    q' <- toComprehensions (getTableInfo conn) q
-    let sqlQueryBundle = nkl2Sql q'
-    frExp <$> executeSql (SqlBackend conn) sqlQueryBundle ty
+decorate :: String -> String
+decorate msg = sepLine ++ msg ++ "\n" ++ sepLine
+  where
+    sepLine = replicate 80 '-' ++ "\n"
 
--- | Debugging function: dump the table algebra plan (JSON) to a file.
-debugTA :: QA a => String -> H.Connection -> Q a -> IO ()
-debugTA prefix c (Q e) = do
-    e' <- toComprehensions (getTableInfo c) e
-    nkl2TAFile prefix e'
+-- | Show unoptimized comprehensions (CL)
+showComprehensionsQ :: forall a.QA a => Q a -> IO ()
+showComprehensionsQ (Q q) = do
+    let cl = toComprehensions q
+    putStrLn $ decorate $ pp cl
 
--- | Debugging function: dump the optimized table algebra plan (JSON) to a file.
-debugTAOpt :: QA a => String -> H.Connection -> Q a -> IO ()
-debugTAOpt prefix c (Q e) = do
-    e' <- toComprehensions (getTableInfo c) e
-    nkl2TAFileOpt prefix e'
+-- | Show optimized comprehensions (CL)
+showComprehensionsOptQ :: forall a. QA a => Q a -> IO ()
+showComprehensionsOptQ (Q q) = do
+    let cl = optimizeComprehensions $ toComprehensions q
+    putStrLn $ decorate $ pp cl
 
--- | Debugging function: dump the VL query plan (DAG) for a query to a
--- file (SQL version).
-debugVL :: QA a => String -> H.Connection -> Q a -> IO ()
-debugVL prefix c (Q e) = do
-    e' <- toComprehensions (getTableInfo c) e
-    nkl2VLFile prefix e'
+-- | Show unoptimized desugared iterators (CL)
+showDesugaredQ :: forall a. QA a => Q a -> IO ()
+showDesugaredQ (Q q) = do
+    let nkl = desugarComprehensions
+              $ optimizeComprehensions
+              $ toComprehensions q
+    putStrLn $ decorate $ pp nkl
 
--- | Debugging function: dump the optimized VL query plan (DAG) for a
--- query to a file (SQL version).
-debugVLOpt :: QA a => String -> H.Connection -> Q a -> IO ()
-debugVLOpt prefix c (Q e) = do
-    e' <- toComprehensions (getTableInfo c) e
-    nkl2VLFileOpt prefix e'
+-- | Show optimized desugared iterators (CL)
+showDesugaredOptQ :: forall a. QA a => Q a -> IO ()
+showDesugaredOptQ (Q q) = do
+    let nkl = optimizeNKL
+              $ desugarComprehensions
+              $ optimizeComprehensions
+              $ toComprehensions q
+    putStrLn $ decorate $ pp nkl
 
--- | Dump all intermediate algebra representations (VL, TA) to files.
-debugQ :: QA a => String -> H.Connection -> Q a -> IO ()
-debugQ prefix conn q = do
-    debugVL prefix conn q
-    debugVLOpt prefix conn q
-    debugTA prefix conn q
-    debugTAOpt prefix conn q
+-- | Show unoptimized lifted operators (FKL intermediate)
+showLiftedQ :: forall a. QA a => Q a -> IO ()
+showLiftedQ (Q q) = do
+    let fkl = liftOperators
+              $ optimizeNKL
+              $ desugarComprehensions
+              $ optimizeComprehensions
+              $ toComprehensions q
+    putStrLn $ decorate $ pp fkl
 
--- | Convenience function: execute a query on a SQL backend and print
--- its result
-runPrint :: (Show a, QA a) => H.Connection -> Q a -> IO ()
-runPrint conn q = (show <$> runQ conn q) >>= putStrLn
+-- | Show optimized lifted operators (FKL intermediate)
+showLiftedOptQ :: forall a. QA a => Q a -> IO ()
+showLiftedOptQ (Q q) = do
+    let fkl = optimizeFKL
+              $ liftOperators
+              $ optimizeNKL
+              $ desugarComprehensions
+              $ optimizeComprehensions
+              $ toComprehensions q
+    putStrLn $ decorate $ pp fkl
+
+-- | Show unoptimized flattened query (FKL)
+showFlattenedQ :: forall a. QA a => Q a -> IO ()
+showFlattenedQ (Q q) = do
+    let fkl = normalizeLifted
+              $ optimizeFKL
+              $ liftOperators
+              $ optimizeNKL
+              $ desugarComprehensions
+              $ optimizeComprehensions
+              $ toComprehensions q
+    putStrLn $ decorate $ pp fkl
+
+-- | Show optimized flattened query (FKL)
+showFlattenedOptQ :: forall a. QA a => Q a -> IO ()
+showFlattenedOptQ (Q q) = do
+    let fkl = optimizeNormFKL
+              $ normalizeLifted
+              $ optimizeFKL
+              $ liftOperators
+              $ optimizeNKL
+              $ desugarComprehensions
+              $ optimizeComprehensions
+              $ toComprehensions q
+    putStrLn $ decorate $ pp fkl
+
+fileId :: IO String
+fileId = sequence $ replicate 8 $ (randomRIO ('a', 'z'))
+
+-- | Show unoptimized vector plan (VL)
+showVectorizedQ :: forall a. QA a => Q a -> IO ()
+showVectorizedQ (Q q) = do
+    let cl = toComprehensions q
+    let vl = compileQ cl
+    h <- fileId
+    let fileName = "q_vl_" ++ h
+    exportPlan fileName vl
+    void $ runCommand $ printf ".cabal-sandbox/bin/vldot -i %s.plan | dot -Tpdf -o %s.pdf" fileName fileName
+    void $ runCommand $ printf "evince %s.pdf" fileName
+
+-- | Show optimized vector plan (VL)
+showVectorizedOptQ :: forall a. QA a => Q a -> IO ()
+showVectorizedOptQ (Q q) = do
+    let cl = toComprehensions q
+    let vl = optimizeVLDefault $ compileQ cl
+    h <- fileId
+    let fileName = "q_vl_" ++ h
+    exportPlan fileName vl
+    void $ runCommand $ printf ".cabal-sandbox/bin/vldot -i %s.plan | dot -Tpdf -o %s.pdf" fileName fileName
+    void $ runCommand $ printf "evince %s.pdf" fileName
+
diff --git a/src/Database/DSH/Execute.hs b/src/Database/DSH/Execute.hs
new file mode 100644
--- /dev/null
+++ b/src/Database/DSH/Execute.hs
@@ -0,0 +1,241 @@
+{-# LANGUAGE ExplicitForAll      #-}
+{-# LANGUAGE FlexibleContexts    #-}
+{-# LANGUAGE GADTs               #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell     #-}
+
+module Database.DSH.Execute
+    ( execQueryBundle
+    ) where
+
+import           Control.Monad.State
+import qualified Data.DList                       as D
+import qualified Data.HashMap.Lazy                as M
+import           Data.List
+import qualified Data.Vector                      as V
+import           Text.Printf
+
+import           Database.DSH.Common.Pretty
+import           Database.DSH.Common.QueryPlan
+import           Database.DSH.Common.Vector
+
+import           Database.DSH.Backend
+import           Database.DSH.Common.Impossible
+import           Database.DSH.Execute.TH
+import qualified Database.DSH.Frontend.Internals  as F
+
+------------------------------------------------------------------------------
+-- Different kinds of layouts that contain results in various forms
+
+-- Generate the definition for the 'TabTuple' type
+$(mkTabTupleType 16)
+
+-- | Row layout with nesting data in the form of raw tabular results
+-- FIXME use newtypes to keep key and ref columns apart
+data TabLayout a where
+    TCol   :: F.Type a -> ColName -> TabLayout a
+    TNest  :: (F.Reify a, Backend c)
+           => F.Type [a]
+           -> [BackendRow c]
+           -> [ColName]
+           -> [ColName]
+           -> TabLayout a
+           -> TabLayout [a]
+    TTuple :: TabTuple a -> TabLayout a
+
+-- Generate the definition for the 'SegTuple' type
+$(mkSegTupleType 16)
+
+-- | A map from segment descriptor to list value expressions
+type SegMap a = M.HashMap CompositeKey (F.Exp a)
+
+-- | Row layout with nesting data in the form of segment maps
+data SegLayout a where
+    SCol   :: F.Type a -> ColName -> SegLayout a
+    SNest  :: F.Reify a => F.Type [a] -> SegMap [a] -> SegLayout [a]
+    STuple :: SegTuple a -> SegLayout a
+
+--------------------------------------------------------------------------------
+-- Turn layouts into layouts with explicit column names
+
+data ColLayout q = CCol ColName
+                 | CNest q (ColLayout q)
+                 | CTuple [ColLayout q]
+
+-- | Annotate every column reference with its column index in a flat
+-- column layout.
+columnIndexes :: RelationalVector v => V.Vector ColName -> Layout v -> ColLayout v
+columnIndexes itemCols lyt = evalState (numberCols itemCols lyt) 1
+
+numberCols :: RelationalVector v => V.Vector ColName -> Layout v -> State Int (ColLayout v)
+numberCols itemCols LCol          = currentCol >>= \i -> return (CCol $ itemCols V.! (i - 1))
+numberCols itemCols (LTuple lyts) = CTuple <$> mapM (numberCols itemCols) lyts
+numberCols _        (LNest q lyt) = CNest q <$> posBracket (numberCols (rvItemCols q) lyt)
+
+currentCol :: State Int Int
+currentCol = do
+    i <- get
+    put $ i + 1
+    return i
+
+posBracket :: State Int (ColLayout q) -> State Int (ColLayout q)
+posBracket ma = do
+    c <- get
+    put 1
+    a <- ma
+    put c
+    return a
+
+--------------------------------------------------------------------------------
+-- Execute flat queries and construct result values
+
+execQueryBundle :: Backend c
+                => c
+                -> Shape (BackendCode c)
+                -> F.Type a
+                -> IO (F.Exp a)
+execQueryBundle conn shape ty =
+    transactionally conn $ \conn' ->
+    case (shape, ty) of
+        (VShape q lyt, F.ListT ety) -> do
+            tab  <- execFlatQuery conn' q
+            tlyt <- execNested conn' (columnIndexes (rvItemCols q) lyt) ety
+            return $ fromVector tab (rvKeyCols q) tlyt
+        (SShape q lyt, _) -> do
+            tab  <- execFlatQuery conn' q
+            tlyt <- execNested conn' (columnIndexes (rvItemCols q) lyt) ty
+            return $ fromPrim tab (rvKeyCols q) tlyt
+        _ -> $impossible
+
+-- | Traverse the layout and execute all subqueries for nested vectors
+execNested :: Backend c
+           => c -> ColLayout (BackendCode c)
+           -> F.Type a
+           -> IO (TabLayout a)
+execNested conn lyt ty =
+    case (lyt, ty) of
+        (CCol i, t)                   -> return $ TCol t i
+        (CNest q clyt, F.ListT t)     -> do
+            tab   <- execFlatQuery conn q
+            clyt' <- execNested conn clyt t
+            return $ TNest ty tab (rvKeyCols q) (rvRefCols q) clyt'
+        (CTuple lyts, F.TupleT tupTy) -> let execTuple = $(mkExecTuple 16)
+                                         in execTuple lyts tupTy
+        (_, _)                        ->
+            error $ printf "Type does not match query structure: %s" (pp ty)
+
+------------------------------------------------------------------------------
+-- Construct result value terms from raw tabular results
+
+-- | Construct a list from an outer vector
+fromVector :: (F.Reify a, Row r) => [r] -> [ColName] -> TabLayout a -> F.Exp [a]
+fromVector tab keyCols tlyt =
+    let slyt = segmentLayout tlyt
+    in F.ListE $ D.toList $ foldl' (vecIter keyCols slyt) D.empty tab
+
+-- | Construct one element value of the result list from a single row
+-- of the outer vector.
+vecIter :: Row r
+        => [ColName]
+        -> SegLayout a
+        -> D.DList (F.Exp a)
+        -> r
+        -> D.DList (F.Exp a)
+vecIter keyCols slyt vals row =
+    let val = constructVal keyCols slyt row
+    in D.snoc vals val
+
+-- | Construct a single value from an outer vector
+fromPrim :: Row r => [r] -> [ColName] -> TabLayout a -> F.Exp a
+fromPrim tab keyCols tlyt =
+    let slyt = segmentLayout tlyt
+    in case tab of
+           [row] -> constructVal keyCols slyt row
+           _     -> $impossible
+
+------------------------------------------------------------------------------
+-- Construct nested result values from segmented vectors
+
+-- | Construct values for nested vectors in the layout.
+segmentLayout :: TabLayout a -> SegLayout a
+segmentLayout tlyt =
+    case tlyt of
+        TCol ty i                            -> SCol ty i
+        TNest ty tab keyCols refCols clyt  ->
+            let slyt = segmentLayout clyt
+            in SNest ty (mkSegMap keyCols refCols tab slyt)
+        TTuple tup                           ->
+            let segmentTuple = $(mkSegmentTupleFun 16)
+            in STuple $ segmentTuple tup
+
+data SegAcc a = SegAcc
+    { saCurrSeg :: CompositeKey
+    , saSegMap  :: SegMap [a]
+    , saCurrVec :: D.DList (F.Exp a)
+    }
+
+-- | Construct a segment map from a segmented vector
+mkSegMap :: (F.Reify a, Row r)
+         => [ColName]
+         -> [ColName]
+         -> [r]
+         -> SegLayout a
+         -> SegMap [a]
+mkSegMap keyCols refCols tab slyt =
+    let -- FIXME using the empty list as the starting key is not exactly nice
+        initialAcc = SegAcc { saCurrSeg = (CompositeKey [])
+                            , saSegMap  = M.empty
+                            , saCurrVec = D.empty
+                            }
+        finalAcc = foldl' (segIter keyCols refCols slyt) initialAcc tab
+    in M.insert (saCurrSeg finalAcc)
+                (F.ListE $ D.toList $ saCurrVec finalAcc)
+                (saSegMap finalAcc)
+
+-- | Fold iterator that constructs a map from segment descriptor to
+-- the list value that is represented by that segment
+segIter :: (F.Reify a, Row r)
+        => [ColName]
+        -> [ColName]
+        -> SegLayout a
+        -> SegAcc a
+        -> r
+        -> SegAcc a
+segIter keyCols refCols lyt acc row =
+    let val = constructVal keyCols lyt row
+        ref = mkCKey row refCols
+    in if ref == saCurrSeg acc
+       then acc { saCurrVec = D.snoc (saCurrVec acc) val }
+       else acc { saCurrSeg = ref
+                , saSegMap  = M.insert (saCurrSeg acc)
+                                     (F.ListE $ D.toList $ saCurrVec acc)
+                                     (saSegMap acc)
+                , saCurrVec = D.singleton val
+                }
+
+------------------------------------------------------------------------------
+-- Construct values from table rows
+
+mkCKey :: Row r => r -> [ColName] -> CompositeKey
+mkCKey r cs = CompositeKey $ map (keyVal . flip col r) cs
+
+-- | Construct a value from a vector row according to the given layout
+constructVal :: Row r => [ColName] -> SegLayout a -> r -> F.Exp a
+constructVal keyCols lyt row =
+    case lyt of
+        STuple stup       -> let constructTuple = $(mkConstructTuple 16)
+                             in constructTuple keyCols stup row
+        SNest _ segMap    -> case M.lookup (mkCKey row keyCols) segMap of
+                                  Just v  -> v
+                                  Nothing -> F.ListE []
+        SCol F.DoubleT c  -> doubleVal (col c row)
+        SCol F.IntegerT c -> integerVal (col c row)
+        SCol F.BoolT c    -> boolVal (col c row)
+        SCol F.CharT c    -> charVal (col c row)
+        SCol F.TextT c    -> textVal (col c row)
+        SCol F.UnitT c    -> unitVal (col c row)
+        SCol F.DayT c     -> dayVal (col c row)
+        SCol F.DecimalT c -> decimalVal (col c row)
+        SCol _       _    -> $impossible
+
+--------------------------------------------------------------------------------
diff --git a/src/Database/DSH/Execute/Backend.hs b/src/Database/DSH/Execute/Backend.hs
deleted file mode 100644
--- a/src/Database/DSH/Execute/Backend.hs
+++ /dev/null
@@ -1,183 +0,0 @@
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE GADTs            #-}
-{-# LANGUAGE TypeFamilies     #-}
-{-# LANGUAGE TemplateHaskell  #-}
-
--- | This module provides an abstraction over flat relational backends
--- w.r.t. to query execution and result value construction.
-module Database.DSH.Execute.Backend where
-
-import           Text.Printf
-import qualified Data.IntMap                     as IM
-import qualified Data.DList as D
-import           Data.List              
-
-import           Database.DSH.Impossible
-import           Database.DSH.Frontend.Internals
-import           Database.DSH.Common.QueryPlan
-import           Database.DSH.Common.Pretty
-import           Database.DSH.Execute.TH
-
--- | An abstract backend on which flat queries can be executed.
-class Backend c where
-    data BackendRow c
-    data BackendCode c
-
-    execFlatQuery :: c -> BackendCode c -> IO [BackendRow c]
-
--- | Abstraction over result rows for a specific backend.
-class Row r where
-    -- | The type of single attribute values
-    data Scalar r
-
-    -- | Look up an attribute in the row
-    col       :: String -> r -> (Scalar r)
-
-    -- | Convert an attribute value to a segment descriptor value
-    descrVal  :: Scalar r -> Int
-
-    -- | Convert an attribute value to a value term
-    scalarVal :: Scalar r -> Type a -> Exp a
-
-------------------------------------------------------------------------------
--- Different kinds of layouts that contain results in various forms
-
--- Generate the definition for the 'TabTuple' type
-$(mkTabTupleType 16)
-
--- | Row layout with nesting data in the form of raw tabular results
-data TabLayout a where
-    TCol   :: Type a -> String -> TabLayout a
-    TNest  :: (Reify a, Backend c, Row (BackendRow c)) => Type [a] -> [BackendRow c] -> TabLayout a -> TabLayout [a]
-    TTuple :: TabTuple a -> TabLayout a
-
--- Generate the definition for the 'SegTuple' type
-$(mkSegTupleType 16)
-
--- | A map from segment descriptor to list value expressions
-type SegMap a = IM.IntMap (Exp a)
-
--- | Row layout with nesting data in the form of segment maps
-data SegLayout a where
-    SCol   :: Type a -> String -> SegLayout a
-    SNest  :: Reify a => Type [a] -> SegMap [a] -> SegLayout [a]
-    STuple :: SegTuple a -> SegLayout a
-
-execQueryBundle :: (Backend c, Row (BackendRow c)) => c -> Shape (BackendCode c) -> Type a -> IO (Exp a)
-execQueryBundle conn shape ty = 
-    case (shape, ty) of
-        (VShape q lyt, ListT ety) -> do
-            tab  <- execFlatQuery conn q
-            tlyt <- execNested conn lyt ety
-            return $ fromVector tab tlyt
-        (SShape q lyt, _) -> do
-            tab  <- execFlatQuery conn q
-            tlyt <- execNested conn lyt ty
-            return $ fromPrim tab tlyt
-        _ -> $impossible
-
--- | Traverse the layout and execute all subqueries for nested vectors
-execNested :: (Backend c, Row (BackendRow c)) => c -> Layout (BackendCode c) -> Type a -> IO (TabLayout a)
-execNested conn lyt ty =
-    case (lyt, ty) of
-        (LCol i, t)             -> return $ TCol t (itemCol i)
-        (LNest q clyt, ListT t) -> do
-            tab   <- execFlatQuery conn q
-            clyt' <- execNested conn clyt t
-            return $ TNest ty tab clyt'
-        (LTuple lyts, TupleT tupTy) -> let execTuple = $(mkExecTuple 16)
-                                       in execTuple lyts tupTy
-        (_, ty) -> error $ printf "Type does not match query structure: %s" (pp ty)
-
-------------------------------------------------------------------------------
--- Construct result value terms from raw tabular results
-
--- | 
-itemCol :: Int -> String
-itemCol 1 = "item1"
-itemCol 2 = "item2"
-itemCol 3 = "item3"
-itemCol 4 = "item4"
-itemCol 5 = "item5"
-itemCol 6 = "item6"
-itemCol 7 = "item7"
-itemCol 8 = "item8"
-itemCol 9 = "item9"
-itemCol 10 = "item10"
-itemCol n = "item" ++ show n
-
-posCol :: Row r => r -> Int
-posCol row = descrVal $ col "pos" row
-
-descrCol :: Row r => r -> Int
-descrCol row = descrVal $ col "descr" row
-
-fromVector :: (Reify a, Row r) => [r] -> TabLayout a -> Exp [a]
-fromVector tab tlyt =
-    let slyt = segmentLayout tlyt
-    in ListE $ D.toList $ foldl' (vecIter slyt) D.empty tab
-
-vecIter :: Row r => SegLayout a -> D.DList (Exp a) -> r -> D.DList (Exp a)
-vecIter slyt vals row = 
-    let val = constructVal slyt row
-    in D.snoc vals val
-
-fromPrim :: Row r => [r] -> TabLayout a -> Exp a
-fromPrim tab tlyt =
-    let slyt = segmentLayout tlyt
-    in case tab of
-           [row] -> constructVal slyt row
-           _     -> $impossible
-
-------------------------------------------------------------------------------
--- Construct nested result values from segmented vectors
-
--- | Construct values for nested vectors in the layout.
-segmentLayout :: TabLayout a -> SegLayout a
-segmentLayout tlyt =
-    case tlyt of
-        TCol ty s            -> SCol ty s
-        TNest ty tab clyt    -> SNest ty (fromSegVector tab clyt)
-        TTuple tup           -> let segmentTuple = $(mkSegmentTupleFun 16)
-                                in STuple $ segmentTuple tup
-
-data SegAcc a = SegAcc { currSeg :: Int
-                       , segMap  :: SegMap [a]
-                       , currVec :: D.DList (Exp a)
-                       }
-
--- | Construct a segment map from a segmented vector
-fromSegVector :: (Reify a, Row r) => [r] -> TabLayout a -> SegMap [a]
-fromSegVector tab tlyt =
-    let slyt = segmentLayout tlyt
-        initialAcc = SegAcc { currSeg = 0, segMap = IM.empty, currVec = D.empty }
-        finalAcc = foldl' (segIter slyt) initialAcc tab
-    in IM.insert (currSeg finalAcc) (ListE $ D.toList $ currVec finalAcc) (segMap finalAcc)
-
--- | Fold iterator that constructs a map from segment descriptor to
--- the list value that is represented by that segment
-segIter :: (Reify a, Row r) => SegLayout a -> SegAcc a -> r -> SegAcc a
-segIter lyt acc row = 
-    let val   = constructVal lyt row
-        descr = descrCol row
-    in if descr == currSeg acc
-       then acc { currVec = D.snoc (currVec acc) val }
-       else acc { currSeg = descr
-                , segMap  = IM.insert (currSeg acc) (ListE $ D.toList $ currVec acc) (segMap acc)
-                , currVec = D.singleton val
-                }
-
-------------------------------------------------------------------------------
--- Construct values from table rows    
-
--- | Construct a value from a vector row according to the given layout
-constructVal :: Row r => SegLayout a -> r -> Exp a
-constructVal lyt row =
-    case lyt of
-        STuple stup       -> let constructTuple = $(mkConstructTuple 16) 
-                             in constructTuple stup row
-        SNest _ segmap    -> let pos = posCol row
-                              in case IM.lookup pos segmap of
-                                  Just v  -> v
-                                  Nothing -> ListE []
-        SCol ty c         -> scalarVal (col c row) ty
diff --git a/src/Database/DSH/Execute/Sql.hs b/src/Database/DSH/Execute/Sql.hs
deleted file mode 100644
--- a/src/Database/DSH/Execute/Sql.hs
+++ /dev/null
@@ -1,83 +0,0 @@
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE TemplateHaskell   #-}
-{-# LANGUAGE TypeFamilies      #-}
-{-# LANGUAGE GADTs             #-}
-
--- | This module implements the execution of SQL query bundles and the
--- construction of nested values from the resulting vector bundle.
-module Database.DSH.Execute.Sql
-  ( executeSql
-  , SqlBackend(..)
-  , BackendCode(..)
-  ) where
-
-import           Text.Printf
-
-import           Database.HDBC
-import           Database.HDBC.PostgreSQL
-
-import qualified Data.Text                             as Txt
-import qualified Data.Text.Encoding                    as Txt
-import qualified Data.Map as M
-import           Control.Monad
-import           Control.Applicative
-
-import           Database.DSH.Impossible
-import           Database.DSH.Frontend.Internals
-import           Database.DSH.Execute.Backend
-
-import           Database.DSH.Common.QueryPlan
-
-newtype SqlBackend = SqlBackend Connection
-
-instance Backend SqlBackend where
-    data BackendRow SqlBackend  = SqlRow (M.Map String SqlValue)
-    data BackendCode SqlBackend = SqlCode String
-
-    execFlatQuery (SqlBackend conn) (SqlCode q) = do
-        stmt  <- prepare conn q
-        void $ execute stmt []
-        map SqlRow <$> fetchAllRowsMap' stmt
-
-instance Row (BackendRow SqlBackend) where
-    data Scalar (BackendRow SqlBackend) = SqlScalar SqlValue
-
-    col c (SqlRow r) = 
-        case M.lookup c r of
-            Just v  -> SqlScalar v
-            Nothing -> error $ printf "col lookup %s failed in %s" c (show r)
-
-    descrVal (SqlScalar (SqlInt32 i))   = fromIntegral i
-    descrVal (SqlScalar (SqlInteger i)) = fromIntegral i
-    descrVal _                          = $impossible
-
-    scalarVal (SqlScalar SqlNull)           UnitT    = UnitE
-    scalarVal (SqlScalar (SqlInteger _))    UnitT    = UnitE
-    scalarVal (SqlScalar (SqlInteger i))    IntegerT = IntegerE i
-    scalarVal (SqlScalar (SqlInt32 i))      IntegerT = IntegerE $ fromIntegral i
-    scalarVal (SqlScalar (SqlInt64 i))      IntegerT = IntegerE $ fromIntegral i
-    scalarVal (SqlScalar (SqlWord32 i))     IntegerT = IntegerE $ fromIntegral i
-    scalarVal (SqlScalar (SqlWord64 i))     IntegerT = IntegerE $ fromIntegral i
-    scalarVal (SqlScalar (SqlDouble d))     DoubleT  = DoubleE d
-    scalarVal (SqlScalar (SqlRational d))   DoubleT  = DoubleE $ fromRational d
-    scalarVal (SqlScalar (SqlInteger d))    DoubleT  = DoubleE $ fromIntegral d
-    scalarVal (SqlScalar (SqlInt32 d))      DoubleT  = DoubleE $ fromIntegral d
-    scalarVal (SqlScalar (SqlInt64 d))      DoubleT  = DoubleE $ fromIntegral d
-    scalarVal (SqlScalar (SqlWord32 d))     DoubleT  = DoubleE $ fromIntegral d
-    scalarVal (SqlScalar (SqlWord64 d))     DoubleT  = DoubleE $ fromIntegral d
-    scalarVal (SqlScalar (SqlBool b))       BoolT    = BoolE b
-    scalarVal (SqlScalar (SqlInteger i))    BoolT    = BoolE (i /= 0)
-    scalarVal (SqlScalar (SqlInt32 i))      BoolT    = BoolE (i /= 0)
-    scalarVal (SqlScalar (SqlInt64 i))      BoolT    = BoolE (i /= 0)
-    scalarVal (SqlScalar (SqlWord32 i))     BoolT    = BoolE (i /= 0)
-    scalarVal (SqlScalar (SqlWord64 i))     BoolT    = BoolE (i /= 0)
-    scalarVal (SqlScalar (SqlChar c))       CharT    = CharE c
-    scalarVal (SqlScalar (SqlString (c:_))) CharT    = CharE c
-    scalarVal (SqlScalar (SqlByteString c)) CharT    = CharE (head $ Txt.unpack $ Txt.decodeUtf8 c)
-    scalarVal (SqlScalar (SqlString t))     TextT    = TextE (Txt.pack t)
-    scalarVal (SqlScalar (SqlByteString s)) TextT    = TextE (Txt.decodeUtf8 s)
-    scalarVal (SqlScalar sql)               _        = error $ "Unsupported SqlValue: "  ++ show sql
-
--- | Execute a SQL query bundle on PostgreSQL.
-executeSql :: SqlBackend -> Shape (BackendCode SqlBackend) -> Type a -> IO (Exp a)
-executeSql = execQueryBundle
diff --git a/src/Database/DSH/Execute/TH.hs b/src/Database/DSH/Execute/TH.hs
--- a/src/Database/DSH/Execute/TH.hs
+++ b/src/Database/DSH/Execute/TH.hs
@@ -8,13 +8,13 @@
     , mkConstructTuple
     ) where
 
-import           Control.Applicative
 import           Language.Haskell.TH
 import           Data.List
 
 import           Text.Printf
 
-import           Database.DSH.Impossible
+import           Database.DSH.Common.Impossible
+import           Database.DSH.Common.TH
 import           Database.DSH.Frontend.TupleTypes
 import qualified Database.DSH.Frontend.Internals as DSH
 
@@ -43,7 +43,7 @@
 mkExecNestedStmt :: Name -> Name -> Name -> Stmt
 mkExecNestedStmt tyName lytName resLytName =
     let execNested = VarE $ mkName "execNested"
-        conn       = VarE $ mkName "conn"      
+        conn       = VarE $ mkName "conn"
         callE      = AppE (AppE (AppE execNested conn) (VarE lytName)) (VarE tyName)
 
     in BindS (VarP resLytName) callE
@@ -56,18 +56,18 @@
 
     -- '([lyt1, ..., lyt<n>], Tuple<n>T ty1 ... ty<n>)'
     let pat = TupP [ ListP $ map VarP lytNames
-                   , ConP (tupTyConstName width) (map VarP tyNames)
+                   , ConP (tupTyConstName "F" width) (map VarP tyNames)
                    ]
 
     -- 'return $ TTuple $ TTuple<n> ty lyt1 ... lyt<n>'
     let execNestedStmts = zipWith3 mkExecNestedStmt tyNames lytNames lytNames'
         returnStmt      = NoBindS $ AppE (VarE 'return)
                                   $ AppE (ConE $ mkName "TTuple")
-                                  $ foldl' AppE 
+                                  $ foldl' AppE
                                            (AppE (ConE $ tabTupleConsName width) (VarE $ mkName "ty"))
                                            (map VarE lytNames')
-                                                
 
+
     return $ Match pat (NormalB $ DoE $ execNestedStmts ++ [returnStmt]) []
 
 -- | Generate a lambda expression that matches on a tuple type layout
@@ -81,7 +81,7 @@
 --          lyt<n>' <- execNested conn lyt<n> ty<n>
 --          return $ TTuple $ TTuple<n> ty lyt1 ... lyt<n>
 -- @
--- 
+--
 -- The lambda expression is /not/ closed: The names 'conn' and 'ty' must be in
 -- scope where 'conn' is the database connection and 'ty' is the tuple type being
 -- dissected.
@@ -116,14 +116,14 @@
         -- (t1, ..., t<n>)
         tupTy            = foldl' AppT (TupleT width)
                            $ map VarT tupElemTyNames
-    
+
         -- a ~ (t1, ..., t<n>)
-        tupConstraint    = EqualP (VarT tupTyName) tupTy
+        tupConstraint    = equalConstrTy (VarT tupTyName) tupTy
 
         -- Reify t1, ..., Reify t<n>
-        reifyConstraints = map (\n -> ClassP ''DSH.Reify [VarT n]) tupElemTyNames
+        reifyConstraints = map (\n -> nameTyApp ''DSH.Reify (VarT n)) tupElemTyNames
 
-        constraints      = tupConstraint : reifyConstraints 
+        constraints      = tupConstraint : reifyConstraints
 
     let -- 'Type a'
         dshTypeTy  = (NotStrict, AppT (ConT ''DSH.Type) (VarT tupTyName))
@@ -131,8 +131,8 @@
         elemLytTys = [ (NotStrict, lytTyCons (VarT t)) -- AppT (ConT $ mkName "TabLayout") (VarT t))
                      | t <- tupElemTyNames
                      ]
-        argTys     = dshTypeTy : elemLytTys 
-    
+        argTys     = dshTypeTy : elemLytTys
+
     return $ ForallC tyVarBinders constraints
            $ NormalC (conName width) {- (tabTupleConsName width) -} argTys
 
@@ -140,16 +140,16 @@
 -- tabular query results.
 -- @
 -- data TabTuple a where
---     TTuple3 :: (Reify t1, ..., Reify t<n>) => Type (t1, ..., t<n>) 
---                                            -> TabLayout t1 
---                                            -> ... 
---                                            -> TabLayout t<n> 
+--     TTuple3 :: (Reify t1, ..., Reify t<n>) => Type (t1, ..., t<n>)
+--                                            -> TabLayout t1
+--                                            -> ...
+--                                            -> TabLayout t<n>
 --                                            -> TabTuple (t1, ..., t<n>)
 -- @
--- 
+--
 -- Because TH does not directly support GADT syntax, we have to
 -- emulate it using explicit universal quantification:
--- 
+--
 -- @
 -- data TabTuple a =
 --     forall t1, ..., t<n>. a ~ (t1, ..., t<n>),
@@ -162,7 +162,7 @@
 mkTupleLyt tyName lytTyCons conName maxWidth = do
     tupTyName <- newName "a"
     cons      <- mapM (mkTupleLytCons tupTyName lytTyCons conName) [2..maxWidth]
-    
+
     return $ [DataD [] tyName  [PlainTV tupTyName] cons []]
 
 --------------------------------------------------------------------------------
@@ -199,22 +199,22 @@
     let tuplePat = ConP (tabTupleConsName width) (VarP tyName : map VarP lytNames)
 
     let segFun  = VarE $ mkName "segmentLayout"
-        segLyts = map ((AppE segFun) . VarE) lytNames
+        segLyts = map (\l -> AppE segFun (VarE l)) lytNames
 
-    let bodyExp = foldl' AppE (ConE $ segTupleConsName width) 
+    let bodyExp = foldl' AppE (ConE $ segTupleConsName width)
                               (VarE tyName : segLyts)
     return $ Match tuplePat (NormalB bodyExp) []
 
 -- | Generate the definition for the 'segmentTuple' function that maps
 -- layouts with tabular SQL results to layouts with segment maps.
 -- @
--- 
--- \lyt -> 
+--
+-- \keyCols lyt ->
 --   case lyt of
 --   ...
---   (TTuple<n> ty tlyt1 ... tlyt<n>) = STuple<n> ty (segmentLayout tlyt1) 
+--   (TTuple<n> ty tlyt1 ... tlyt<n>) = STuple<n> ty (segmentLayout keyCols tlyt1)
 --                                                   ...
---                                                   (segmentLayout tlyt<n>)
+--                                                   (segmentLayout keyCols tlyt<n>)
 -- @
 mkSegmentTupleFun :: Int -> Q Exp
 mkSegmentTupleFun maxWidth = do
@@ -228,27 +228,31 @@
 -- Generate the constructor function from a segmap tuple layout to a
 -- tuple value
 
-mkConstructTupleMatch :: Name -> Int -> Q Match
-mkConstructTupleMatch rowName width = do
+mkConstructTupleMatch :: Name -> Name -> Int -> Q Match
+mkConstructTupleMatch keysName rowName width = do
     lytNames <- mapM (\i -> newName $ printf "slyt%d" i) [1..width]
 
     let tuplePat = ConP (segTupleConsName width) (WildP : map VarP lytNames)
 
-    let constructFun   = VarE $ mkName "constructVal"
-        resultElemExps = [ AppE (AppE constructFun (VarE l)) (VarE rowName)
-                         | l <- lytNames
-                         ]
-        resultValExp   = AppE (ConE outerConst) 
-                              (foldl' AppE (ConE $ innerConst width) resultElemExps)
+    let constructFun    = VarE $ mkName "constructVal"
+        constructArgs l = [VarE keysName, VarE l, VarE rowName ]
+        resultElemExps  = [ foldl' AppE constructFun (constructArgs l)
+                          | l <- lytNames
+                          ]
+        tupleConstE     = ConE $ innerConst "F" width
+        resultValExp    = AppE (ConE $ mkName "F.TupleConstE")
+                               (foldl' AppE tupleConstE resultElemExps)
 
     return $ Match tuplePat (NormalB resultValExp) []
 
 mkConstructTuple :: Int -> Q Exp
 mkConstructTuple maxWidth = do
+    keysName      <- newName "keyCols"
     lytName       <- newName "lyt"
     rowName       <- newName "row"
 
-    tupMatches    <- mapM (mkConstructTupleMatch rowName) [2..maxWidth]
+    tupMatches    <- mapM (mkConstructTupleMatch keysName rowName)
+                          [2..maxWidth]
     let lamBody = CaseE (TupE [VarE lytName]) tupMatches
 
-    return $ LamE [VarP lytName, VarP rowName] lamBody
+    return $ LamE [VarP keysName, VarP lytName, VarP rowName] lamBody
diff --git a/src/Database/DSH/Export.hs b/src/Database/DSH/Export.hs
deleted file mode 100644
--- a/src/Database/DSH/Export.hs
+++ /dev/null
@@ -1,37 +0,0 @@
--- | Debug functions to export query plans and rendered database code
--- in various forms.
-module Database.DSH.Export
-  ( exportVLPlan
-  , exportTAPlan
-  ) where
-
-import           Database.Algebra.Dag
-import           Database.Algebra.Table.Lang
-import qualified Database.Algebra.Table.Render.JSON as PFJSON
-
-import           Database.DSH.Common.QueryPlan
-import           Database.DSH.VL.Lang
-import           Database.DSH.VL.Vector
-import qualified Database.DSH.VL.Render.JSON        as VLJSON
-
-exportVLPlan :: String -> QueryPlan VL VLDVec -> IO ()
-exportVLPlan prefix vlPlan = do
-  let planPath = prefix ++ "_vl.plan"
-      shapePath = prefix ++ "_vl.shape"
-
-  VLJSON.planToFile planPath ( queryTags vlPlan
-                             , shapeNodes $ queryShape vlPlan
-                             , nodeMap $ queryDag vlPlan
-                             )
-  writeFile shapePath $ show $ queryShape vlPlan
-
-exportTAPlan :: String -> QueryPlan TableAlgebra NDVec -> IO ()
-exportTAPlan prefix pfPlan = do
-  let planPath = prefix ++ "_ta.plan"
-      shapePath = prefix ++ "_ta.shape"
-
-  PFJSON.planToFile planPath ( queryTags pfPlan
-                             , shapeNodes $ queryShape pfPlan
-                             , nodeMap $ queryDag pfPlan
-                             )
-  writeFile shapePath $ show $ queryShape pfPlan
diff --git a/src/Database/DSH/FKL/Kure.hs b/src/Database/DSH/FKL/Kure.hs
--- a/src/Database/DSH/FKL/Kure.hs
+++ b/src/Database/DSH/FKL/Kure.hs
@@ -12,10 +12,10 @@
 
       -- * The KURE monad
     , RewriteM, RewriteStateM, TransformF, RewriteF, LensF
-    
+
       -- * Setters and getters for the translation state
     , get, put, modify, initialCtx
-    
+
       -- * Changing between stateful and non-stateful transforms
     , statefulT, liftstateT
 
@@ -33,23 +33,22 @@
     , ifR, constExprR, varR, letR
 
     , inScopeNames, freeIn, boundIn, freshNameT
-    
+
     ) where
-    
-       
+
+
 import           Control.Monad
-import           Data.Monoid
 
 import           Language.KURE
 import           Language.KURE.Lens
-       
+
 import           Database.DSH.Common.RewriteM
 import           Database.DSH.Common.Nat
 import           Database.DSH.Common.Lang
 import           Database.DSH.Common.Type
 import           Database.DSH.Common.Pretty
 import           Database.DSH.FKL.Lang
-                 
+
 --------------------------------------------------------------------------------
 -- Convenience type aliases
 
@@ -93,10 +92,10 @@
 data FlatCtx = FlatCtx { fkl_path     :: AbsPathF
                        , fkl_bindings :: [Ident]
                        }
-                       
+
 instance ExtendPath FlatCtx CrumbF where
     c@@n = c { fkl_path = fkl_path c @@ n }
-    
+
 instance ReadPath FlatCtx CrumbF where
     absPath c = fkl_path c
 
@@ -137,14 +136,14 @@
 --------------------------------------------------------------------------------
 -- Congruence combinators for FKL lexpressions
 
-tableT :: Monad m => (Type -> String -> [Column] -> TableHints -> b)
+tableT :: Monad m => (Type -> String -> BaseTableSchema -> b)
                   -> Transform FlatCtx m (ExprTempl l e) b
 tableT f = contextfreeT $ \expr -> case expr of
-                      Table ty n cs ks -> return $ f ty n cs ks
-                      _                -> fail "not a table node"
-{-# INLINE tableT #-}                      
+                      Table ty n schema -> return $ f ty n schema
+                      _                 -> fail "not a table node"
+{-# INLINE tableT #-}
 
-                      
+
 tableR :: Monad m => Rewrite FlatCtx m (ExprTempl l e)
 tableR = tableT Table
 {-# INLINE tableR #-}
@@ -155,30 +154,18 @@
                -> (Type -> a1 -> a2 -> a3 -> b)
                -> Transform FlatCtx m (ExprTempl l e) b
 ifT t1 t2 t3 f = transform $ \c expr -> case expr of
-                    If ty e1 e2 e3 -> f ty <$> applyT t1 (c@@IfCond) e1               
+                    If ty e1 e2 e3 -> f ty <$> applyT t1 (c@@IfCond) e1
                                            <*> applyT t2 (c@@IfThen) e2
                                            <*> applyT t3 (c@@IfElse) e3
                     _              -> fail "not an if expression"
-{-# INLINE ifT #-}                      
-                    
+{-# INLINE ifT #-}
+
 ifR :: Monad m => Rewrite FlatCtx m (ExprTempl l e)
                -> Rewrite FlatCtx m (ExprTempl l e)
                -> Rewrite FlatCtx m (ExprTempl l e)
                -> Rewrite FlatCtx m (ExprTempl l e)
-ifR t1 t2 t3 = ifT t1 t2 t3 If               
-{-# INLINE ifR #-}                      
-
-{- FIXME will be needed again when let-bindings are added.
-varT :: Monad m => (Type -> Ident -> b) -> Transform FlatCtx m (Expr l) b
-varT f = contextfreeT $ \expr -> case expr of
-                    Var ty n -> return $ f ty n
-                    _        -> fail "not a variable"
-{-# INLINE varT #-}                      
-                    
-varR :: Monad m => Rewrite FlatCtx m (Expr l)
-varR = varT Var
-{-# INLINE varR #-}                      
--}
+ifR t1 t2 t3 = ifT t1 t2 t3 If
+{-# INLINE ifR #-}
 
 binopT :: Monad m => Transform FlatCtx m (ExprTempl l e) a1
                   -> Transform FlatCtx m (ExprTempl l e) a2
@@ -187,11 +174,11 @@
 binopT t1 t2 f = transform $ \c expr -> case expr of
                      BinOp ty op l e1 e2 -> f ty op l <$> applyT t1 (c@@BinOpArg1) e1 <*> applyT t2 (c@@BinOpArg2) e2
                      _                   -> fail "not a binary operator application"
-{-# INLINE binopT #-}                      
+{-# INLINE binopT #-}
 
 binopR :: Monad m => Rewrite FlatCtx m (ExprTempl l e) -> Rewrite FlatCtx m (ExprTempl l e) -> Rewrite FlatCtx m (ExprTempl l e)
 binopR t1 t2 = binopT t1 t2 BinOp
-{-# INLINE binopR #-}                      
+{-# INLINE binopR #-}
 
 unopT :: Monad m => Transform FlatCtx m (ExprTempl l e) a
                  -> (Type -> ScalarUnOp -> l -> a -> b)
@@ -204,18 +191,18 @@
 unopR :: Monad m => Rewrite FlatCtx m (ExprTempl l e) -> Rewrite FlatCtx m (ExprTempl l e)
 unopR t = unopT t UnOp
 {-# INLINE unopR #-}
-                     
+
 papp1T :: Monad m => Transform FlatCtx m (ExprTempl l e) a
                   -> (Type -> Prim1 -> l -> a -> b)
                   -> Transform FlatCtx m (ExprTempl l e) b
 papp1T t f = transform $ \c expr -> case expr of
-                      PApp1 ty p l e -> f ty p l <$> applyT t (c@@PApp1Arg) e                  
+                      PApp1 ty p l e -> f ty p l <$> applyT t (c@@PApp1Arg) e
                       _              -> fail "not a unary primitive application"
-{-# INLINE papp1T #-}                      
-                      
+{-# INLINE papp1T #-}
+
 papp1R :: Monad m => Rewrite FlatCtx m (ExprTempl l e) -> Rewrite FlatCtx m (ExprTempl l e)
 papp1R t = papp1T t PApp1
-{-# INLINE papp1R #-}                      
+{-# INLINE papp1R #-}
 
 papp2T :: Monad m => Transform FlatCtx m (ExprTempl l e) a1
                   -> Transform FlatCtx m (ExprTempl l e) a2
@@ -224,11 +211,11 @@
 papp2T t1 t2 f = transform $ \c expr -> case expr of
                      PApp2 ty p l e1 e2 -> f ty p l <$> applyT t1 (c@@PApp2Arg1) e1 <*> applyT t2 (c@@PApp2Arg2) e2
                      _                  -> fail "not a binary primitive application"
-{-# INLINE papp2T #-}                      
+{-# INLINE papp2T #-}
 
 papp2R :: Monad m => Rewrite FlatCtx m (ExprTempl l e) -> Rewrite FlatCtx m (ExprTempl l e) -> Rewrite FlatCtx m (ExprTempl l e)
 papp2R t1 t2 = papp2T t1 t2 PApp2
-{-# INLINE papp2R #-}                      
+{-# INLINE papp2R #-}
 
 papp3T :: Monad m => Transform FlatCtx m (ExprTempl l e) a1
                   -> Transform FlatCtx m (ExprTempl l e) a2
@@ -237,43 +224,43 @@
                   -> Transform FlatCtx m (ExprTempl l e) b
 papp3T t1 t2 t3 f = transform $ \c expr -> case expr of
                      PApp3 ty p l e1 e2 e3 -> f ty p l
-                                              <$> applyT t1 (c@@PApp3Arg1) e1 
+                                              <$> applyT t1 (c@@PApp3Arg1) e1
                                               <*> applyT t2 (c@@PApp3Arg2) e2
                                               <*> applyT t3 (c@@PApp3Arg3) e3
                      _                     -> fail "not a ternary primitive application"
-{-# INLINE papp3T #-}                      
+{-# INLINE papp3T #-}
 
-papp3R :: Monad m 
-       => Rewrite FlatCtx m (ExprTempl l e) 
-       -> Rewrite FlatCtx m (ExprTempl l e) 
-       -> Rewrite FlatCtx m (ExprTempl l e) 
+papp3R :: Monad m
+       => Rewrite FlatCtx m (ExprTempl l e)
        -> Rewrite FlatCtx m (ExprTempl l e)
+       -> Rewrite FlatCtx m (ExprTempl l e)
+       -> Rewrite FlatCtx m (ExprTempl l e)
 papp3R t1 t2 t3 = papp3T t1 t2 t3 PApp3
-{-# INLINE papp3R #-}                      
+{-# INLINE papp3R #-}
 
 constExprT :: Monad m => (Type -> Val -> b) -> Transform FlatCtx m (ExprTempl l e) b
 constExprT f = contextfreeT $ \expr -> case expr of
                     Const ty v -> return $ f ty v
                     _          -> fail "not a constant"
-{-# INLINE constExprT #-}                      
-                    
+{-# INLINE constExprT #-}
+
 constExprR :: Monad m => Rewrite FlatCtx m (ExprTempl l e)
 constExprR = constExprT Const
-{-# INLINE constExprR #-}                      
+{-# INLINE constExprR #-}
 
 letT :: Monad m => Transform FlatCtx m (ExprTempl l e) a1
                 -> Transform FlatCtx m (ExprTempl l e) a2
-                -> (Type -> Ident -> a1 -> a2 -> b) 
+                -> (Type -> Ident -> a1 -> a2 -> b)
                 -> Transform FlatCtx m (ExprTempl l e) b
 letT t1 t2 f = transform $ \c expr -> case expr of
-                 Let ty x xs e -> f ty x <$> applyT t1 (c@@LetBind) xs 
+                 Let ty x xs e -> f ty x <$> applyT t1 (c@@LetBind) xs
                                          <*> applyT t2 (bindVar x $ c@@LetBody) e
                  _             -> fail "not a let expression"
 {-# INLINE letT #-}
 
-letR :: Monad m => Rewrite FlatCtx m (ExprTempl l e) 
-                -> Rewrite FlatCtx m (ExprTempl l e) 
+letR :: Monad m => Rewrite FlatCtx m (ExprTempl l e)
                 -> Rewrite FlatCtx m (ExprTempl l e)
+                -> Rewrite FlatCtx m (ExprTempl l e)
 letR r1 r2 = letT r1 r2 Let
 {-# INLINE letR #-}
 
@@ -302,7 +289,7 @@
                 -> (a -> b)
                 -> Transform FlatCtx m (ExprTempl l e) b
 extT t f = transform $ \c expr -> case expr of
-    Ext e -> f <$> applyT t (c@@ExtExpr) e                  
+    Ext e -> f <$> applyT t (c@@ExtExpr) e
     _     -> fail "not an extension mode"
 {-# INLINE extT #-}
 
@@ -317,27 +304,27 @@
                    -> (Nat -> Type -> a -> b)
                    -> Transform FlatCtx m ShapeExt b
 forgetT t f = transform $ \c expr -> case expr of
-                        Forget n ty e -> f n ty <$> applyT t (c@@ForgetArg) e                  
+                        Forget n ty e -> f n ty <$> applyT t (c@@ForgetArg) e
                         _             -> fail "not a forget application"
-{-# INLINE forgetT #-}                      
-                      
-forgetR :: Monad m => Rewrite FlatCtx m FExpr -> Rewrite FlatCtx m ShapeExt 
+{-# INLINE forgetT #-}
+
+forgetR :: Monad m => Rewrite FlatCtx m FExpr -> Rewrite FlatCtx m ShapeExt
 forgetR t = forgetT t Forget
-{-# INLINE forgetR #-}                      
+{-# INLINE forgetR #-}
 
 imprintT :: Monad m => Transform FlatCtx m FExpr a1
                     -> Transform FlatCtx m FExpr a2
                     -> (Nat -> Type -> a1 -> a2 -> b)
                     -> Transform FlatCtx m ShapeExt b
 imprintT t1 t2 f = transform $ \c expr -> case expr of
-                     Imprint n ty e1 e2 -> f n ty <$> applyT t1 (c@@ImprintArg1) e1 
+                     Imprint n ty e1 e2 -> f n ty <$> applyT t1 (c@@ImprintArg1) e1
                                                   <*> applyT t2 (c@@ImprintArg2) e2
                      _                  -> fail "not a imprint call"
-{-# INLINE imprintT #-}                      
+{-# INLINE imprintT #-}
 
-imprintR :: Monad m => Rewrite FlatCtx m FExpr -> Rewrite FlatCtx m FExpr -> Rewrite FlatCtx m ShapeExt 
+imprintR :: Monad m => Rewrite FlatCtx m FExpr -> Rewrite FlatCtx m FExpr -> Rewrite FlatCtx m ShapeExt
 imprintR t1 t2 = imprintT t1 t2 Imprint
-{-# INLINE imprintR #-}                      
+{-# INLINE imprintR #-}
 
 --------------------------------------------------------------------------------
 
@@ -350,8 +337,8 @@
                                    <*> applyT t2 (c@@BroadcastArg2) e2
 {-# INLINE broadcastT #-}
 
-broadcastR :: Monad m => Rewrite FlatCtx m LExpr 
-                      -> Rewrite FlatCtx m LExpr 
+broadcastR :: Monad m => Rewrite FlatCtx m LExpr
+                      -> Rewrite FlatCtx m LExpr
                       -> Rewrite FlatCtx m BroadcastExt
 broadcastR r1 r2 = broadcastT r1 r2 Broadcast
 {-# INLINE broadcastR #-}
@@ -390,12 +377,12 @@
 
     project (ExtFKL s) = Just s
     project _          = Nothing
-   
 
+
 --------------------------------------------------------------------------------
 
 instance Walker FlatCtx (FKL Lifted ShapeExt) where
-    allR r = 
+    allR r =
         rewrite $ \c fkl -> case fkl of
             ExprFKL expr -> inject <$> applyT (allRExpr r) c expr
             ExtFKL o     -> inject <$> applyT allRShape c o
@@ -406,7 +393,7 @@
                 Forget{}  -> forgetR (extractR r)
 
 instance Walker FlatCtx (FKL LiftedN BroadcastExt) where
-    allR r = 
+    allR r =
         rewrite $ \c fkl -> case fkl of
             ExprFKL expr -> inject <$> applyT (allRExpr r) c expr
             ExtFKL o     -> inject <$> applyT allRBC c o
@@ -431,16 +418,3 @@
         Var{}         -> idR
         MkTuple{}     -> mkTupleR (extractR r)
         Ext{}         -> extR (extractR r)
-
-
---------------------------------------------------------------------------------
--- I find it annoying that Applicative is not a superclass of Monad.
-
-(<$>) :: Monad m => (a -> b) -> m a -> m b
-(<$>) = liftM
-{-# INLINE (<$>) #-}
-
-(<*>) :: Monad m => m (a -> b) -> m a -> m b
-(<*>) = ap
-{-# INLINE (<*>) #-}
-
diff --git a/src/Database/DSH/FKL/Lang.hs b/src/Database/DSH/FKL/Lang.hs
--- a/src/Database/DSH/FKL/Lang.hs
+++ b/src/Database/DSH/FKL/Lang.hs
@@ -4,10 +4,11 @@
 
 module Database.DSH.FKL.Lang where
 
+import           Prelude hiding ((<$>))
 import           Text.PrettyPrint.ANSI.Leijen
 import           Text.Printf
 
-import           Database.DSH.Impossible
+import           Database.DSH.Common.Impossible
 import           Database.DSH.Common.Pretty
 import           Database.DSH.Common.Nat
 import qualified Database.DSH.Common.Lang   as L
@@ -23,7 +24,7 @@
 data Lifted = Lifted | NotLifted deriving (Show)
 
 -- | 'FExpr' is the target language of the flattening transformation.
-data ExprTempl l e = Table Type String [L.Column] L.TableHints
+data ExprTempl l e = Table Type String L.BaseTableSchema
                    | PApp1 Type Prim1 l (ExprTempl l e)
                    | PApp2 Type Prim2 l (ExprTempl l e) (ExprTempl l e)
                    | PApp3 Type Prim3 l (ExprTempl l e) (ExprTempl l e) (ExprTempl l e)
@@ -57,25 +58,19 @@
            | Avg
            | Minimum
            | Maximum
-           | The
-           | Tail
            | Reverse
            | And
            | Or
-           | Init
-           | Last
            | Nub
            | Number
+           | Sort
+           | Restrict
+           | Group
            | Singleton
-           | Transpose
-           | Reshape Integer
+           | Only
     deriving (Show, Eq)
 
-data Prim2 = Group
-           | Sort
-           | Restrict
-           | Append
-           | Index
+data Prim2 = Append
            | Zip
            | CartProduct
            | NestProduct
@@ -86,13 +81,26 @@
            | Dist
            deriving (Show, Eq)
 
+isJoinOp :: Prim2 -> Bool
+isJoinOp op =
+    case op of
+        CartProduct -> True
+        NestProduct -> True
+        ThetaJoin{} -> True
+        NestJoin{}  -> True
+        SemiJoin{}  -> True
+        AntiJoin{}  -> True
+        Append      -> False
+        Zip         -> False
+        Dist        -> False
+
 data Prim3 = Combine
     deriving (Show, Eq)
 
 instance Typed e => Typed (ExprTempl l e) where
     typeOf (Var t _)           = t
     typeOf (Let t _ _ _)       = t
-    typeOf (Table t _ _ _)     = t
+    typeOf (Table t _ _)       = t
     typeOf (PApp1 t _ _ _)     = t
     typeOf (PApp2 t _ _ _ _)   = t
     typeOf (PApp3 t _ _ _ _ _) = t
@@ -114,85 +122,91 @@
 -- Pretty-printing of FKL dialects
 
 superscript :: Int -> Doc
+superscript 0 = char '⁰'
 superscript 1 = char '¹'
 superscript 2 = char '²'
 superscript 3 = char '³'
 superscript 4 = char '⁴'
 superscript 5 = char '⁵'
 superscript 6 = char '⁶'
+superscript 7 = char '⁷'
+superscript 8 = char '⁸'
 superscript n = char '^' <> int n
 
+subscript :: Int -> Doc
+subscript 1 = char '₁'
+subscript 2 = char '₂'
+subscript 3 = char '₃'
+subscript 4 = char '₄'
+subscript 5 = char '₅'
+subscript 6 = char '₆'
+subscript 7 = char '₇'
+subscript 8 = char '₈'
+subscript n = char '_' <> int n
+
 instance Pretty Lifted where
-    pretty Lifted    = text "ᴸ"
-    pretty NotLifted = empty
+    pretty Lifted    = super $ text "¹"
+    pretty NotLifted = super $ text "⁰"
 
 instance Pretty LiftedN where
-    pretty (LiftedN Zero) = empty
-    pretty (LiftedN n)    = superscript (intFromNat n)
+    pretty (LiftedN n)    = super $ superscript (intFromNat n)
 
 instance Pretty Prim1 where
-    pretty Length       = text "length"
-    pretty Concat       = text "concat"
-    pretty Sum          = text "sum"
-    pretty Avg          = text "avg"
-    pretty The          = text "the"
-    pretty Minimum      = text "minimum"
-    pretty Maximum      = text "maximum"
-    pretty Tail         = text "tail"
-    pretty Reverse      = text "reverse"
-    pretty And          = text "and"
-    pretty Or           = text "or"
-    pretty Init         = text "init"
-    pretty Last         = text "last"
-    pretty Nub          = text "nub"
-    pretty Number       = text "number"
-    pretty Transpose    = text "transpose"
-    pretty (Reshape n)  = text $ printf "reshape(%d)" n
-    pretty Singleton    = text "sng"
+    pretty Length       = combinator $ text "length"
+    pretty Concat       = combinator $ text "concat"
+    pretty Sum          = combinator $ text "sum"
+    pretty Avg          = combinator $ text "avg"
+    pretty Minimum      = combinator $ text "minimum"
+    pretty Maximum      = combinator $ text "maximum"
+    pretty Reverse      = combinator $ text "reverse"
+    pretty And          = combinator $ text "and"
+    pretty Or           = combinator $ text "or"
+    pretty Nub          = combinator $ text "nub"
+    pretty Number       = combinator $ text "number"
+    pretty Sort         = combinator $ text "sort"
+    pretty Restrict     = restrict $ text "restrict"
+    pretty Group        = combinator $ text "group"
+    pretty Singleton    = combinator $ text "sng"
+    pretty Only         = combinator $ text "only"
     pretty TupElem{}    = $impossible
 
 instance Pretty Prim2 where
-    pretty Group           = text "group"
-    pretty Sort            = text "sort"
-    pretty Dist            = text "dist"
-    pretty Restrict        = text "restrict"
-    pretty Append          = text "append"
-    pretty Index           = text "index"
-    pretty Zip             = text "zip"
-    pretty CartProduct     = text "⨯"
-    pretty NestProduct     = text "▽"
-    pretty (ThetaJoin p)   = text $ printf "⨝_%s" (pp p)
-    pretty (NestJoin p)    = text $ printf "△_%s" (pp p)
-    pretty (SemiJoin p)    = text $ printf "⋉_%s" (pp p)
-    pretty (AntiJoin p)    = text $ printf "▷_%s" (pp p)
+    pretty Dist            = dist $ text "dist"
+    pretty Append          = combinator $ text "append"
+    pretty Zip             = combinator $ text "zip"
+    pretty CartProduct     = join $ text "cartproduct"
+    pretty NestProduct     = join $ text "nestproduct"
+    pretty (ThetaJoin p)   = join $ text $ printf "thetajoin{%s}" (pp p)
+    pretty (NestJoin p)    = join $ text $ printf "nestjoin{%s}" (pp p)
+    pretty (SemiJoin p)    = join $ text $ printf "semijoin{%s}" (pp p)
+    pretty (AntiJoin p)    = join $ text $ printf "antijoin{%s}" (pp p)
 
 instance Pretty Prim3 where
-    pretty Combine = text "combine"
+    pretty Combine = combinator $ text "combine"
 
 instance (Pretty l, Pretty e) => Pretty (ExprTempl l e) where
-    pretty (MkTuple _ l es) = (tupled $ map pretty es) <> pretty l
-
+    pretty (MkTuple _ l es) = (prettyTuple $ map pretty es) <> pretty l
     pretty (Var _ n) = text n
-    pretty (Let _ x e1 e) = 
-        align $ text "let" <+> text x {- <> colon <> colon <> pretty (typeOf e1) -} <+> char '=' <+> pretty e1
-                <$>
-                text "in" <+> pretty e
-
-    pretty (Table _ n _c _k) = text "table" <> parens (text n)
-
-    pretty (PApp1 _ (TupElem n) l e1) = 
+    pretty (Let _ x e1 e) = prettyLet (text x) (pretty e1) (pretty e)
+    pretty (Table _ n _) = kw (text "table") <> parens (text n)
+    pretty (PApp1 _ (TupElem n) l e1) =
         parenthize e1 <> dot <> int (tupleIndex n) <> pretty l
 
     pretty (PApp1 _ f l e1) =
-        pretty f <> pretty l <+> (parenthize e1)
+        pretty f <> pretty l <+> parenthize e1
 
-    pretty (PApp2 _ f l e1 e2) =
-        pretty f <> pretty l <+> (align $ (parenthize e1) </> (parenthize e2))
+    pretty (PApp2 _ p2 l e1 e2)
+        | isJoinOp p2 = prettyJoin (pretty p2 <> pretty l)
+                                   (parenthize e1)
+                                   (parenthize e2)
+        | otherwise   = prettyApp2 (pretty p2 <> pretty l)
+                                   (parenthize e1)
+                                   (parenthize e2)
 
     pretty (PApp3 _ f l e1 e2 e3) =
         pretty f <> pretty l
-        <+> (align $ (parenthize e1) 
-                     </> (parenthize e2) 
+        <+> (align $ (parenthize e1)
+                     </> (parenthize e2)
                      </> (parenthize e3))
     pretty (If _ e1 e2 e3) =
         let e1' = pretty e1
@@ -202,34 +216,36 @@
            </> (nest 2 $ text "then" <+> e2')
            </> (nest 2 $ text "else" <+> e3')
 
-    pretty (BinOp _ o l e1 e2) =
-        align $ parenthize e1 </> pretty o <> pretty l </> parenthize e2
+    pretty (BinOp _ o l e1 e2)
+        | L.isBinInfixOp o = prettyInfixBinOp (pretty o <> pretty l)
+                                              (parenthize e1)
+                                              (parenthize e2)
+        | otherwise        = prettyPrefixBinOp (pretty o <> pretty l)
+                                               (parenthize e1)
+                                               (parenthize e2)
 
-    pretty (UnOp _ o l e) =
-        pretty o <> pretty l <> parens (pretty e)
+    pretty (UnOp _ o l e) = prettyUnOp (pretty o <> pretty l) (pretty e)
 
     pretty (Const _ v) = pretty v
 
     pretty (Ext o) = pretty o
 
 instance Pretty ShapeExt where
-    pretty (Forget n _ e) = 
-        text "forget" 
-        <> (angles $ int $ intFromNat n)
+    pretty (Forget n _ e) =
+        forget (text "forget")
+        <> (forget $ subscript $ intFromNat n)
         <+> (parenthize e)
 
-    pretty (Imprint n _ e1 e2) = 
-        text "imprint" 
-        <> (angles $ int $ intFromNat n) 
-        <+> (align $ (parenthize e1) 
-                     </> (parenthize e2))
-    
+    pretty (Imprint n _ e1 e2) =
+        prettyApp2 (forget (text "imprint") <> (forget $ subscript $ intFromNat n))
+                   (parenthize e1)
+                   (parenthize e2)
+
 instance Pretty BroadcastExt where
-    pretty (Broadcast n _ e1 e2) = 
-        text "forget" 
-        <> (angles $ int $ intFromNat n)
-        <+> (align $ (parenthize e1)
-                     </> (parenthize e2))
+    pretty (Broadcast n _ e1 e2) =
+        prettyApp2 (forget (text "broadcast") <> (forget $ subscript $ intFromNat n))
+                   (parenthize e1)
+                   (parenthize e2)
 
 parenthize :: (Pretty l, Pretty e) => ExprTempl l e -> Doc
 parenthize e =
diff --git a/src/Database/DSH/FKL/Primitives.hs b/src/Database/DSH/FKL/Primitives.hs
--- a/src/Database/DSH/FKL/Primitives.hs
+++ b/src/Database/DSH/FKL/Primitives.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE PatternSynonyms #-}
 
 -- | Smart constructors for FKL functions and operators
 module Database.DSH.FKL.Primitives where
@@ -12,42 +13,32 @@
 import           Database.DSH.Common.Pretty
 import           Database.DSH.Common.Type
 import           Database.DSH.FKL.Lang
-import           Database.DSH.Impossible
+import           Database.DSH.Common.Impossible
 
 --------------------------------------------------------------------------------
 -- Smart constructors for primitive combinators in the lifting FKL dialect
 
--- tranpose :: [[a]] -> [[a]]
-transpose :: LExpr -> Nat -> LExpr
-transpose e d =
-    let t = unliftTypeN d $ typeOf e
-    in PApp1 (liftTypeN d t) Transpose (LiftedN d) e
-
--- transpose :: [a] -> [[a]]
-reshape :: Integer -> LExpr -> Nat -> LExpr
-reshape n e d =
-    let t = unliftTypeN d $ typeOf e
-    in PApp1 (liftTypeN d $ ListT t) (Reshape n) (LiftedN d) e
-
--- group :: [a] -> [b] -> [(b, [a])]
-group :: LExpr -> LExpr -> Nat -> LExpr
-group xs gs d =
-    let ListT xt = unliftTypeN d $ typeOf xs
-        ListT gt = unliftTypeN d $ typeOf gs
-        rt             = listT (pairT gt (listT xt))
-    in PApp2 (liftTypeN d rt) Group (LiftedN d) xs gs
+group :: LExpr -> Nat -> LExpr
+group xs d =
+    let ListT (TupleT [xt, gt]) = unliftTypeN d $ typeOf xs
+        rt                      = ListT (PPairT gt (ListT xt))
+    in PApp1 (liftTypeN d rt) Group (LiftedN d) xs
 
--- sort :: [a] -> [b] -> [a]
-sort :: LExpr -> LExpr -> Nat -> LExpr
-sort xs ss d =
-    let xst = unliftTypeN d $ typeOf xs
-    in PApp2 (liftTypeN d xst) Sort (LiftedN d) xs ss
+sort :: LExpr -> Nat -> LExpr
+sort xs d =
+    let ListT (TupleT [xt, _]) = unliftTypeN d $ typeOf xs
+    in PApp1 (liftTypeN d (ListT xt)) Sort (LiftedN d) xs
 
 sng :: LExpr -> Nat -> LExpr
 sng e d =
     let t = unliftTypeN d $ typeOf e
     in PApp1 (liftTypeN d t) Singleton (LiftedN d) e
 
+only :: LExpr -> Nat -> LExpr
+only e1 d =
+    let ListT t1 = unliftTypeN d $ typeOf e1
+    in PApp1 (liftTypeN d t1) Only (LiftedN d) e1
+
 tuple :: [LExpr] -> Nat -> LExpr
 tuple es d =
     let ts = map (unliftTypeN d . typeOf) es
@@ -59,33 +50,33 @@
 zip xs ys d =
     let ListT xt = unliftTypeN d $ typeOf xs
         ListT yt = unliftTypeN d $ typeOf ys
-    in PApp2 (liftTypeN d $ listT (pairT xt yt)) Zip (LiftedN d) xs ys
+    in PApp2 (liftTypeN d $ ListT (PPairT xt yt)) Zip (LiftedN d) xs ys
 
 cartProduct :: LExpr -> LExpr -> Nat -> LExpr
 cartProduct xs ys d =
     let ListT xt = unliftTypeN d $ typeOf xs
         ListT yt = typeOf ys
-    in PApp2 (liftTypeN d $ listT (pairT xt yt)) CartProduct (LiftedN d) xs ys
+    in PApp2 (liftTypeN d $ ListT (PPairT xt yt)) CartProduct (LiftedN d) xs ys
 
 -- nestProduct :: [a] -> [b] -> [(a, [(a, b)])]
 nestProduct :: LExpr -> LExpr -> Nat -> LExpr
 nestProduct xs ys d =
     let ListT xt = unliftTypeN d $ typeOf xs
         ListT yt = unliftTypeN d $ typeOf ys
-        rt       = listT (pairT xt (listT (pairT xt yt)))
+        rt       = ListT (PPairT xt (ListT (PPairT xt yt)))
     in PApp2 (liftTypeN d rt) NestProduct (LiftedN d) xs ys
 
 thetaJoin :: JoinPredicate JoinExpr  -> LExpr -> LExpr -> Nat -> LExpr
 thetaJoin p xs ys d =
     let ListT xt = unliftTypeN d $ typeOf xs
         ListT yt = unliftTypeN d $ typeOf ys
-    in PApp2 (liftTypeN d $ listT (pairT xt yt)) (ThetaJoin p) (LiftedN d) xs ys
+    in PApp2 (liftTypeN d $ ListT (PPairT xt yt)) (ThetaJoin p) (LiftedN d) xs ys
 
 nestJoin :: JoinPredicate JoinExpr  -> LExpr -> LExpr -> Nat -> LExpr
 nestJoin p xs ys d =
     let ListT xt = unliftTypeN d $ typeOf xs
         ListT yt = unliftTypeN d $ typeOf ys
-        rt       = listT (pairT xt (listT (pairT xt yt)))
+        rt       = ListT (PPairT xt (ListT (PPairT xt yt)))
     in PApp2 (liftTypeN d rt) (NestJoin p) (LiftedN d) xs ys
 
 semiJoin :: JoinPredicate JoinExpr  -> LExpr -> LExpr -> Nat -> LExpr
@@ -103,33 +94,8 @@
     let t1 = unliftTypeN d $ typeOf e1
     in PApp2 (liftTypeN d t1) Append (LiftedN d) e1 e2
 
-index :: LExpr -> LExpr -> Nat -> LExpr
-index e1 e2 d =
-    let ListT t = unliftTypeN d $ typeOf e1
-    in PApp2 (liftTypeN d t) Index (LiftedN d) e1 e2
-
 length :: LExpr -> Nat -> LExpr
-length e1 d = PApp1 (liftTypeN d intT) Length (LiftedN d) e1
-
--- FIXME this is not the right place to perform this step. If at all,
--- do it during compilation to VL.
-head :: LExpr -> Nat -> LExpr
-head = the
-
-the :: LExpr -> Nat -> LExpr
-the e1 d =
-    let ListT t1 = unliftTypeN d $ typeOf e1
-    in PApp1 (liftTypeN d t1) The (LiftedN d) e1
-
-last :: LExpr -> Nat -> LExpr
-last e1 d =
-    let ListT t1 = unliftTypeN d $ typeOf e1
-    in PApp1 (liftTypeN d t1) Last (LiftedN d) e1
-
-tail :: LExpr -> Nat -> LExpr
-tail e1 d =
-    let t1@(ListT _) = unliftTypeN d $ typeOf e1
-    in PApp1 (liftTypeN d t1) Tail (LiftedN d) e1
+length e1 d = PApp1 (liftTypeN d PIntT) Length (LiftedN d) e1
 
 nub :: LExpr -> Nat -> LExpr
 nub e1 d =
@@ -139,24 +105,19 @@
 number :: LExpr -> Nat -> LExpr
 number e1 d =
     let ListT t = unliftTypeN d $ typeOf e1
-        rt      = (ListT (pairT t IntT ))
+        rt      = (ListT (PPairT t PIntT ))
     in PApp1 (liftTypeN d rt) Number (LiftedN d) e1
 
-init :: LExpr -> Nat -> LExpr
-init e1 d =
-    let t1@(ListT _) = unliftTypeN d $ typeOf e1
-    in PApp1 (liftTypeN d t1) Init (LiftedN d) e1
-
 reverse :: LExpr -> Nat -> LExpr
 reverse e1 d =
     let t1@(ListT _) = unliftTypeN d $ typeOf e1
     in PApp1 (liftTypeN d t1) Reverse (LiftedN d) e1
 
 and :: LExpr -> Nat -> LExpr
-and e1 d = PApp1 (liftTypeN d BoolT) And (LiftedN d) e1
+and e1 d = PApp1 (liftTypeN d PBoolT) And (LiftedN d) e1
 
 or :: LExpr -> Nat -> LExpr
-or e1 d = PApp1 (liftTypeN d BoolT) Or (LiftedN d) e1
+or e1 d = PApp1 (liftTypeN d PBoolT) Or (LiftedN d) e1
 
 sum :: LExpr -> Nat -> LExpr
 sum e1 d =
@@ -164,7 +125,10 @@
     in PApp1 (liftTypeN d t) Sum (LiftedN d) e1
 
 avg :: LExpr -> Nat -> LExpr
-avg e1 d = PApp1 (liftTypeN d DoubleT) Avg (LiftedN d) e1
+avg e1 d = case unliftTypeN d $ typeOf e1 of
+               ListT PDoubleT  -> PApp1 (liftTypeN d PDoubleT) Avg (LiftedN d) e1
+               ListT PDecimalT -> PApp1 (liftTypeN d PDecimalT) Avg (LiftedN d) e1
+               _              -> $impossible
 
 minimum :: LExpr -> Nat -> LExpr
 minimum e1 d =
@@ -184,12 +148,12 @@
 dist :: LExpr -> LExpr -> Nat -> LExpr
 dist e1 e2 d =
     let t1 = typeOf e1
-    in PApp2 (listT t1) Dist (LiftedN d) e1 e2
+    in PApp2 (ListT t1) Dist (LiftedN d) e1 e2
 
-restrict :: LExpr -> LExpr -> Nat -> LExpr
-restrict xs bs d =
-    let xst = unliftTypeN d $ typeOf xs
-    in PApp2 (liftTypeN d xst) Restrict (LiftedN d) xs bs
+restrict :: LExpr -> Nat -> LExpr
+restrict xs d =
+    let ListT (TupleT [xt, PBoolT]) = unliftTypeN d $ typeOf xs
+    in PApp1 (liftTypeN d (ListT xt)) Restrict (LiftedN d) xs
 
 -- combine :: [Bool] -> [a] -> [a] -> [a]
 combine :: LExpr -> LExpr -> LExpr -> Nat -> LExpr
@@ -198,13 +162,13 @@
     in PApp3 (liftTypeN d xst) Combine (LiftedN d) e1 e2 e3
 
 tupElem :: TupleIndex -> LExpr -> Nat -> LExpr
-tupElem f e d = 
+tupElem f e d =
     let t = tupleElemT (unliftTypeN d $ typeOf e) f
     in PApp1 (liftTypeN d t) (TupElem f) (LiftedN d) e
 
 if_ :: Typed e => ExprTempl l e -> ExprTempl l e -> ExprTempl l e -> ExprTempl l e
 if_ eb et ee =
-    let (BoolT, tt, te) = (typeOf eb, typeOf et, typeOf ee)
+    let (PBoolT, tt, te) = (typeOf eb, typeOf et, typeOf ee)
     in if tt == te
        then If tt eb et ee
        else error $ printf "FKL.if: incompatible types: %s %s" (pp tt) (pp te)
@@ -243,11 +207,11 @@
 
 wrapListType :: Nat -> Type -> Type
 wrapListType Zero t     = t
-wrapListType (Succ n') t = wrapListType n' (listT t)
+wrapListType (Succ n') t = wrapListType n' (ListT t)
 
 -- | A regular single 'dist' in the normalized FKL dialect
 fdist :: FExpr -> FExpr -> FExpr
-fdist e1 e2 = PApp2 (listT $ typeOf e1) Dist NotLifted e1 e2
+fdist e1 e2 = PApp2 (ListT $ typeOf e1) Dist NotLifted e1 e2
 
 --------------------------------------------------------------------------------
 -- Smart constructors for special forms in the flat FKL dialect
diff --git a/src/Database/DSH/FKL/Rewrite.hs b/src/Database/DSH/FKL/Rewrite.hs
--- a/src/Database/DSH/FKL/Rewrite.hs
+++ b/src/Database/DSH/FKL/Rewrite.hs
@@ -1,21 +1,29 @@
-{-# LANGUAGE FlexibleContexts    #-}
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE PatternSynonyms       #-}
 
 module Database.DSH.FKL.Rewrite
     ( optimizeFKL
+    , optimizeNormFKL
     ) where
 
-import Data.Monoid
-import Data.List
-import Control.Arrow
 
-import Database.DSH.Common.RewriteM
-import Database.DSH.Common.Lang
-import Database.DSH.Common.Type
-import Database.DSH.Common.Kure
-import Database.DSH.Common.Pretty
-import Database.DSH.FKL.Lang
-import Database.DSH.FKL.Kure
 
+import           Control.Arrow
+import           Data.List
+import           Data.Monoid
+
+
+import           Database.DSH.Common.Lang
+import           Database.DSH.Common.Nat
+
+import           Database.DSH.Common.RewriteM
+import           Database.DSH.Common.Type
+import           Database.DSH.FKL.Kure
+import           Database.DSH.FKL.Lang
+
+import qualified Database.DSH.FKL.Primitives  as P
+
 -- | Run a translate on an expression without context
 applyExpr :: (Injection (ExprTempl l e) (FKL l e))
           => TransformF (FKL l e) b -> ExprTempl l e -> Either String b
@@ -24,10 +32,10 @@
 --------------------------------------------------------------------------------
 -- Computation of free and bound variables
 
-freeVarsT :: (Injection (ExprTempl l e) (FKL l e), Walker FlatCtx (FKL l e)) 
+freeVarsT :: (Injection (ExprTempl l e) (FKL l e), Walker FlatCtx (FKL l e))
           => TransformF (FKL l e) [Ident]
-freeVarsT = fmap nub 
-            $ crushbuT 
+freeVarsT = fmap nub
+            $ crushbuT
             $ do (ctx, ExprFKL (Var _ v)) <- exposeT
                  guardM (v `freeIn` ctx)
                  return [v]
@@ -66,8 +74,8 @@
         else anyR $ substR v s
 
     -- A let binding which shadows v -> don't descend into the body
-    ExprFKL (Let _ x _ _) | v == x                      -> tryR $ childR LetBind (substR v s)
-    _                                                   -> anyR $ substR v s
+    ExprFKL (Let _ x _ _) | v == x -> tryR $ childR LetBind (substR v s)
+    _                              -> anyR $ substR v s
 
 --------------------------------------------------------------------------------
 -- Simple optimizations
@@ -89,7 +97,7 @@
 
 
 -- | Remove a let-binding that is not referenced.
-unusedBindingR :: (Injection (ExprTempl l e) (FKL l e), Walker FlatCtx (FKL l e)) 
+unusedBindingR :: (Injection (ExprTempl l e) (FKL l e), Walker FlatCtx (FKL l e))
                => RewriteF (FKL l e)
 unusedBindingR = do
     ExprFKL (Let _ x _ e2) <- idR
@@ -98,7 +106,10 @@
 
 
 -- | Inline a let-binding that is only referenced once.
-referencedOnceR :: (Injection (ExprTempl l e) (FKL l e), Walker FlatCtx (FKL l e), Typed e)
+referencedOnceR :: ( Injection (ExprTempl l e) (FKL l e)
+                   , Walker FlatCtx (FKL l e)
+                   , Typed e
+                   )
                 => RewriteF (FKL l e)
 referencedOnceR = do
     ExprFKL (Let _ x e1 _) <- idR
@@ -112,24 +123,130 @@
 simpleExpr _                         = False
 
 -- | Inline a let-binding that binds a simple expression.
-simpleBindingR :: (Injection (ExprTempl l e) (FKL l e), Walker FlatCtx (FKL l e), Typed e)
+simpleBindingR :: ( Injection (ExprTempl l e) (FKL l e)
+                  , Walker FlatCtx (FKL l e)
+                  , Typed e
+                  )
                => RewriteF (FKL l e)
 simpleBindingR = do
     ExprFKL (Let _ x e1 _) <- idR
     guardM $ simpleExpr e1
     childT LetBody $ substR x e1
 
-fklOptimizations :: (Injection (ExprTempl l e) (FKL l e), Walker FlatCtx (FKL l e), Typed e)
+--------------------------------------------------------------------------------
+-- Rewrites that remove redundant combinations of shape operators
+-- (forget and imprint)
+
+pattern ImprintP d e1 e2 <- Ext (Imprint d _ e1 e2)
+pattern ForgetP d e <- Ext (Forget d _ e)
+
+-- | Remove nested occurences of 'imprint':
+--
+-- imprint_d (imprint_d e1 _) e2
+-- =>
+-- imprint_d e1 e2
+--
+-- The reasoning is simple: The inner 'imprint' attaches the outer 'd'
+-- layers of 'e1' onto 'e2'. The outer 'imprint' takes exactly these
+-- 'd' outer layers and attaches it to 'e2'. Therefore, we can use the
+-- outer 'd' layers of 'e1' directly without the inner 'imprint'.
+nestedimprintR :: RewriteF (FKL Lifted ShapeExt)
+nestedimprintR = do
+    ExprFKL (ImprintP d (ImprintP d' e1 _) e2) <- idR
+    guardM $ d == d'
+    return $ ExprFKL (P.imprint d' e1 e2)
+
+-- | Remove combinations of forget and imprint that cancel each
+-- other out.
+forgetimprintR :: RewriteF (FKL Lifted ShapeExt)
+forgetimprintR = do
+    ExprFKL (ForgetP d (ImprintP d' _ xs)) <- idR
+    guardM $ d == d'
+    return $ ExprFKL xs
+
+-- | If 'forget' removes /strictly more/ nesting than the nested 'imprint' adds,
+-- we can remove the 'imprint' and 'forget' only the difference.
+forgetimprintlargerR :: RewriteF (FKL Lifted ShapeExt)
+forgetimprintlargerR = do
+    ExtFKL (Forget d1 t (Ext (Imprint d2 _ _ xs))) <- idR
+    guardM $ d1 > d2
+    case d1 .- d2 of
+        Just dd -> return $ ExtFKL (Forget dd t xs)
+        Nothing -> fail "depths are not compatible"
+
+-- | If 'forget' removes /strictly less/ nesting than the nested 'imprint'
+-- adds, we can not remove one of the shape combinators. However, we
+-- can decrease the depth of shape operations. 'imprint' adds the 'd2'
+-- outer layers of 'e1' to 'e2'. Of those 'd2' outer layers, 'forget'
+-- removes the outermost 'd1' (which are less than 'd2'). Effectively,
+-- only the vectors 'd1' to 'd2' of 'e1' are added to
+-- 'e2'. Consequentially, we can apply 'forget' first and only
+-- 'imprint' the inner vectors.
+--
+-- forget_d1 (imprint_d2 e1 e2)
+-- =>
+-- imprint_(d_2 - d_1) (forget_d1 e1) e2
+--
+-- This rewrite does not immediately lead to a reduction of term
+-- size. However, it decreases the depth of vectors that are
+-- applied/forgotten. That might be a good thing on its own (but
+-- propably irrelevant, because shape operations crucially do not have
+-- runtime cost). Additionally, it can expose other rewrite
+-- opportunities. This is very true e.g. in query 'expectedRevenueFor'
+-- (dsh-tpch-other).
+forgetimprintsmallerR :: RewriteF (FKL Lifted ShapeExt)
+forgetimprintsmallerR = do
+    ExprFKL (ForgetP d1 (ImprintP d2 e1 e2)) <- idR
+    guardM $ d2 > d1
+    case d2 .- d1 of
+        Just dd -> return $ ExprFKL $ P.imprint dd (P.forget d1 e1) e2
+        Nothing -> fail "depths are not compatible"
+
+-- | 'forget'/'imprint' combinations are often obscured by
+-- 'let'-bindings. This rewrite inlines a binding and succeeds if
+-- other rewrites succeed in the resulting term.
+boundforgetimprintR :: RewriteF (FKL Lifted ShapeExt)
+boundforgetimprintR = do
+    ExprFKL (Let _ x e1 _) <- idR
+    childT LetBody (substR x e1 >>> anybuR rewrites)
+
+  where
+    rewrites =    forgetimprintR
+               <+ nestedimprintR
+               <+ forgetimprintlargerR
+               <+ forgetimprintsmallerR
+
+--------------------------------------------------------------------------------
+
+fklOptimizations :: ( Injection (ExprTempl l e) (FKL l e)
+                    , Walker FlatCtx (FKL l e)
+                    , Typed e
+                    )
                  => RewriteF (FKL l e)
-fklOptimizations = anybuR $ unusedBindingR 
+fklOptimizations = anybuR $ unusedBindingR
                             <+ referencedOnceR
                             <+ simpleBindingR
 
-optimizeFKL :: ( Injection (ExprTempl l e) (FKL l e)
-               , Walker FlatCtx (FKL l e)
-               , Typed e, Pretty (ExprTempl l e)
-               ) 
-            => String -> ExprTempl l e -> ExprTempl l e
-optimizeFKL stage expr = debugOpt stage expr expr'
+fklNormOptimizations :: RewriteF (FKL Lifted ShapeExt)
+fklNormOptimizations = repeatR $ anybuR rewrites
   where
-    expr' = applyExpr (fklOptimizations >>> projectT) expr
+    rewrites = unusedBindingR
+               <+ referencedOnceR
+               <+ simpleBindingR
+               <+ forgetimprintR
+               <+ forgetimprintlargerR
+               <+ boundforgetimprintR
+               <+ nestedimprintR
+               <+ forgetimprintsmallerR
+
+optimizeNormFKL :: FExpr -> FExpr
+optimizeNormFKL expr =
+    case applyExpr (fklNormOptimizations >>> projectT) expr of
+        Left _      -> expr
+        Right expr' -> expr'
+
+optimizeFKL :: LExpr -> LExpr
+optimizeFKL expr =
+    case applyExpr (fklOptimizations >>> projectT) expr of
+        Left _      -> expr
+        Right expr' -> expr'
diff --git a/src/Database/DSH/Frontend/Builtins.hs b/src/Database/DSH/Frontend/Builtins.hs
new file mode 100644
--- /dev/null
+++ b/src/Database/DSH/Frontend/Builtins.hs
@@ -0,0 +1,78 @@
+{-# LANGUAGE GADTs           #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+-- | Definition of (typed) DSH builtins
+module Database.DSH.Frontend.Builtins
+    ( Fun(..)
+    , TupElem(..)
+    ) where
+
+import           Data.Decimal
+import           Data.Text                        (Text)
+import           Data.Time.Calendar               (Day)
+
+import           Database.DSH.Frontend.TupleTypes
+
+-- Splice in the type for tuple element accessors
+$(mkTupElemType 16)
+
+data Fun a b where
+    Not              :: Fun Bool Bool
+    IntegerToDouble  :: Fun Integer Double
+    IntegerToDecimal :: Fun Integer Decimal
+    And              :: Fun [Bool] Bool
+    Or               :: Fun [Bool] Bool
+    Concat           :: Fun [[a]] [a]
+    Null             :: Fun [a] Bool
+    Length           :: Fun [a] Integer
+    Only             :: Fun [a] a
+    Guard            :: Fun Bool [()]
+    Reverse          :: Fun [a] [a]
+    Number           :: Fun [a] [(a, Integer)]
+    Fst              :: Fun (a,b) a
+    Snd              :: Fun (a,b) b
+    Sum              :: Fun [a] a
+    Avg              :: Fun [a] a
+    Maximum          :: Fun [a] a
+    Minimum          :: Fun [a] a
+    Nub              :: Fun [a] [a]
+    Append           :: Fun ([a], [a]) [a]
+    Add              :: Fun (a,a) a
+    Mul              :: Fun (a,a) a
+    Sub              :: Fun (a,a) a
+    Div              :: Fun (a,a) a
+    Mod              :: Fun (Integer,Integer) Integer
+    Lt               :: Fun (a,a) Bool
+    Lte              :: Fun (a,a) Bool
+    Equ              :: Fun (a,a) Bool
+    NEq              :: Fun (a,a) Bool
+    Gte              :: Fun (a,a) Bool
+    Gt               :: Fun (a,a) Bool
+    Conj             :: Fun (Bool,Bool) Bool
+    Disj             :: Fun (Bool,Bool) Bool
+    Cons             :: Fun (a,[a]) [a]
+    Zip              :: Fun ([a],[b]) [(a,b)]
+    Map              :: Fun (a -> b,[a]) [b]
+    ConcatMap        :: Fun (a -> [b],[a]) [b]
+    Filter           :: Fun (a -> Bool,[a]) [a]
+    GroupWithKey     :: Fun (a -> b,[a]) [(b, [a])]
+    SortWith         :: Fun (a -> b,[a]) [a]
+    Cond             :: Fun (Bool,a,a) a
+    Like             :: Fun (Text,Text) Bool
+    SubString        :: Integer -> Integer -> Fun Text Text
+    Sin              :: Fun Double Double
+    Cos              :: Fun Double Double
+    Tan              :: Fun Double Double
+    Sqrt             :: Fun Double Double
+    Exp              :: Fun Double Double
+    Log              :: Fun Double Double
+    ASin             :: Fun Double Double
+    ACos             :: Fun Double Double
+    ATan             :: Fun Double Double
+    AddDays          :: Fun (Integer, Day) Day
+    SubDays          :: Fun (Integer, Day) Day
+    DiffDays         :: Fun (Day, Day) Integer
+    DayDay           :: Fun Day Integer
+    DayMonth         :: Fun Day Integer
+    DayYear          :: Fun Day Integer
+    TupElem          :: TupElem a b -> Fun a b
diff --git a/src/Database/DSH/Frontend/Externals.hs b/src/Database/DSH/Frontend/Externals.hs
--- a/src/Database/DSH/Frontend/Externals.hs
+++ b/src/Database/DSH/Frontend/Externals.hs
@@ -6,118 +6,137 @@
 {-# LANGUAGE ViewPatterns          #-}
 
 module Database.DSH.Frontend.Externals where
-       
-import Database.DSH.Frontend.Internals
-import Database.DSH.Frontend.Funs
-import Database.DSH.Impossible
-import Database.DSH.Frontend.TupleTypes
 
-import Prelude ( Eq, Ord, Num(..), Fractional(..), Floating(..)
-               , Bool(..), Char, Integer, Double, Maybe(..), Either(..)
-               , id, ($), (.))
-import qualified Prelude as P
+import           Prelude                          (Bool (..), Char, Double,
+                                                   Either (..), Eq,
+                                                   Floating (..),
+                                                   Fractional (..), Integer,
+                                                   Maybe (..), Num (..), Ord,
+                                                   id, ($), (.))
+import qualified Prelude                          as P
 
-import Data.String
-import Data.Text (Text)
-import qualified Data.Text as T
+import           Data.Decimal
+import           Data.List.NonEmpty               (NonEmpty)
+import           Data.String
+import           Data.Text                        (Text)
+import qualified Data.Text                        as T
+import           Data.Time.Calendar               (Day)
 
+import           Database.DSH.Common.Impossible
+import           Database.DSH.Frontend.Builtins
+import           Database.DSH.Frontend.Internals
+import           Database.DSH.Frontend.TupleTypes
+
+
 -- QA Instances
 
 instance QA () where
-  type Rep () = ()
-  toExp () = UnitE
-  frExp UnitE = ()
-  frExp _ = $impossible
+    type Rep () = ()
+    toExp () = UnitE
+    frExp UnitE = ()
+    frExp _ = $impossible
 
 instance QA Bool where
-  type Rep Bool = Bool
-  toExp = BoolE
-  frExp (BoolE b) = b
-  frExp _ = $impossible
+    type Rep Bool = Bool
+    toExp = BoolE
+    frExp (BoolE b) = b
+    frExp _ = $impossible
 
 instance QA Char where
-  type Rep Char = Char
-  toExp = CharE
-  frExp (CharE c) = c
-  frExp _ = $impossible
+    type Rep Char = Char
+    toExp = CharE
+    frExp (CharE c) = c
+    frExp _ = $impossible
 
 instance QA Integer where
-  type Rep Integer = Integer
-  toExp = IntegerE
-  frExp (IntegerE i) = i
-  frExp _ = $impossible
+    type Rep Integer = Integer
+    toExp = IntegerE
+    frExp (IntegerE i) = i
+    frExp _ = $impossible
 
 instance QA Double where
-  type Rep Double = Double
-  toExp = DoubleE
-  frExp (DoubleE d) = d
-  frExp _ = $impossible
+    type Rep Double = Double
+    toExp = DoubleE
+    frExp (DoubleE d) = d
+    frExp _ = $impossible
 
 instance QA Text where
-  type Rep Text = Text
-  toExp = TextE
-  frExp (TextE t) = t
+    type Rep Text = Text
+    toExp = TextE
+    frExp (TextE t) = t
+    frExp _ = $impossible
+
+instance QA Decimal where
+    type Rep Decimal = Decimal
+    toExp = DecimalE
+    frExp (DecimalE d) = d
+    frExp _ = $impossible
+
+instance QA Day where
+  type Rep Day = Day
+  toExp = DayE
+  frExp (DayE d) = d
   frExp _ = $impossible
 
 instance (QA a) => QA [a] where
-  type Rep [a] = [Rep a]
-  toExp as = ListE (P.map toExp as)
-  frExp (ListE as) = P.map frExp as
-  frExp _ = $impossible
+    type Rep [a] = [Rep a]
+    toExp as = ListE (P.map toExp as)
+    frExp (ListE as) = P.map frExp as
+    frExp _ = $impossible
 
 instance (QA a) => QA (Maybe a) where
-  type Rep (Maybe a) = [Rep a]
-  toExp Nothing = ListE []
-  toExp (Just a) = ListE [toExp a]
-  frExp (ListE []) = Nothing
-  frExp (ListE (a : _)) = Just (frExp a)
-  frExp _ = $impossible
+    type Rep (Maybe a) = [Rep a]
+    toExp Nothing = ListE []
+    toExp (Just a) = ListE [toExp a]
+    frExp (ListE []) = Nothing
+    frExp (ListE (a : _)) = Just (frExp a)
+    frExp _ = $impossible
 
 instance (QA a,QA b) => QA (Either a b) where
-  type Rep (Either a b) = ([Rep a],[Rep b])
-  toExp (Left a) = pairE (ListE [toExp a]) (ListE [])
-  toExp (Right b) = pairE (ListE []) (ListE [toExp b])
-  frExp (TupleConstE (Tuple2E (ListE (a : _)) _)) = Left (frExp a)
-  frExp (TupleConstE (Tuple2E _ (ListE (a : _)))) = Right (frExp a)
-  frExp _ = $impossible
+    type Rep (Either a b) = ([Rep a],[Rep b])
+    toExp (Left a) = pairE (ListE [toExp a]) (ListE [])
+    toExp (Right b) = pairE (ListE []) (ListE [toExp b])
+    frExp (TupleConstE (Tuple2E (ListE (a : _)) _)) = Left (frExp a)
+    frExp (TupleConstE (Tuple2E _ (ListE (a : _)))) = Right (frExp a)
+    frExp _ = $impossible
 
 -- Elim instances
 
 instance (QA r) => Elim () r where
-  type Eliminator () r = Q r -> Q r
-  elim _ r = r
+    type Eliminator () r = Q r -> Q r
+    elim _ r = r
 
 instance (QA r) => Elim Bool r where
-  type Eliminator Bool r = Q r -> Q r -> Q r
-  elim (Q e) (Q e1) (Q e2) = Q (AppE Cond (TupleConstE (Tuple3E e e1 e2)))
+    type Eliminator Bool r = Q r -> Q r -> Q r
+    elim (Q e) (Q e1) (Q e2) = Q (AppE Cond (TupleConstE (Tuple3E e e1 e2)))
 
 instance (QA r) => Elim Char r where
-  type Eliminator Char r = (Q Char -> Q r) -> Q r
-  elim q f = f q
+    type Eliminator Char r = (Q Char -> Q r) -> Q r
+    elim q f = f q
 
 instance (QA r) => Elim Integer r where
-  type Eliminator Integer r = (Q Integer -> Q r) -> Q r
-  elim q f = f q
+    type Eliminator Integer r = (Q Integer -> Q r) -> Q r
+    elim q f = f q
 
 instance (QA r) => Elim Double r where
-  type Eliminator Double r = (Q Double -> Q r) -> Q r
-  elim q f = f q
+    type Eliminator Double r = (Q Double -> Q r) -> Q r
+    elim q f = f q
 
 instance (QA r) => Elim Text r where
-  type Eliminator Text r = (Q Text -> Q r) -> Q r
-  elim q f = f q
+    type Eliminator Text r = (Q Text -> Q r) -> Q r
+    elim q f = f q
 
 instance (QA a,QA b,QA r) => Elim (a,b) r where
-  type Eliminator (a,b) r = (Q a -> Q b -> Q r) -> Q r
-  elim q f = f (fst q) (snd q)
+    type Eliminator (a,b) r = (Q a -> Q b -> Q r) -> Q r
+    elim q f = f (fst q) (snd q)
 
 instance (QA a,QA r) => Elim (Maybe a) r where
-  type Eliminator (Maybe a) r = Q r -> (Q a -> Q r) -> Q r
-  elim q r f = maybe r f q
+    type Eliminator (Maybe a) r = Q r -> (Q a -> Q r) -> Q r
+    elim q r f = maybe r f q
 
 instance (QA a,QA b,QA r) => Elim (Either a b) r where
-  type Eliminator (Either a b) r = (Q a -> Q r) -> (Q b -> Q r) -> Q r
-  elim q f g = either f g q
+    type Eliminator (Either a b) r = (Q a -> Q r) -> (Q b -> Q r) -> Q r
+    elim q f g = either f g q
 
 -- BasicType instances
 
@@ -127,6 +146,8 @@
 instance BasicType Integer where
 instance BasicType Double where
 instance BasicType Text where
+instance BasicType Decimal where
+instance BasicType Day where
 
 -- TA instances
 
@@ -136,135 +157,168 @@
 instance TA Integer where
 instance TA Double where
 instance TA Text where
+instance TA Decimal where
+instance TA Day where
 
--- Num and Fractional instances
+-- Numerical instances
 
 instance Num (Exp Integer) where
-  (+) e1 e2 = AppE Add (pairE e1 e2)
-  (*) e1 e2 = AppE Mul (pairE e1 e2)
-  (-) e1 e2 = AppE Sub (pairE e1 e2)
+    (+) e1 e2 = AppE Add (pairE e1 e2)
+    (*) e1 e2 = AppE Mul (pairE e1 e2)
+    (-) e1 e2 = AppE Sub (pairE e1 e2)
 
-  fromInteger = IntegerE
+    fromInteger = IntegerE
 
-  abs e = let c = AppE Lt (pairE e 0)
-          in AppE Cond (tripleE c (negate e) e)
+    abs e = let c = AppE Lt (pairE e 0)
+            in AppE Cond (tripleE c (negate e) e)
 
-  signum e = let c1 = AppE Lt  (pairE e 0)
-                 c2 = AppE Equ (pairE e 0)
-                 e' = AppE Cond (tripleE c2 0 1)
-             in AppE Cond (tripleE c1 (-1) e')
+    signum e = let c1 = AppE Lt  (pairE e 0)
+                   c2 = AppE Equ (pairE e 0)
+                   e' = AppE Cond (tripleE c2 0 1)
+               in AppE Cond (tripleE c1 (-1) e')
 
 instance Num (Exp Double) where
-  (+) e1 e2 = AppE Add (pairE e1 e2)
-  (*) e1 e2 = AppE Mul (pairE e1 e2)
-  (-) e1 e2 = AppE Sub (pairE e1 e2)
+    (+) e1 e2 = AppE Add (pairE e1 e2)
+    (*) e1 e2 = AppE Mul (pairE e1 e2)
+    (-) e1 e2 = AppE Sub (pairE e1 e2)
 
-  fromInteger = DoubleE . fromInteger
+    fromInteger = DoubleE . fromInteger
 
-  abs e = let c = AppE Lt (pairE e 0)
-          in  AppE Cond (tripleE c (negate e) e)
+    abs e = let c = AppE Lt (pairE e 0)
+            in  AppE Cond (tripleE c (negate e) e)
 
-  signum e = let c1 = AppE Lt  (pairE e 0.0)
-                 c2 = AppE Equ (pairE e 0.0)
-                 e' = AppE Cond (tripleE c2 0 1)
-             in  AppE Cond (tripleE c1 (-1) e')
+    signum e = let c1 = AppE Lt  (pairE e 0.0)
+                   c2 = AppE Equ (pairE e 0.0)
+                   e' = AppE Cond (tripleE c2 0 1)
+               in  AppE Cond (tripleE c1 (-1) e')
 
+instance Num (Exp Decimal) where
+    (+) e1 e2 = AppE Add (pairE e1 e2)
+    (*) e1 e2 = AppE Mul (pairE e1 e2)
+    (-) e1 e2 = AppE Sub (pairE e1 e2)
+
+    fromInteger = DecimalE . fromInteger
+
+    abs e = let c = AppE Lt (pairE e 0)
+            in  AppE Cond (tripleE c (negate e) e)
+
+    signum e = let c1 = AppE Lt  (pairE e 0)
+                   c2 = AppE Equ (pairE e 0)
+                   e' = AppE Cond (tripleE c2 0 1)
+               in  AppE Cond (tripleE c1 (-1) e')
+
 instance Fractional (Exp Double) where
-  (/) e1 e2    = AppE Div (pairE e1 e2)
-  fromRational = DoubleE . fromRational
+    (/) e1 e2    = AppE Div (pairE e1 e2)
+    fromRational = DoubleE . fromRational
 
+instance Fractional (Exp Decimal) where
+    (/) e1 e2    = AppE Div (pairE e1 e2)
+    fromRational = DecimalE . fromRational
+
+instance Fractional (Q Decimal) where
+    (/) (Q e1) (Q e2) = Q (e1 / e2)
+    fromRational = Q . fromRational
+
 instance Floating (Exp Double) where
-  pi     = DoubleE 3.141592653589793
-  sin e  = AppE Sin e
-  cos e  = AppE Cos e
-  tan e  = AppE Tan e
-  sqrt e = AppE Sqrt e
-  exp e  = AppE Exp e
-  log e  = AppE Log e
-  asin e = AppE ASin e
-  acos e = AppE ACos e
-  atan e = AppE ATan e
-  sinh   = $unimplemented
-  cosh   = $unimplemented
-  asinh  = $unimplemented
-  atanh  = $unimplemented
-  acosh  = $unimplemented
+    pi     = DoubleE 3.141592653589793
+    sin e  = AppE Sin e
+    cos e  = AppE Cos e
+    tan e  = AppE Tan e
+    sqrt e = AppE Sqrt e
+    exp e  = AppE Exp e
+    log e  = AppE Log e
+    asin e = AppE ASin e
+    acos e = AppE ACos e
+    atan e = AppE ATan e
+    sinh   = $unimplemented
+    cosh   = $unimplemented
+    asinh  = $unimplemented
+    atanh  = $unimplemented
+    acosh  = $unimplemented
 
 instance Num (Q Integer) where
-  (+) (Q e1) (Q e2) = Q (e1 + e2)
-  (*) (Q e1) (Q e2) = Q (e1 * e2)
-  (-) (Q e1) (Q e2) = Q (e1 - e2)
-  fromInteger       = Q . IntegerE
-  abs (Q e)         = Q (abs e)
-  signum (Q e)      = Q (signum e)
+    (+) (Q e1) (Q e2) = Q (e1 + e2)
+    (*) (Q e1) (Q e2) = Q (e1 * e2)
+    (-) (Q e1) (Q e2) = Q (e1 - e2)
+    fromInteger       = Q . IntegerE
+    abs (Q e)         = Q (abs e)
+    signum (Q e)      = Q (signum e)
 
 instance Num (Q Double) where
-  (+) (Q e1) (Q e2) = Q (e1 + e2)
-  (*) (Q e1) (Q e2) = Q (e1 * e2)
-  (-) (Q e1) (Q e2) = Q (e1 - e2)
-  fromInteger       = Q . DoubleE . fromInteger
-  abs (Q e)         = Q (abs e)
-  signum (Q e)      = Q (signum e)
+    (+) (Q e1) (Q e2) = Q (e1 + e2)
+    (*) (Q e1) (Q e2) = Q (e1 * e2)
+    (-) (Q e1) (Q e2) = Q (e1 - e2)
+    fromInteger       = Q . DoubleE . fromInteger
+    abs (Q e)         = Q (abs e)
+    signum (Q e)      = Q (signum e)
 
+instance Num (Q Decimal) where
+    (+) (Q e1) (Q e2) = Q (e1 + e2)
+    (*) (Q e1) (Q e2) = Q (e1 * e2)
+    (-) (Q e1) (Q e2) = Q (e1 - e2)
+    fromInteger       = Q . DecimalE . fromInteger
+    abs (Q e)         = Q (abs e)
+    signum (Q e)      = Q (signum e)
+
 instance Fractional (Q Double) where
-  (/) (Q e1) (Q e2) = Q (e1 / e2)
-  fromRational = Q . DoubleE . fromRational
+    (/) (Q e1) (Q e2) = Q (e1 / e2)
+    fromRational = Q . DoubleE . fromRational
 
 instance Floating (Q Double) where
-  pi         = Q pi
-  sin (Q e)  = Q (sin e)
-  cos (Q e)  = Q (cos e)
-  tan (Q e)  = Q (tan e)
-  asin (Q e) = Q (asin e)
-  acos (Q e) = Q (acos e)
-  atan (Q e) = Q (atan e)
-  exp (Q e)  = Q (exp e)
-  log (Q e)  = Q (log e)
-  sqrt (Q e) = Q (sqrt e)
-  sinh   = $unimplemented
-  cosh   = $unimplemented
-  asinh  = $unimplemented
-  atanh  = $unimplemented
-  acosh  = $unimplemented
+    pi         = Q pi
+    sin (Q e)  = Q (sin e)
+    cos (Q e)  = Q (cos e)
+    tan (Q e)  = Q (tan e)
+    asin (Q e) = Q (asin e)
+    acos (Q e) = Q (acos e)
+    atan (Q e) = Q (atan e)
+    exp (Q e)  = Q (exp e)
+    log (Q e)  = Q (log e)
+    sqrt (Q e) = Q (sqrt e)
+    sinh   = $unimplemented
+    cosh   = $unimplemented
+    asinh  = $unimplemented
+    atanh  = $unimplemented
+    acosh  = $unimplemented
 
 -- View instances
 
 instance View (Q ()) where
-  type ToView (Q ()) = Q ()
-  view = id
+    type ToView (Q ()) = Q ()
+    view = id
 
 instance View (Q Bool) where
-  type ToView (Q Bool) = Q Bool
-  view = id
+    type ToView (Q Bool) = Q Bool
+    view = id
 
 instance View (Q Char) where
-  type ToView (Q Char) = Q Char
-  view = id
+    type ToView (Q Char) = Q Char
+    view = id
 
 instance View (Q Integer) where
-  type ToView (Q Integer) = Q Integer
-  view = id
+    type ToView (Q Integer) = Q Integer
+    view = id
 
 instance View (Q Double) where
-  type ToView (Q Double) = Q Double
-  view = id
+    type ToView (Q Double) = Q Double
+    view = id
 
 instance View (Q Text) where
-  type ToView (Q Text) = Q Text
-  view = id
+    type ToView (Q Text) = Q Text
+    view = id
 
 -- IsString instances
 
 instance IsString (Q Text) where
-  fromString = Q . TextE . T.pack
+    fromString = Q . TextE . T.pack
 
 -- * Referring to persistent tables
 
-defaultHints :: TableHints
-defaultHints = TableHints [] PossiblyEmpty
+defaultHints :: NonEmpty Key -> TableHints
+defaultHints keys = TableHints keys PossiblyEmpty
 
-table :: (QA a, TA a) => String -> TableHints -> Q [a]
-table name hints = Q (TableE (TableDB name hints))
+table :: (QA a, TA a) => String -> NonEmpty ColName -> TableHints -> Q [a]
+table name schema hints = Q (TableE (TableDB name schema hints))
 
 -- * toQ
 
@@ -336,13 +390,15 @@
 
 max :: (QA a,Ord a,TA a) => Q a -> Q a -> Q a
 max a b = cond (a > b) a b
-    
-mod :: Q Integer -> Q Integer -> Q Integer
-mod (Q a) (Q b) = Q (AppE Mod (pairE a b))
 
-div :: Q Integer -> Q Integer -> Q Integer
-div (Q a) (Q b) = Q (AppE Div (pairE a b))
+-- | Remainder of division.
+rem :: Q Integer -> Q Integer -> Q Integer
+rem (Q a) (Q b) = Q (AppE Mod (pairE a b))
 
+-- | Integer division truncated towards zero.
+quot :: Q Integer -> Q Integer -> Q Integer
+quot (Q a) (Q b) = Q (AppE Div (pairE a b))
+
 -- * Conditionals
 
 bool :: (QA a) => Q a -> Q a -> Q Bool -> Q a
@@ -414,8 +470,8 @@
 
 either :: (QA a,QA b,QA c) => (Q a -> Q c) -> (Q b -> Q c) -> Q (Either a b) -> Q c
 either lf rf e =
-  let p = eitherToPair e
-  in  head (map lf (fst p) ++ map rf (snd p))
+    let p = eitherToPair e
+    in  head (map lf (fst p) ++ map rf (snd p))
 
 lefts :: (QA a,QA b) => Q [Either a b] -> Q [a]
 lefts = concatMap (fst . eitherToPair)
@@ -431,9 +487,6 @@
 nil :: (QA a) => Q [a]
 nil = Q (ListE [])
 
-empty :: (QA a) => Q [a]
-empty = nil
-
 cons :: (QA a) => Q a -> Q [a] -> Q [a]
 cons (Q a) (Q as) = Q (AppE Cons (pairE a as))
 
@@ -451,12 +504,24 @@
 
 -- * List Operations
 
+only :: QA a => Q [a] -> Q a
+only (Q as) = Q (AppE Only as)
+
 head :: (QA a) => Q [a] -> Q a
-head (Q as) = Q (AppE Head as)
+head as = only $ map fst $ filter (\xp -> snd xp == 1) $ number as
 
 tail :: (QA a) => Q [a] -> Q [a]
-tail (Q as) = Q (AppE Tail as)
+tail as = map fst $ filter (\xp -> snd xp > 1) $ number as
 
+last :: (QA a) => Q [a] -> Q a
+last as = only $ map fst $ filter (\xp -> snd xp == length as) $ number as
+
+init :: (QA a) => Q [a] -> Q [a]
+init as = map fst $ filter (\xp -> snd xp < length as) $ number as
+
+index :: (QA a) => Q [a] -> Q Integer -> Q a
+index as i = only $ map fst $ filter (\xp -> snd xp == i + 1) $ number as 
+
 take :: (QA a) => Q Integer -> Q [a] -> Q [a]
 take i xs = map fst $ filter (\xp -> snd xp <= i) $ number xs
 
@@ -483,24 +548,29 @@
 groupWith :: (QA a,QA b,Ord b, TA b) => (Q a -> Q b) -> Q [a] -> Q [[a]]
 groupWith f as = map snd (groupWithKey f as)
 
-sortWith :: (QA a,QA b,Ord b, TA b) => (Q a -> Q b) -> Q [a] -> Q [a]
-sortWith f (Q as) = Q (AppE SortWith (pairE (LamE (toLam f)) as))
+-- | Group a list and apply an aggregate.
+groupAggr :: (QA a, QA b, QA c, QA k, Ord k, TA k)
+          => (Q a -> Q k)    -- ^ The grouping key
+          -> (Q a -> Q b)    -- ^ The aggregate input
+          -> (Q [b] -> Q c)  -- ^ The aggregate function
+          -> Q [a]           -- ^ The input list
+          -> Q [(k, c)]
+groupAggr k p agg as =
+    map (\kg -> pair (fst kg) (agg $ map p $ snd kg)) (groupWithKey k as)
 
-last :: (QA a) => Q [a] -> Q a
-last (Q as) = Q (AppE Last as)
 
-init :: (QA a) => Q [a] -> Q [a]
-init (Q as) = Q (AppE Init as)
+sortWith :: (QA a,QA b,Ord b, TA b) => (Q a -> Q b) -> Q [a] -> Q [a]
+sortWith f (Q as) = Q (AppE SortWith (pairE (LamE (toLam f)) as))
 
 null :: (QA a) => Q [a] -> Q Bool
 null (Q as) = Q (AppE Null as)
 
+empty :: QA a => Q [a] -> Q Bool
+empty = null
+
 length :: (QA a) => Q [a] -> Q Integer
 length (Q as) = Q (AppE Length as)
 
-index :: (QA a) => Q [a] -> Q Integer -> Q a
-index (Q as) (Q i) = Q (AppE Index (pairE as i))
-
 (!!) :: (QA a) => Q [a] -> Q Integer -> Q a
 (!!) = index
 
@@ -527,7 +597,7 @@
 sum :: (QA a,Num a) => Q [a] -> Q a
 sum (Q as) = Q (AppE Sum as)
 
-avg :: (QA a,Num a) => Q [a] -> Q Double
+avg :: (QA a, Fractional a) => Q [a] -> Q a
 avg (Q as) = Q (AppE Avg as)
 
 concat :: (QA a) => Q [[a]] -> Q [a]
@@ -549,18 +619,18 @@
 
 -- FIXME might be implemented using non-dense numbering!
 takeWhile :: (QA a) => (Q a -> Q Bool) -> Q [a] -> Q [a]
-takeWhile p xs = 
+takeWhile p xs =
     let ys            = map (\xpos -> pair xpos (p $ fst xpos)) $ number xs
         notQualifying = filter (\xposp -> not (snd xposp)) ys
         maxPos = minimum $ map (\xposp -> snd $ fst xposp) notQualifying
-     
-    in cond (null notQualifying) 
+
+    in cond (null notQualifying)
             xs
             (map (\xposp -> fst $ fst xposp) $ filter (\xposp -> (snd $ fst xposp) < maxPos) ys)
 
 -- FIXME might be implemented using non-dense numbering!
 dropWhile :: (QA a) => (Q a -> Q Bool) -> Q [a] -> Q [a]
-dropWhile p xs = 
+dropWhile p xs =
     let ys  = map (\xpos -> pair xpos (p $ fst xpos)) $ number xs
         minPos = minimum $ map (\xposp -> snd $ fst xposp) $ filter (\xposp -> not (snd xposp)) ys
     in map (\xposp -> fst $ fst xposp) $ filter (\xposp -> (snd $ fst xposp) >= minPos) ys
@@ -623,27 +693,43 @@
 integerToDouble :: Q Integer -> Q Double
 integerToDouble (Q i) = Q (AppE IntegerToDouble i)
 
+integerToDecimal :: Q Integer -> Q Decimal
+integerToDecimal (Q i) = Q (AppE IntegerToDecimal i)
+
 -- * Text Functions
 
 -- | 'like' matches a string (first argument) against a pattern (second
--- argument). The pattern must be a SQL LIKE pattern, that is use '_' for single
--- character wildcards and '_' for multi-character wildcards.
+-- argument). The pattern must be a SQL LIKE pattern, that is use '_'
+-- for single character wildcards and '_' for multi-character
+-- wildcards.
 like :: Q Text -> Q Text -> Q Bool
 like (Q t) (Q p) = Q (AppE Like (pairE t p))
 
+notLike :: Q Text -> Q Text -> Q Bool
+notLike t p = not (like t p)
+
 subString :: Integer -> Integer -> Q Text -> Q Text
 subString from to (Q t) = Q (AppE (SubString from to) t)
 
--- * Matrix/Vector-like operators
+-- * Date and Time Combinators
 
--- | Transpose a matrix in nested-list representation
-transpose :: QA a => Q [[a]] -> Q [[a]]
-transpose (Q ass) = Q (AppE Transpose ass)
+addDays :: Q Integer -> Q Day -> Q Day
+addDays (Q i) (Q d) = Q (AppE AddDays (pairE i d))
 
--- | Divide the list into sublists of length 'n'
--- FIXME should propably have a constraint to flat types
-reshape :: QA a => Integer -> Q [a] -> Q [[a]]
-reshape n (Q e) = Q (AppE (Reshape n) e)
+subDays :: Q Integer -> Q Day -> Q Day
+subDays (Q i) (Q d) = Q (AppE SubDays (pairE i d))
+
+diffDays :: Q Day -> Q Day -> Q Integer
+diffDays (Q d1) (Q d2) = Q (AppE DiffDays (pairE d1 d2))
+
+toGregorian :: Q Day -> Q (Integer, Integer, Integer)
+toGregorian (Q d) = Q $ tripleE (AppE DayYear d)
+                                (AppE DayMonth d)
+                                (AppE DayDay d)
+
+dateYear :: Q Day -> Q Integer
+dateYear d = let (view -> (year, _, _)) = toGregorian d
+             in year
 
 -- * Rebind Monadic Combinators
 
diff --git a/src/Database/DSH/Frontend/Funs.hs b/src/Database/DSH/Frontend/Funs.hs
deleted file mode 100644
--- a/src/Database/DSH/Frontend/Funs.hs
+++ /dev/null
@@ -1,74 +0,0 @@
-{-# LANGUAGE GADTs                     #-}
-{-# LANGUAGE TemplateHaskell           #-}
-
-module Database.DSH.Frontend.Funs
-    ( Fun(..)
-    , TupElem(..)
-    ) where
-
-import Data.Text (Text)
-
-import Database.DSH.Frontend.TupleTypes
-
--- Splice in the type for tuple element accessors
-$(mkTupElemType 16)
-
-data Fun a b where
-    Not             :: Fun Bool Bool
-    IntegerToDouble :: Fun Integer Double
-    And             :: Fun [Bool] Bool
-    Or              :: Fun [Bool] Bool
-    Concat          :: Fun [[a]] [a]
-    Head            :: Fun [a] a
-    Tail            :: Fun [a] [a]
-    Init            :: Fun [a] [a]
-    Last            :: Fun [a] a
-    Null            :: Fun [a] Bool
-    Length          :: Fun [a] Integer
-    Guard           :: Fun Bool [()]
-    Reverse         :: Fun [a] [a]
-    Number          :: Fun [a] [(a, Integer)]
-    Fst             :: Fun (a,b) a
-    Snd             :: Fun (a,b) b
-    Sum             :: Fun [a] a
-    Avg             :: Fun [a] Double
-    Maximum         :: Fun [a] a
-    Minimum         :: Fun [a] a
-    Nub             :: Fun [a] [a]
-    Append          :: Fun ([a], [a]) [a]
-    Add             :: Fun (a,a) a
-    Mul             :: Fun (a,a) a
-    Sub             :: Fun (a,a) a
-    Div             :: Fun (a,a) a
-    Mod             :: Fun (Integer,Integer) Integer
-    Lt              :: Fun (a,a) Bool
-    Lte             :: Fun (a,a) Bool
-    Equ             :: Fun (a,a) Bool
-    NEq             :: Fun (a,a) Bool
-    Gte             :: Fun (a,a) Bool
-    Gt              :: Fun (a,a) Bool
-    Conj            :: Fun (Bool,Bool) Bool
-    Disj            :: Fun (Bool,Bool) Bool
-    Cons            :: Fun (a,[a]) [a]
-    Index           :: Fun ([a],Integer) a
-    Zip             :: Fun ([a],[b]) [(a,b)]
-    Map             :: Fun (a -> b,[a]) [b]
-    ConcatMap       :: Fun (a -> [b],[a]) [b]
-    Filter          :: Fun (a -> Bool,[a]) [a]
-    GroupWithKey    :: Fun (a -> b,[a]) [(b, [a])]
-    SortWith        :: Fun (a -> b,[a]) [a]
-    Cond            :: Fun (Bool,a,a) a
-    Like            :: Fun (Text,Text) Bool
-    SubString       :: Integer -> Integer -> Fun Text Text 
-    Transpose       :: Fun [[a]] [[a]]
-    Reshape         :: Integer -> Fun [a] [[a]]
-    Sin             :: Fun Double Double
-    Cos             :: Fun Double Double
-    Tan             :: Fun Double Double
-    Sqrt            :: Fun Double Double
-    Exp             :: Fun Double Double
-    Log             :: Fun Double Double
-    ASin            :: Fun Double Double
-    ACos            :: Fun Double Double
-    ATan            :: Fun Double Double
-    TupElem         :: TupElem a b -> Fun a b
diff --git a/src/Database/DSH/Frontend/Internals.hs b/src/Database/DSH/Frontend/Internals.hs
--- a/src/Database/DSH/Frontend/Internals.hs
+++ b/src/Database/DSH/Frontend/Internals.hs
@@ -1,17 +1,22 @@
 {-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE GADTs                 #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE ScopedTypeVariables   #-}
 {-# LANGUAGE TemplateHaskell       #-}
 {-# LANGUAGE TypeFamilies          #-}
+{-# LANGUAGE TypeSynonymInstances  #-}
 
 module Database.DSH.Frontend.Internals where
 
+import           Data.Decimal
+import           Data.List.NonEmpty               (NonEmpty)
 import           Data.Text                        (Text)
+import           Data.Time.Calendar               (Day)
 import           Text.PrettyPrint.ANSI.Leijen
 
-import           Database.DSH.Impossible
-import           Database.DSH.Frontend.Funs
+import           Database.DSH.Common.Impossible
+import           Database.DSH.Frontend.Builtins
 import           Database.DSH.Frontend.TupleTypes
 
 --------------------------------------------------------------------------------
@@ -22,29 +27,33 @@
 $(mkTupleAstComponents 16)
 
 data Exp a where
-  UnitE       :: Exp ()
-  BoolE       :: Bool    -> Exp Bool
-  CharE       :: Char    -> Exp Char
-  IntegerE    :: Integer -> Exp Integer
-  DoubleE     :: Double  -> Exp Double
-  TextE       :: Text    -> Exp Text
-  ListE       :: (Reify a)           => [Exp a] -> Exp [a]
-  AppE        :: (Reify a, Reify b)  => Fun a b -> Exp a -> Exp b
-  LamE        :: (Reify a, Reify b)  => (Exp a -> Exp b) -> Exp (a -> b)
-  VarE        :: (Reify a)           => Integer -> Exp a
-  TableE      :: (Reify a)           => Table -> Exp [a]
-  TupleConstE :: TupleConst a -> Exp a
+    UnitE       :: Exp ()
+    BoolE       :: Bool    -> Exp Bool
+    CharE       :: Char    -> Exp Char
+    IntegerE    :: Integer -> Exp Integer
+    DoubleE     :: Double  -> Exp Double
+    TextE       :: Text    -> Exp Text
+    DecimalE    :: Decimal -> Exp Decimal
+    DayE        :: Day     -> Exp Day
+    ListE       :: (Reify a)           => [Exp a] -> Exp [a]
+    AppE        :: (Reify a, Reify b)  => Fun a b -> Exp a -> Exp b
+    LamE        :: (Reify a, Reify b)  => (Exp a -> Exp b) -> Exp (a -> b)
+    VarE        :: (Reify a)           => Integer -> Exp a
+    TableE      :: (Reify a)           => Table -> Exp [a]
+    TupleConstE :: TupleConst a -> Exp a
 
 data Type a where
-  UnitT     :: Type ()
-  BoolT     :: Type Bool
-  CharT     :: Type Char
-  IntegerT  :: Type Integer
-  DoubleT   :: Type Double
-  TextT     :: Type Text
-  ListT     :: (Reify a)          => Type a -> Type [a]
-  ArrowT    :: (Reify a,Reify b)  => Type a -> Type b -> Type (a -> b)
-  TupleT    :: TupleType a -> Type a
+    UnitT     :: Type ()
+    BoolT     :: Type Bool
+    CharT     :: Type Char
+    IntegerT  :: Type Integer
+    DoubleT   :: Type Double
+    TextT     :: Type Text
+    DecimalT  :: Type Decimal
+    DayT      :: Type Day
+    ListT     :: (Reify a)          => Type a -> Type [a]
+    ArrowT    :: (Reify a,Reify b)  => Type a -> Type b -> Type (a -> b)
+    TupleT    :: TupleType a -> Type a
 
 instance Pretty (Type a) where
     pretty UnitT          = text "()"
@@ -53,6 +62,8 @@
     pretty IntegerT       = text "Integer"
     pretty DoubleT        = text "Double"
     pretty TextT          = text "Text"
+    pretty DecimalT       = text "Decimal"
+    pretty DayT           = text "Day"
     pretty (ListT t)      = brackets $ pretty t
     pretty (ArrowT t1 t2) = parens $ pretty t1 <+> text "->" <+> pretty t2
     pretty (TupleT t)     = pretty t
@@ -66,24 +77,24 @@
 -- Classes
 
 class Reify a where
-  reify :: a -> Type a
+    reify :: a -> Type a
 
 class (Reify (Rep a)) => QA a where
-  type Rep a
-  toExp :: a -> Exp (Rep a)
-  frExp :: Exp (Rep a) -> a
+    type Rep a
+    toExp :: a -> Exp (Rep a)
+    frExp :: Exp (Rep a) -> a
 
 class (QA a,QA r) => Elim a r where
-  type Eliminator a r
-  elim :: Q a -> Eliminator a r
+    type Eliminator a r
+    elim :: Q a -> Eliminator a r
 
 class BasicType a where
 
 class TA a where
 
 class View a where
-  type ToView a
-  view :: a -> ToView a
+    type ToView a
+    view :: a -> ToView a
 
 newtype Q a = Q (Exp (Rep a))
 
@@ -93,47 +104,58 @@
 tripleE :: (Reify a, Reify b, Reify c) => Exp a -> Exp b -> Exp c -> Exp (a, b, c)
 tripleE a b c = TupleConstE (Tuple3E a b c)
 
+--------------------------------------------------------------------------------
+-- Definition of database-resident tables
+
 -- | A combination of column names that form a candidate key
-newtype Key = Key [String] deriving (Eq, Ord, Show)
+newtype Key = Key (NonEmpty String) deriving (Eq, Ord, Show)
 
 -- | Is the table guaranteed to be not empty?
 data Emptiness = NonEmpty
                | PossiblyEmpty
                deriving (Eq, Ord, Show)
 
+type ColName = String
+
 -- | Catalog information hints that users may give to DSH
 data TableHints = TableHints
-    { keysHint     :: [Key]
+    { keysHint     :: NonEmpty Key
     , nonEmptyHint :: Emptiness
     } deriving (Eq, Ord, Show)
 
-data Table = TableDB String TableHints
+data Table = TableDB String (NonEmpty ColName) TableHints
 
 -- Reify instances
 
 instance Reify () where
-  reify _ = UnitT
+    reify _ = UnitT
 
 instance Reify Bool where
-  reify _ = BoolT
+    reify _ = BoolT
 
 instance Reify Char where
-  reify _ = CharT
+    reify _ = CharT
 
 instance Reify Integer where
-  reify _ = IntegerT
+    reify _ = IntegerT
 
 instance Reify Double where
-  reify _ = DoubleT
+    reify _ = DoubleT
 
+instance Reify Decimal where
+    reify _ = DecimalT
+
 instance Reify Text where
-  reify _ = TextT
+    reify _ = TextT
 
+instance Reify Day where
+  reify _ = DayT
+
 instance (Reify a) => Reify [a] where
-  reify _ = ListT (reify (undefined :: a))
+    reify _ = ListT (reify (undefined :: a))
 
 instance (Reify a, Reify b) => Reify (a -> b) where
-  reify _ = ArrowT (reify (undefined :: a)) (reify (undefined :: b))
+    reify _ = ArrowT (reify (undefined :: a)) (reify (undefined :: b))
 
 -- Utility functions
 
diff --git a/src/Database/DSH/Frontend/Schema.hs b/src/Database/DSH/Frontend/Schema.hs
deleted file mode 100644
--- a/src/Database/DSH/Frontend/Schema.hs
+++ /dev/null
@@ -1,44 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-
--- | This module contains functionality to retrieve information about
--- the schema of actual database tables.
-module Database.DSH.Frontend.Schema
-    ( getTableInfo
-    ) where
-
-import qualified Data.List                as L
-import           GHC.Exts
-import           Text.Printf
-
-import qualified Database.HDBC            as H
-
-import qualified Database.DSH.Common.Type as T
-
--- | Retrieve through the given database connection information on the
--- table (columns with their types) which name is given as the second
--- argument.
-getTableInfo :: H.IConnection conn => conn -> String -> IO [(String, String, (T.Type -> Bool))]
-getTableInfo conn tableName = do
-    info <- H.describeTable conn tableName
-    case info of
-        []    -> error $ printf "Unknown table %s" tableName
-        _ : _ -> return $ toTableDescr info
-
-  where
-    toTableDescr :: [(String, H.SqlColDesc)] -> [(String, String, T.Type -> Bool)]
-    toTableDescr cols = sortWith (\(n, _, _) -> n)
-                        [ (name, show colTy, compatibleType colTy)
-                        | (name, props) <- cols
-                        , let colTy = H.colType props
-                        ]
-
-
-    compatibleType :: H.SqlTypeId -> T.Type -> Bool
-    compatibleType dbT hsT =
-        case hsT of
-            T.UnitT   -> True
-            T.BoolT   -> L.elem dbT [H.SqlSmallIntT, H.SqlIntegerT, H.SqlBitT]
-            T.StringT -> L.elem dbT [H.SqlCharT, H.SqlWCharT, H.SqlVarCharT]
-            T.IntT    -> L.elem dbT [H.SqlSmallIntT, H.SqlIntegerT, H.SqlTinyIntT, H.SqlBigIntT, H.SqlNumericT]
-            T.DoubleT -> L.elem dbT [H.SqlDecimalT, H.SqlRealT, H.SqlFloatT, H.SqlDoubleT]
-            t         -> error $ printf "Unsupported column type %s for table %s" (show t) (show tableName)
diff --git a/src/Database/DSH/Frontend/TH.hs b/src/Database/DSH/Frontend/TH.hs
--- a/src/Database/DSH/Frontend/TH.hs
+++ b/src/Database/DSH/Frontend/TH.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE TemplateHaskell #-}
 
-module Database.DSH.Frontend.TH 
+module Database.DSH.Frontend.TH
     ( deriveDSH
     , deriveQA
     , deriveTA
@@ -16,7 +16,6 @@
     ) where
 
 import           Control.Monad
-import           Control.Applicative
 import           Data.Char
 import           Data.List
 
@@ -25,8 +24,9 @@
 
 import qualified Database.DSH.Frontend.Internals  as DSH
 import           Database.DSH.Frontend.TupleTypes
-import qualified Database.DSH.Frontend.Funs       as F
-import           Database.DSH.Impossible
+import qualified Database.DSH.Frontend.Builtins   as F
+import           Database.DSH.Common.Impossible
+import           Database.DSH.Common.TH
 
 
 -----------------------------------------
@@ -61,7 +61,7 @@
 
 deriveTyConQA :: Name -> [TyVarBndr] -> [Con] -> Q [Dec]
 deriveTyConQA name tyVarBndrs cons = do
-  let context       = map (\tv -> ClassP ''DSH.QA [VarT (tyVarBndrToName tv)])
+  let context       = map (\tv -> nameTyApp ''DSH.QA (VarT (tyVarBndrToName tv)))
                           tyVarBndrs
   let typ           = foldl AppT (ConT name) (map (VarT . tyVarBndrToName) tyVarBndrs)
   let instanceHead  = AppT (ConT ''DSH.QA) typ
@@ -130,7 +130,7 @@
   return (Clause [pat1] body1 [])
 -- FIXME adapt code for types with multiple constructors to new tuple
 -- regime.
-deriveToExpClause n i con = $unimplemented
+deriveToExpClause _n _i _con = $unimplemented
 {-
   (pat1,names1) <- conToPattern con
   let exp1 = deriveToExpMainExp names1
@@ -172,7 +172,7 @@
   return (Clause [pat1] body1 [])
 -- FIXME adapt code for types with multiple constructors to new tuple
 -- regime.
-deriveFrExpClause n i con = $unimplemented
+deriveFrExpClause _n _i _con = $unimplemented
 {-
   (_,names1) <- conToPattern con
   let pat1 = deriveFrExpMainPat names1
@@ -207,7 +207,7 @@
 
 deriveTyConTA :: Name -> [TyVarBndr] -> [Con] -> Q [Dec]
 deriveTyConTA name tyVarBndrs _cons = do
-  let context       = map (\tv -> ClassP ''DSH.BasicType [VarT (tyVarBndrToName tv)])
+  let context       = map (\tv -> nameTyApp ''DSH.BasicType (VarT (tyVarBndrToName tv)))
                           tyVarBndrs
   let typ           = foldl AppT (ConT name) (map (VarT . tyVarBndrToName) tyVarBndrs)
   let instanceHead  = AppT (ConT ''DSH.TA) typ
@@ -229,7 +229,8 @@
 
 deriveTyConView :: Name -> [TyVarBndr] -> Con -> Q [Dec]
 deriveTyConView name tyVarBndrs con = do
-  let context = map (\tv -> ClassP ''DSH.QA [VarT (tyVarBndrToName tv)]) tyVarBndrs
+  let context = map (\tv -> nameTyApp ''DSH.QA (VarT (tyVarBndrToName tv)))
+                    tyVarBndrs
   let typ1 = AppT (ConT ''DSH.Q)
                   (foldl AppT (ConT name) (map (VarT . tyVarBndrToName) tyVarBndrs))
   let instanceHead = AppT (ConT ''DSH.View) typ1
@@ -276,8 +277,9 @@
   resultTyName <- newName "r"
   let resTy = VarT resultTyName
   let ty = foldl AppT (ConT name) (map (VarT . tyVarBndrToName) tyVarBndrs)
-  let context = ClassP ''DSH.QA [resTy] :
-                map (\tv -> ClassP ''DSH.QA [VarT (tyVarBndrToName tv)]) tyVarBndrs
+  let context = nameTyApp ''DSH.QA (resTy) :
+                map (\tv -> nameTyApp ''DSH.QA (VarT (tyVarBndrToName tv)))
+                    tyVarBndrs
   let instanceHead = AppT (AppT (ConT ''DSH.Elim) ty) resTy
   let eliminatorDec = deriveEliminator ty resTy cons
   elimDec <- deriveElimFun cons
@@ -315,57 +317,58 @@
   return (FunD 'DSH.elim [clause1])
 
 deriveElimFunClause :: [Con] -> Q Clause
-deriveElimFunClause cons = do
-  en  <- newName "e"
-  fns <- mapM (\ _ -> newName "f") cons
-  let fes = map VarE fns
-  let pats1 = ConP 'DSH.Q [VarP en] : map VarP fns
+deriveElimFunClause = $unimplemented
+-- deriveElimFunClause cons = do
+--   en  <- newName "e"
+--   fns <- mapM (\ _ -> newName "f") cons
+--   let fes = map VarE fns
+--   let pats1 = ConP 'DSH.Q [VarP en] : map VarP fns
 
-  fes2 <- zipWithM deriveElimToLamExp fes (map (length . conToTypes) cons)
+--   fes2 <- zipWithM deriveElimToLamExp fes (map (length . conToTypes) cons)
 
-  let e       = VarE en
-  liste <- [| DSH.ListE $(listE $ deriveElimFunClauseExp (return e) (map return fes2)) |]
-  let concate = AppE (AppE (ConE 'DSH.AppE) (ConE 'F.Concat)) liste
-  let heade   = AppE (AppE (ConE 'DSH.AppE) (ConE 'F.Head)) concate
-  let qe      = AppE (ConE 'DSH.Q) heade
-  return (Clause pats1 (NormalB qe) [])
+--   let e       = VarE en
+--   liste <- [| DSH.ListE $(listE $ deriveElimFunClauseExp (return e) (map return fes2)) |]
+--   let concate = AppE (AppE (ConE 'DSH.AppE) (ConE 'F.Concat)) liste
+--   let heade   = AppE (AppE (ConE 'DSH.AppE) (ConE 'F.Head)) concate
+--   let qe      = AppE (ConE 'DSH.Q) heade
+--   return (Clause pats1 (NormalB qe) [])
 
-deriveElimToLamExp :: Exp -> Int -> Q Exp
-deriveElimToLamExp f 0 =
-  return (AppE (VarE 'const) (AppE (VarE 'DSH.unQ) f))
-deriveElimToLamExp f 1 = do
-  xn <- newName "x"
-  let xe = VarE xn
-  let xp = VarP xn
-  let qe = AppE (ConE 'DSH.Q) xe
-  let fappe = AppE f qe
-  let unqe = AppE (VarE 'DSH.unQ) fappe
-  return (LamE [xp] unqe)
-deriveElimToLamExp f n = do
-  xn <- newName "x"
-  let xe = VarE xn
-  let xp = VarP xn
-  let fste = AppE (AppE (ConE 'DSH.AppE) (ConE 'F.Fst)) xe
-  let snde = AppE (AppE (ConE 'DSH.AppE) (ConE 'F.Snd)) xe
-  let qe = AppE (ConE 'DSH.Q) fste
-  let fappe = AppE f qe
-  f' <- deriveElimToLamExp fappe (n - 1)
-  return (LamE [xp] (AppE f' snde))
+-- deriveElimToLamExp :: Exp -> Int -> Q Exp
+-- deriveElimToLamExp f 0 =
+--   return (AppE (VarE 'const) (AppE (VarE 'DSH.unQ) f))
+-- deriveElimToLamExp f 1 = do
+--   xn <- newName "x"
+--   let xe = VarE xn
+--   let xp = VarP xn
+--   let qe = AppE (ConE 'DSH.Q) xe
+--   let fappe = AppE f qe
+--   let unqe = AppE (VarE 'DSH.unQ) fappe
+--   return (LamE [xp] unqe)
+-- deriveElimToLamExp f n = do
+--   xn <- newName "x"
+--   let xe = VarE xn
+--   let xp = VarP xn
+--   let fste = AppE (AppE (ConE 'DSH.AppE) (ConE 'F.Fst)) xe
+--   let snde = AppE (AppE (ConE 'DSH.AppE) (ConE 'F.Snd)) xe
+--   let qe = AppE (ConE 'DSH.Q) fste
+--   let fappe = AppE f qe
+--   f' <- deriveElimToLamExp fappe (n - 1)
+--   return (LamE [xp] (AppE f' snde))
 
-deriveElimFunClauseExp :: Q Exp -> [Q Exp] -> [Q Exp]
-deriveElimFunClauseExp _ [] = error errMsgExoticType
-deriveElimFunClauseExp e [f] = [ [| DSH.ListE [$f $e] |] ]
-deriveElimFunClauseExp e fs = go e fs
-  where
-  go :: Q Exp -> [Q Exp] -> [Q Exp]
-  go _ []  = error errMsgExoticType
-  -- FIXME PairE
-  go e1 [f1] = do
-    [ [| DSH.AppE F.Map (DSH.TupleConstE (DSH.Tuple2E (DSH.LamE $f1) $e1)) |] ]
-  go e1 (f1 : fs1) = do
-    let mape = [| DSH.AppE F.Map (DSH.TupleConstE (DSH.Tuple2E (DSH.LamE $f1) (DSH.AppE F.Fst $e1))) |]
-    let snde = [| DSH.AppE F.Snd $e1 |]
-    mape : go snde fs1
+-- deriveElimFunClauseExp :: Q Exp -> [Q Exp] -> [Q Exp]
+-- deriveElimFunClauseExp _ [] = error errMsgExoticType
+-- deriveElimFunClauseExp e [f] = [ [| DSH.ListE [$f $e] |] ]
+-- deriveElimFunClauseExp e fs = go e fs
+--   where
+--   go :: Q Exp -> [Q Exp] -> [Q Exp]
+--   go _ []  = error errMsgExoticType
+--   -- FIXME PairE
+--   go e1 [f1] = do
+--     [ [| DSH.AppE F.Map (DSH.TupleConstE (DSH.Tuple2E (DSH.LamE $f1) $e1)) |] ]
+--   go e1 (f1 : fs1) = do
+--     let mape = [| DSH.AppE F.Map (DSH.TupleConstE (DSH.Tuple2E (DSH.LamE $f1) (DSH.AppE F.Fst $e1))) |]
+--     let snde = [| DSH.AppE F.Snd $e1 |]
+--     mape : go snde fs1
 
 ---------------------------------
 -- Deriving Smart Constructors --
@@ -392,7 +395,7 @@
 
   let resTyp = AppT (ConT ''DSH.Q) (foldl AppT (ConT typConName) boundTyps)
 
-  let smartConContext = map (ClassP ''DSH.QA . return) boundTyps
+  let smartConContext = map (nameTyApp ''DSH.QA) boundTyps
 
   let smartConTyp = foldr (AppT . AppT ArrowT . AppT (ConT ''DSH.Q))
                           resTyp
@@ -408,7 +411,7 @@
   -- FIXME PairE -> TupleE
   smartConExp <- if null es
                  then return $ ConE 'DSH.UnitE
-                 else mkTupConstTerm es 
+                 else mkTupConstTerm es
   smartConBody <- deriveSmartConBody n i smartConExp
   let smartConClause = Clause smartConPat (NormalB smartConBody) []
 
@@ -438,11 +441,11 @@
   '(' : cs            -> mkName ("tuple" ++ show (length (filter (== ',') cs) + 1))
   c : cs | isAlpha c  -> mkName (toLower c : cs)
   cs                  -> mkName (':' : cs)
-  
+
 ----------------------------------------
 -- Generating lifted record selectors --
 ----------------------------------------
-   
+
 {-
 
 For a record declaration like
@@ -458,38 +461,40 @@
 bQ (view -> (_, b)) = b
 
 -}
-  
+
 -- | Create lifted record selectors
 generateTableSelectors :: Name -> Q [Dec]
 generateTableSelectors name = do
   info <- reify name
   case info of
-    TyConI (DataD _ typName [] [RecC _ fields] _) -> concat <$> mapM instSelectors fields
+    TyConI (DataD _ typName [] [RecC _ fields] _) ->
+        concat <$> mapM instSelectors fields
       where fieldNames    = map (\(f, _, _) -> f) fields
             instSelectors = generateTableSelector typName fieldNames
     _ -> fail errMsgBaseRecCons
-    
+
 generateTableSelector :: Name -> [Name] -> VarStrictType -> Q [Dec]
 generateTableSelector typeName allFieldNames (fieldName, _strict, typ) = do
   let selName = case fieldName of
                   Name (OccName n) _ -> mkName $ n ++ "Q"
-  
-  let selType = AppT (AppT ArrowT (AppT (ConT ''DSH.Q) (ConT typeName))) (AppT (ConT ''DSH.Q) typ)
+
+  let selType = AppT (AppT ArrowT (AppT (ConT ''DSH.Q) (ConT typeName)))
+                     (AppT (ConT ''DSH.Q) typ)
       sigDec  = SigD selName selType
-  
+
   fieldVarName <- newName "x"
   let projectField f | f == fieldName = VarP fieldVarName
       projectField _                  = WildP
-  
+
       tupPat   = map projectField allFieldNames
 
       argPat   = ViewP (VarE 'DSH.view) (TupP tupPat)
-      
+
       bodyExp  = NormalB $ VarE fieldVarName
-      
+
       funDec   = FunD selName [Clause [argPat] bodyExp []]
-      
-  
+
+
   return [sigDec, funDec]
 
 -- Helper Functions
@@ -501,7 +506,8 @@
 -- TupleE (Tuple3E a b) -> ...
 -- @
 mkTuplePat :: [Name] -> Pat
-mkTuplePat names = ConP 'DSH.TupleConstE [ConP (innerConst $ length names) (map VarP names)]
+mkTuplePat names = ConP 'DSH.TupleConstE
+                        [ConP (innerConst "" $ length names) (map VarP names)]
 
 -- | Generate a (flat) tuple type from the list of element types.
 mkTupleType :: [Type] -> Type
@@ -533,10 +539,10 @@
 conToPattern (ForallC _tyVarBndr _cxt con) = conToPattern con
 
 conToName :: Con -> Name
-conToName (NormalC name _) = name
-conToName (RecC name _) = name
+conToName (NormalC name _)  = name
+conToName (RecC name _)     = name
 conToName (InfixC _ name _) = name
-conToName (ForallC _ _ con)	= conToName con
+conToName (ForallC _ _ con) = conToName con
 
 countConstructors :: Name -> Q Int
 countConstructors name = do
diff --git a/src/Database/DSH/Frontend/TupleTypes.hs b/src/Database/DSH/Frontend/TupleTypes.hs
--- a/src/Database/DSH/Frontend/TupleTypes.hs
+++ b/src/Database/DSH/Frontend/TupleTypes.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE TemplateHaskell #-}
 
+
 -- | Generate AST types, functions and instances for tuples.
 module Database.DSH.Frontend.TupleTypes
     ( -- * Generate tuple types, functions and instances
@@ -22,13 +23,13 @@
     , tupTyConstName
     ) where
 
-import           Control.Applicative
 import           Data.List
 import           Text.Printf
 
 import           Language.Haskell.TH
 
-import           Database.DSH.Impossible
+import           Database.DSH.Common.Impossible
+import           Database.DSH.Common.TH
 import           Database.DSH.Common.Nat
 import qualified Database.DSH.Common.Type   as T
 import qualified Database.DSH.CL.Primitives as CP
@@ -45,8 +46,8 @@
 
 mkTupType :: Int -> Int -> [Name] -> Name -> Type
 mkTupType elemIdx width boundTyVars bTyVar =
-    let elemTys = map VarT $ take (elemIdx - 1) boundTyVars 
-                             ++ [bTyVar] 
+    let elemTys = map VarT $ take (elemIdx - 1) boundTyVars
+                             ++ [bTyVar]
                              ++ drop (elemIdx - 1) boundTyVars
     in foldl' AppT (TupleT width) elemTys
 
@@ -55,30 +56,30 @@
     let binders = map PlainTV boundTyVars
     let tupTy   = mkTupType elemIdx width boundTyVars bTyVar
     let con     = tupAccName width elemIdx
-    let ctx     = [EqualP (VarT aTyVar) tupTy]
+    let ctx     = [equalConstrTy (VarT aTyVar) tupTy]
     return $ ForallC binders ctx (NormalC con [])
 
 -- | Generate the complete type of tuple acccessors for all tuple
 -- widths.
--- 
+--
 -- @
--- data TupElem a b where 
---     Tup2_1 :: TupElem (a, b) a 
---     Tup2_2 :: TupElem (a, b) b 
---     Tup3_1 :: TupElem (a, b, c) a 
---     Tup3_2 :: TupElem (a, b, c) b 
---     Tup3_3 :: TupElem (a, b, c) c 
+-- data TupElem a b where
+--     Tup2_1 :: TupElem (a, b) a
+--     Tup2_2 :: TupElem (a, b) b
+--     Tup3_1 :: TupElem (a, b, c) a
+--     Tup3_2 :: TupElem (a, b, c) b
+--     Tup3_3 :: TupElem (a, b, c) c
 --     ...
 -- @
--- 
+--
 -- Due to the lack of support for proper GADT syntax in TH, we have
 -- to work with explicit universal quantification:
--- 
+--
 -- @
 -- data TupElem a b =
 --     | forall d. a ~ (b, d) => Tup2_1
 --     | forall d. a ~ (d, b) => Tup2_2
--- 
+--
 --     | forall d e. a ~ (b, d, e) => Tup3_1
 --     | forall d e. a ~ (d, b, e) => Tup3_2
 --     | forall d e. a ~ (d, e, b) => Tup3_3
@@ -95,34 +96,43 @@
     cons   <- concat <$> mapM (mkTupElemCons aTyVar bTyVar) [2..maxWidth]
 
     return $ [DataD [] tyName tyVars cons []]
- 
+
 --------------------------------------------------------------------------------
 -- Translation of tuple accessors to CL
 
-mkCompileMatch :: Name -> (Name, Int) -> Q Match
-mkCompileMatch exprName (con, elemIdx) = do
-    let translateVar = return $ VarE $ mkName "translate"
-        exprVar      = return $ VarE exprName
-        idxLit       = return $ LitE $ IntegerL $ fromIntegral elemIdx
-    bodyExp  <- [| CP.tupElem (intIndex $idxLit) <$> $translateVar $exprVar |]
+-- TupElem a b -> Exp a -> Compile CL.Expr
+-- \te e ->
+--     case te of
+--         Tup{2}_{1} -> CP.tupElem (indIndex 1) <$> translate e
+--         Tup{2}_{k} -> CP.tupElem (indIndex k) <$> translate e
+--         Tup{3}_{1} -> CP.tupElem (indIndex 1) <$> translate e
+--         ...
+--         Tup{n}_{j} -> CP.tupElem (indIndex j) <$> translate e
+
+-- FIXME mkTupElemCompile does not depend on 'translate'
+-- anymore. Therefore, we could inject a regular global binding for
+-- the function instead of a lambda.
+
+mkCompileMatch :: (Name, Int) -> Q Match
+mkCompileMatch (con, elemIdx) = do
+    let idxLit       = return $ LitE $ IntegerL $ fromIntegral elemIdx
+    bodyExp  <- [| CP.tupElem (intIndex $idxLit)  |]
     let body = NormalB $ bodyExp
     return $ Match (ConP con []) body []
 
 mkTupElemCompile :: Int -> Q Exp
 mkTupElemCompile maxWidth = do
     let cons = concat [ [ (tupAccName width idx, idx)
-                        | idx <- [1..width] 
-                        ] 
-                      | width <- [2..maxWidth] 
+                        | idx <- [1..width]
+                        ]
+                      | width <- [2..maxWidth]
                       ]
 
-    exprName <- newName "e"
     opName   <- newName "te"
-
-    matches  <- mapM (mkCompileMatch exprName) cons
+    matches  <- mapM mkCompileMatch cons
 
     let lamBody = CaseE (VarE opName) matches
-    return $ LamE [VarP opName, VarP exprName] lamBody
+    return $ LamE [VarP opName] lamBody
 
 --------------------------------------------------------------------------------
 -- Reify instances for tuple types
@@ -133,16 +143,16 @@
 mkReifyFun :: [Name] -> Dec
 mkReifyFun tyNames =
     let argTys         = map reifyType tyNames
-        body           = AppE (ConE $ mkName "TupleT") 
-                         $ foldl' AppE (ConE $ tupTyConstName $ length tyNames) argTys
+        body           = AppE (ConE $ mkName "TupleT")
+                         $ foldl' AppE (ConE $ tupTyConstName "" $ length tyNames) argTys
     in FunD (mkName "reify") [Clause [WildP] (NormalB body) []]
 
 mkReifyInstance :: Int -> Dec
 mkReifyInstance width =
     let tyNames  = map (\i -> mkName $ "t" ++ show i) [1..width]
         instTy   = AppT (ConT $ mkName "Reify") $ tupleType $ map VarT tyNames
-        reifyCxt = map (\tyName -> ClassP (mkName "Reify") [VarT tyName]) tyNames
-        
+        reifyCxt = map (\tyName -> nameTyApp (mkName "Reify") (VarT tyName)) tyNames
+
     in InstanceD reifyCxt instTy [mkReifyFun tyNames]
 
 mkReifyInstances :: Int -> Q [Dec]
@@ -155,16 +165,18 @@
 mkToExp width elemNames =
     let toExpVar   = VarE $ mkName "toExp"
         elemArgs   = map (\n -> AppE toExpVar (VarE n)) elemNames
-        body       = NormalB $ AppE (ConE outerConst) 
-                             $ foldl' AppE (ConE $ innerConst width) elemArgs
+        body       = NormalB $ AppE (ConE $ outerConst "")
+                             $ foldl' AppE (ConE $ innerConst "" width) elemArgs
         tupClause  = Clause [TupP $ map VarP elemNames] body []
     in FunD (mkName "toExp") [tupClause]
 
 mkFrExp :: Int -> [Name] -> Q Dec
 mkFrExp width elemNames = do
     impossibleExpr <- [| error $(litE $ StringL $ printf "frExp %d" width) |]
-    let tupPattern       = ConP outerConst [ConP (innerConst width) (map VarP elemNames) ]
-        tupleExpr        = TupE $ map (\n -> AppE (VarE $ mkName "frExp") (VarE n)) elemNames
+    let tupPattern       = ConP (outerConst "")
+                                [ConP (innerConst "" width) (map VarP elemNames) ]
+        tupleExpr        = TupE $ map (\n -> AppE (VarE $ mkName "frExp") (VarE n))
+                                      elemNames
         tupleClause      = Clause [tupPattern] (NormalB tupleExpr) []
         impossibleClause = Clause [WildP] (NormalB impossibleExpr) []
     return $ FunD (mkName "frExp") [tupleClause, impossibleClause]
@@ -172,7 +184,7 @@
 mkRep :: Int -> [Name] -> Type -> Dec
 mkRep width tyNames tupTyPat =
     let resTy    = foldl' AppT (TupleT width)
-                   $ map (AppT $ ConT $ mkName "Rep") 
+                   $ map (AppT $ ConT $ mkName "Rep")
                    $ map VarT tyNames
     in TySynInstD (mkName "Rep") (TySynEqn [tupTyPat] resTy)
 
@@ -181,14 +193,14 @@
     let tyNames = map (\i -> mkName $ "t" ++ show i) [1..width]
         tupTy   = tupleType $ map VarT tyNames
         instTy  = AppT (ConT $ mkName "QA") tupTy
-        qaCxt   = map (\tyName -> ClassP (mkName "QA") [VarT tyName]) tyNames
+        qaCxt   = map (\tyName -> nameTyApp (mkName "QA") (VarT tyName)) tyNames
         rep     = mkRep width tyNames tupTy
         toExp   = mkToExp width tyNames
     frExp <- mkFrExp width tyNames
     return $ InstanceD qaCxt instTy [rep, toExp, frExp]
 
 -- | Generate QA instances for tuple types according to the following template:
--- 
+--
 -- @
 -- instance (QA t1, ..., QA tn) => QA (t1, ..., tn) where
 --   type Rep (t1, ..., tn) = (Rep t1, ..., Rep tn)
@@ -207,11 +219,11 @@
     let tyNames = map (\i -> mkName $ "t" ++ show i) [1..width]
         tupTy   = foldl' AppT (TupleT width) $ map VarT tyNames
         instTy  = AppT (ConT $ mkName "TA") tupTy
-        taCxt   = map (\tyName -> ClassP (mkName "BasicType") [VarT tyName]) tyNames
+        taCxt   = map (\tyName -> nameTyApp (mkName "BasicType") (VarT tyName)) tyNames
     in InstanceD taCxt instTy []
 
 -- | Generate TA instances for tuple types according to the following template:
--- 
+--
 -- @
 -- instance (BasicType t1, ..., BasicType tn) => TA (t1, ..., tn) where
 -- @
@@ -235,13 +247,13 @@
         tupTy     = AppT (ConT qName) $ foldl' AppT (TupleT width) $ map VarT tyNames
         elemTys   = map (AppT (ConT qName)) $ map VarT tyNames
         arrowTy   = foldr mkArrowTy tupTy elemTys
-        qaConstr  = map (\n -> ClassP (mkName "QA") [VarT n]) tyNames
+        qaConstr  = map (\n -> nameTyApp (mkName "QA") (VarT n)) tyNames
         funTy     = ForallT (map PlainTV tyNames) qaConstr arrowTy
 
         -- Term stuff
-        qPats     = map (\n -> ConP qName [VarP n]) tyNames 
-        tupConApp = foldl' AppE (ConE $ innerConst width) $ map VarE tyNames
-        bodyExp   = AppE (ConE qName) (AppE (ConE outerConst) tupConApp)
+        qPats     = map (\n -> ConP qName [VarP n]) tyNames
+        tupConApp = foldl' AppE (ConE $ innerConst "" width) $ map VarE tyNames
+        bodyExp   = AppE (ConE qName) (AppE (ConE $ outerConst "") tupConApp)
 
         sig       = SigD (tupConName width) funTy
         body      = FunD (tupConName width) [Clause qPats (NormalB bodyExp) []]
@@ -249,7 +261,7 @@
 
 -- | Construct smart constructors for tuple types according to the
 -- following template.
--- 
+--
 -- @
 -- tup<n> :: (QA t1, ...,QA tn) => Q t1 -> ... -> Q tn -> Q (t1, ..., tn)
 -- tup<n> (Q v1) ... (Q vn)= Q (TupleConstE (Tuple<n>E v1 ... vn))
@@ -281,12 +293,12 @@
         subTermNames   = map mkName names
         transTermNames = map (mkName . (++ "'")) names
         transBinds     = zipWith mkTransBind subTermNames transTermNames
-        
+
         transTerms     = listE $ map varE transTermNames
-    conStmt <- NoBindS <$> 
+    conStmt <- NoBindS <$>
                [| return $ CL.MkTuple (T.TupleT $ map T.typeOf $transTerms) $transTerms |]
     let matchBody = DoE $ transBinds ++ [conStmt]
-        matchPat  = ConP (innerConst width) (map VarP subTermNames)
+        matchPat  = ConP (innerConst "" width) (map VarP subTermNames)
     return $ Match matchPat (NormalB matchBody) []
 
 -- | Generate the lambda expression that translates frontend tuple
@@ -311,11 +323,11 @@
 mkTranslateTypeMatch :: Int -> Q Match
 mkTranslateTypeMatch width = do
     let subTyNames   = map mkName $ map (\c -> [c]) $ take width ['a' .. 'z']
-        matchPat     = ConP (tupTyConstName width) (map VarP subTyNames)
+        matchPat     = ConP (tupTyConstName "" width) (map VarP subTyNames)
         transElemTys = ListE $ map (\n -> AppE (VarE $ mkName "translateType") (VarE n)) subTyNames
 
     let matchBody  = AppE (ConE 'T.TupleT) transElemTys
-        
+
     return $ Match matchPat (NormalB matchBody) []
 
 mkTranslateType :: Int -> Q Exp
@@ -351,10 +363,10 @@
         qPat        = ConP qName [VarP expName]
 
     viewBodyExp <- TupE <$> mapM (\idx -> appE (conE qName) $ mkTupElemTerm width idx expVar)
-                                 [1..width] 
+                                 [1..width]
 
     let viewClause  = Clause [qPat] (NormalB viewBodyExp) []
-        
+
     return $ FunD (mkName "view") [viewClause]
 
 mkViewInstance :: Int -> Q Dec
@@ -363,7 +375,7 @@
         tupTy     = tupleType $ map VarT names
         instTy    = AppT (ConT $ mkName "View") (AppT (ConT qName) tupTy)
 
-        viewCxt   = map (\n -> ClassP (mkName "QA") [VarT n]) names
+        viewCxt   = map (\n -> nameTyApp (mkName "QA") (VarT n)) names
         toViewDec = mkToView names tupTy
     viewDec <- mkViewFun width
     return $ InstanceD viewCxt instTy [toViewDec, viewDec]
@@ -388,39 +400,39 @@
         -- (t1, ..., t<n>)
         tupTy            = foldl' AppT (TupleT width)
                            $ map VarT tupElemTyNames
-    
+
         -- a ~ (t1, ..., t<n>)
-        tupConstraint    = EqualP (VarT tupTyName) tupTy
+        tupConstraint    = equalConstrTy (VarT tupTyName) tupTy
 
         -- Reify t1, ..., Reify t<n>
-        reifyConstraints = map (\n -> ClassP (mkName "Reify") [VarT n]) tupElemTyNames
+        reifyConstraints = map (\n -> nameTyApp (mkName "Reify") (VarT n)) tupElemTyNames
 
-        constraints      = tupConstraint : reifyConstraints 
+        constraints      = tupConstraint : reifyConstraints
 
     let -- '(Exp/Type t1) ... (Exp/Type t<n>)'
         elemTys = [ (NotStrict, elemTyCons (VarT t))
                   | t <- tupElemTyNames
                   ]
-    
+
     return $ ForallC tyVarBinders constraints
            $ NormalC (conName width) elemTys
 
--- | Generate the types for AST type and term tuple constructors: 'TupleConst' and 
+-- | Generate the types for AST type and term tuple constructors: 'TupleConst' and
 -- 'TupleType'. The first parameter is the name of the type. The second parameter
 -- is the type constructor for element fields and the third parameter generates
 -- the constructor name for a given tuple width.
--- 
+--
 -- @
 -- data TupleConst a where
---     Tuple<n>E :: (Reify t1, ..., Reify t<n>) => Exp t1 
---                                              -> ... 
---                                              -> Exp t<n> 
+--     Tuple<n>E :: (Reify t1, ..., Reify t<n>) => Exp t1
+--                                              -> ...
+--                                              -> Exp t<n>
 --                                              -> TupleConst (t1, ..., t<n>)
 -- @
--- 
+--
 -- Because TH does not directly support GADT syntax, we have to
 -- emulate it using explicit universal quantification:
--- 
+--
 -- @
 -- data TupleConst a =
 --     forall t1, ..., t<n>. a ~ (t1, ..., t<n>),
@@ -433,20 +445,20 @@
 mkTupleASTTy tyName elemTyCons conName maxWidth = do
     tupTyName <- newName "a"
     cons      <- mapM (mkTupleCons tupTyName conName elemTyCons) [2..maxWidth]
-    
+
     return $ [DataD [] tyName  [PlainTV tupTyName] cons []]
 
 -- | Generate the 'TupleConst' AST type for tuple term construction
 mkAstTupleConst :: Int -> Q [Dec]
 mkAstTupleConst maxWidth =
-    mkTupleASTTy (mkName "TupleConst") expCon innerConst maxWidth
+    mkTupleASTTy (mkName "TupleConst") expCon (innerConst "") maxWidth
   where
     expCon = AppT $ ConT $ mkName "Exp"
 
 -- | Generate the 'TupleConst' AST type for tuple term construction
 mkAstTupleType :: Int -> Q [Dec]
 mkAstTupleType maxWidth =
-    mkTupleASTTy (mkName "TupleType") expCon tupTyConstName maxWidth
+    mkTupleASTTy (mkName "TupleType") expCon (tupTyConstName "") maxWidth
   where
     expCon = AppT $ ConT $ mkName "Type"
 
@@ -460,21 +472,24 @@
 
 -- | The name of the constructor that constructs a tuple construction
 -- term.
-outerConst :: Name
-outerConst = mkName "TupleConstE"
+outerConst :: String -> Name
+outerConst "" = mkName "TupleConstE"
+outerConst m  = mkName $ printf "%s.TupleConstE" m
 
 -- | The name of the constructor for a given tuple width.
-innerConst :: Int -> Name
-innerConst width = mkName $ printf "Tuple%dE" width
+innerConst :: String -> Int -> Name
+innerConst "" width = mkName $ printf "Tuple%dE" width
+innerConst m  width = mkName $ printf "%s.Tuple%dE" m width
 
 -- | The name of a tuple access constructor for a given tuple width
 -- and element index.
 tupAccName :: Int -> Int -> Name
 tupAccName width elemIdx = mkName $ printf "Tup%d_%d" width elemIdx
-    
+
 -- | The name of the tuple type constructor for a given tuple width.
-tupTyConstName :: Int -> Name
-tupTyConstName width = mkName $ printf "Tuple%dT" width
+tupTyConstName :: String -> Int -> Name
+tupTyConstName "" width = mkName $ printf "Tuple%dT" width
+tupTyConstName m  width = mkName $ printf "%s.Tuple%dT" m width
 
 -- |
 tupleType :: [Type] -> Type
@@ -493,7 +508,7 @@
 
 -- | From a list of operand terms, construct a DSH tuple term.
 mkTupConstTerm :: [Exp] -> Q Exp
-mkTupConstTerm ts 
-    | length ts <= 16 = return $ AppE (ConE $ mkName "TupleConstE") 
-                               $ foldl' AppE (ConE $ innerConst $ length ts) ts
+mkTupConstTerm ts
+    | length ts <= 16 = return $ AppE (ConE $ mkName "TupleConstE")
+                               $ foldl' AppE (ConE $ innerConst "" $ length ts) ts
     | otherwise       = impossible
diff --git a/src/Database/DSH/Impossible.hs b/src/Database/DSH/Impossible.hs
deleted file mode 100644
--- a/src/Database/DSH/Impossible.hs
+++ /dev/null
@@ -1,19 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-
-module Database.DSH.Impossible (impossible, unimplemented) where
-
-import qualified Language.Haskell.TH as TH
-
-impossible :: TH.ExpQ
-impossible = do
-  loc <- TH.location
-  let pos =  (TH.loc_filename loc, fst (TH.loc_start loc), snd (TH.loc_start loc))
-  let message = "DSH: Impossible happened at " ++ show pos
-  return (TH.AppE (TH.VarE 'error) (TH.LitE (TH.StringL message)))
-
-unimplemented :: TH.ExpQ
-unimplemented = do
-  loc <- TH.location
-  let pos =  (TH.loc_filename loc, fst (TH.loc_start loc), snd (TH.loc_start loc))
-  let message = "DSH: Unimplemented at " ++ show pos
-  return (TH.AppE (TH.VarE 'error) (TH.LitE (TH.StringL message)))
diff --git a/src/Database/DSH/NKL/Kure.hs b/src/Database/DSH/NKL/Kure.hs
--- a/src/Database/DSH/NKL/Kure.hs
+++ b/src/Database/DSH/NKL/Kure.hs
@@ -11,10 +11,10 @@
 
       -- * The KURE monad
     , RewriteM, RewriteStateM, TransformN, RewriteN, LensN, freshNameT
-    
+
       -- * Setters and getters for the translation state
     , get, put, modify
-    
+
       -- * Changing between stateful and non-stateful transforms
     , statefulT, liftstateT
 
@@ -25,21 +25,20 @@
       -- * Congruence combinators
     , tableT, appe1T, appe2T, binopT, ifT, constExprT, varT, iteratorT, letT
     , tableR, appe1R, appe2R, binopR, ifR, litR, varR, iteratorR, letR
-    
+
     ) where
-    
-       
+
+
 import           Control.Monad
-import           Data.Monoid
 
 import           Language.KURE
 import           Language.KURE.Lens
-       
+
 import           Database.DSH.Common.RewriteM
 import           Database.DSH.Common.Lang
 import           Database.DSH.Common.Type
 import           Database.DSH.NKL.Lang
-                 
+
 --------------------------------------------------------------------------------
 -- Convenience type aliases
 
@@ -74,10 +73,10 @@
 data NestedCtx = NestedCtx { nkl_bindings :: [Ident]
                            , nkl_path     :: AbsPathN
                            }
-                       
+
 instance ExtendPath NestedCtx CrumbN where
     c@@n = c { nkl_path = nkl_path c @@ n }
-    
+
 instance ReadPath NestedCtx CrumbN where
     absPath c = nkl_path c
 
@@ -118,13 +117,13 @@
 --------------------------------------------------------------------------------
 -- Congruence combinators for CL expressions
 
-tableT :: Monad m => (Type -> String -> [Column] -> TableHints -> b)
+tableT :: Monad m => (Type -> String -> BaseTableSchema -> b)
                   -> Transform NestedCtx m Expr b
 tableT f = contextfreeT $ \expr -> case expr of
-                      Table ty n cs ks -> return $ f ty n cs ks
-                      _                -> fail "not a table node"
-{-# INLINE tableT #-}                      
-                      
+                      Table ty n schema -> return $ f ty n schema
+                      _                 -> fail "not a table node"
+{-# INLINE tableT #-}
+
 tableR :: Monad m => Rewrite NestedCtx m Expr
 tableR = tableT Table
 {-# INLINE tableR #-}
@@ -134,8 +133,8 @@
                      -> (Type -> a1 -> Ident -> a2 -> b)
                      -> Transform NestedCtx m Expr b
 iteratorT t1 t2 f = transform $ \c expr -> case expr of
-                     Iterator ty h x xs -> f ty <$> applyT t1 (c@@IteratorHead) h 
-                                                <*> return x 
+                     Iterator ty h x xs -> f ty <$> applyT t1 (c@@IteratorHead) h
+                                                <*> return x
                                                 <*> applyT t2 (c@@IteratorSource) xs
                      _              -> fail "not an iterator node"
 {-# INLINE iteratorT #-}
@@ -143,46 +142,46 @@
 iteratorR :: Monad m => Rewrite NestedCtx m Expr -> Rewrite NestedCtx m Expr -> Rewrite NestedCtx m Expr
 iteratorR t1 t2 = iteratorT t1 t2 Iterator
 {-# INLINE iteratorR #-}
-                                       
+
 appe1T :: Monad m => Transform NestedCtx m Expr a
                   -> (Type -> Prim1 -> a -> b)
                   -> Transform NestedCtx m Expr b
 appe1T t f = transform $ \c expr -> case expr of
-                      AppE1 ty p e -> f ty p <$> applyT t (c@@AppE1Arg) e                  
+                      AppE1 ty p e -> f ty p <$> applyT t (c@@AppE1Arg) e
                       _            -> fail "not a unary primitive application"
-{-# INLINE appe1T #-}                      
-                      
+{-# INLINE appe1T #-}
+
 appe1R :: Monad m => Rewrite NestedCtx m Expr -> Rewrite NestedCtx m Expr
 appe1R t = appe1T t AppE1
-{-# INLINE appe1R #-}                      
-                      
+{-# INLINE appe1R #-}
+
 appe2T :: Monad m => Transform NestedCtx m Expr a1
                   -> Transform NestedCtx m Expr a2
                   -> (Type -> Prim2 -> a1 -> a2 -> b)
                   -> Transform NestedCtx m Expr b
 appe2T t1 t2 f = transform $ \c expr -> case expr of
-                     AppE2 ty p e1 e2 -> f ty p <$> applyT t1 (c@@AppE2Arg1) e1 
+                     AppE2 ty p e1 e2 -> f ty p <$> applyT t1 (c@@AppE2Arg1) e1
                                                 <*> applyT t2 (c@@AppE2Arg2) e2
                      _                -> fail "not a binary primitive application"
-{-# INLINE appe2T #-}                      
+{-# INLINE appe2T #-}
 
 appe2R :: Monad m => Rewrite NestedCtx m Expr -> Rewrite NestedCtx m Expr -> Rewrite NestedCtx m Expr
 appe2R t1 t2 = appe2T t1 t2 AppE2
-{-# INLINE appe2R #-}                      
-                     
+{-# INLINE appe2R #-}
+
 binopT :: Monad m => Transform NestedCtx m Expr a1
                   -> Transform NestedCtx m Expr a2
                   -> (Type -> ScalarBinOp -> a1 -> a2 -> b)
                   -> Transform NestedCtx m Expr b
 binopT t1 t2 f = transform $ \c expr -> case expr of
-                     BinOp ty op e1 e2 -> f ty op <$> applyT t1 (c@@BinOpArg1) e1 
+                     BinOp ty op e1 e2 -> f ty op <$> applyT t1 (c@@BinOpArg1) e1
                                                   <*> applyT t2 (c@@BinOpArg2) e2
                      _                 -> fail "not a binary operator application"
-{-# INLINE binopT #-}                      
+{-# INLINE binopT #-}
 
 binopR :: Monad m => Rewrite NestedCtx m Expr -> Rewrite NestedCtx m Expr -> Rewrite NestedCtx m Expr
 binopR t1 t2 = binopT t1 t2 BinOp
-{-# INLINE binopR #-}                      
+{-# INLINE binopR #-}
 
 unopT :: Monad m => Transform NestedCtx m Expr a
                  -> (Type -> ScalarUnOp -> a -> b)
@@ -195,58 +194,58 @@
 unopR :: Monad m => Rewrite NestedCtx m Expr -> Rewrite NestedCtx m Expr
 unopR t = unopT t UnOp
 {-# INLINE unopR #-}
-                     
+
 ifT :: Monad m => Transform NestedCtx m Expr a1
                -> Transform NestedCtx m Expr a2
                -> Transform NestedCtx m Expr a3
                -> (Type -> a1 -> a2 -> a3 -> b)
                -> Transform NestedCtx m Expr b
 ifT t1 t2 t3 f = transform $ \c expr -> case expr of
-                    If ty e1 e2 e3 -> f ty <$> applyT t1 (c@@IfCond) e1               
+                    If ty e1 e2 e3 -> f ty <$> applyT t1 (c@@IfCond) e1
                                            <*> applyT t2 (c@@IfThen) e2
                                            <*> applyT t3 (c@@IfElse) e3
                     _              -> fail "not an if expression"
-{-# INLINE ifT #-}                      
-                    
+{-# INLINE ifT #-}
+
 ifR :: Monad m => Rewrite NestedCtx m Expr
                -> Rewrite NestedCtx m Expr
                -> Rewrite NestedCtx m Expr
                -> Rewrite NestedCtx m Expr
-ifR t1 t2 t3 = ifT t1 t2 t3 If               
-{-# INLINE ifR #-}                      
-                    
+ifR t1 t2 t3 = ifT t1 t2 t3 If
+{-# INLINE ifR #-}
+
 constExprT :: Monad m => (Type -> Val -> b) -> Transform NestedCtx m Expr b
 constExprT f = contextfreeT $ \expr -> case expr of
                     Const ty v -> return $ f ty v
                     _          -> fail "not a constant"
-{-# INLINE constExprT #-}                      
-                    
+{-# INLINE constExprT #-}
+
 litR :: Monad m => Rewrite NestedCtx m Expr
 litR = constExprT Const
-{-# INLINE litR #-}                      
-                    
+{-# INLINE litR #-}
+
 varT :: Monad m => (Type -> Ident -> b) -> Transform NestedCtx m Expr b
 varT f = contextfreeT $ \expr -> case expr of
                     Var ty n -> return $ f ty n
                     _        -> fail "not a variable"
-{-# INLINE varT #-}                      
-                    
+{-# INLINE varT #-}
+
 varR :: Monad m => Rewrite NestedCtx m Expr
 varR = varT Var
-{-# INLINE varR #-}                      
+{-# INLINE varR #-}
 
 letT :: Monad m => Transform NestedCtx m Expr a1
                 -> Transform NestedCtx m Expr a2
-                -> (Type -> Ident -> a1 -> a2 -> b) 
+                -> (Type -> Ident -> a1 -> a2 -> b)
                 -> Transform NestedCtx m Expr b
 letT t1 t2 f = transform $ \c expr -> case expr of
-                 Let ty x xs e -> f ty x <$> applyT t1 (c@@LetBind) xs 
+                 Let ty x xs e -> f ty x <$> applyT t1 (c@@LetBind) xs
                                          <*> applyT t2 (bindVar x $ c@@LetBody) e
                  _             -> fail "not a let expression"
 
-letR :: Monad m => Rewrite NestedCtx m Expr 
-                -> Rewrite NestedCtx m Expr 
+letR :: Monad m => Rewrite NestedCtx m Expr
                 -> Rewrite NestedCtx m Expr
+                -> Rewrite NestedCtx m Expr
 letR r1 r2 = letT r1 r2 Let
 
 mkTupleT :: Monad m => Transform NestedCtx m Expr a
@@ -262,7 +261,7 @@
 
 
 --------------------------------------------------------------------------------
-       
+
 instance Walker NestedCtx Expr where
     allR :: forall m. MonadCatch m => Rewrite NestedCtx m Expr -> Rewrite NestedCtx m Expr
     allR r = readerT $ \e -> case e of
@@ -277,15 +276,3 @@
             Var{}      -> idR
             Let{}      -> letR (extractR r) (extractR r)
             MkTuple{}  -> mkTupleR (extractR r)
-            
---------------------------------------------------------------------------------
--- I find it annoying that Applicative is not a superclass of Monad.
-
-(<$>) :: Monad m => (a -> b) -> m a -> m b
-(<$>) = liftM
-{-# INLINE (<$>) #-}
-
-(<*>) :: Monad m => m (a -> b) -> m a -> m b
-(<*>) = ap
-{-# INLINE (<*>) #-}
-
diff --git a/src/Database/DSH/NKL/Lang.hs b/src/Database/DSH/NKL/Lang.hs
--- a/src/Database/DSH/NKL/Lang.hs
+++ b/src/Database/DSH/NKL/Lang.hs
@@ -14,14 +14,14 @@
 import           Text.PrettyPrint.ANSI.Leijen
 import           Text.Printf
 
-import           Database.DSH.Impossible
-import qualified Database.DSH.Common.Lang     as L
-import           Database.DSH.Common.Pretty
+import           Database.DSH.Common.Impossible
+import qualified Database.DSH.Common.Lang       as L
 import           Database.DSH.Common.Nat
-import           Database.DSH.Common.Type     (Type, Typed, typeOf)
+import           Database.DSH.Common.Pretty
+import           Database.DSH.Common.Type       (Type, Typed, typeOf)
 
 -- | Nested Kernel Language (NKL) expressions
-data Expr  = Table Type String [L.Column] L.TableHints
+data Expr  = Table Type String L.BaseTableSchema
            | AppE1 Type Prim1 Expr
            | AppE2 Type Prim2 Expr Expr
            | BinOp Type L.ScalarBinOp Expr Expr
@@ -35,7 +35,7 @@
            deriving (Show)
 
 instance Typed Expr where
-    typeOf (Table t _ _ _)    = t
+    typeOf (Table t _ _)      = t
     typeOf (AppE1 t _ _)      = t
     typeOf (AppE2 t _ _ _)    = t
     typeOf (If t _ _ _)       = t
@@ -48,91 +48,79 @@
     typeOf (MkTuple t _)      = t
 
 instance Pretty Expr where
-    pretty (MkTuple _ es)      = tupled $ map pretty es
-    pretty (AppE1 _ (TupElem n) e1) = 
+    pretty (MkTuple _ es)      = prettyTuple $ map pretty es
+    pretty (AppE1 _ (TupElem n) e1) =
         parenthize e1 <> dot <> int (tupleIndex n)
-    pretty (Table _ n _ _)     = text "table" <> parens (text n)
-    pretty (AppE1 _ p1 e)      = (text $ show p1) <+> (parenthize e)
-    pretty (AppE2 _ p1 e1 e2)  = (text $ show p1) <+> (align $ (parenthize e1) </> (parenthize e2))
-    pretty (BinOp _ o e1 e2)   = (parenthize e1) <+> (pretty o) <+> (parenthize e2)
-    pretty (UnOp _ o e)        = text (show o) <> parens (pretty e)
-    pretty (If _ c t e)        = text "if"
-                                 <+> pretty c
-                                 <+> text "then"
-                                 <+> (parenthize t)
-                                 <+> text "else"
-                                 <+> (parenthize e)
+    pretty (Table _ n _)       = kw (text "table") <> parens (text n)
+    pretty (AppE1 _ p1 e)      = pretty p1 <+> (parenthize e)
+    pretty (AppE2 _ p2 e1 e2)
+        | isJoinOp p2 = prettyJoin (pretty p2) (parenthize e1) (parenthize e2)
+        | otherwise   = prettyApp2 (pretty p2) (parenthize e1) (parenthize e2)
+    pretty (UnOp _ o e)        = prettyUnOp (pretty o) (pretty e)
+    pretty (BinOp _ o e1 e2)
+        | L.isBinInfixOp o = prettyInfixBinOp (pretty o)
+                                              (parenthize e1)
+                                              (parenthize e2)
+        | otherwise        = prettyPrefixBinOp (pretty o)
+                                               (parenthize e1)
+                                               (parenthize e2)
+    pretty (If _ c t e)        = prettyIf (pretty c) (pretty t) (pretty e)
     pretty (Const _ v)         = pretty v
     pretty (Var _ s)           = text s
-    pretty (Iterator _ e x xs) = align 
-                                $ brackets 
-                                $ enclose (char ' ') (char ' ') 
-                                $ pretty e </> char '|' <+> text x <+> text "<-" <+> pretty xs
-    pretty (Let _ x e1 e)      = 
-        align $ text "let" <+> text x <+> char '=' <+> pretty e1
-                </>
-                text "in" <+> pretty e
+    pretty (Iterator _ e x xs) =
+        prettyComp (pretty e) [text x <+> comp (text "<-") <+> pretty xs]
+    pretty (Let _ x e1 e)      = prettyLet (text x) (pretty e1) (pretty e)
 
 parenthize :: Expr -> Doc
 parenthize e =
     case e of
         Var _ _               -> pretty e
         Const _ _             -> pretty e
-        Table _ _ _ _         -> pretty e
+        Table _ _ _           -> pretty e
         Iterator _ _ _ _      -> pretty e
         AppE1 _ (TupElem _) _ -> pretty e
         _                     -> parens $ pretty e
 
 data Prim1 = Singleton
-           | Length 
+           | Only
+           | Length
            | Concat
-           | Sum 
-           | Avg 
-           | The 
-           | Head
-           | Tail
-           | Minimum 
+           | Sum
+           | Avg
+           | Minimum
            | Maximum
-           | Reverse 
-           | And 
+           | Reverse
+           | And
            | Or
-           | Init 
-           | Last 
            | Nub
            | Number
-           | Reshape Integer
-           | Transpose
+           | Sort
+           | Group
+           | Restrict
            | TupElem TupleIndex
-           deriving (Eq)
+           deriving (Eq, Show)
 
-instance Show Prim1 where
-    show Singleton       = "sng"
-    show Length          = "length"
-    show Concat          = "concat"
-    show Sum             = "sum"
-    show Avg             = "avg"
-    show The             = "the"
-    show Head            = "head"
-    show Minimum         = "minimum"
-    show Maximum         = "maximum"
-    show Tail            = "tail"
-    show Reverse         = "reverse"
-    show And             = "and"
-    show Or              = "or"
-    show Init            = "init"
-    show Last            = "last"
-    show Nub             = "nub"
-    show Number          = "number"
-    show Transpose       = "transpose"
-    show (Reshape n)     = printf "reshape(%d)" n
+instance Pretty Prim1 where
+    pretty Singleton       = combinator $ text "sng"
+    pretty Only            = combinator $ text "only"
+    pretty Length          = combinator $ text "length"
+    pretty Concat          = combinator $ text "concat"
+    pretty Sum             = combinator $ text "sum"
+    pretty Avg             = combinator $ text "avg"
+    pretty Minimum         = combinator $ text "minimum"
+    pretty Maximum         = combinator $ text "maximum"
+    pretty Reverse         = combinator $ text "reverse"
+    pretty And             = combinator $ text "and"
+    pretty Or              = combinator $ text "or"
+    pretty Nub             = combinator $ text "nub"
+    pretty Number          = combinator $ text "number"
+    pretty Sort            = combinator $ text "sort"
+    pretty Restrict        = restrict $ text "restrict"
+    pretty Group           = combinator $ text "group"
     -- tuple access is pretty-printed in a special way
-    show TupElem{}       = $impossible
-  
-data Prim2 = Group
-           | Sort
-           | Restrict
-           | Append
-           | Index
+    pretty TupElem{}       = $impossible
+
+data Prim2 = Append
            | Zip
            | CartProduct
            | NestProduct
@@ -140,18 +128,27 @@
            | NestJoin (L.JoinPredicate L.JoinExpr)
            | SemiJoin (L.JoinPredicate L.JoinExpr)
            | AntiJoin (L.JoinPredicate L.JoinExpr)
-           deriving (Eq)
+           deriving (Eq, Show)
 
-instance Show Prim2 where
-    show Group        = "group"
-    show Sort         = "sort"
-    show Restrict     = "restrict"
-    show Append       = "append"
-    show Index        = "index"
-    show Zip          = "zip"
-    show CartProduct  = "⨯"
-    show NestProduct  = "▽"
-    show (ThetaJoin p) = printf "⨝_%s" (pp p)
-    show (NestJoin p)  = printf "△_%s" (pp p)
-    show (SemiJoin p)  = printf "⋉_%s" (pp p)
-    show (AntiJoin p)  = printf "▷_%s" (pp p)
+isJoinOp :: Prim2 -> Bool
+isJoinOp op =
+    case op of
+        CartProduct -> True
+        NestProduct -> True
+        ThetaJoin{} -> True
+        NestJoin{}  -> True
+        SemiJoin{}  -> True
+        AntiJoin{}  -> True
+        Append      -> False
+        Zip         -> False
+
+instance Pretty Prim2 where
+    pretty Append        = combinator $ text "append"
+    pretty Zip           = combinator $ text "zip"
+
+    pretty CartProduct     = join $ text "cartproduct"
+    pretty NestProduct     = join $ text "nestproduct"
+    pretty (ThetaJoin p)   = join $ text $ printf "thetajoin{%s}" (pp p)
+    pretty (NestJoin p)    = join $ text $ printf "nestjoin{%s}" (pp p)
+    pretty (SemiJoin p)    = join $ text $ printf "semijoin{%s}" (pp p)
+    pretty (AntiJoin p)    = join $ text $ printf "antijoin{%s}" (pp p)
diff --git a/src/Database/DSH/NKL/Primitives.hs b/src/Database/DSH/NKL/Primitives.hs
--- a/src/Database/DSH/NKL/Primitives.hs
+++ b/src/Database/DSH/NKL/Primitives.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE PatternSynonyms #-}
+
 -- | Smart constructors for NKL combinators
 module Database.DSH.NKL.Primitives where
 
@@ -24,7 +26,7 @@
 -- Smart constructors
 
 tupElem :: TupleIndex -> Expr -> Expr
-tupElem f e = 
+tupElem f e =
     let t = tupleElemT (typeOf e) f
     in AppE1 t (TupElem f) e
 
@@ -44,7 +46,7 @@
     in MkTuple rt es
 
 sng :: Expr -> Expr
-sng x = AppE1 (listT $ typeOf x) Singleton x
+sng x = AppE1 (ListT $ typeOf x) Singleton x
 
 concat :: Expr -> Expr
 concat e = let t = typeOf e
@@ -52,23 +54,22 @@
                then AppE1 (unliftType t) Concat e
                else tyErrShow "concat" [t]
 
-restrict :: Expr -> Expr -> Expr
-restrict vs bs = let vst@(ListT _)     = typeOf vs
-                 in AppE2 vst Restrict vs bs
+restrict :: Expr -> Expr
+restrict xs = let ListT (TupleT [xt, PBoolT]) = typeOf xs
+              in AppE1 (ListT xt) Restrict xs
 
-sort :: Expr -> Expr -> Expr
-sort vs ss = let vst@(ListT _) = typeOf vs
-             in AppE2 vst Sort vs ss
+sort :: Expr -> Expr
+sort xs = let ListT (TupleT [xt, _]) = typeOf xs
+          in AppE1 (ListT xt) Sort xs
 
--- FIXME type is not correct
-group :: Expr -> Expr -> Expr
-group vs gs = let vst@(ListT _) = typeOf vs
-              in AppE2 vst Group vs gs
+group :: Expr -> Expr
+group xs = let ListT (TupleT [xt, gt]) = typeOf xs
+           in AppE1 (ListT (TupleT [gt, ListT xt])) Group xs
 
 let_ :: Ident -> Expr -> Expr -> Expr
 let_ x e1 e2 = let t = typeOf e1 in Let t x e1 e2
 
 if_ :: Expr -> Expr -> Expr -> Expr
-if_ c t e = if BoolT == typeOf c
+if_ c t e = if PBoolT == typeOf c
             then If (typeOf t) c t e
             else tyErr "if_"
diff --git a/src/Database/DSH/NKL/Rewrite.hs b/src/Database/DSH/NKL/Rewrite.hs
--- a/src/Database/DSH/NKL/Rewrite.hs
+++ b/src/Database/DSH/NKL/Rewrite.hs
@@ -9,18 +9,19 @@
     , optimizeNKL
     ) where
 
-import Control.Arrow
-import Data.List
-import Data.Monoid
+import           Control.Arrow
+import           Data.List
+import           Data.Monoid
 
-import Database.DSH.Impossible
-import Database.DSH.Common.Type
-import Database.DSH.Common.Lang
-import Database.DSH.Common.Kure
-import Database.DSH.Common.RewriteM
-import Database.DSH.NKL.Kure
-import Database.DSH.NKL.Lang
+import           Database.DSH.Common.Impossible
 
+import           Database.DSH.Common.Lang
+import           Database.DSH.Common.RewriteM
+import           Database.DSH.Common.Type
+import           Database.DSH.NKL.Kure
+import           Database.DSH.NKL.Lang
+import qualified Database.DSH.NKL.Primitives    as P
+
 -- | Run a translate on an expression without context
 applyExpr :: [Ident] -> TransformN Expr b -> Expr -> Either String b
 applyExpr nameCtx f e = runRewriteM $ applyT f (initialCtx nameCtx) (inject e)
@@ -56,12 +57,12 @@
 subst nameCtx x s e = either (const e) id $ applyExpr nameCtx (substR x s) e
 
 alphaCompR :: [Ident] -> RewriteN Expr
-alphaCompR avoidNames = do 
+alphaCompR avoidNames = do
     Iterator compTy h x _  <- idR
     x'                     <- freshNameT (x : freeVars h ++ avoidNames)
     let varTy = elemT compTy
-    iteratorT (tryR $ substR x (Var varTy x')) 
-              idR 
+    iteratorT (tryR $ substR x (Var varTy x'))
+              idR
               (\_ h' _ xs' -> Iterator compTy h' x' xs')
 
 alphaLetR :: [Ident] -> RewriteN Expr
@@ -129,8 +130,9 @@
     _                         -> anyR $ inlineBindingR v s
 
 pattern ConcatP t xs <- AppE1 t Concat xs
-pattern SingletonP e <- AppE1 _ Singleton e 
-       
+pattern SingletonP e <- AppE1 _ Singleton e
+pattern RestrictP e  <- AppE1 _ Restrict e
+
 -- concatMap (\x -> [e x]) xs
 -- concat [ [ e x ] | x <- xs ]
 -- =>
@@ -147,7 +149,7 @@
     Var _ n | n == v         -> return 1
     Var _ _ | otherwise      -> return 0
 
-    Let _ n _ _ | n == v     -> letT (constT $ return 0) 
+    Let _ n _ _ | n == v     -> letT (constT $ return 0)
                                      (countVarRefT v)
                                      (\_ _ c1 c2 -> c1 + c2)
     Let _ _ _ _ | otherwise  -> letT (countVarRefT v)
@@ -197,15 +199,62 @@
     Let _ x e1 _ <- idR
     guardM $ simpleExpr e1
     childT LetBody $ substR x e1
-    
+
+-- | Eliminate an iterator that does not perform any work.
+identityIteratorR :: RewriteN Expr
+identityIteratorR = do
+    Iterator _ (Var _ x) x' xs <- idR
+    guardM $ x == x'
+    return xs
+
+-- | Push an iterator expression into a Sort operator to get a more
+-- compact NKL expression. Note: Effectively, this rewrite pulls up
+-- sorting in the plan. For sorting, this is propably OK. For
+-- Restrict, though, that would not be a good idea.
+--
+-- [ f x | x <- sort [ (g y, h y) | y <- ys ] ]
+-- =>
+-- sort [ (f [g y/x], h y) | y <- ys ]
+mergeSortIteratorR :: RewriteN Expr
+mergeSortIteratorR = do
+    Iterator _ f x (AppE1 _ Sort (Iterator _ (MkTuple _ [g, h]) y ys)) <- idR
+    g' <- constT (return f) >>> substR x g
+    let ft = typeOf f
+        pt = TupleT [ft, PBoolT]
+    return $ AppE1 (ListT ft) Sort (Iterator (ListT pt) (MkTuple pt [g', h]) y ys)
+
+-- | Merge two adjacent restricts into one.
+--
+-- restrict [ (x, p1 x) | x <- restrict [ (y, p2 y) | y <- ys ] ]
+-- =>
+-- restrict [ (y, p1[y/x] y && p2 y) | y <- ys ]
+mergeRestrictR :: RewriteN Expr
+mergeRestrictR = do
+    RestrictP (Iterator _ (MkTuple _ [Var _ x', p1])
+                          x
+                          (RestrictP (Iterator _ (MkTuple _ [Var _ y', p2])
+                                     y
+                                     ys)))                                  <- idR
+    guardM $ x == x'
+    guardM $ y == y'
+    let yt  = elemT $ typeOf ys
+        yst = ListT yt
+    p1' <- constT (return p1) >>> substR x (Var yt y)
+    let p = BinOp PBoolT (SBBoolOp Conj) p1' p2
+    return $ P.restrict (Iterator yst (P.tuple [Var yt y, p]) y ys)
+
 nklOptimizations :: RewriteN Expr
-nklOptimizations = anybuR $ singletonHeadR 
-                            <+ unusedBindingR 
+nklOptimizations = anybuR $ singletonHeadR
+                            <+ unusedBindingR
                             <+ referencedOnceR
                             <+ simpleBindingR
+                            <+ identityIteratorR
+                            <+ mergeSortIteratorR
+                            <+ mergeRestrictR
 
 optimizeNKL :: Expr -> Expr
-optimizeNKL expr = debugOpt "NKL" expr optimizedExpr
-  where
-    optimizedExpr = applyExpr [] nklOptimizations expr
-        
+optimizeNKL expr =
+    case applyExpr [] nklOptimizations expr of
+        Left _      -> expr
+        Right expr' -> expr'
+
diff --git a/src/Database/DSH/Optimizer/Common/Auxiliary.hs b/src/Database/DSH/Optimizer/Common/Auxiliary.hs
deleted file mode 100644
--- a/src/Database/DSH/Optimizer/Common/Auxiliary.hs
+++ /dev/null
@@ -1,11 +0,0 @@
-module Database.DSH.Optimizer.Common.Auxiliary where
-
-import qualified Data.IntMap as M
-
--- | Perform a map lookup and fail with the given error string if the key
--- is not present
-lookupUnsafe :: Show a => M.IntMap a -> String -> Int -> a
-lookupUnsafe m s u =
-    case M.lookup u m of
-        Just p -> p
-        Nothing -> error $ s ++ " " ++ (show u) ++ " in " ++ (show m)
diff --git a/src/Database/DSH/Optimizer/Common/Rewrite.hs b/src/Database/DSH/Optimizer/Common/Rewrite.hs
deleted file mode 100644
--- a/src/Database/DSH/Optimizer/Common/Rewrite.hs
+++ /dev/null
@@ -1,74 +0,0 @@
-module Database.DSH.Optimizer.Common.Rewrite
-  ( module Database.Algebra.Rewrite.Match
-  , module Database.Algebra.Rewrite.PatternConstruction
-  , module Database.Algebra.Rewrite.Properties
-  , module Database.Algebra.Rewrite.Rule
-  , module Database.Algebra.Rewrite.Traversal
-  , replaceRoot
-  , replaceWithNew
-  , replace
-  , R.Rewrite
-  , R.runRewrite
-  , R.initRewriteState
-  , R.Log
-  , R.logGeneral
-  , R.logRewrite
-  , R.parents
-  , R.topsort
-  , R.operator
-  , R.rootNodes
-  , R.exposeDag
-  , R.getExtras
-  , R.condRewrite
-  , R.updateExtras
-  , R.insert
-  , R.insertNoShare
-  , R.replaceChild
-  , R.infer
-  , R.collect
-  )
-
-where
-
-import qualified Database.Algebra.Dag                          as D
-import           Database.Algebra.Dag.Common
-import qualified Database.Algebra.Rewrite.DagRewrite           as R
-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
-
-import           Database.DSH.Common.QueryPlan
-import           Database.DSH.VL.Vector
-
---------------------------------------------------------------
--- Versions of rewrite combinators that maintain the Shape
--- description of the query structure.
-
--- | Replace a root node while maintaining the query structure
--- information.
-replaceRoot :: (DagVector v, D.Operator o) => AlgNode -> AlgNode -> R.Rewrite o (Shape v) ()
-replaceRoot oldRoot newRoot = do
-  sh <- R.getExtras
-  R.updateExtras $ updateShape oldRoot newRoot sh
-  R.replaceRoot oldRoot newRoot
-
--- | Replace a node with a new operator while mainting the query
--- structure information.
-replaceWithNew :: (D.Operator o, Show o, DagVector v) 
-               => AlgNode -> o -> R.Rewrite o (Shape v) AlgNode
-replaceWithNew oldNode newOp = do
-  sh <- R.getExtras
-  newNode <- R.replaceWithNew oldNode newOp
-  R.updateExtras $ updateShape oldNode newNode sh
-  return newNode
-
--- | Replace a node with another node while maintaining the query
--- structure information.
-replace :: (DagVector v, D.Operator o) 
-        => AlgNode -> AlgNode -> R.Rewrite o (Shape v) ()
-replace oldNode newNode = do
-  sh <- R.getExtras
-  R.replace oldNode newNode
-  R.updateExtras $ updateShape oldNode newNode sh
diff --git a/src/Database/DSH/Optimizer/TA/OptimizeTA.hs b/src/Database/DSH/Optimizer/TA/OptimizeTA.hs
deleted file mode 100644
--- a/src/Database/DSH/Optimizer/TA/OptimizeTA.hs
+++ /dev/null
@@ -1,52 +0,0 @@
-module Database.DSH.Optimizer.TA.OptimizeTA where
-
-import qualified Data.IntMap as M
-
-import qualified Database.Algebra.Dag                                             as Dag
-
-import           Database.Algebra.Table.Lang
-
-import           Database.DSH.Common.QueryPlan
-import           Database.DSH.VL.Vector
-
-import           Database.DSH.Optimizer.Common.Rewrite
-
-import           Database.DSH.Optimizer.TA.Rewrite.Basic
-
-{-
-
-rough plan/first goals:
-
-merge projections: no properties, leads to basic infrastructure
-
-prune unreferenced rownums: icols prop
-
-simplify rownums, e.g. key-based: key prop, maybe fd (not sure if necessary)
-
-merge sorting criteria into rownums:  track sorting criteria
-
-remove rownums if concrete values not required: use prop, key prop, ?
-
--}
-
-type RewriteClass = Rewrite TableAlgebra (Shape NDVec) Bool
-
-defaultPipeline :: [RewriteClass]
-defaultPipeline = [cleanup]
-
-runPipeline :: Dag.AlgebraDag TableAlgebra 
-            -> (Shape NDVec)
-            -> [RewriteClass] 
-            -> Bool 
-            -> (Dag.AlgebraDag TableAlgebra, Log, Shape NDVec)
-runPipeline d sh pipeline debug = (d', rewriteLog, sh')
-  where (d', sh', _, rewriteLog) = runRewrite (sequence_ pipeline) d sh debug
-
-optimizeTA :: QueryPlan TableAlgebra NDVec -> QueryPlan TableAlgebra NDVec
-optimizeTA plan =
-#ifdef DEBUGGRAPH
-  let (d, _rewriteLog, shape) = runPipeline (queryDag plan) (queryShape plan) defaultPipeline True
-#else
-  let (d, _rewriteLog, shape) = runPipeline (queryDag plan) (queryShape plan) defaultPipeline False
-#endif
-  in QueryPlan { queryDag = d, queryShape = shape, queryTags = M.empty }
diff --git a/src/Database/DSH/Optimizer/TA/Properties/Auxiliary.hs b/src/Database/DSH/Optimizer/TA/Properties/Auxiliary.hs
deleted file mode 100644
--- a/src/Database/DSH/Optimizer/TA/Properties/Auxiliary.hs
+++ /dev/null
@@ -1,73 +0,0 @@
--- | Some auxiliary functions for property inference.
-module Database.DSH.Optimizer.TA.Properties.Auxiliary where
-
-import qualified Data.Set.Monad              as S
-
-import           Database.Algebra.Table.Lang
-
-(∪) :: Ord a => S.Set a -> S.Set a -> S.Set a
-(∪) = S.union
-
-(∩) :: Ord a => S.Set a -> S.Set a -> S.Set a
-(∩) = S.intersection
-
-(∖) :: Ord a => S.Set a -> S.Set a -> S.Set a
-(∖) = S.difference
-
-(∈) :: Ord a => a -> S.Set a -> Bool
-(∈) = S.member
-
-(⊆) :: Ord a => S.Set a -> S.Set a -> Bool
-(⊆) = S.isSubsetOf
-
--- | Singleton set abbreviation
-ss :: Ord a => a -> S.Set a
-ss = S.singleton
-
--- | List set abbreviation
-ls :: Ord a => [a] -> S.Set a
-ls = S.fromList
-
-unionss :: Ord a => S.Set (S.Set a) -> S.Set a
-unionss = S.foldr (∪) S.empty
-
-exprCols :: Expr -> S.Set Attr
-exprCols (BinAppE _ e1 e2) = exprCols e1 ∪ exprCols e2
-exprCols (IfE c t e)       = exprCols c ∪ exprCols t ∪ exprCols e
-exprCols (UnAppE _ e)      = exprCols e
-exprCols (ColE c)          = S.singleton c
-exprCols (ConstE _)        = S.empty
-
-aggrInput :: AggrType -> S.Set Attr
-aggrInput (Avg e)  = exprCols e
-aggrInput (Max e)  = exprCols e
-aggrInput (Min e)  = exprCols e
-aggrInput (Sum e)  = exprCols e
-aggrInput (All e)  = exprCols e
-aggrInput (Any e)  = exprCols e
-aggrInput Count    = S.empty
-
-winFunInput :: WinFun -> S.Set Attr
-winFunInput (WinAvg e)        = exprCols e
-winFunInput (WinMax e)        = exprCols e
-winFunInput (WinMin e)        = exprCols e
-winFunInput (WinSum e)        = exprCols e
-winFunInput (WinAll e)        = exprCols e
-winFunInput (WinAny e)        = exprCols e
-winFunInput (WinFirstValue e) = exprCols e
-winFunInput (WinLastValue e)  = exprCols e
-winFunInput WinCount          = S.empty
-
-mapCol :: Proj -> Maybe (Attr, Attr)
-mapCol (a, ColE b)                   = Just (a, b)
-mapCol (a, UnAppE (Cast _) (ColE b)) = Just (a, b)
-mapCol _                             = Nothing
-
-mColE :: Expr -> Maybe Attr
-mColE (ColE c) = Just c
-mColE _        = Nothing
-
-posCol :: SerializeOrder -> S.Set Attr
-posCol (AbsPos c)  = S.singleton c
-posCol (RelPos cs) = S.fromList cs
-posCol NoPos       = S.empty
diff --git a/src/Database/DSH/Optimizer/TA/Properties/BottomUp.hs b/src/Database/DSH/Optimizer/TA/Properties/BottomUp.hs
deleted file mode 100644
--- a/src/Database/DSH/Optimizer/TA/Properties/BottomUp.hs
+++ /dev/null
@@ -1,93 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-
-module Database.DSH.Optimizer.TA.Properties.BottomUp where
-
-import qualified Data.Set.Monad                             as S
-
-import           Database.Algebra.Dag
-import           Database.Algebra.Dag.Common
-import           Database.Algebra.Table.Lang
-
-import           Database.DSH.Impossible
-
-import           Database.DSH.Optimizer.Common.Auxiliary
-import           Database.DSH.Optimizer.Common.Rewrite
-
-import           Database.DSH.Optimizer.TA.Properties.Card1
-import           Database.DSH.Optimizer.TA.Properties.Cols
-import           Database.DSH.Optimizer.TA.Properties.Empty
-import           Database.DSH.Optimizer.TA.Properties.Keys
-import           Database.DSH.Optimizer.TA.Properties.Order
-import           Database.DSH.Optimizer.TA.Properties.Const
-import           Database.DSH.Optimizer.TA.Properties.Types
-
--- FIXME this is (almost) identical to its X100 counterpart -> merge
-inferWorker :: NodeMap TableAlgebra -> TableAlgebra -> AlgNode -> NodeMap BottomUpProps -> BottomUpProps
-inferWorker _ op n pm =
-    let res =
-           case op of
-                TerOp _ _ _ _ -> $impossible
-                BinOp vl c1 c2 ->
-                  let c1Props = lookupUnsafe pm "no children properties" c1
-                      c2Props = lookupUnsafe pm "no children properties" c2
-                  in inferBinOp vl c1Props c2Props
-                UnOp vl c ->
-                  let cProps = lookupUnsafe pm "no children properties" c
-                  in inferUnOp vl cProps
-                NullaryOp vl -> inferNullOp vl
-    in case res of
-            Left msg -> error $ "Inference failed at node " ++ (show n) ++ ": " ++ msg
-            Right props -> props
-
-inferNullOp :: NullOp -> Either String BottomUpProps
-inferNullOp op = do
-  let opCols  = inferColsNullOp op
-      opKeys  = inferKeysNullOp op
-      opEmpty = inferEmptyNullOp op
-      opCard1 = inferCard1NullOp op
-      -- We only care for rownum-generated columns. Therefore, For
-      -- nullary operators order is empty.
-      opOrder = []
-      opConst = inferConstNullOp op
-  return $ BUProps { pCols = opCols
-                   , pKeys = opKeys
-                   , pEmpty = opEmpty
-                   , pCard1 = opCard1
-                   , pOrder = opOrder
-                   , pConst = opConst
-                   }
-
-inferUnOp :: UnOp -> BottomUpProps -> Either String BottomUpProps
-inferUnOp op cProps = do
-  let opCols  = inferColsUnOp (pCols cProps) op
-      opKeys  = inferKeysUnOp (pKeys cProps) (pCard1 cProps) (S.map fst $ pCols cProps) op
-      opEmpty = inferEmptyUnOp (pEmpty cProps) op
-      opCard1 = inferCard1UnOp (pCard1 cProps) (pEmpty cProps) op
-      opOrder = inferOrderUnOp (pOrder cProps) op
-      opConst = inferConstUnOp (pConst cProps) op
-  return $ BUProps { pCols = opCols
-                   , pKeys = opKeys
-                   , pEmpty = opEmpty
-                   , pCard1 = opCard1
-                   , pOrder = opOrder
-                   , pConst = opConst
-                   }
-
-inferBinOp :: BinOp -> BottomUpProps -> BottomUpProps -> Either String BottomUpProps
-inferBinOp op c1Props c2Props = do
-  let opCols  = inferColsBinOp (pCols c1Props) (pCols c2Props) op
-      opKeys  = inferKeysBinOp (pKeys c1Props) (pKeys c2Props) (pCard1 c1Props) (pCard1 c2Props) op
-      opEmpty = inferEmptyBinOp (pEmpty c1Props) (pEmpty c2Props) op
-      opCard1 = inferCard1BinOp (pCard1 c1Props) (pCard1 c2Props) op
-      opOrder = inferOrderBinOp (pOrder c1Props) (pOrder c2Props) op
-      opConst = inferConstBinOp (pConst c1Props) (pConst c2Props) op
-  return $ BUProps { pCols = opCols
-                   , pKeys = opKeys
-                   , pEmpty = opEmpty
-                   , pCard1 = opCard1
-                   , pOrder = opOrder
-                   , pConst = opConst
-                   }
-
-inferBottomUpProperties :: AlgebraDag TableAlgebra -> NodeMap BottomUpProps
-inferBottomUpProperties dag = inferBottomUpGeneral inferWorker dag
diff --git a/src/Database/DSH/Optimizer/TA/Properties/Card1.hs b/src/Database/DSH/Optimizer/TA/Properties/Card1.hs
deleted file mode 100644
--- a/src/Database/DSH/Optimizer/TA/Properties/Card1.hs
+++ /dev/null
@@ -1,39 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-
-module Database.DSH.Optimizer.TA.Properties.Card1 where
-
-import           Database.Algebra.Table.Lang
-
-import           Database.DSH.Optimizer.TA.Properties.Types
-
-inferCard1NullOp :: NullOp -> Card1
-inferCard1NullOp op =
-    case op of
-        LitTable (vals, _) -> length vals == 1
-        TableRef (_, _, _) -> False
-
-inferCard1UnOp :: Card1 -> Empty -> UnOp -> Card1
-inferCard1UnOp childCard1 childEmpty op =
-    case op of
-        WinFun _          -> childCard1
-        RowNum (_, _, _)  -> childCard1
-        RowRank (_, _)    -> childCard1
-        Rank (_, _)       -> childCard1
-        Project _         -> childCard1
-        Select _          -> False
-        Distinct _        -> childCard1
-        Aggr (_, _ : _)   -> childCard1
-        Aggr (_, [])      -> not childEmpty
-        Serialize    _    -> childCard1
-
-inferCard1BinOp :: Card1 -> Card1 -> BinOp -> Card1
-inferCard1BinOp leftCard1 rightCard1 op =
-    case op of
-        Cross _      -> leftCard1 && rightCard1
-        EqJoin _     -> False
-        ThetaJoin _  -> False
-        SemiJoin _   -> False
-        AntiJoin _   -> False
-        DisjUnion _  -> False
-        Difference _ -> False
-
diff --git a/src/Database/DSH/Optimizer/TA/Properties/Cols.hs b/src/Database/DSH/Optimizer/TA/Properties/Cols.hs
deleted file mode 100644
--- a/src/Database/DSH/Optimizer/TA/Properties/Cols.hs
+++ /dev/null
@@ -1,157 +0,0 @@
-{-# LANGUAGE MonadComprehensions #-}
-{-# LANGUAGE TemplateHaskell     #-}
-
--- | Infer the output schema of TableAlgebra operators.
-module Database.DSH.Optimizer.TA.Properties.Cols where
-
-import qualified Data.Set.Monad                             as S
-
-
-import           Database.Algebra.Table.Lang
-
-import           Database.DSH.Impossible
-import           Database.DSH.Optimizer.TA.Properties.Auxiliary
-import           Database.DSH.Optimizer.TA.Properties.Types
-
-----------------------------------------------------------------------------
--- Type inference for tablealgebra expressions
-
-isNumeric :: BinFun -> Bool
-isNumeric f = f `elem` [Plus, Minus, Times, Div]
-
-isComp :: BinFun -> Bool
-isComp f = f `elem` [Gt, Lt, LtE, GtE, Eq, Contains, SimilarTo, Like]
-
-isBool :: BinFun -> Bool
-isBool f = f `elem` [And, Or]
-
-binAppTy :: BinFun -> ATy -> ATy -> ATy
-binAppTy f t1 _t2 =
-    case f of
-        Gt        -> ABool
-        Lt        -> ABool
-        LtE       -> ABool
-        GtE       -> ABool
-        Eq        -> ABool
-        NEq       -> ABool
-        Contains  -> ABool
-        SimilarTo -> ABool
-        Like      -> ABool
-        And       -> ABool
-        Or        -> ABool
-        Plus      -> t1
-        Minus     -> t1
-        Times     -> t1
-        Div       -> t1
-        Modulo    -> AInt
-        Concat    -> AStr
-
-unAppTy :: UnFun -> ATy
-unAppTy Not         = ABool
-unAppTy (Cast t)    = t
-unAppTy Sin         = ADouble
-unAppTy Cos         = ADouble
-unAppTy Tan         = ADouble
-unAppTy ASin        = ADouble
-unAppTy ACos        = ADouble
-unAppTy ATan        = ADouble
-unAppTy Log         = ADouble
-unAppTy Sqrt        = ADouble
-unAppTy Exp         = ADouble
-unAppTy SubString{} = AStr
-
-valType :: AVal -> ATy
-valType (VInt _)    = AInt
-valType (VStr _)    = AStr
-valType (VBool _)   = ABool
-valType (VDouble _) = ADouble
-valType (VDec _)    = ADec
-valType (VNat _)    = ANat
-
-exprTy :: S.Set TypedAttr -> Expr -> ATy
-exprTy childCols expr =
-    case expr of
-        ColE c          -> typeOf c childCols
-        ConstE v        -> valType v
-        BinAppE f e1 e2 -> binAppTy f (exprTy childCols e1) (exprTy childCols e2)
-        UnAppE f _      -> unAppTy f
-        IfE _ t _       -> exprTy childCols t
-
-----------------------------------------------------------------------------
--- Type inference for aggregate functions
-
-numAggr :: ATy -> ATy
-numAggr AInt    = AInt
-numAggr ADec    = ADec
-numAggr ANat    = ANat
-numAggr ADouble = ADouble
-numAggr _       = $impossible
-
-
-aggrTy :: S.Set TypedAttr -> (AggrType, Attr) -> TypedAttr
-aggrTy childCols (aggr, resCol) = (resCol, resType)
-  where
-    resType = case aggr of
-        All _  -> ABool
-        Any _  -> ABool
-        Count  -> AInt
-        Avg e  -> numAggr $ exprTy childCols e
-        Max e  -> numAggr $ exprTy childCols e
-        Min e  -> numAggr $ exprTy childCols e
-        Sum e  -> numAggr $ exprTy childCols e
-
-winFunTy :: S.Set TypedAttr -> (WinFun, Attr) -> TypedAttr
-winFunTy childCols (aggr, resCol) = (resCol, resType)
-  where
-    resType = case aggr of
-        WinAll _        -> ABool
-        WinAny _        -> ABool
-        WinCount        -> AInt
-        WinAvg e        -> numAggr $ exprTy childCols e
-        WinMax e        -> numAggr $ exprTy childCols e
-        WinMin e        -> numAggr $ exprTy childCols e
-        WinSum e        -> numAggr $ exprTy childCols e
-        WinFirstValue e -> exprTy childCols e
-        WinLastValue e  -> exprTy childCols e
-
-----------------------------------------------------------------------------
--- Schema inference for tablealgebra operators
-
-inferColsNullOp :: NullOp -> S.Set TypedAttr
-inferColsNullOp op =
-    case op of
-        LitTable (_, schema)   -> S.fromList schema
-        TableRef (_, attrs, _) -> S.fromList attrs
-
-inferColsUnOp :: S.Set TypedAttr -> UnOp -> S.Set TypedAttr
-inferColsUnOp childCols op =
-    case op of
-        WinFun ((resCol, fun), _, _, _) -> S.insert (winFunTy childCols (fun, resCol)) childCols
-        RowNum (resCol, _, _) -> S.insert (resCol, AInt) childCols
-        RowRank (resCol, _)   -> S.insert (resCol, AInt) childCols
-        Rank (resCol, _)      -> S.insert (resCol, AInt) childCols
-        Project projs         -> S.fromList $ map (\(c, e) -> (c, exprTy childCols e)) projs
-        Select _              -> childCols
-        Distinct _            -> childCols
-        Aggr (afuns, pexprs)  -> (S.fromList $ map (aggrTy childCols) afuns)
-                                 ∪
-                                 [ (c, exprTy childCols e) | (c, e) <- S.fromList pexprs ]
-        Serialize (md, mp, cs) ->
-            let cols = (S.fromList $ map (\(PayloadCol c) -> c) cs)
-                       ∪ (maybe S.empty (\(DescrCol c) -> S.singleton c) md)
-                       ∪ posCol mp
-            in S.map (\c -> (c, typeOf c childCols)) cols
-
-inferColsBinOp :: S.Set TypedAttr -> S.Set TypedAttr -> BinOp -> S.Set TypedAttr
-inferColsBinOp leftCols rightCols op =
-    case op of
-        Cross _      -> S.union leftCols rightCols
-        EqJoin _     -> S.union leftCols rightCols
-        ThetaJoin _  -> S.union leftCols rightCols
-        SemiJoin _   -> S.union leftCols rightCols
-        AntiJoin _   -> S.union leftCols rightCols
-        DisjUnion _  -> leftCols
-        Difference _ -> leftCols
-
-
-
diff --git a/src/Database/DSH/Optimizer/TA/Properties/Const.hs b/src/Database/DSH/Optimizer/TA/Properties/Const.hs
deleted file mode 100644
--- a/src/Database/DSH/Optimizer/TA/Properties/Const.hs
+++ /dev/null
@@ -1,71 +0,0 @@
-{-# LANGUAGE MonadComprehensions #-}
-{-# LANGUAGE TemplateHaskell     #-}
-
-module Database.DSH.Optimizer.TA.Properties.Const
-    ( inferConstNullOp
-    , inferConstUnOp
-    , inferConstBinOp
-    , constExpr
-    ) where
-
-import           Data.Maybe
-import           Data.List
-
-import           Database.Algebra.Table.Lang
-
-import           Database.DSH.Optimizer.TA.Properties.Types
-
-constExpr :: [ConstCol] -> Expr -> Maybe AVal
-constExpr _         (BinAppE _ _ _) = Nothing
-constExpr _         (UnAppE _ _)    = Nothing
-constExpr constCols (ColE c)        = lookup c constCols
-constExpr _         (ConstE v)      = Just v
-constExpr _         (IfE _ _ _)     = Nothing
-
-constProj :: [ConstCol] -> (Attr, Expr) -> Maybe ConstCol
-constProj constCols (c, e) = constExpr constCols e >>= \v -> return (c, v)
-
-inferConstNullOp :: NullOp -> [ConstCol]
-inferConstNullOp op =
-    case op of
-        LitTable (tuples, schema) -> concat $ zipWith constCol (transpose tuples) (map fst schema)
-          where
-            constCol (v:vs) c | all (== v) vs = [(c, v)]
-            constCol _      _                 = []
-        TableRef _             -> []
-
-inferConstSelect :: Expr -> [ConstCol]
-inferConstSelect (BinAppE Eq (ColE c) (ConstE v)) = [(c, v)]
-inferConstSelect (BinAppE Eq (ConstE v) (ColE c)) = [(c, v)]
-inferConstSelect (BinAppE And e1 e2)              = inferConstSelect e1 ++ inferConstSelect e2
-inferConstSelect _                                = []
-
-inferConstUnOp :: [ConstCol] -> UnOp -> [ConstCol]
-inferConstUnOp childConst op = 
-    case op of
-        WinFun _          -> childConst
-        RowNum (_, _, _)  -> childConst
-        RowRank (_, _)    -> childConst
-        Rank (_, _)       -> childConst
-        Select p          -> inferConstSelect p ++ childConst
-        Distinct _        -> childConst
-        Aggr _            -> []
-        Project projs     -> mapMaybe (constProj childConst) projs
-        Serialize _       -> childConst
-
-inferConstBinOp :: [ConstCol] -> [ConstCol] -> BinOp -> [ConstCol]
-inferConstBinOp leftChildConst rightChildConst op =
-    case op of
-        Cross _      -> leftChildConst ++ rightChildConst
-        EqJoin _     -> leftChildConst ++ rightChildConst
-        ThetaJoin _  -> leftChildConst ++ rightChildConst
-        SemiJoin _   -> leftChildConst
-        AntiJoin _   -> leftChildConst
-        DisjUnion _  -> [ (c1, v1)
-                        | (c1, v1) <- leftChildConst
-                        , (c2, v2) <- rightChildConst
-                        , c1 == c2
-                        , v1 == v2
-                        ]
-        Difference _ -> leftChildConst
-
diff --git a/src/Database/DSH/Optimizer/TA/Properties/Empty.hs b/src/Database/DSH/Optimizer/TA/Properties/Empty.hs
deleted file mode 100644
--- a/src/Database/DSH/Optimizer/TA/Properties/Empty.hs
+++ /dev/null
@@ -1,37 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-
-module Database.DSH.Optimizer.TA.Properties.Empty where
-
-import           Database.Algebra.Table.Lang
-
-import           Database.DSH.Optimizer.TA.Properties.Types
-
-inferEmptyNullOp :: NullOp -> Empty
-inferEmptyNullOp op =
-    case op of
-        LitTable (vs, _)   -> null vs
-        TableRef (_, _, _) -> False
-
-inferEmptyUnOp :: Empty -> UnOp -> Empty
-inferEmptyUnOp childEmpty op =
-    case op of
-        WinFun _         -> childEmpty
-        RowNum (_, _, _) -> childEmpty
-        RowRank (_, _)   -> childEmpty
-        Rank (_, _)      -> childEmpty
-        Project _        -> childEmpty
-        Select _         -> childEmpty
-        Distinct _       -> childEmpty
-        Aggr (_, _)      -> childEmpty
-        Serialize    _   -> childEmpty
-
-inferEmptyBinOp :: Empty -> Empty -> BinOp -> Empty
-inferEmptyBinOp leftEmpty rightEmpty op =
-    case op of
-        Cross _      -> leftEmpty || rightEmpty
-        EqJoin _     -> leftEmpty || rightEmpty
-        ThetaJoin _  -> leftEmpty || rightEmpty
-        SemiJoin _   -> leftEmpty
-        AntiJoin _   -> False
-        DisjUnion _  -> False
-        Difference _ -> False
diff --git a/src/Database/DSH/Optimizer/TA/Properties/ICols.hs b/src/Database/DSH/Optimizer/TA/Properties/ICols.hs
deleted file mode 100644
--- a/src/Database/DSH/Optimizer/TA/Properties/ICols.hs
+++ /dev/null
@@ -1,107 +0,0 @@
-{-# LANGUAGE MonadComprehensions #-}
-{-# LANGUAGE TemplateHaskell     #-}
-
--- | Infer the input columns required in TableAlgebra plans.
-module Database.DSH.Optimizer.TA.Properties.ICols where
-
-import qualified Data.Set.Monad                           as S
-
-import           Database.Algebra.Table.Lang
-
-import           Database.DSH.Optimizer.TA.Properties.Auxiliary
-
-inferIColsBinOp :: S.Set Attr  -- ^ columns that are required from us
-                -> S.Set Attr  -- ^ Columns required from the left child
-                -> S.Set Attr  -- ^ Output of the left child
-                -> S.Set Attr  -- ^ Columns required from the right child
-                -> S.Set Attr  -- ^ Output of the left child
-                -> BinOp       -- ^ The operator
-                -> (S.Set Attr, S.Set Attr)
-inferIColsBinOp ownICols leftICols leftCols rightICols rightCols op =
-    case op of
-         -- Require columns from the originating side.
-         Cross _ -> ( leftICols ∪ (ownICols ∩ leftCols)
-                    , rightICols ∪ (ownICols ∩ rightCols) )
-
-         -- Require columns from the originating side, in addition to the join
-         -- columns.
-         EqJoin (leftJoinCol, rightJoinCol) ->
-             ( leftICols ∪ (ownICols ∩ leftCols) ∪ (S.singleton leftJoinCol)
-             , rightICols ∪ (ownICols ∩rightCols) ∪ (S.singleton rightJoinCol) )
-         ThetaJoin cs ->
-             let leftExprCols = S.unions $ map (\(l, _, _) -> exprCols l) cs
-                 rightExprCols = S.unions $ map (\(_, r, _) -> exprCols r) cs
-
-                 leftICols' = leftICols ∪ (ownICols ∩ leftCols) ∪ leftExprCols
-                 rightICols' = rightICols ∪ (ownICols ∩ rightCols) ∪ rightExprCols
-             in (leftICols', rightICols')
-
-         -- From the left, we require all columns required by us, in addition to
-         -- the left join columns.
-         SemiJoin cs ->
-             let leftExprCols = S.unions $ map (\(l, _, _) -> exprCols l) cs
-                 rightExprCols = S.unions $ map (\(_, r, _) -> exprCols r) cs
-
-                 leftICols' = leftICols ∪ ownICols ∪ leftExprCols
-                 rightICols' = rightExprCols
-             in (leftICols', rightICols')
-         AntiJoin cs ->
-             let leftExprCols = S.unions $ map (\(l, _, _) -> exprCols l) cs
-                 rightExprCols = S.unions $ map (\(_, r, _) -> exprCols r) cs
-
-                 leftICols' = leftICols ∪ ownICols ∪ leftExprCols
-                 rightICols' = rightExprCols
-             in (leftICols', rightICols')
-
-         -- The schemata of both union inputs must be kept in sync. No
-         -- ICols-based (i.e. colummn-pruning) rewrites can be
-         -- performed unless there is a guarantee that they happen in
-         -- both branches.
-         DisjUnion _  -> (leftCols, rightCols)
-
-         Difference _ -> (leftICols ∪ leftCols, rightICols ∪ leftCols)
-
-inferIColsUnOp :: S.Set Attr -> S.Set Attr -> UnOp -> S.Set Attr
-inferIColsUnOp ownICols childICols op =
-    case op of
-        WinFun ((resCol, fun), partExprs, sortInf, _) ->
-            (S.delete resCol ownICols)
-            ∪ (winFunInput fun)
-            ∪ (S.unions $ map (exprCols . fst) sortInf)
-            ∪ (S.unions $ map exprCols partExprs)
-            ∪ childICols
-        -- Require the sorting columns, if the rownum output is required.
-        RowNum (resCol, sortInf, groupExprs) ->
-            (S.delete resCol ownICols)
-            ∪ (S.unions $ map (exprCols . fst) sortInf)
-            ∪ (S.unions $ map exprCols groupExprs)
-            ∪ childICols
-
-        RowRank (resCol, sortInf)   ->
-            (S.delete resCol ownICols)
-            ∪ (S.unions $ map (exprCols . fst) sortInf)
-            ∪ childICols
-        Rank (resCol, sortInf)      ->
-            (S.delete resCol ownICols)
-            ∪ (S.unions $ map (exprCols . fst) sortInf)
-            ∪ childICols
-
-        -- For projections we require input columns of expressions, but only for
-        -- those output columns which are actually required from downstream.
-        Project projs         -> S.foldr (∪) childICols $ S.fromList $ map (exprCols . snd) projs
-
-        -- Require all columns for the select columns, in addition to columns
-        -- required downstream
-        Select e              -> childICols ∪ ownICols ∪ exprCols e
-        Distinct _            -> childICols ∪ ownICols
-
-        Aggr (acols, pexprs)  -> (S.foldr (∪) childICols $ S.fromList $ map (aggrInput . fst) acols)
-                                 ∪
-                                 (S.foldr (∪) S.empty $ S.fromList $ map (exprCols . snd) pexprs)
-
-        Serialize cs          ->
-            let (mDescr, mPos, cols) = cs
-            in childICols
-               ∪ (S.fromList $ map (\(PayloadCol c) -> c) cols)
-               ∪ (maybe S.empty (\(DescrCol c) -> S.singleton c) mDescr)
-               ∪ posCol mPos
diff --git a/src/Database/DSH/Optimizer/TA/Properties/Keys.hs b/src/Database/DSH/Optimizer/TA/Properties/Keys.hs
deleted file mode 100644
--- a/src/Database/DSH/Optimizer/TA/Properties/Keys.hs
+++ /dev/null
@@ -1,170 +0,0 @@
--- FIXME once 7.8 is out, use overloaded list notation for sets
--- instead of S.fromList!
-{-# LANGUAGE MonadComprehensions #-}
-{-# LANGUAGE TemplateHaskell     #-}
-
-module Database.DSH.Optimizer.TA.Properties.Keys where
-
-import           Data.Maybe
-import           Data.List
-import qualified Data.Set.Monad as S
-
-import           Database.Algebra.Table.Lang
-
-import           Database.DSH.Impossible
-import           Database.DSH.Optimizer.TA.Properties.Auxiliary
-import           Database.DSH.Optimizer.TA.Properties.Types
-                 
-subsetsOfSize :: Ord a => Int -> S.Set a -> S.Set (S.Set a)
-subsetsOfSize n s
-    | n == 0                    = S.singleton S.empty
-    | S.size s < n || n < 0     = error "onlyLists: out of range n"
-    | S.size s == n             = S.singleton s
-    | otherwise                 = S.fromDistinctAscList . map S.fromDistinctAscList $
-                                                         go n (S.size s) (S.toList s)
-      where
-        go 1 _ xs = map return xs
-        go k l (x:xs)
-            | k == l = [x:xs]
-            | otherwise = map (x:) (go (k-1) (l-1) xs) ++ go k (l-1) xs
-        go _ _ [] = $impossible
-
--- | Enumerate all subsets of size n
-
--- | Compute keys for rank and rowrank operators
-rowRankKeys :: Attr -> S.Set Attr -> Card1 -> S.Set PKey -> S.Set PKey
-rowRankKeys resCol sortCols childCard1 childKeys =
-    -- All old keys stay intact
-    childKeys
-    ∪
-    -- Trivial case: singleton input
-    [ ss resCol | childCard1 ]
-    ∪
-    -- If sorting columns form a part of a key, the output column
-    -- combined with the key columns that are not sorting columns also
-    -- is a key.
-    [ (ss resCol) ∪ (k ∖ sortCols)
-    | k <- childKeys
-    , k ∩ sortCols /= S.empty
-    ]
-
-inferKeysNullOp :: NullOp -> S.Set PKey
-inferKeysNullOp op =
-    case op of
-        -- FIXME check all combinations of columns for uniqueness
-        LitTable (vals, schema)  -> S.fromList
-                                    $ map (ss . snd) 
-                                    $ filter (isUnique . fst)
-                                    $ zip (transpose vals) (map fst schema)
-          where
-            isUnique :: [AVal] -> Bool
-            isUnique vs = (length $ nub vs) == (length vs)
-
-        TableRef (_, _, keys) -> S.fromList $ map (\(Key k) -> ls k) keys
-
-inferKeysUnOp :: S.Set PKey -> Card1 -> S.Set Attr -> UnOp -> S.Set PKey
-inferKeysUnOp childKeys childCard1 childCols op =
-    case op of
-        WinFun _                       -> childKeys
-        RowNum (resCol, _, [])         -> S.insert (ss resCol) childKeys
-        -- FIXME can we infer a key here if partitioning includes
-        -- general expressions?
-        RowNum (resCol, _, pexprs)     -> {- (S.singleton $ ls [resCol, pattr])
-                                          ∪ -}
-                                          [ ss resCol | childCard1 ]
-                                          ∪
-                                          childKeys
-        -- FIXME infer complete rank keys
-        RowRank (resCol, sortInfo)     -> childKeys -- rowRankKeys resCol (ls $ map fst sortInfo) childCard1 childKeys
-        Rank (resCol, sortInfo)        -> childKeys -- rowRankKeys resCol (ls $ map fst sortInfo) childCard1 childKeys
-
-        -- This is just the standard Pathfinder way: we take all keys
-        -- whose columns survive the projection and update to the new
-        -- attr names. We could consider all expressions, but need to
-        -- be careful here as not all operators might be injective.
-        Project projs           -> -- all sets A of a's s.t. |A| = |k| and 
-                                   -- associated bs = k
-                                   S.foldr S.union S.empty
-                                   [ [ as
-                                     | as <- subsetsOfSize (S.size k) pa
-                                     , let bs = [ b | (a, b) <- attrPairs, a ∈ as ]
-                                     , bs == k
-                                     ]
-                                   | k <- childKeys
-                                   -- check that the key survives at all
-                                   , let attrPairs = S.fromList $ mapMaybe mapCol projs
-                                   , k ⊆ [ snd x | x <- attrPairs ]
-                                   -- generate the set pa of a's s.t. (a, b) ∈ attrPairs and b ∈ k
-                                   -- i.e. consider only those a's for which the original b is
-                                   -- actually part of the current key.
-                                   , let pa = [ a | (a, b) <- attrPairs, b ∈ k ]
-                                   ]
-
-        Select _                 -> childKeys
-        Distinct _               -> S.insert childCols childKeys 
-        Aggr (_, [])             -> S.empty
-        Aggr (_, pexprs@(_ : _)) -> S.singleton $ S.fromList $ map fst pexprs
-        Serialize _              -> S.empty 
-
-inferKeysBinOp :: S.Set PKey -> S.Set PKey -> Card1 -> Card1 -> BinOp -> S.Set PKey
-inferKeysBinOp leftKeys rightKeys leftCard1 rightCard1 op =
-    case op of
-        Cross _      -> [ k | k <- leftKeys, rightCard1 ]
-                        ∪
-                        [ k | k <- rightKeys, leftCard1 ]
-                        ∪
-                        [ k1 ∪ k2 | k1 <- leftKeys, k2 <- rightKeys ]
-        EqJoin (a, b) -> [ k | k <- leftKeys, rightCard1 ]
-                         ∪
-                         [ k | k <- rightKeys, leftCard1 ]
-                         ∪
-                         [ k | k <- leftKeys, (ss b) ∈ rightKeys ]
-                         ∪
-                         [ k | k <- rightKeys, (ss a) ∈ leftKeys ]
-                         ∪
-                         [ ( k1 ∖ (ss a)) ∪ k2
-                         | (ss b) ∈ rightKeys
-                         , k1 <- leftKeys
-                         , k2 <- rightKeys
-                         ]
-                         ∪
-                         [ k1 ∪ (k2 ∖ (ss b))
-                         | (ss a) ∈ leftKeys
-                         , k1 <- leftKeys
-                         , k2 <- rightKeys
-                         ]
-                         ∪
-                         [ k1 ∪ k2 | k1 <- leftKeys, k2 <- rightKeys ]
-                         
-        ThetaJoin preds -> [ k | k <- leftKeys, rightCard1 ]
-                           ∪
-                           [ k | k <- rightKeys, leftCard1 ]
-                           ∪
-                           [ k 
-                           | k <- leftKeys
-                           , (_, be, p) <- S.fromList preds
-                           , p == EqJ
-                           , b            <- singleCol be
-                           , (ss b) ∈ rightKeys
-                           ]
-                           ∪
-                           [ k 
-                           | k <- rightKeys
-                           , (ae, _, p) <- S.fromList preds
-                           , p == EqJ
-                           , a            <- singleCol ae
-                           , (ss a) ∈ leftKeys
-                           ]
-                           ∪
-                           [ k1 ∪ k2 | k1 <- leftKeys, k2 <- rightKeys ]
-                  
-        SemiJoin _    -> leftKeys
-        AntiJoin _    -> leftKeys
-        DisjUnion _   -> S.empty -- FIXME need domain property.
-        Difference _  -> leftKeys
-
-singleCol :: Expr -> S.Set Attr
-singleCol (ColE c) = S.singleton c
-singleCol _        = S.empty
-
-
diff --git a/src/Database/DSH/Optimizer/TA/Properties/Order.hs b/src/Database/DSH/Optimizer/TA/Properties/Order.hs
deleted file mode 100644
--- a/src/Database/DSH/Optimizer/TA/Properties/Order.hs
+++ /dev/null
@@ -1,102 +0,0 @@
-{-# LANGUAGE MonadComprehensions #-}
-{-# LANGUAGE TemplateHaskell     #-}
-
-module Database.DSH.Optimizer.TA.Properties.Order where
-
-import           Data.Maybe
-import qualified Data.Set.Monad                             as S
-import           Data.Tuple
-
-import           Database.Algebra.Table.Lang
-
-import           Database.DSH.Impossible
-
-import           Database.DSH.Optimizer.TA.Properties.Auxiliary
-import           Database.DSH.Optimizer.TA.Properties.Types
-
--- | Column 'c' has been overwritten by the current operator. Remove
--- all associated sorting information.
-invalidate :: Attr -> Orders -> Orders
-invalidate c order = [ o | o@(c', _) <- order, c /= c' ]
-
--- | Overwrite (if present) order information for column 'o' with new
--- information.
--- FIXME Handle case of arbitrary expressions defining order.
-overwrite :: (Attr, [Expr]) -> Orders -> Orders
-overwrite (resCol, ordExprs) os =
-    if all isJust mOrdCols
-    -- Check if the result column overwrites some older order column
-    then if any ((== resCol) . fst) os
-         then [ (resCol, ordCols) | (oc, _) <- os, oc == resCol ]
-         else (resCol, ordCols) : os
-    -- The order is defined by non-column expressions. We don't handle
-    -- that case currently.
-    else os
-
-  where
-    mOrdCols = map mColE ordExprs
-    ordCols  = catMaybes mOrdCols
-
--- | Produce all new sorting columns from the list of new names per
--- old sorting column:
--- [[a, b, c], [d, e], [f]] => [[a, d, f], [a, e, f], [b, d, f], ...]
--- [[a, b, c], [], [f]]     => []
-ordCombinations :: [[Attr]] -> [[Attr]]
-ordCombinations []        = $impossible
-ordCombinations (s : [])  = map (: []) s
-ordCombinations (s : scs) = dist s (ordCombinations scs)
-
-  where
-    dist :: [Attr] -> [[Attr]] -> [[Attr]]
-    dist as bs = [ a : b | a <- as, b <- bs ]
-
--- | Find all new names for column 'c'.
-newCols :: [(Attr, Attr)] -> Attr -> [Attr]
-newCols colMap c = [ cn | (co, cn) <- colMap, co == c ]
-
--- | Refresh order information with new names for the order column and
--- new names for the sorting columns.
-update :: [(Attr, Attr)] -> (Attr, [Attr]) -> Orders
-update colMap (ordCol, sortCols) =
-    let ordCols'  = newCols colMap ordCol
-        sortCols' = map (newCols colMap) sortCols
-
-    in if any null sortCols'
-       then []
-       else [ (oc, scs) | oc <- ordCols', scs <- ordCombinations sortCols' ]
-
-inferOrderUnOp :: Orders -> UnOp -> Orders
-inferOrderUnOp childOrder op =
-    case op of
-        WinFun _                          -> childOrder
-        RowNum (oc, scs, [])
-             | not (null scs) 
-               -- Only consider ascending sorting
-               && all ((== Asc) . snd) scs
-               -- Avoid circular references
-               && (ColE oc) `notElem` (map fst scs)
-                                          -> overwrite (oc, map fst scs) childOrder
-             | otherwise
-                                          -> invalidate oc childOrder
-        RowNum (resCol, _, _)             -> invalidate resCol childOrder
-        RowRank (resCol, _)               -> invalidate resCol childOrder
-        Rank (resCol, _)                  -> invalidate resCol childOrder
-        Select _                          -> childOrder
-        Distinct _                        -> childOrder
-        Aggr _                            -> []
-        Project projs                     ->
-            let colMap = S.toList $ S.map swap $ S.fromList $ mapMaybe mapCol projs
-            in concatMap (update colMap) childOrder
-        Serialize _                       -> []
-
-inferOrderBinOp :: Orders -> Orders -> BinOp -> Orders
-inferOrderBinOp leftChildOrder rightChildOrder op =
-    case op of
-        Cross _      -> leftChildOrder ++ rightChildOrder
-        EqJoin _     -> leftChildOrder ++ rightChildOrder
-        ThetaJoin _  -> leftChildOrder ++ rightChildOrder
-        SemiJoin _   -> leftChildOrder
-        AntiJoin _   -> leftChildOrder
-        DisjUnion _  -> []
-        Difference _ -> leftChildOrder
-
diff --git a/src/Database/DSH/Optimizer/TA/Properties/TopDown.hs b/src/Database/DSH/Optimizer/TA/Properties/TopDown.hs
deleted file mode 100644
--- a/src/Database/DSH/Optimizer/TA/Properties/TopDown.hs
+++ /dev/null
@@ -1,113 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-
-module Database.DSH.Optimizer.TA.Properties.TopDown where
-
-import           Control.Monad.State
-
-import qualified Data.IntMap                                as M
-import           Data.List
-import qualified Data.Set.Monad                             as S
-
-import           Database.Algebra.Dag
-import           Database.Algebra.Dag.Common
-import           Database.Algebra.Table.Lang
-
-import           Database.DSH.Impossible
-import           Database.DSH.Optimizer.Common.Auxiliary
-import           Database.DSH.Optimizer.TA.Properties.ICols
-import           Database.DSH.Optimizer.TA.Properties.Types
-import           Database.DSH.Optimizer.TA.Properties.Use
-
-
-seed :: TopDownProps
-seed = TDProps { pICols = S.empty, pUse = S.empty }
-
-type InferenceState = NodeMap TopDownProps
-
-lookupProps :: AlgNode -> State InferenceState TopDownProps
-lookupProps n = do
-    m <- get
-    case M.lookup n m of
-        Just props -> return props
-        Nothing -> error "TopDown.lookupProps"
-
-replaceProps :: AlgNode -> TopDownProps -> State InferenceState ()
-replaceProps n p = modify (M.insert n p)
-
-inferUnOp :: TopDownProps -> TopDownProps -> UnOp -> TopDownProps
-inferUnOp ownProps cp op =
-    TDProps { pICols = inferIColsUnOp (pICols ownProps) (pICols cp) op
-            , pUse   = inferUseUnOp (pUse ownProps) (pUse cp) op }
-
-inferBinOp :: BottomUpProps
-           -> BottomUpProps
-           -> TopDownProps
-           -> TopDownProps
-           -> TopDownProps
-           -> BinOp
-           -> (TopDownProps, TopDownProps)
-inferBinOp childBUProps1 childBUProps2 ownProps cp1 cp2 op =
-  let (crc1', crc2') = inferIColsBinOp (pICols ownProps)
-                                       (pICols cp1)
-                                       (S.map fst $ pCols childBUProps1)
-                                       (pICols cp2)
-                                       (S.map fst $ pCols childBUProps2)
-                                       op
-      (urc1', urc2') = inferUseBinOp (pUse ownProps)
-                                     (pUse cp1)
-                                     (pUse cp2)
-                                     (S.map fst $ pCols childBUProps1)
-                                     (S.map fst $ pCols childBUProps2)
-                                     op
-      cp1' = TDProps { pICols = crc1', pUse = urc1' }
-      cp2' = TDProps { pICols = crc2', pUse = urc2' }
-  in (cp1', cp2')
-
-inferChildProperties :: NodeMap BottomUpProps -> AlgebraDag TableAlgebra -> AlgNode -> State InferenceState ()
-inferChildProperties buPropMap d n = do
-    ownProps <- lookupProps n
-    case operator n d of
-        NullaryOp _ -> return ()
-        UnOp op c -> do
-            cp <- lookupProps c
-            let cp' = inferUnOp ownProps cp op
-            replaceProps c cp'
-        BinOp op c1 c2 -> do
-            cp1 <- lookupProps c1
-            cp2 <- lookupProps c2
-            let buProps1 = lookupUnsafe buPropMap "TopDown.inferChildProperties" c1
-                buProps2 = lookupUnsafe buPropMap "TopDown.inferChildProperties" c2
-            let (cp1', cp2') = inferBinOp buProps1 buProps2 ownProps cp1 cp2 op
-            replaceProps c1 cp1'
-            replaceProps c2 cp2'
-        TerOp _ _ _ _ -> $impossible
-
--- | Infer properties during a top-down traversal.
-inferAllProperties :: NodeMap BottomUpProps -> [AlgNode] -> AlgebraDag TableAlgebra -> NodeMap AllProps
-inferAllProperties buPropMap topOrderedNodes d =
-    case mergeProps buPropMap tdPropMap of
-        Just ps -> ps
-        Nothing -> $impossible
-  where
-    tdPropMap = execState action initialMap
-    action = mapM_ (inferChildProperties buPropMap d) topOrderedNodes
-
-    initialMap = M.map (const seed) $ nodeMap d
-
-    mergeProps :: NodeMap BottomUpProps -> NodeMap TopDownProps -> Maybe (NodeMap AllProps)
-    mergeProps bum tdm = do
-        let keys1 = M.keys bum
-            keys2 = M.keys tdm
-            keys  = keys1 `intersect` keys2
-        guard $ length keys == length keys1 && length keys == length keys2
-
-        let merge :: AlgNode -> Maybe (AlgNode, AllProps)
-            merge n = do
-                bup <- M.lookup n bum
-                tdp <- M.lookup n tdm
-                return (n, AllProps { td = tdp, bu = bup })
-
-        merged <- mapM merge keys
-        return $ M.fromList merged
-
-
diff --git a/src/Database/DSH/Optimizer/TA/Properties/Types.hs b/src/Database/DSH/Optimizer/TA/Properties/Types.hs
deleted file mode 100644
--- a/src/Database/DSH/Optimizer/TA/Properties/Types.hs
+++ /dev/null
@@ -1,48 +0,0 @@
-{-# LANGUAGE MonadComprehensions #-}
-{-# LANGUAGE TemplateHaskell     #-}
-
-module Database.DSH.Optimizer.TA.Properties.Types where
-
-import qualified Data.Set.Monad              as S
-import           Database.Algebra.Table.Lang
-import           Database.DSH.Impossible
-
-----------------------------------------------------------------------------
--- Property types
-
-data TopDownProps = TDProps { pICols :: S.Set Attr
-                            , pUse   :: S.Set Attr
-                            }
-
-instance Show TopDownProps where
-    show ps = show $ S.toList (pICols ps)
-
--- FIXME: unite with Database.Algebra.Pathfinder....Data.Algebra.Key
-type PKey = S.Set Attr
-
--- | Signal if an operator produces exactly one or zero tuples, respectively.
-type Card1 = Bool
-type Empty = Bool
-
-type Orders = [(Attr, [Attr])]
-
-type ConstCol = (Attr, AVal)
-
-data BottomUpProps = BUProps { pCols  :: S.Set TypedAttr
-     		     	     , pKeys  :: S.Set PKey
-                             , pCard1 :: Card1
-                             , pEmpty :: Empty
-                             , pOrder :: Orders
-                             , pConst :: [ConstCol]
-     		     	     } deriving (Show)
-
-data AllProps = AllProps { bu :: BottomUpProps, td :: TopDownProps } deriving (Show)
-
-----------------------------------------------------------------------------
--- Utility functions on properties
-
-typeOf :: Attr -> S.Set TypedAttr -> ATy
-typeOf k s =
-    case S.toList $ [ b | (a, b) <- s, k == a ] of
-        [b] -> b
-        _   -> $impossible
diff --git a/src/Database/DSH/Optimizer/TA/Properties/Use.hs b/src/Database/DSH/Optimizer/TA/Properties/Use.hs
deleted file mode 100644
--- a/src/Database/DSH/Optimizer/TA/Properties/Use.hs
+++ /dev/null
@@ -1,96 +0,0 @@
-{-# LANGUAGE MonadComprehensions #-}
-{-# LANGUAGE TemplateHaskell     #-}
-
--- | Infer columns whose exact values are required to compute the
--- correct result.
-module Database.DSH.Optimizer.TA.Properties.Use where
-
-import qualified Data.Set.Monad                           as S
-
-import           Database.Algebra.Table.Lang
-
-import           Database.DSH.Optimizer.TA.Properties.Auxiliary
-
-flatten :: S.Set (S.Set Attr) -> S.Set Attr
-flatten = S.foldl' (∪) S.empty
-
-
-inferUseBinOp :: S.Set Attr
-              -> S.Set Attr
-              -> S.Set Attr
-              -> S.Set Attr
-              -> S.Set Attr
-              -> BinOp
-              -> (S.Set Attr, S.Set Attr)
-inferUseBinOp ownUse leftUse rightUse leftCols rightCols op =
-    case op of
-         Cross _      -> ( leftUse ∪ [ c | c <- leftCols, c ∈ ownUse ]
-                         , rightUse ∪ [ c | c <- rightCols, c ∈ ownUse ] )
-
-         EqJoin (jc1, jc2) -> ( leftUse ∪ (ss jc1) ∪ [ c | c <- leftCols, c ∈ ownUse ]
-                              , rightUse ∪ (ss jc2) ∪ [ c | c <- rightCols, c ∈ ownUse ] )
-         ThetaJoin ps -> ( leftUse
-                           ∪
-                           flatten [ exprCols a | (a, _, _) <- S.fromList ps ]
-                           ∪
-                           [ c | c <- leftCols, c ∈ ownUse ]
-                         , rightUse
-                           ∪
-                           flatten [ exprCols b | (_, b, _) <- S.fromList ps ]
-                           ∪
-                           [ c | c <- rightCols, c ∈ ownUse ]
-                         )
-         SemiJoin ps  -> ( leftUse
-                           ∪
-                           flatten [ exprCols a | (a, _, _) <- S.fromList ps ]
-                           ∪
-                           [ c | c <- leftCols, c ∈ ownUse ]
-                         , rightUse
-                           ∪
-                           flatten [ exprCols b | (_, b, _) <- S.fromList ps ]
-                         )
-         AntiJoin ps  -> ( leftUse
-                           ∪
-                           flatten [ exprCols a | (a, _, _) <- S.fromList ps ]
-                           ∪
-                           [ c | c <- leftCols, c ∈ ownUse ]
-                         , rightUse
-                           ∪
-                           flatten [ exprCols b | (_, b, _) <- S.fromList ps ])
-
-         DisjUnion _  -> ( leftUse ∪ leftCols, rightUse ∪ rightCols )
-         Difference _ -> ( leftUse ∪ leftCols, rightUse ∪ rightCols )
-
-absPos :: SerializeOrder -> S.Set Attr
-absPos (AbsPos c) = S.singleton c
-absPos (RelPos _) = S.empty
-absPos NoPos      = S.empty
-
-inferUseUnOp :: S.Set Attr -> S.Set Attr -> UnOp -> S.Set Attr
-inferUseUnOp ownUse childUse op =
-    case op of
-        WinFun ((resCol, winFun), partExprs, sortCols, _) ->
-            childUse
-            ∪ (S.delete resCol ownUse)
-            ∪ (S.unions $ map exprCols partExprs)
-            ∪ (S.unions $ map (exprCols . fst) sortCols)
-            ∪ (winFunInput winFun)
-        RowNum (resCol, _, _)     -> childUse ∪ (S.delete resCol ownUse)
-        RowRank (resCol, _)       -> childUse ∪ (S.delete resCol ownUse)
-        Rank (resCol, _)          -> childUse ∪ (S.delete resCol ownUse)
-        Project projs             -> childUse
-                                     ∪ (unionss [ exprCols e | (a, e) <- S.fromList projs, a ∈ ownUse ])
-        Select e                  -> childUse ∪ ownUse ∪ (exprCols e)
-        Distinct _                -> childUse ∪ ownUse
-
-        -- FIXME unconditionally declaring pcols as used might be a bit too defensive.
-        Aggr (acols, pexprs)      -> (S.unions $ map (exprCols . snd) pexprs)
-                                     ∪
-                                     (S.unions $ map (aggrInput . fst) acols)
-
-        Serialize (md, mp, cs)    -> childUse
-                                     ∪ (S.fromList $ map (\(PayloadCol c) -> c) cs)
-                                     ∪ (maybe S.empty (\(DescrCol c) -> S.singleton c) md)
-                                     -- FIXME once order and -- surrogates are decoupled, absolute pos
-                                     -- values are no longer required.
-                                     ∪ absPos mp
diff --git a/src/Database/DSH/Optimizer/TA/Rewrite/Basic.hs b/src/Database/DSH/Optimizer/TA/Rewrite/Basic.hs
deleted file mode 100644
--- a/src/Database/DSH/Optimizer/TA/Rewrite/Basic.hs
+++ /dev/null
@@ -1,562 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE TupleSections   #-}
-
-module Database.DSH.Optimizer.TA.Rewrite.Basic where
-
-import           Debug.Trace
-import           Text.Printf
-
-import           Control.Applicative
-import           Control.Monad
-import           Data.Either.Combinators
-import           Data.List                                  hiding (insert)
-import           Data.Maybe
-import qualified Data.Set.Monad                             as S
-
-import           Database.Algebra.Dag.Common
-import           Database.Algebra.Table.Lang                hiding (replace)
-
-import           Database.DSH.Impossible
-import           Database.DSH.Optimizer.Common.Rewrite
-import           Database.DSH.Optimizer.TA.Properties.Auxiliary
-import           Database.DSH.Optimizer.TA.Properties.Types
-import           Database.DSH.Optimizer.TA.Properties.Const
-import           Database.DSH.Optimizer.TA.Rewrite.Common
-
-cleanup :: TARewrite Bool
-cleanup = iteratively $ sequenceRewrites [ applyToAll noProps cleanupRules
-                                         , applyToAll inferAll cleanupRulesTopDown
-                                         ]
-
-cleanupRules :: TARuleSet ()
-cleanupRules = [ stackedProject
-               , serializeProject
-               , pullProjectWinFun
-               , pullProjectSelect
-               , duplicateSortingCriteriaWin
-               , duplicateSortingCriteriaRownum
-               , duplicateSortingCriteriaSerialize
-               ]
-
-cleanupRulesTopDown :: TARuleSet AllProps
-cleanupRulesTopDown = [ unreferencedRownum
-                      , unreferencedRank
-                      , unreferencedProjectCols
-                      , unreferencedAggrCols
-                      , unreferencedLiteralCols
-                      , postFilterRownum
-                      , inlineSortColsRownum
-                      , inlineSortColsSerialize
-                      , inlineSortColsWinFun
-                      , keyPrefixOrdering
-                      , constAggrKey
-                      , constRownumCol
-                      , constRowRankCol
-                      , constSerializeCol
-                      , constWinOrderCol
-                      ]
-
-----------------------------------------------------------------------------------
--- Rewrite rules
-
--- | Eliminate rownums which re-generate positions based on one
--- sorting column. These rownums typically occur after filtering
--- operators, i.e. select, antijoin, semijoin. If the absolute values
--- generated by the rownum are not required and only the encoded order
--- is relevant, we can safely remove the rownum and use the sorting
--- column. In that case, positions might not be dense anymore.
-postFilterRownum :: TARule AllProps
-postFilterRownum q =
-  $(dagPatMatch 'q "RowNum args (q1)"
-    [| do
-        (res, [(ColE sortCol, Asc)], []) <- return $(v "args")
-        useCols <- pUse <$> td <$> properties q
-        keys    <- pKeys <$> bu <$> properties $(v "q1")
-        cols    <- pCols <$> bu <$> properties $(v "q1")
-
-        -- To get rid of the rownum, the absolute values generated by
-        -- it must not be required.
-        predicate $ not $ res `S.member` useCols
-
-        -- Rownum produces a key. If we remove the rownum because its
-        -- absolute values are not needed and replace it with the
-        -- original sorting column, it should still be a key.
-        predicate $ (S.singleton sortCol) `S.member` keys
-
-        -- If we reuse a sorting column, it's type should be int.
-        predicate $ AInt == typeOf sortCol cols
-
-        return $ do
-          logRewrite "Basic.Rownum.Unused" q
-          let projs = (res, ColE sortCol) : map (\c -> (c, ColE c)) (map fst $ S.toList cols)
-          void $ replaceWithNew q $ UnOp (Project projs) $(v "q1") |])
-
-
----------------------------------------------------------------------------
--- ICols rewrites
-
--- | Prune a rownumber operator if its output is not required
-unreferencedRownum :: TARule AllProps
-unreferencedRownum q =
-  $(dagPatMatch 'q "RowNum args (q1)"
-    [| do
-         (res, _, _) <- return $(v "args")
-         neededCols  <- pICols <$> td <$> properties q
-         predicate $ not (res `S.member` neededCols)
-
-         return $ do
-           logRewrite "Basic.ICols.Rownum" q
-           replace q $(v "q1") |])
-
--- | Prune a rownumber operator if its output is not required
-unreferencedRank :: TARule AllProps
-unreferencedRank q =
-  $(dagPatMatch 'q "[Rank | RowRank] args (q1)"
-    [| do
-         (res, _) <- return $(v "args")
-         neededCols  <- pICols <$> td <$> properties q
-         predicate $ not (res `S.member` neededCols)
-
-         return $ do
-           logRewrite "Basic.ICols.Rank" q
-           replace q $(v "q1") |])
-
--- | Prune projections from a project operator if the result columns
--- are not required.
-unreferencedProjectCols :: TARule AllProps
-unreferencedProjectCols q =
-  $(dagPatMatch 'q "Project projs (q1)"
-    [| do
-        neededCols <- pICols <$> td <$> properties q
-        let neededProjs = filter (flip S.member neededCols . fst) $(v "projs")
-
-        -- Only modify the project if we could actually get rid of some columns.
-        predicate $ length neededProjs < length $(v "projs")
-
-        return $ do
-          logRewrite "Basic.ICols.Project" q
-          void $ replaceWithNew q $ UnOp (Project neededProjs) $(v "q1") |])
-
--- | Remove aggregate functions whose output is not referenced.
-unreferencedAggrCols :: TARule AllProps
-unreferencedAggrCols q =
-  $(dagPatMatch 'q "Aggr args (q1)"
-    [| do
-        neededCols <- pICols <$> td <$> properties q
-        (aggrs, partCols) <- return $(v "args")
-
-        let neededAggrs = filter (flip S.member neededCols . snd) aggrs
-
-        predicate $ length neededAggrs < length aggrs
-
-        return $ do
-          case neededAggrs of
-              -- If the output of all aggregate functions is not
-              -- required, we can replace it with a distinct operator
-              -- on the grouping columns.
-              [] -> do
-                  logRewrite "Basic.ICols.Aggr.Prune" q
-                  projectNode <- insert $ UnOp (Project partCols) $(v "q1")
-                  void $ replaceWithNew q $ UnOp (Distinct ()) projectNode
-
-              -- Otherwise, we just prune the unreferenced aggregate functions
-              _ : _ -> do
-                  logRewrite "Basic.ICols.Aggr.Narrow" q
-                  void $ replaceWithNew q $ UnOp (Aggr (neededAggrs, partCols)) $(v "q1") |])
-
-
-unreferencedLiteralCols :: TARule AllProps
-unreferencedLiteralCols q =
-  $(dagPatMatch 'q "LitTable tab "
-    [| do
-         neededCols <- pICols <$> td <$> properties q
-
-         predicate (not $ S.null neededCols)
-
-         let (tuples, schema)  = $(v "tab")
-
-         predicate (not $ null tuples)
-
-         predicate $ S.size neededCols < length schema
-    
-         return $ do
-
-             let columns = transpose tuples
-             let (reqCols, reqSchema) = 
-                  unzip 
-                  $ filter (\(_, (colName, _)) -> colName `S.member` neededCols) 
-                  $ zip columns schema
-             let reqTuples = transpose reqCols
-
-             void $ replaceWithNew q $ NullaryOp $ LitTable (reqTuples, reqSchema) |])
-
-----------------------------------------------------------------------------------
--- Basic Const rewrites
-
-isConstExpr :: [ConstCol] -> Expr -> Bool
-isConstExpr constCols e = isJust $ constExpr constCols e
-
--- | Prune const columns from aggregation keys
-constAggrKey :: TARule AllProps
-constAggrKey q =
-  $(dagPatMatch 'q "Aggr args (q1)"
-    [| do
-         constCols   <- pConst <$> bu <$> properties $(v "q1")
-         neededCols  <- S.toList <$> pICols <$> td <$> properties q
-         (aggrFuns, keyCols@(_:_)) <- return $(v "args")
-
-         let keyCols'   = filter (\(_, e) -> not $ isConstExpr constCols e) keyCols
-             prunedKeys = (map fst keyCols) \\ (map fst keyCols')
-
-         predicate $ not $ null prunedKeys
-
-         return $ do
-             logRewrite "Basic.Const.Aggr" q
-             let necessaryKeys = prunedKeys `intersect` neededCols
-
-                 constProj c   = lookup c constCols >>= \val -> return (c, ConstE val)
-
-                 constProjs    = mapMaybe constProj necessaryKeys
-
-                 proj          = map (\(_, c) -> (c, ColE c)) aggrFuns
-                                 ++
-                                 map (\(c, _) -> (c, ColE c)) keyCols'
-                                 ++
-                                 constProjs
-                                 
-
-             aggrNode <- insert $ UnOp (Aggr ($(v "aggrFuns"), keyCols')) $(v "q1")
-             void $ replaceWithNew q $ UnOp (Project proj) aggrNode |])
-
-constRownumCol :: TARule AllProps
-constRownumCol q =
-  $(dagPatMatch 'q "RowNum args (q1)"
-    [| do
-         constCols <- pConst <$> bu <$> properties $(v "q1")
-
-         (resCol, sortCols, partExprs) <- return $(v "args")
-         let sortCols' = filter (\(e, _) -> not $ isConstExpr constCols e) sortCols
-         predicate $ length sortCols' < length sortCols
-         
-         return $ do
-             logRewrite "Basic.Const.RowNum" q
-             void $ replaceWithNew q $ UnOp (RowNum (resCol, sortCols', partExprs)) $(v "q1") |])
-
-constRowRankCol :: TARule AllProps
-constRowRankCol q =
-  $(dagPatMatch 'q "RowRank args (q1)"
-    [| do
-         constCols          <- pConst <$> bu <$> properties $(v "q1")
-         (resCol, sortCols) <- return $(v "args")
-         let sortCols' = filter (\(e, _) -> not $ isConstExpr constCols e) sortCols
-         predicate $ length sortCols' < length sortCols
-         
-         return $ do
-             logRewrite "Basic.Const.RowRank" q
-             void $ replaceWithNew q $ UnOp (RowRank (resCol, sortCols')) $(v "q1") |])
-
-constSerializeCol :: TARule AllProps
-constSerializeCol q =
-  $(dagPatMatch 'q "Serialize args (q1)"
-    [| do
-         (mDescr, RelPos sortCols, payload) <- return $(v "args")
-         constCols                          <- map fst <$> pConst <$> bu <$> properties $(v "q1")
-
-         let sortCols' = filter (\c -> c `notElem` constCols) sortCols
-         predicate $ length sortCols' < length sortCols
-         
-         return $ do
-             logRewrite "Basic.Const.Serialize" q
-             void $ replaceWithNew q $ UnOp (Serialize (mDescr, RelPos sortCols', payload)) $(v "q1") |])
-
-constWinOrderCol :: TARule AllProps
-constWinOrderCol q =
-  $(dagPatMatch 'q "WinFun args (q1)"
-    [| do
-         constCols <- pConst <$> bu <$> properties $(v "q1")
-         let (f, part, sortCols, frameSpec) = $(v "args")
-         let sortCols' = filter (\(e, _) -> not $ isConstExpr constCols e) sortCols
-         predicate $ length sortCols' < length sortCols
-
-         return $ do
-             logRewrite "Basic.Const.WinFun" q
-             void $ replaceWithNew q $ UnOp (WinFun (f, part, sortCols', frameSpec)) $(v "q1") |])
-
-
-----------------------------------------------------------------------------------
--- Basic Order rewrites
-
--- | @lookupSortCol@ returns @Left@ if there is no mapping from the
--- original sort column and @Right@ if there is a mapping from the
--- original sort column to a list of columns that define the same
--- order.
-lookupSortCol :: SortSpec -> Orders -> TAMatch AllProps (Either [SortSpec] [SortSpec])
-lookupSortCol (ColE oldSortCol, Asc) os =
-    case lookup oldSortCol os of
-        Nothing          -> return $ Left [(ColE oldSortCol, Asc)]
-        Just newSortCols -> return $ Right $ map (\c -> (ColE c, Asc)) newSortCols
-lookupSortCol (_, Asc)               _  = fail "only consider column expressions for now"
-lookupSortCol (_, Desc)              _  = fail "only consider ascending orders"
-
-inlineSortColsRownum :: TARule AllProps
-inlineSortColsRownum q =
-  $(dagPatMatch 'q "RowNum o (q1)"
-    [| do
-        (resCol, sortCols@(_:_), []) <- return $(v "o")
-
-        predicate $ all ((== Asc) . snd) sortCols
-
-        orders@(_:_) <- pOrder <$> bu <$> properties $(v "q1")
-
-        -- For each sorting column, try to find the original
-        -- order-defining sorting columns.
-        mSortCols <- mapM (flip lookupSortCol orders) sortCols
-
-        -- The rewrite should only fire if something actually changes
-        predicate $ any isRight mSortCols
-
-        let sortCols' = nub $ concatMap (either id id) mSortCols
-
-        return $ do
-          logRewrite "Basic.InlineOrder.RowNum" q
-          void $ replaceWithNew q $ UnOp (RowNum (resCol, sortCols', [])) $(v "q1") |])
-
-inlineSortColsSerialize :: TARule AllProps
-inlineSortColsSerialize q =
-  $(dagPatMatch 'q "Serialize scols (q1)"
-    [| do
-        (d, RelPos cs, reqCols) <- return $(v "scols")
-        orders@(_:_) <- pOrder <$> bu <$> properties $(v "q1")
-
-        let cs' = nub $ concatMap (\c -> maybe [c] id $ lookup c orders) cs
-        predicate $ cs /= cs'
-
-        return $ do
-            logRewrite "Basic.InlineOrder.Serialize" q
-            void $ replaceWithNew q $ UnOp (Serialize (d, RelPos cs', reqCols)) $(v "q1") |])
-
-inlineSortColsWinFun :: TARule AllProps
-inlineSortColsWinFun q =
-  $(dagPatMatch 'q "WinFun args (q1)"
-    [| do
-        let (f, part, sortCols, frameSpec) = $(v "args")
-
-        orders@(_:_) <- pOrder <$> bu <$> properties $(v "q1")
-
-        -- For each sorting column, try to find the original
-        -- order-defining sorting columns.
-        mSortCols <- mapM (flip lookupSortCol orders) sortCols
-
-        -- The rewrite should only fire if something actually changes
-        predicate $ any isRight mSortCols
-
-        let sortCols' = nub $ concatMap (either id id) mSortCols
-            args'     = (f, part, sortCols', frameSpec)
-
-        return $ do
-            logRewrite "Basic.InlineOrder.WinFun" q
-            void $ replaceWithNew q $ UnOp (WinFun args') $(v "q1") |])
-
-isKeyPrefix :: S.Set PKey -> [SortSpec] -> Bool
-isKeyPrefix keys orderCols =
-    case mapM mColE $ map fst orderCols of
-        Just cols -> S.fromList cols `S.member` keys
-        Nothing   -> False
-
--- | If a prefix of the ordering columns in a rownum operator forms a
--- key, the suffix can be removed.
-keyPrefixOrdering :: TARule AllProps
-keyPrefixOrdering q =
-  $(dagPatMatch 'q "RowNum args (q1)"
-    [| do
-        (resCol, sortCols, []) <- return $(v "args")
-        keys                   <- pKeys <$> bu <$> properties $(v "q1")
-
-        predicate $ not $ null sortCols
-       
-        -- All non-empty and incomplete prefixes of the ordering
-        -- columns
-        let ordPrefixes = init $ drop 1 (inits sortCols)
-        Just prefix <- return $ find (isKeyPrefix keys) ordPrefixes
-
-        return $ do
-            logRewrite "Basic.SimplifyOrder.KeyPrefix" q
-            let sortCols' = take (length prefix) sortCols
-            void $ replaceWithNew q $ UnOp (RowNum (resCol, sortCols', [])) $(v "q1") |])
-
-duplicateSortingCriteriaRownum :: TARule ()
-duplicateSortingCriteriaRownum q =
-  $(dagPatMatch 'q "RowNum args (q1)"
-    [| do
-        (resCol, sortCols, []) <- return $(v "args")
-
-        let sortCols' = nub sortCols
-
-        predicate $ length sortCols' < length sortCols
-
-        return $ do
-            logRewrite "Basic.SimplifyOrder.Duplicates.Rownum" q
-            let args' = (resCol, sortCols', [])
-            void $ replaceWithNew q $ UnOp (RowNum args') $(v "q1") |])
-
-duplicateSortingCriteriaWin :: TARule ()
-duplicateSortingCriteriaWin q =
-  $(dagPatMatch 'q "WinFun args (q1)"
-    [| do
-        let (winFuns, part, sortCols, mFrameBounds) = $(v "args")
-        
-        let sortCols' = nub sortCols
-
-        predicate $ length sortCols' < length sortCols
-
-        return $ do
-            logRewrite "Basic.SimplifyOrder.Duplicates.WinFun" q
-            let args' = (winFuns, part, sortCols', mFrameBounds)
-            void $ replaceWithNew q $ UnOp (WinFun args') $(v "q1") |])
-
-duplicateSortingCriteriaSerialize :: TARule ()
-duplicateSortingCriteriaSerialize q =
-  $(dagPatMatch 'q "Serialize args (q1)"
-    [| do
-        (mDescr, RelPos sortCols, payload) <- return $(v "args")
-        let sortCols' = nub sortCols
-
-        predicate $ length sortCols' < length sortCols
-
-        return $ do
-            logRewrite "Basic.SimplifyOrder.Duplicates.Serialize" q
-            let args' = (mDescr, RelPos sortCols', payload)
-            void $ replaceWithNew q $ UnOp (Serialize args') $(v "q1") |])
-        
-
-----------------------------------------------------------------------------------
--- Serialize rewrites
-
--- | Merge a projection which only maps columns into a Serialize operator.
-serializeProject :: TARule ()
-serializeProject q =
-    $(dagPatMatch 'q "Serialize scols (Project projs (q1))"
-      [| do
-          (d, p, reqCols) <- return $(v "scols")
-
-          let projCol (c', ColE c) = return (c', c)
-              projCol _            = fail "no match"
-
-              lookupFail x xys = case lookup x xys of
-                  Just y  -> return y
-                  Nothing -> fail "no match"
-
-          colMap <- mapM projCol $(v "projs")
-
-          -- find new names for all required columns
-          reqCols' <- mapM (\(PayloadCol c) -> PayloadCol <$> lookupFail c colMap) reqCols
-
-          -- find new name for the descriptor column (if required)
-          d' <- case d of
-              Just (DescrCol c)  -> Just <$> DescrCol <$> lookupFail c colMap
-              Nothing            -> return Nothing
-
-          -- find new name for the pos column (if required)
-          p' <- case p of
-              AbsPos c  -> AbsPos <$> lookupFail c colMap
-              RelPos cs -> RelPos <$> mapM (flip lookupFail colMap) cs
-              NoPos     -> return NoPos
-
-          return $ do
-              logRewrite "Basic.Serialize.Project" q
-              void $ replaceWithNew q $ UnOp (Serialize (d', p', reqCols')) $(v "q1") |])
-
---------------------------------------------------------------------------------
--- Pulling projections through other operators and merging them into
--- other operators
-
-inlineExpr :: [Proj] -> Expr -> Expr
-inlineExpr proj expr =
-    case expr of
-        BinAppE op e1 e2 -> BinAppE op (inlineExpr proj e1) (inlineExpr proj e2)
-        UnAppE op e      -> UnAppE op (inlineExpr proj e)
-        ColE c           -> fromMaybe (failedLookup c) (lookup c proj)
-        ConstE val       -> ConstE val
-        IfE c t e        -> IfE (inlineExpr proj c) (inlineExpr proj t) (inlineExpr proj e)
-
-  where
-    failedLookup :: Attr -> a
-    failedLookup c = trace (printf "mergeProjections: column lookup %s failed\n%s\n%s"
-                                   c (show expr) (show proj))
-                           $impossible
-
-mergeProjections :: [Proj] -> [Proj] -> [Proj]
-mergeProjections proj1 proj2 = map (\(c, e) -> (c, inlineExpr proj2 e)) proj1
-
-stackedProject :: TARule ()
-stackedProject q =
-  $(dagPatMatch 'q "Project ps1 (Project ps2 (qi))"
-    [| do
-         return $ do
-           let ps = mergeProjections $(v "ps1") $(v "ps2")
-           logRewrite "Basic.Project.Merge" q
-           void $ replaceWithNew q $ UnOp (Project ps) $(v "qi") |])
-
-
-
-mapWinFun :: (Expr -> Expr) -> WinFun -> WinFun
-mapWinFun f (WinMax e)        = WinMax $ f e
-mapWinFun f (WinMin e)        = WinMin $ f e
-mapWinFun f (WinSum e)        = WinSum $ f e
-mapWinFun f (WinAvg e)        = WinAvg $ f e
-mapWinFun f (WinAll e)        = WinAll $ f e
-mapWinFun f (WinAny e)        = WinAny $ f e
-mapWinFun f (WinFirstValue e) = WinFirstValue $ f e
-mapWinFun f (WinLastValue e)  = WinLastValue $ f e
-mapWinFun _ WinCount          = WinCount
-
-mapAggrFun :: (Expr -> Expr) -> AggrType -> AggrType
-mapAggrFun f (Max e) = Max $ f e
-mapAggrFun f (Min e) = Min $ f e
-mapAggrFun f (Sum e) = Sum $ f e
-mapAggrFun f (Avg e) = Avg $ f e
-mapAggrFun f (All e) = All $ f e
-mapAggrFun f (Any e) = Any $ f e
-mapAggrFun _ Count   = Count
-
-pullProjectWinFun :: TARule ()
-pullProjectWinFun q =
-    $(dagPatMatch 'q "WinFun args (Project proj (q1))"
-      [| do
-          -- Only consider window functions without partitioning for
-          -- now. Partitioning requires proper values and inlining
-          -- would be problematic.
-          ((resCol, f), [], sortSpec, frameSpec) <- return $(v "args")
-
-          -- If the window function result overwrites one of the
-          -- projection columns, we can't pull.
-          predicate $ resCol `notElem` (map fst $(v "proj"))
-
-          return $ do
-              logRewrite "Basic.PullProject.WinFun" q
-
-              -- Merge the projection expressions into window function
-              -- arguments and ordering expressions.
-              let f'        = mapWinFun (inlineExpr $(v "proj")) f
-
-                  sortSpec' = map (\(e, d) -> (inlineExpr $(v "proj") e, d)) sortSpec
-
-                  proj'     = $(v "proj") ++ [(resCol, ColE resCol)]
-
-              winNode <- insert $ UnOp (WinFun ((resCol, f'), [], sortSpec', frameSpec)) $(v "q1")
-              void $ replaceWithNew q $ UnOp (Project proj') winNode |])
-
-pullProjectSelect :: TARule ()
-pullProjectSelect q =
-    $(dagPatMatch 'q "Select p (Project proj (q1))"
-      [| do
-          return $ do
-              logRewrite "Basic.PullProject.Select" q
-              let p' = inlineExpr $(v "proj") $(v "p")
-              selectNode <- insert $ UnOp (Select p') $(v "q1")
-              void $ replaceWithNew q $ UnOp (Project $(v "proj")) selectNode |])
-
-inlineJoinPredRight :: [Proj] -> [(Expr, Expr, JoinRel)] -> [(Expr, Expr, JoinRel)]
-inlineJoinPredRight proj p = map inlineConjunct p
-  where
-    inlineConjunct (le, re, rel) = (le, inlineExpr proj re, rel)
diff --git a/src/Database/DSH/Optimizer/TA/Rewrite/Common.hs b/src/Database/DSH/Optimizer/TA/Rewrite/Common.hs
deleted file mode 100644
--- a/src/Database/DSH/Optimizer/TA/Rewrite/Common.hs
+++ /dev/null
@@ -1,38 +0,0 @@
-module Database.DSH.Optimizer.TA.Rewrite.Common where
-
-import qualified Data.IntMap                                   as M
-
-import           Database.Algebra.Dag.Common
-
-import           Database.DSH.Common.QueryPlan
-
-import           Database.DSH.Optimizer.Common.Rewrite
-
-import           Database.Algebra.Table.Lang
-
-import           Database.DSH.VL.Vector
-
-import           Database.DSH.Optimizer.TA.Properties.BottomUp
-import           Database.DSH.Optimizer.TA.Properties.TopDown
-import           Database.DSH.Optimizer.TA.Properties.Types
-
-  -- Type abbreviations for convenience
-type TARewrite p = Rewrite TableAlgebra (Shape NDVec) p
-type TARule p = Rule TableAlgebra p (Shape NDVec)
-type TARuleSet p = RuleSet TableAlgebra  p (Shape NDVec)
-type TAMatch p = Match TableAlgebra p (Shape NDVec)
-
-inferBottomUp :: TARewrite (NodeMap BottomUpProps)
-inferBottomUp = do
-  props <- infer inferBottomUpProperties
-  return props
-
-inferAll :: TARewrite (NodeMap AllProps)
-inferAll = do
-  to <- topsort
-  buPropMap <- infer inferBottomUpProperties
-  props <- infer (inferAllProperties buPropMap to)
-  return props
-
-noProps :: Monad m => m (M.IntMap a)
-noProps = return M.empty
diff --git a/src/Database/DSH/Optimizer/VL/OptimizeVL.hs b/src/Database/DSH/Optimizer/VL/OptimizeVL.hs
deleted file mode 100644
--- a/src/Database/DSH/Optimizer/VL/OptimizeVL.hs
+++ /dev/null
@@ -1,56 +0,0 @@
-module Database.DSH.Optimizer.VL.OptimizeVL where
-
-import qualified Data.IntMap                                                      as M
-
-import qualified Database.Algebra.Dag                                             as Dag
-
-import           Database.DSH.Common.QueryPlan
-
-import           Database.DSH.VL.Lang
-import           Database.DSH.VL.Vector
-
-import           Database.DSH.Optimizer.Common.Rewrite
-import           Database.DSH.Optimizer.VL.Rewrite.Expressions
-import           Database.DSH.Optimizer.VL.Rewrite.PruneEmpty
-import           Database.DSH.Optimizer.VL.Rewrite.Redundant
-
-type RewriteClass = Rewrite VL (Shape VLDVec) Bool
-
-rewriteClasses :: [(Char, RewriteClass)]
-rewriteClasses = [ ('E', pruneEmpty)
-                 , ('R', removeRedundancy)
-                 , ('C', optExpressions)
-                 ]
-
-defaultPipeline :: [RewriteClass]
-defaultPipeline = case assemblePipeline "ER" of
-  Just p -> p
-  Nothing -> error "invalid default pipeline"
-
-runPipeline 
-  :: Dag.AlgebraDag VL 
-  -> (Shape VLDVec) 
-  -> [RewriteClass] 
-  -> Bool -> (Dag.AlgebraDag VL, Log, Shape VLDVec)
-runPipeline d sh pipeline debug = (d', rewriteLog, sh')
-  where (d', sh', _, rewriteLog) = runRewrite (sequence_ pipeline) d sh debug
-
-assemblePipeline :: String -> Maybe [RewriteClass]
-assemblePipeline s = mapM (flip lookup rewriteClasses) s
-
-optimizeVL :: [RewriteClass] -> QueryPlan VL VLDVec -> QueryPlan VL VLDVec
-optimizeVL pipeline plan =
-#ifdef DEBUGGRAPH
-  let (d, _, shape) = runPipeline (queryDag plan) (queryShape plan) pipeline True
-#else
-  let (d, _, shape) = runPipeline (queryDag plan) (queryShape plan) pipeline False
-#endif
-  in QueryPlan { queryDag = d, queryShape = shape, queryTags = M.empty }
-
-optimizeVL' :: [RewriteClass] -> QueryPlan VL VLDVec -> (QueryPlan VL VLDVec, Log)
-optimizeVL' pipeline plan =
-  let (d, l, shape) = runPipeline (queryDag plan) (queryShape plan) pipeline False
-  in (QueryPlan { queryDag = d, queryShape = shape, queryTags = M.empty }, l)
-
-optimizeVLDefault :: QueryPlan VL VLDVec -> QueryPlan VL VLDVec
-optimizeVLDefault = optimizeVL defaultPipeline
diff --git a/src/Database/DSH/Optimizer/VL/Properties/BottomUp.hs b/src/Database/DSH/Optimizer/VL/Properties/BottomUp.hs
deleted file mode 100644
--- a/src/Database/DSH/Optimizer/VL/Properties/BottomUp.hs
+++ /dev/null
@@ -1,100 +0,0 @@
-module Database.DSH.Optimizer.VL.Properties.BottomUp where
-
-import Text.Printf
-
-import Database.Algebra.Dag
-import Database.Algebra.Dag.Common
-
-import Database.DSH.VL.Lang
-import Database.DSH.Optimizer.Common.Auxiliary
-import Database.DSH.Optimizer.Common.Rewrite
-import Database.DSH.Optimizer.VL.Properties.Card
-import Database.DSH.Optimizer.VL.Properties.Const
-import Database.DSH.Optimizer.VL.Properties.Empty
-import Database.DSH.Optimizer.VL.Properties.NonEmpty
-import Database.DSH.Optimizer.VL.Properties.Types
-import Database.DSH.Optimizer.VL.Properties.VectorType
-
--- FIXME this is (almost) identical to its X100 counterpart -> merge
-inferWorker :: NodeMap VL -> VL -> AlgNode -> NodeMap BottomUpProps -> BottomUpProps
-inferWorker d op node pm =
-    case op of
-         TerOp vl c1 c2 c3 ->
-           let c1Props = lookupUnsafe pm "no children properties" c1
-               c2Props = lookupUnsafe pm "no children properties" c2
-               c3Props = lookupUnsafe pm "no children properties" c3
-           in checkError d node [c1Props, c2Props, c3Props] pm $ inferTerOp vl c1Props c2Props c3Props
-         BinOp vl c1 c2 ->
-           let c1Props = lookupUnsafe pm "no children properties" c1
-               c2Props = lookupUnsafe pm "no children properties" c2
-           in checkError d node [c1Props, c2Props] pm $ inferBinOp vl c1Props c2Props
-         UnOp vl c ->
-           let cProps = lookupUnsafe pm "no children properties" c
-           in checkError d node [cProps] pm $ inferUnOp vl cProps
-         NullaryOp vl -> checkError d node [] pm $ inferNullOp vl
-
-checkError :: NodeMap VL -> AlgNode -> [BottomUpProps] -> NodeMap BottomUpProps -> Either String BottomUpProps -> BottomUpProps
-checkError d n childProps propMap (Left msg) = 
-    let childPropsMsg = concatMap ((++) "\n" . show) childProps
-        completeMsg   = printf "Inference failed at node %d\n%s\n%s\n%s\n%s" n msg childPropsMsg (show propMap) (show d)
-    in error completeMsg
-checkError _ _ _ _ (Right props) = props
-
-inferNullOp :: NullOp -> Either String BottomUpProps
-inferNullOp op = do
-  opEmpty    <- inferEmptyNullOp op
-  opNonEmpty <- inferNonEmptyNullOp op
-  opConst    <- inferConstVecNullOp op
-  opType     <- inferVectorTypeNullOp op
-  opCard     <- inferCardOneNullOp op
-  return $ BUProps { emptyProp = opEmpty
-                   , nonEmptyProp = opNonEmpty
-                   , constProp = opConst
-                   , card1Prop = opCard
-                   , vectorTypeProp = opType }
-
-inferUnOp :: UnOp -> BottomUpProps -> Either String BottomUpProps
-inferUnOp op cProps = do
-  opEmpty    <- inferEmptyUnOp (emptyProp cProps) op
-  opNonEmpty <- inferNonEmptyUnOp (nonEmptyProp cProps) op
-  opType     <- inferVectorTypeUnOp (vectorTypeProp cProps) op
-  opConst    <- inferConstVecUnOp (constProp cProps) op
-  opCard     <- inferCardOneUnOp (card1Prop cProps) op
-  return $ BUProps { emptyProp = opEmpty
-                   , nonEmptyProp = opNonEmpty
-                   , constProp = opConst
-                   , card1Prop = opCard
-                   , vectorTypeProp = opType }
-
-inferBinOp :: BinOp -> BottomUpProps -> BottomUpProps -> Either String BottomUpProps
-inferBinOp op c1Props c2Props = do
-  opEmpty    <- inferEmptyBinOp (emptyProp c1Props) (emptyProp c2Props) op
-  opNonEmpty <- inferNonEmptyBinOp (nonEmptyProp c1Props) (nonEmptyProp c2Props) op
-  opType     <- inferVectorTypeBinOp (vectorTypeProp c1Props) (vectorTypeProp c2Props) op
-  opConst    <- inferConstVecBinOp (constProp c1Props) (constProp c2Props) op
-  opCard     <- inferCardOneBinOp (card1Prop c1Props) (card1Prop c2Props) op
-  return $ BUProps { emptyProp = opEmpty
-                   , nonEmptyProp = opNonEmpty
-                   , constProp = opConst
-                   , card1Prop = opCard
-                   , vectorTypeProp = opType }
-
-inferTerOp :: TerOp
-           -> BottomUpProps
-           -> BottomUpProps
-           -> BottomUpProps
-           -> Either String BottomUpProps
-inferTerOp op c1Props c2Props c3Props = do
-  opEmpty    <- inferEmptyTerOp (emptyProp c1Props) (emptyProp c2Props) (emptyProp c3Props) op
-  opNonEmpty <- inferNonEmptyTerOp (nonEmptyProp c1Props) (nonEmptyProp c2Props) (nonEmptyProp c3Props) op
-  opType     <- inferVectorTypeTerOp (vectorTypeProp c1Props) (vectorTypeProp c2Props) (vectorTypeProp c3Props) op
-  opConst    <- inferConstVecTerOp (constProp c1Props) (constProp c2Props) (constProp c3Props) op
-  opCard     <- inferCardOneTerOp (card1Prop c1Props) (card1Prop c2Props) (card1Prop c3Props) op
-  return $ BUProps { emptyProp = opEmpty
-                   , nonEmptyProp = opNonEmpty
-                   , constProp = opConst
-                   , card1Prop = opCard
-                   , vectorTypeProp = opType }
-
-inferBottomUpProperties :: AlgebraDag VL -> NodeMap BottomUpProps
-inferBottomUpProperties dag = inferBottomUpGeneral inferWorker dag
diff --git a/src/Database/DSH/Optimizer/VL/Properties/Card.hs b/src/Database/DSH/Optimizer/VL/Properties/Card.hs
deleted file mode 100644
--- a/src/Database/DSH/Optimizer/VL/Properties/Card.hs
+++ /dev/null
@@ -1,102 +0,0 @@
--- FIXME complete rules
-{-# LANGUAGE TemplateHaskell #-}
-
-module Database.DSH.Optimizer.VL.Properties.Card where
-
-import Control.Applicative
-
-import Database.DSH.VL.Lang
-
-import Database.DSH.Optimizer.VL.Properties.Types
-import Database.DSH.Optimizer.VL.Properties.Common
-
-unp :: Show a => VectorProp a -> Either String a
-unp = unpack "Properties.Card"
-
-inferCardOneNullOp :: NullOp -> Either String (VectorProp Bool)
-inferCardOneNullOp op =
-  case op of
-    SingletonDescr   -> Right $ VProp True
-    Lit (_, _, rows) -> Right $ VProp $ length rows == 1
-    TableRef _       -> Right $ VProp False
-
-inferCardOneUnOp :: VectorProp Bool -> UnOp -> Either String (VectorProp Bool)
-inferCardOneUnOp c op = 
-  case op of
-    UniqueS -> Right c
-    Aggr _ -> Right $ VProp True
-    AggrNonEmpty _ -> Right $ VProp True
-    WinFun _ -> Right c
-    UnboxRename -> Right c
-    Segment -> Right c
-    Unsegment -> Right c
-    Project _  -> Right c
-    Reverse -> unp c >>= (\uc -> return $ VPropPair uc uc)
-    ReverseS -> unp c >>= (\uc -> return $ VPropPair uc uc)
-    SelectPos1{}  -> Right $ VPropTriple False False False
-    SelectPos1S{} -> Right $ VPropTriple False False False
-    Select _ -> Right $ VPropPair False False
-    SortS _ -> unp c >>= (\uc -> return $ VPropPair uc uc)
-    GroupS _ -> unp c >>= (\uc -> return $ VPropTriple uc uc uc)
-    R1 -> 
-      case c of
-        VProp _           -> Left "Properties.Card: not a pair/triple"
-        VPropPair b _     -> Right $ VProp b
-        VPropTriple b _ _ -> Right $ VProp b
-    R2 ->
-      case c of
-        VProp _           -> Left "Properties.Card: not a pair/triple"
-        VPropPair _ b     -> Right $ VProp b
-        VPropTriple _ b _ -> Right $ VProp b
-    R3 ->
-      case c of
-        VPropTriple _ _ b -> Right $ VProp b
-        _                 -> Left "Properties.Card: not a triple"
-    GroupAggr ([], _) -> Right $ VProp True
-    GroupAggr (_, _)  -> Right c
-    Number -> Right c
-    NumberS -> Right c
-    Reshape _ -> unp c >>= (\uc -> return $ VPropPair uc uc)
-    ReshapeS _ -> unp c >>= (\uc -> return $ VPropPair uc uc)
-    Transpose -> unp c >>= (\uc -> return $ VPropPair uc uc)
-    AggrNonEmptyS _ -> return $ VProp False
-    
-
-inferCardOneBinOp :: VectorProp Bool -> VectorProp Bool -> BinOp -> Either String (VectorProp Bool)
-inferCardOneBinOp c1 c2 op =
-  case op of
-    AggrS _ -> return $ VProp False
-    NestProduct -> return $ VPropTriple False False False
-    DistLift -> return $ VPropPair False False
-    PropRename -> return $ VProp False
-    PropFilter -> return $ VPropPair False False
-    PropReorder -> return $ VPropPair False False
-    UnboxNested -> return $ VPropPair False False
-    UnboxScalar -> return $ VProp False
-    -- FIXME more precisely: empty(left) and card1(right) or card1(left) and empty(right)
-    Append -> Right $ VPropTriple False False False
-    AppendS -> Right $ VPropTriple False False False
-    SelectPos _ -> return $ VPropTriple False False False
-    SelectPosS _ -> return $ VPropTriple False False False
-    Zip -> VProp <$> ((||) <$> unp c1 <*> unp c2)
-    Align -> VProp <$> ((||) <$> unp c1 <*> unp c2)
-    CartProduct -> return $ VPropTriple False False False
-    CartProductS -> return $ VPropTriple False False False
-    NestProductS -> return $ VPropTriple False False False
-    ThetaJoin _ -> return $ VPropTriple False False False
-    NestJoin _ -> return $ VPropTriple False False False
-    ThetaJoinS _ -> return $ VPropTriple False False False
-    NestJoinS _ -> return $ VPropTriple False False False
-    SemiJoin _ -> return $ VPropPair False False
-    SemiJoinS _ -> return $ VPropPair False False
-    AntiJoin _ -> return $ VPropPair False False
-    AntiJoinS _ -> return $ VPropPair False False
-    TransposeS -> return $ VPropPair False False
-    ZipS -> do
-      c <- (||) <$> unp c1 <*> unp c2
-      return $ VPropTriple c c c
-      
-inferCardOneTerOp :: VectorProp Bool -> VectorProp Bool -> VectorProp Bool -> TerOp -> Either String (VectorProp Bool)
-inferCardOneTerOp _ _ _ op =
-  case op of
-    Combine -> return $ VPropTriple False False False
diff --git a/src/Database/DSH/Optimizer/VL/Properties/Common.hs b/src/Database/DSH/Optimizer/VL/Properties/Common.hs
deleted file mode 100644
--- a/src/Database/DSH/Optimizer/VL/Properties/Common.hs
+++ /dev/null
@@ -1,19 +0,0 @@
-module Database.DSH.Optimizer.VL.Properties.Common where
-
-import Control.Monad
-
-import Database.DSH.Optimizer.VL.Properties.Types
-
-unpack :: Show a => String -> VectorProp a -> Either String a
-unpack _ (VProp b)  = Right b
-unpack moduleName p = Left $ "no single vector in " ++ moduleName ++ " " ++ (show p)
-
-mapUnpack :: Show a => String 
-             -> VectorProp a
-             -> VectorProp a
-             -> (a -> a -> VectorProp a) 
-             -> Either String (VectorProp a)
-mapUnpack moduleName e1 e2 f = let ue1 = unpack moduleName e1
-                                   ue2 = unpack moduleName e2
-                               in liftM2 f ue1 ue2
-                                  
diff --git a/src/Database/DSH/Optimizer/VL/Properties/Const.hs b/src/Database/DSH/Optimizer/VL/Properties/Const.hs
deleted file mode 100644
--- a/src/Database/DSH/Optimizer/VL/Properties/Const.hs
+++ /dev/null
@@ -1,492 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-
-module Database.DSH.Optimizer.VL.Properties.Const
-    ( inferConstVecNullOp
-    , inferConstVecUnOp
-    , inferConstVecBinOp
-    , inferConstVecTerOp
-    ) where
-
-import           Control.Monad
-import           Data.List
-import qualified Data.List.NonEmpty                          as N
-import           Data.Maybe
-
-import Database.DSH.Impossible
-import           Database.DSH.Optimizer.VL.Properties.Common
-import           Database.DSH.Optimizer.VL.Properties.Types
-import           Database.DSH.VL.Lang
-import           Database.DSH.Common.Lang
-
-unp :: Show a => VectorProp a -> Either String a
-unp = unpack "Properties.Const"
-
-fromDBV :: ConstVec -> Either String (ConstDescr, [ConstPayload])
-fromDBV (DBVConst d ps)   = Right (d, ps)
-fromDBV x                 = Left $ "Properties.Const fromDBV " ++ (show x)
-
-fromRVec :: ConstVec -> Either String (SourceConstDescr, TargetConstDescr)
-fromRVec (RenameVecConst s t) = Right (s, t)
-fromRVec x                    = Left ("Properties.Const fromRVec " ++ (show x))
-
-fromPVec :: ConstVec -> Either String (SourceConstDescr, TargetConstDescr)
-fromPVec (PropVecConst s t)  = Right (s, t)
-fromPVec _                   = Left "Properties.Const fromPVec"
-
---------------------------------------------------------------------------------
--- Evaluation of constant expressions
-
--- FIXME finish remaining cases, only integer numeric operations so
--- far.
-
-mkEnv :: [ConstPayload] -> [(DBCol, VLVal)]
-mkEnv constCols = mapMaybe envEntry $ zip [1..] constCols
-  where
-    envEntry :: (DBCol, ConstPayload) -> Maybe (DBCol, VLVal)
-    envEntry (_, NonConstPL) = mzero
-    envEntry (c, ConstPL v)  = return (c, v)
-
-evalNumOp :: BinNumOp -> Int -> Int -> Int
-evalNumOp op v1 v2 =
-    case op of
-        Add -> v1 + v2
-        Sub -> v1 - v2
-        Div -> v1 `div` v2
-        Mul -> v1 * v2
-        Mod -> v1 `mod` v2
-
-evalBinOp :: ScalarBinOp -> VLVal -> VLVal -> Maybe VLVal
-evalBinOp op v1 v2 =
-    case (v1, v2) of
-        (VLInt i1, VLInt i2)       ->
-            case op of
-                SBNumOp nop  -> return $ VLInt $ evalNumOp nop i1 i2
-                SBRelOp _    -> mzero
-                SBBoolOp _   -> $impossible
-                SBStringOp _ -> $impossible
-                
-        (VLBool _, VLBool _)     ->
-            case op of
-                SBBoolOp _   -> mzero
-                SBRelOp _    -> mzero
-                SBNumOp _    -> $impossible
-                SBStringOp _ -> $impossible
-        (VLString _, VLString _) ->
-            case op of
-                SBRelOp _    -> mzero
-                SBStringOp _ -> mzero
-                SBBoolOp _   -> $impossible
-                SBNumOp _    -> $impossible
-        (VLDouble _, VLDouble _) ->
-            case op of
-                SBRelOp _    -> mzero
-                SBNumOp _    -> mzero
-                SBBoolOp _   -> $impossible
-                SBStringOp _ -> $impossible
-        (VLUnit, VLUnit)           -> mzero
-        _                          -> $impossible
-
-evalUnOp :: ScalarUnOp -> VLVal -> Maybe VLVal
-evalUnOp _ _ = mzero
-
-constExpr :: [ConstPayload] -> Expr -> Either String ConstPayload
-constExpr constCols expr =
-    case eval expr of
-        Just v  -> return $ ConstPL v
-        Nothing -> return NonConstPL
-
-  where
-    env :: [(DBCol, VLVal)]
-    env = mkEnv constCols
-
-    eval :: Expr -> Maybe VLVal
-    eval (Constant v)      = return v
-    eval (Column i)        = lookup i env
-    eval (BinApp op e1 e2) = do
-        v1 <- eval e1
-        v2 <- eval e2
-        evalBinOp op v1 v2
-    eval (UnApp op e1)     = do
-        v <- eval e1
-        evalUnOp op v
-    eval (If c t e)        = do
-        cv <- eval c
-        case cv of
-            VLBool True  -> eval t
-            VLBool False -> eval e
-            _            -> mzero
-
---------------------------------------------------------------------------------
--- Stuff
-
-nonConstPVec :: ConstVec
-nonConstPVec = PropVecConst (SC NonConstDescr) (TC NonConstDescr)
-
-nonConstRVec :: ConstVec
-nonConstRVec = RenameVecConst (SC NonConstDescr) (TC NonConstDescr)
-
-inferConstVecNullOp :: NullOp -> Either String (VectorProp ConstVec)
-inferConstVecNullOp op =
-  case op of
-    SingletonDescr                    -> return $ VProp $ DBVConst (ConstDescr 1) []
-    -- do not include the first two columns in the payload columns because they represent descr and pos.
-    Lit (_, colTypes, rows)      ->
-      if null rows
-      then return $ VProp $ DBVConst NonConstDescr $ map (const NonConstPL) colTypes
-      else return $ VProp $ DBVConst (ConstDescr 1) constCols
-        where constCols       = map toConstPayload $ drop 2 $ transpose rows
-
-              toConstPayload col@(c : _) = if all (c ==) col
-                                           then ConstPL c
-                                           else NonConstPL
-              toConstPayload []          = NonConstPL
-
-    TableRef              (_, cols, _)    -> return $ VProp $ DBVConst (ConstDescr 1) $ map (const NonConstPL) cols
-
-inferConstVecUnOp :: (VectorProp ConstVec) -> UnOp -> Either String (VectorProp ConstVec)
-inferConstVecUnOp c op =
-  case op of
-    WinFun _ -> do
-      (d, cols) <- unp c >>= fromDBV
-      return $ VProp $ DBVConst d (cols ++ [NonConstPL])
-
-    UniqueS -> return c
-
-    Aggr _ -> do
-      return $ VProp $ DBVConst NonConstDescr [NonConstPL]
-
-    AggrNonEmpty _ -> do
-      return $ VProp $ DBVConst (ConstDescr 1) [NonConstPL]
-
-    UnboxRename -> do
-      (d, _) <- unp c >>= fromDBV
-      return $ VProp $ RenameVecConst (SC NonConstDescr) (TC d)
-
-    Segment -> do
-      (_, constCols) <- unp c >>= fromDBV
-      return $ VProp $ DBVConst NonConstDescr constCols
-
-    Unsegment -> do
-      (_, constCols) <- unp c >>= fromDBV
-      return $ VProp $ DBVConst NonConstDescr constCols
-
-    SelectPos1{}  -> do
-      (d, cols) <- unp c >>= fromDBV
-      return $ VPropTriple (DBVConst d cols) 
-                           (RenameVecConst (SC NonConstDescr) (TC NonConstDescr))
-                           (RenameVecConst (SC NonConstDescr) (TC NonConstDescr))
-
-    SelectPos1S{} -> do
-      (d, cols) <- unp c >>= fromDBV
-      return $ VPropTriple (DBVConst d cols) 
-                           (RenameVecConst (SC NonConstDescr) (TC NonConstDescr))
-                           (RenameVecConst (SC NonConstDescr) (TC NonConstDescr))
-
-    Reverse -> do
-      (d, cs) <- unp c >>= fromDBV
-      return $ VPropPair (DBVConst d cs) (PropVecConst (SC NonConstDescr) (TC NonConstDescr))
-
-    ReverseS -> do
-      (d, cs) <- unp c >>= fromDBV
-      return $ VPropPair (DBVConst d cs) (PropVecConst (SC NonConstDescr) (TC NonConstDescr))
-
-    Project projExprs   -> do
-      (constDescr, constCols) <- unp c >>= fromDBV
-      constCols'              <- mapM (constExpr constCols) projExprs
-      return $ VProp $ DBVConst constDescr constCols'
-
-    Select _       -> do
-      (d, cols) <- unp c >>= fromDBV
-      return $ VPropPair (DBVConst d cols) (RenameVecConst (SC NonConstDescr) (TC NonConstDescr))
-
-    GroupAggr (g, as) -> do
-      (d, _) <- unp c >>= fromDBV
-      return $ VProp $ DBVConst d (map (const NonConstPL) [ 1 .. (length g) + (N.length as) ])
-
-    Number -> do
-      (d, cols) <- unp c >>= fromDBV
-      return $ VProp $ DBVConst d (cols ++ [NonConstPL])
-
-    NumberS -> do
-      (d, cols) <- unp c >>= fromDBV
-      return $ VProp $ DBVConst d (cols ++ [NonConstPL])
-
-    SortS _ -> do
-      (d, cs) <- unp c >>= fromDBV
-      return $ VPropPair (DBVConst d cs) (PropVecConst (SC NonConstDescr) (TC NonConstDescr))
-
-    GroupS es -> do
-      (d, cs) <- unp c >>= fromDBV
-      return $ VPropTriple (DBVConst d (map (const NonConstPL) es))
-                           (DBVConst NonConstDescr (map (const NonConstPL) cs))
-                           (PropVecConst (SC NonConstDescr) (TC NonConstDescr))
-
-    Transpose -> do
-      (_, cols) <- unp c >>= fromDBV
-      return $ VPropPair (DBVConst NonConstDescr []) (DBVConst NonConstDescr cols)
-    Reshape _ -> do
-      (_, cols) <- unp c >>= fromDBV
-      return $ VPropPair (DBVConst NonConstDescr []) (DBVConst NonConstDescr cols)
-    ReshapeS _ -> do
-      (_, cols) <- unp c >>= fromDBV
-      return $ VPropPair (DBVConst NonConstDescr []) (DBVConst NonConstDescr cols)
-
-    AggrNonEmptyS _ -> do
-      return $ VProp $ DBVConst NonConstDescr [NonConstPL]
-
-    R1 ->
-      case c of
-        VProp _           -> Left "Properties.Const: not a pair/triple"
-        VPropPair b _     -> Right $ VProp b
-        VPropTriple b _ _ -> Right $ VProp b
-    R2 ->
-      case c of
-        VProp _           -> Left "Properties.Const: not a pair/triple"
-        VPropPair _ b     -> Right $ VProp b
-        VPropTriple _ b _ -> Right $ VProp b
-    R3 ->
-      case c of
-        VPropTriple _ _ b -> Right $ VProp b
-        _                 -> Left "Properties.Const: not a triple"
-
-inferConstVecBinOp :: (VectorProp ConstVec) -> (VectorProp ConstVec) -> BinOp -> Either String (VectorProp ConstVec)
-inferConstVecBinOp c1 c2 op =
-  case op of
-    -- FIXME use cardinality property to infer the length if possible
-    -- FIXME handle special cases: empty input, cardinality 1 and const input, ...
-    AggrS _ -> do
-      return $ VProp $ DBVConst NonConstDescr [NonConstPL]
-
-    DistLift -> do
-      (_, cols1) <- unp c1 >>= fromDBV
-      (d, cols2) <- unp c2 >>= fromDBV
-      return $ VPropPair (DBVConst d (cols1 ++ cols2)) (PropVecConst (SC NonConstDescr) (TC NonConstDescr))
-
-    PropRename -> do
-      (_, cols) <- unp c2 >>= fromDBV
-      (SC _, TC target) <- unp c1 >>= fromRVec
-
-      return $ VProp $ DBVConst target cols
-
-    PropFilter -> do
-      (_, cols) <- unp c2 >>= fromDBV
-      (SC _, TC target) <- unp c1 >>= fromRVec
-
-      return $ VPropPair (DBVConst target cols) (RenameVecConst (SC NonConstDescr) (TC NonConstDescr))
-
-    PropReorder -> do
-      (_, cols) <- unp c2 >>= fromDBV
-      (SC _, TC target) <- unp c1 >>= fromPVec
-
-      return $ VPropPair (DBVConst target cols) (PropVecConst (SC NonConstDescr) (TC NonConstDescr))
-
-    UnboxNested -> do
-      (_, TC descr) <- unp c1 >>= fromRVec
-      (_, cols)     <- unp c2 >>= fromDBV
-
-      return $ VPropPair (DBVConst descr cols) (RenameVecConst (SC NonConstDescr) (TC NonConstDescr))
-
-    UnboxScalar -> do
-      (d1, cols1) <- unp c1 >>= fromDBV
-      (_, cols2)  <- unp c2 >>= fromDBV
-      return $ VProp $ DBVConst d1 (cols1 ++ cols2)
-
-    Append -> do
-      (d1, cols1) <- unp c1 >>= fromDBV
-      (d2, cols2) <- unp c2 >>= fromDBV
-
-      let constCols = map sameConst $ zip cols1 cols2
-
-          sameConst ((ConstPL v1), (ConstPL v2)) | v1 == v2 = ConstPL v1
-          sameConst (_, _)                                  = NonConstPL
-
-          d = case (d1, d2) of
-            (ConstDescr n1, ConstDescr n2) | n1 == n2 -> ConstDescr n1
-            _                                         -> NonConstDescr
-
-      return $ VPropTriple (DBVConst d constCols) nonConstRVec nonConstRVec
-
-    AppendS -> do
-      (d1, cols1) <- unp c1 >>= fromDBV
-      (d2, cols2) <- unp c2 >>= fromDBV
-
-      let constCols = map sameConst $ zip cols1 cols2
-
-          sameConst ((ConstPL v1), (ConstPL v2)) | v1 == v2 = ConstPL v1
-          sameConst (_, _)                                  = NonConstPL
-
-          d = case (d1, d2) of
-            (ConstDescr n1, ConstDescr n2) | n1 == n2 -> ConstDescr n1
-            _                                         -> NonConstDescr
-
-      return $ VPropTriple (DBVConst d constCols) nonConstRVec nonConstRVec
-
-    SelectPos _ -> do
-      (d1, cols1) <- unp c1 >>= fromDBV
-
-      return $ VPropTriple (DBVConst d1 cols1) 
-                           (RenameVecConst (SC NonConstDescr) (TC NonConstDescr))
-                           (RenameVecConst (SC NonConstDescr) (TC NonConstDescr))
-
-    SelectPosS _ -> do
-      (d1, cols1) <- unp c1 >>= fromDBV
-
-      return $ VPropTriple (DBVConst d1 cols1) 
-                           (RenameVecConst (SC NonConstDescr) (TC NonConstDescr))
-                           (RenameVecConst (SC NonConstDescr) (TC NonConstDescr))
-
-    Align -> do
-      (d1, cols1) <- unp c1 >>= fromDBV
-      (_, cols2)  <- unp c2 >>= fromDBV
-
-      let cols = cols1 ++ cols2
-
-      return $ VProp $ DBVConst d1 cols
-
-    Zip -> do
-      (d1, cols1) <- unp c1 >>= fromDBV
-      (_, cols2)  <- unp c2 >>= fromDBV
-
-      let cols = cols1 ++ cols2
-
-      return $ VProp $ DBVConst d1 cols
-
-    ZipS -> do
-      (d1, cols1) <- unp c1 >>= fromDBV
-      (_, cols2)  <- unp c2 >>= fromDBV
-
-      let cols = cols1 ++ cols2
-          renameVec = RenameVecConst (SC NonConstDescr) (TC NonConstDescr)
-
-      return $ VPropTriple (DBVConst d1 cols) renameVec renameVec
-
-    CartProduct -> do
-      (_, cols1) <- unp c1 >>= fromDBV
-      (_, cols2) <- unp c2 >>= fromDBV
-
-      let constCols = cols1 ++ cols2
-
-      -- FIXME check propVec components for correctness/precision
-      -- FIXME descr = 1 is almost certainly not correct
-      return $ VPropTriple (DBVConst (ConstDescr 1) constCols) nonConstPVec nonConstPVec
-
-    CartProductS -> do
-      (_, cols1) <- unp c1 >>= fromDBV
-      (_, cols2) <- unp c2 >>= fromDBV
-
-      let constCols = cols1 ++ cols2
-
-      -- FIXME check propVec components for correctness/precision
-      return $ VPropTriple (DBVConst NonConstDescr constCols) nonConstPVec nonConstPVec
-
-    NestProductS -> do
-      (_, cols1) <- unp c1 >>= fromDBV
-      (_, cols2) <- unp c2 >>= fromDBV
-
-      let constCols = cols1 ++ cols2
-
-      -- FIXME check propVec components for correctness/precision
-      return $ VPropTriple (DBVConst NonConstDescr constCols) nonConstPVec nonConstPVec
-
-    NestJoin _ -> do
-      (_, cols1) <- unp c1 >>= fromDBV
-      (_, cols2) <- unp c2 >>= fromDBV
-
-      let constCols = cols1 ++ cols2
-
-      -- FIXME check propVec components for correctness/precision
-      return $ VPropTriple (DBVConst NonConstDescr constCols) nonConstPVec nonConstPVec
-
-    NestProduct -> do
-      (_, cols1) <- unp c1 >>= fromDBV
-      (_, cols2) <- unp c2 >>= fromDBV
-
-      let constCols = cols1 ++ cols2
-
-      -- FIXME check propVec components for correctness/precision
-      return $ VPropTriple (DBVConst NonConstDescr constCols) nonConstPVec nonConstPVec
-
-    ThetaJoin _ -> do
-      (_, cols1) <- unp c1 >>= fromDBV
-      (_, cols2) <- unp c2 >>= fromDBV
-
-      let constCols = cols1 ++ cols2
-
-      -- FIXME check propVec components for correctness/precision
-      return $ VPropTriple (DBVConst (ConstDescr 1) constCols) nonConstPVec nonConstPVec
-
-    ThetaJoinS _ -> do
-      (_, cols1) <- unp c1 >>= fromDBV
-      (_, cols2) <- unp c2 >>= fromDBV
-
-      let constCols = cols1 ++ cols2
-
-      -- FIXME check propVec components for correctness/precision
-      return $ VPropTriple (DBVConst NonConstDescr constCols) nonConstPVec nonConstPVec
-
-    NestJoinS _ -> do
-      (_, cols1) <- unp c1 >>= fromDBV
-      (_, cols2) <- unp c2 >>= fromDBV
-
-      let constCols = cols1 ++ cols2
-
-      -- FIXME check propVec components for correctness/precision
-      return $ VPropTriple (DBVConst NonConstDescr constCols) nonConstPVec nonConstPVec
-
-    SemiJoin _ -> do
-      (_, cols1) <- unp c1 >>= fromDBV
-
-      -- FIXME This is propably too pessimistic for the source descriptor
-      let renameVec = RenameVecConst (SC NonConstDescr) (TC NonConstDescr)
-
-      -- FIXME This is propably too pessimistic for the descr
-      return $ VPropPair (DBVConst NonConstDescr cols1) renameVec
-
-    SemiJoinS _ -> do
-      (_, cols1) <- unp c1 >>= fromDBV
-
-      -- FIXME This is propably too pessimistic for the source descriptor
-      let renameVec = RenameVecConst (SC NonConstDescr) (TC NonConstDescr)
-
-      -- FIXME This is propably too pessimistic for the descr
-      return $ VPropPair (DBVConst NonConstDescr cols1) renameVec
-
-    AntiJoin _ -> do
-      (_, cols1) <- unp c1 >>= fromDBV
-
-      -- FIXME This is propably too pessimistic for the source descriptor
-      let renameVec = RenameVecConst (SC NonConstDescr) (TC NonConstDescr)
-
-      -- FIXME This is propably too pessimistic for the descr
-      return $ VPropPair (DBVConst NonConstDescr cols1) renameVec
-
-    AntiJoinS _ -> do
-      (_, cols1) <- unp c1 >>= fromDBV
-
-      -- FIXME This is propably too pessimistic for the source descriptor
-      let renameVec = RenameVecConst (SC NonConstDescr) (TC NonConstDescr)
-
-      -- FIXME This is propably too pessimistic for the descr
-      return $ VPropPair (DBVConst NonConstDescr cols1) renameVec
-
-    TransposeS -> do
-      (_, cols2) <- unp c2 >>= fromDBV
-      return $ VPropPair (DBVConst NonConstDescr []) (DBVConst NonConstDescr cols2)
-
-inferConstVecTerOp :: (VectorProp ConstVec) -> (VectorProp ConstVec) -> (VectorProp ConstVec) -> TerOp -> Either String (VectorProp ConstVec)
-inferConstVecTerOp c1 c2 c3 op =
-  case op of
-    Combine -> do
-      (d1, _) <- unp c1 >>= fromDBV
-      (_, cols2)  <- unp c2 >>= fromDBV
-      (_, cols3)  <- unp c3 >>= fromDBV
-
-      let constCols = map sameConst $ zip cols2 cols3
-
-          sameConst ((ConstPL v1), (ConstPL v2)) | v1 == v2 = ConstPL v1
-          sameConst (_, _)                                  = NonConstPL
-
-          renameVec = RenameVecConst (SC NonConstDescr) (TC NonConstDescr)
-
-      return $ VPropTriple (DBVConst d1 constCols) renameVec renameVec
-
diff --git a/src/Database/DSH/Optimizer/VL/Properties/Empty.hs b/src/Database/DSH/Optimizer/VL/Properties/Empty.hs
deleted file mode 100644
--- a/src/Database/DSH/Optimizer/VL/Properties/Empty.hs
+++ /dev/null
@@ -1,115 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-
-module Database.DSH.Optimizer.VL.Properties.Empty where
-
-import Control.Monad
-  
-import Database.DSH.VL.Lang
-
-import Database.DSH.Optimizer.VL.Properties.Types
-import Database.DSH.Optimizer.VL.Properties.Common
-  
-unp :: Show a => VectorProp a -> Either String a
-unp = unpack "Properties.Empty"
-                   
-mapUnp :: Show a => VectorProp a
-          -> VectorProp a 
-          -> (a -> a -> VectorProp a) 
-          -> Either String (VectorProp a)
-mapUnp = mapUnpack "Properties.Empty"  
-
-inferEmptyNullOp :: NullOp -> Either String (VectorProp Bool)
-inferEmptyNullOp op =
-  case op of
-    SingletonDescr     -> Right $ VProp False
-    Lit (_, _, [])     -> Right $ VProp True
-    Lit (_, _, _)      -> Right $ VProp False
-    TableRef (_, _, _) -> Right $ VProp False
-    
-inferEmptyUnOp :: VectorProp Bool -> UnOp -> Either String (VectorProp Bool)
-inferEmptyUnOp e op =
-  case op of
-    WinFun _       -> Right e
-    UniqueS         -> Right e
-    Aggr _          -> Right $ VProp False
-    AggrNonEmpty _  -> Right $ VProp False
-    UnboxRename     -> Right e
-    Segment         -> Right e
-    Unsegment       -> Right e
-    Reverse         -> let ue = unp e in liftM2 VPropPair ue ue
-    ReverseS        -> let ue = unp e in liftM2 VPropPair ue ue
-    Project _       -> Right e
-    Select _        -> let ue = unp e in liftM2 VPropPair ue ue
-    SortS _         -> let ue = unp e in liftM2 VPropPair ue ue
-    GroupS _        -> let ue = unp e in liftM3 VPropTriple ue ue ue
-
-    -- FIXME this documents the current implementation behaviour, not
-    -- what _should_ happen!
-    ReshapeS _ -> let ue = unp e in liftM2 VPropPair ue ue
-    Reshape _ -> let ue = unp e in liftM2 VPropPair ue ue
-    Transpose -> let ue = unp e in liftM2 VPropPair ue ue
-
-    SelectPos1{} -> let ue = unp e in liftM3 VPropTriple ue ue ue
-    SelectPos1S{} -> let ue = unp e in liftM3 VPropTriple ue ue ue
-    -- FIXME think about it: what happens if we feed an empty vector into the aggr operator?
-    GroupAggr (_, _) -> Right $ VProp False
-    Number -> Right e
-    NumberS -> Right e
-    AggrNonEmptyS _ -> return $ VProp False
-  
-    R1 -> 
-      case e of
-        VProp _           -> Left "Properties.Empty: not a pair/triple"
-        VPropPair b _     -> Right $ VProp b
-        VPropTriple b _ _ -> Right $ VProp b
-    R2 ->
-      case e of
-        VProp _           -> Left "Properties.Empty: not a pair/triple"
-        VPropPair _ b     -> Right $ VProp b
-        VPropTriple _ b _ -> Right $ VProp b
-    R3 ->
-      case e of
-        VPropTriple _ _ b -> Right $ VProp b
-        p                 -> Left ("Properties.Empty: not a triple" ++ show p)
-
-    
-inferEmptyBinOp :: VectorProp Bool -> VectorProp Bool -> BinOp -> Either String (VectorProp Bool)
-inferEmptyBinOp e1 e2 op =
-  case op of
-    DistLift -> mapUnp e1 e2 (\ue1 ue2 -> VPropPair (ue1 || ue2) (ue1 || ue2))
-    PropRename -> mapUnp e1 e2 (\ue1 ue2 -> VProp (ue1 || ue2))
-    PropFilter -> mapUnp e1 e2 (\ue1 ue2 -> VPropPair (ue1 || ue2) (ue1 || ue2))
-    PropReorder -> mapUnp e1 e2 (\ue1 ue2 -> VPropPair (ue1 || ue2) (ue1 || ue2))
-    UnboxNested -> mapUnp e1 e2 (\ue1 ue2 -> VPropPair (ue1 || ue2) (ue1 || ue2))
-    UnboxScalar -> mapUnp e1 e2 (\ue1 ue2 -> VProp (ue1 || ue2))
-    Append -> mapUnp e1 e2 (\ue1 ue2 -> VPropTriple (ue1 && ue2) ue1 ue2)
-    AppendS -> mapUnp e1 e2 (\ue1 ue2 -> VPropTriple (ue1 && ue2) ue1 ue2)
-    AggrS _ -> return $ VProp False
-    SelectPos _ -> mapUnp e1 e2 (\ue1 ue2 -> let b = ue1 || ue2 in VPropTriple b b b)
-    SelectPosS _ -> mapUnp e1 e2 (\ue1 ue2 -> let b = ue1 || ue2 in VPropTriple b b b)
-    Zip -> mapUnp e1 e2 (\ue1 ue2 -> VProp (ue1 || ue2))
-    Align -> mapUnp e1 e2 (\ue1 ue2 -> VProp (ue1 || ue2))
-    ZipS -> mapUnp e1 e2 (\ue1 ue2 -> (\p -> VPropTriple p p p) (ue1 || ue2))
-    CartProduct -> mapUnp e1 e2 (\ue1 ue2 -> (\p -> VPropTriple p p p) (ue1 || ue2))
-    CartProductS -> mapUnp e1 e2 (\ue1 ue2 -> (\p -> VPropTriple p p p) (ue1 || ue2))
-    NestProductS -> mapUnp e1 e2 (\ue1 ue2 -> (\p -> VPropTriple p p p) (ue1 || ue2))
-    ThetaJoin _ -> mapUnp e1 e2 (\ue1 ue2 -> (\p -> VPropTriple p p p) (ue1 || ue2))
-    NestJoin _ -> mapUnp e1 e2 (\ue1 ue2 -> (\p -> VPropTriple p p p) (ue1 || ue2))
-    NestProduct -> mapUnp e1 e2 (\ue1 ue2 -> (\p -> VPropTriple p p p) (ue1 || ue2))
-    ThetaJoinS _ -> mapUnp e1 e2 (\ue1 ue2 -> (\p -> VPropTriple p p p) (ue1 || ue2))
-    NestJoinS _ -> mapUnp e1 e2 (\ue1 ue2 -> (\p -> VPropTriple p p p) (ue1 || ue2))
-    SemiJoin _ -> mapUnp e1 e2 (\ue1 ue2 -> (\p -> VPropPair p p) (ue1 || ue2))
-    SemiJoinS _ -> mapUnp e1 e2 (\ue1 ue2 -> (\p -> VPropPair p p) (ue1 || ue2))
-    AntiJoin _ -> mapUnp e1 e2 (\ue1 _ -> (\p -> VPropPair p p) ue1)
-    AntiJoinS _ -> mapUnp e1 e2 (\ue1 _ -> (\p -> VPropPair p p) ue1)
-    -- FIXME This documents the current behaviour of the algebraic
-    -- implementations, not what _should_ happen!
-    TransposeS -> mapUnp e1 e2 (\ue1 ue2 -> (\p -> VPropPair p p) (ue1 || ue2))
-    
-inferEmptyTerOp :: VectorProp Bool -> VectorProp Bool -> VectorProp Bool -> TerOp -> Either String (VectorProp Bool)
-inferEmptyTerOp _ e2 e3 op =
-  case op of
-    Combine -> let ue2 = unp e2
-                   ue3 = unp e3
-               in liftM3 VPropTriple (liftM2 (&&) ue2 ue3) ue2 ue3
-    
diff --git a/src/Database/DSH/Optimizer/VL/Properties/NonEmpty.hs b/src/Database/DSH/Optimizer/VL/Properties/NonEmpty.hs
deleted file mode 100644
--- a/src/Database/DSH/Optimizer/VL/Properties/NonEmpty.hs
+++ /dev/null
@@ -1,139 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-
-{-
-
-FIXME semantics need to be clarified.
-
-For an inner vector (one with multiple segments), True means that all
-segments contained in the outer vector will be present. This is
-particularly true for the output of a grouping operator.
-
-For a non-segmented vector, it is true if we can (derived from a base
-tables non-empty property) statically assert that a vector will not be
-empty.
-
-This is all rather unclear. Currently, the main purpose of this
-property is to avoid the special treatment of empty segments in
-segmented aggregates.
-
--}
-
-module Database.DSH.Optimizer.VL.Properties.NonEmpty where
-
-import Control.Monad
-  
-import Database.DSH.Common.Lang(nonEmptyHint, Emptiness(..))
-import Database.DSH.VL.Lang
-
-import Database.DSH.Optimizer.VL.Properties.Types
-import Database.DSH.Optimizer.VL.Properties.Common
-  
-unp :: Show a => VectorProp a -> Either String a
-unp = unpack "Properties.NonEmpty"
-                   
-mapUnp :: Show a => VectorProp a
-          -> VectorProp a 
-          -> (a -> a -> VectorProp a) 
-          -> Either String (VectorProp a)
-mapUnp = mapUnpack "Properties.NonEmpty"  
-
-inferNonEmptyNullOp :: NullOp -> Either String (VectorProp Bool)
-inferNonEmptyNullOp op =
-  case op of
-    SingletonDescr            -> Right $ VProp False
-    Lit (NonEmpty, _, _)      -> Right $ VProp True
-    Lit (PossiblyEmpty, _, _) -> Right $ VProp False
-    TableRef (_, _, hs)       -> return $ VProp $ (nonEmptyHint hs) == NonEmpty
-    
-inferNonEmptyUnOp :: VectorProp Bool -> UnOp -> Either String (VectorProp Bool)
-inferNonEmptyUnOp e op =
-  case op of
-    WinFun _       -> Right e
-    UniqueS         -> Right e
-    Aggr _          -> Right $ VProp True
-    AggrNonEmpty _  -> Right $ VProp True
-    UnboxRename     -> Right e
-    Segment         -> Right e
-    Unsegment       -> Right e
-    Reverse         -> let ue = unp e in liftM2 VPropPair ue ue
-    ReverseS        -> let ue = unp e in liftM2 VPropPair ue ue
-    Project _       -> Right e
-    Select _        -> Right $ VPropPair False False
-    SortS _         -> let ue = unp e in liftM2 VPropPair ue ue
-    -- If the input is not completely empty (that is, segments exist),
-    -- grouping leads to a nested vector in which every inner segment
-    -- is not empty.
-    GroupS _        -> let ue = unp e in liftM3 VPropTriple ue (return True) ue
-
-    -- FIXME this documents the current implementation behaviour, not
-    -- what _should_ happen!
-    ReshapeS _ -> let ue = unp e in liftM2 VPropPair ue ue
-    Reshape _ -> let ue = unp e in liftM2 VPropPair ue ue
-    Transpose -> let ue = unp e in liftM2 VPropPair ue ue
-
-    SelectPos1{} -> return $ VPropTriple False False False
-    SelectPos1S{} -> return $ VPropTriple False False False
-    -- FIXME think about it: what happens if we feed an empty vector into the aggr operator?
-    GroupAggr (_, _) -> Right e
-    Number -> Right e
-    NumberS -> Right e
-    AggrNonEmptyS _ -> return $ VProp True
-  
-    R1 -> 
-      case e of
-        VProp _           -> Left "Properties.NonEmpty: not a pair/triple"
-        VPropPair b _     -> Right $ VProp b
-        VPropTriple b _ _ -> Right $ VProp b
-    R2 ->
-      case e of
-        VProp _           -> Left "Properties.NonEmpty: not a pair/triple"
-        VPropPair _ b     -> Right $ VProp b
-        VPropTriple _ b _ -> Right $ VProp b
-    R3 ->
-      case e of
-        VPropTriple _ _ b -> Right $ VProp b
-        _                 -> Left "Properties.NonEmpty: not a triple"
-
-    
-inferNonEmptyBinOp :: VectorProp Bool -> VectorProp Bool -> BinOp -> Either String (VectorProp Bool)
-inferNonEmptyBinOp e1 e2 op =
-  case op of
-    DistLift        -> mapUnp e1 e2 (\ue1 ue2 -> VPropPair (ue1 && ue2) (ue1 && ue2))
-    PropRename      -> mapUnp e1 e2 (\ue1 ue2 -> VProp (ue1 && ue2))
-    PropFilter      -> mapUnp e1 e2 (\ue1 ue2 -> VPropPair (ue1 && ue2) (ue1 && ue2))
-    PropReorder     -> mapUnp e1 e2 (\ue1 ue2 -> VPropPair (ue1 && ue2) (ue1 && ue2))
-    UnboxNested     -> mapUnp e1 e2 (\ue1 ue2 -> VPropPair (ue1 && ue2) (ue1 && ue2))
-    UnboxScalar     -> mapUnp e1 e2 (\ue1 ue2 -> VProp (ue1 && ue2))
-    Append          -> mapUnp e1 e2 (\ue1 ue2 -> VPropTriple (ue1 || ue2) ue1 ue2)
-    AppendS         -> mapUnp e1 e2 (\ue1 ue2 -> VPropTriple (ue1 || ue2) ue1 ue2)
-    AggrS _         -> return $ VProp True
-    SelectPos _     -> mapUnp e1 e2 (\ue1 ue2 -> let b = ue1 && ue2 in VPropTriple b b b)
-    SelectPosS _    -> mapUnp e1 e2 (\ue1 ue2 -> let b = ue1 && ue2 in VPropTriple b b b)
-    Zip             -> mapUnp e1 e2 (\ue1 ue2 -> VProp (ue1 && ue2))
-    Align           -> mapUnp e1 e2 (\ue1 ue2 -> VProp (ue1 && ue2))
-    ZipS            -> mapUnp e1 e2 (\ue1 ue2 -> (\p -> VPropTriple p p p) (ue1 && ue2))
-    CartProduct     -> mapUnp e1 e2 (\ue1 ue2 -> (\p -> VPropTriple p p p) (ue1 && ue2))
-    CartProductS    -> mapUnp e1 e2 (\ue1 ue2 -> (\p -> VPropTriple p p p) (ue1 && ue2))
-    NestProductS    -> mapUnp e1 e2 (\ue1 ue2 -> (\p -> VPropTriple p p p) (ue1 && ue2))
-    ThetaJoin _     -> return $ VPropTriple False False False
-    NestJoin _      -> return $ VPropTriple False False False
-    NestProduct     -> return $ VPropTriple False False False
-    ThetaJoinS _    -> return $ VPropTriple False False False
-    NestJoinS _     -> return $ VPropTriple False False False
-    SemiJoin _      -> return $ VPropPair False False
-    SemiJoinS _     -> return $ VPropPair False False
-    AntiJoin _      -> return $ VPropPair False False
-    AntiJoinS _     -> return $ VPropPair False False
-    -- FIXME This documents the current behaviour of the algebraic
-    -- implementations, not what _should_ happen!
-    TransposeS      -> mapUnp e1 e2 (\ue1 ue2 -> (\p -> VPropPair p p) (ue1 || ue2))
-    
-inferNonEmptyTerOp :: VectorProp Bool -> VectorProp Bool -> VectorProp Bool -> TerOp -> Either String (VectorProp Bool)
-inferNonEmptyTerOp e1 e2 e3 op =
-  case op of
-    Combine -> do
-        ue1 <- unp e1
-        ue2 <- unp e2
-        ue3 <- unp e3
-        return $ VPropTriple ue1 ue2 ue3
-    
diff --git a/src/Database/DSH/Optimizer/VL/Properties/ReqColumns.hs b/src/Database/DSH/Optimizer/VL/Properties/ReqColumns.hs
deleted file mode 100644
--- a/src/Database/DSH/Optimizer/VL/Properties/ReqColumns.hs
+++ /dev/null
@@ -1,418 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-
-module Database.DSH.Optimizer.VL.Properties.ReqColumns where
-
-import           Control.Applicative
-import qualified Data.List                                  as L
-import qualified Data.List.NonEmpty                         as N
-
-import           Database.DSH.Common.Lang
-import           Database.DSH.Optimizer.VL.Properties.Types
-import           Database.DSH.VL.Lang
-
-
-(∪) :: VectorProp ReqCols -> VectorProp ReqCols -> Either String (VectorProp ReqCols)
-(∪) (VProp (Just cols1)) (VProp (Just cols2)) = return $ VProp $ Just $ cols1 `L.union` cols2
-(∪) (VProp (Just cols1)) (VProp Nothing)      = return $ VProp $ Just $ cols1
-(∪) (VProp Nothing)      (VProp (Just cols2)) = return $ VProp $ Just $ cols2
-(∪) (VProp Nothing)      (VProp Nothing)      = return $ VProp $ Nothing
-(∪) p1                   p2                   = Left $ "ReqColumns.union"
-                                                       ++ " "
-                                                       ++ (show p1)
-                                                       ++ " "
-                                                       ++ (show p2)
-
-none :: VectorProp ReqCols
-none = VProp $ Just []
-
-one :: VectorProp ReqCols
-one = VProp $ Just [1]
-
-na :: VectorProp ReqCols
-na = VProp Nothing
-
-reqExprCols :: Expr -> [DBCol]
-reqExprCols (BinApp _ e1 e2) = reqExprCols e1 `L.union` reqExprCols e2
-reqExprCols (UnApp _ e)      = reqExprCols e
-reqExprCols (Column col)     = [col]
-reqExprCols (Constant _)     = []
-reqExprCols (If c t e)       = reqExprCols c `L.union` reqExprCols t `L.union` reqExprCols e
-
-reqLeftPredCols :: JoinPredicate Expr -> [DBCol]
-reqLeftPredCols (JoinPred cs) = L.nub 
-                                $ concatMap (\(JoinConjunct le _ _) -> reqExprCols le) 
-                                $ N.toList cs
-
-reqRightPredCols :: JoinPredicate Expr -> [DBCol]
-reqRightPredCols (JoinPred cs) = L.nub 
-                                $ concatMap (\(JoinConjunct _ _ re) -> reqExprCols re) 
-                                $ N.toList cs
-
-aggrReqCols :: AggrFun -> [DBCol]
-aggrReqCols (AggrSum _ e) = reqExprCols e
-aggrReqCols (AggrMin e)   = reqExprCols e
-aggrReqCols (AggrMax e)   = reqExprCols e
-aggrReqCols (AggrAvg e)   = reqExprCols e
-aggrReqCols (AggrAll e)   = reqExprCols e
-aggrReqCols (AggrAny e)   = reqExprCols e
-aggrReqCols AggrCount     = []
-
-winReqCols :: WinFun -> [DBCol]
-winReqCols (WinSum e)        = reqExprCols e
-winReqCols (WinMin e)        = reqExprCols e
-winReqCols (WinMax e)        = reqExprCols e
-winReqCols (WinAvg e)        = reqExprCols e
-winReqCols (WinAll e)        = reqExprCols e
-winReqCols (WinAny e)        = reqExprCols e
-winReqCols (WinFirstValue e) = reqExprCols e
-winReqCols WinCount          = []
-
-fromProp :: Show a => VectorProp a -> Either String a
-fromProp (VProp p) = return p
-fromProp x         = fail $ "ReqColumns.fromProp " ++ (show x)
-
-fromPropPair :: VectorProp a -> Either String (a, a)
-fromPropPair (VPropPair x y) = return (x, y)
-fromPropPair _               = fail "not a property pair"
-
-fromPropTriple :: VectorProp a -> Either String (a, a, a)
-fromPropTriple (VPropTriple x y z) = return (x, y, z)
-fromPropTriple _                   = fail "not a property triple"
-
-allCols :: BottomUpProps -> Either String (VectorProp ReqCols)
-allCols props = do
-    VProp (ValueVector w) <- return $ vectorTypeProp props
-    return $ VProp $ Just [1 .. w]
-
--- | For operators that combine two value vectors in a product-like
--- manner (products, joins, zips, ...), map the columns that are
--- required from above to the respective input columns.
-partitionCols :: BottomUpProps   -- ^ Available columns in the left input
-              -> BottomUpProps   -- ^ Available columns in the right input
-              -> ReqCols         -- ^ Columns required from above
-              -> Either String (VectorProp ReqCols, VectorProp ReqCols)
-partitionCols childBUProps1 childBUProps2 ownReqCols = do
-    ValueVector w1 <- fromProp $ vectorTypeProp childBUProps1
-    ValueVector w2 <- fromProp $ vectorTypeProp childBUProps2
-
-    let cols = maybe [] id ownReqCols
-
-    -- If both inputs are ValueVectors, map the required columns to
-    -- the respective inputs
-    let leftReqCols  = cols `L.intersect` [1 .. w1]
-        rightReqCols = map (\c -> c - w1) $ cols `L.intersect` [(w1 + 1) .. (w1 + w2)]
-    return (VProp $ Just leftReqCols, VProp $ Just rightReqCols)
-
--- | Infer required columns for unary operators
-inferReqColumnsUnOp :: BottomUpProps          -- ^ Input properties
-                    -> VectorProp ReqCols     -- ^ Columns required from the current node
-                    -> VectorProp ReqCols     -- ^ Columns required from the input node
-                    -> UnOp                   -- ^ Current operator
-                    -> Either String (VectorProp ReqCols)
-inferReqColumnsUnOp childBUProps ownReqColumns childReqColumns op =
-    case op of
-        WinFun (wfun, _) -> do
-            cs <- (VProp $ Just $ winReqCols wfun)
-                  ∪
-                  childReqColumns
-            cs ∪ ownReqColumns
-        Transpose  -> do
-            cols <- snd <$> fromPropPair ownReqColumns
-            childReqColumns ∪ VProp cols
-
-        Reshape _  -> do
-            cols <- snd <$> fromPropPair ownReqColumns
-            VProp cols ∪ childReqColumns
-
-        ReshapeS _ -> do
-            cols <- snd <$> fromPropPair ownReqColumns
-            VProp cols ∪ childReqColumns
-
-        UniqueS    -> ownReqColumns ∪ childReqColumns
-
-        Aggr aggrFun -> (VProp $ Just $ aggrReqCols aggrFun)
-                        ∪
-                        childReqColumns
-
-        AggrNonEmpty aggrFuns -> (VProp $ Just $ concatMap aggrReqCols (N.toList aggrFuns))
-                                 ∪
-                                 childReqColumns
-
-        UnboxRename -> none ∪ childReqColumns
-
-        Segment    -> ownReqColumns ∪ childReqColumns
-        Unsegment  -> ownReqColumns ∪ childReqColumns
-
-        -- Numbering operators add one column at the end. We have to
-        -- determine the column index of the new column and remove it
-        -- from the set of required columns
-        Number     -> do
-            ValueVector w <- fromProp $ vectorTypeProp childBUProps
-            Just cols     <- fromProp ownReqColumns
-            let cols'     = filter (/= w) cols
-            VProp (Just cols') ∪ childReqColumns
-        NumberS    -> do
-            ValueVector w <- fromProp $ vectorTypeProp childBUProps
-            (Just cols)   <- fromProp ownReqColumns
-            let cols'     = filter (/= w) cols
-            VProp (Just cols') ∪ childReqColumns
-
-        Reverse    -> do
-            cols <- fst <$> fromPropPair ownReqColumns
-            VProp cols ∪ childReqColumns
-        ReverseS   -> do
-            cols <- fst <$> fromPropPair ownReqColumns
-            VProp cols ∪ childReqColumns
-
-        Project ps -> childReqColumns ∪ (VProp $ Just $ L.nub $ concatMap reqExprCols ps)
-
-        Select e   -> do
-            cols           <- fst <$> fromPropPair ownReqColumns
-            ownReqColumns' <- (VProp cols) ∪ (VProp $ Just $ reqExprCols e)
-            ownReqColumns' ∪ childReqColumns
-
-        SelectPos1{}   -> do
-            (cols, _, _) <- fromPropTriple ownReqColumns
-            childReqColumns ∪ (VProp cols)
-
-        SelectPos1S{}   -> do
-            (cols, _, _) <- fromPropTriple ownReqColumns
-            childReqColumns ∪ (VProp cols)
-
-        -- We don't need to look at the columns required from above,
-        -- because they can only be a subset of (gs ++ as).
-        GroupAggr (gs, as) -> childReqColumns
-                           ∪
-                           (VProp $ Just $ L.nub $ concatMap reqExprCols gs
-                                                   ++
-                                                   concatMap aggrReqCols (N.toList as))
-
-        SortS exprs -> do
-            cols <- fst <$> fromPropPair ownReqColumns
-            ownReqColumns' <- VProp cols
-                              ∪
-                              (VProp $ Just $ L.nub $ concatMap reqExprCols exprs)
-            childReqColumns ∪ ownReqColumns'
-
-        GroupS exprs -> do
-            (_, colsi, _) <- fromPropTriple ownReqColumns
-            ownReqColumns' <- VProp colsi
-                              ∪
-                              (VProp $ Just $ L.nub $ concatMap reqExprCols exprs)
-            childReqColumns ∪ ownReqColumns'
-
-        AggrNonEmptyS aggrFuns -> do
-          reqCols <- (VProp $ Just $ concatMap aggrReqCols (N.toList aggrFuns))
-                      ∪
-                      childReqColumns
-          return reqCols
-
-        R1               ->
-            case childReqColumns of
-                VProp _                       -> Left $ "ReqColumns.R1 " ++ (show childReqColumns)
-                VPropPair cols1 cols2         -> do
-                    cols1' <- fromProp =<< VProp cols1 ∪ ownReqColumns
-                    return $ VPropPair cols1' cols2
-                VPropTriple cols1 cols2 cols3 -> do
-                    cols1' <- fromProp =<< VProp cols1 ∪ ownReqColumns
-                    return $ VPropTriple cols1' cols2 cols3
-
-        R2               ->
-            case childReqColumns of
-                VProp _                       -> fail "ReqColumns.R2"
-                VPropPair cols1 cols2         -> do
-                    cols2' <- fromProp =<< VProp cols2 ∪ ownReqColumns
-                    return $ VPropPair cols1 cols2'
-                VPropTriple cols1 cols2 cols3 -> do
-                    cols2' <- fromProp =<< VProp cols2 ∪ ownReqColumns
-                    return $ VPropTriple cols1 cols2' cols3
-
-        R3               ->
-            case childReqColumns of
-                VProp _                       -> fail "ReqColumns.R3/1"
-                VPropPair _ _                 -> fail "ReqColumns.R3/2"
-                VPropTriple cols1 cols2 cols3 -> do
-                    cols3' <- fromProp =<< VProp cols3 ∪ ownReqColumns
-                    return $ VPropTriple cols1 cols2 cols3'
-
-
--- | Infer required columns for binary operators
-inferReqColumnsBinOp :: BottomUpProps
-                     -> BottomUpProps
-                     -> VectorProp ReqCols
-                     -> VectorProp ReqCols
-                     -> VectorProp ReqCols
-                     -> BinOp
-                     -> Either String (VectorProp ReqCols, VectorProp ReqCols)
-inferReqColumnsBinOp childBUProps1 childBUProps2 ownReqColumns childReqColumns1 childReqColumns2 op =
-  case op of
-      AggrS aggrFun   -> do
-          fromLeft  <- childReqColumns1 ∪ none
-          fromRight <- (VProp $ Just $ aggrReqCols aggrFun)
-                       ∪
-                       childReqColumns2
-          return (fromLeft, fromRight)
-
-      DistLift -> do
-          cols <- fst <$> fromPropPair ownReqColumns
-          (ownLeft, ownRight) <- partitionCols childBUProps1 childBUProps2 cols
-          (,) <$> (childReqColumns1 ∪ ownLeft) <*> (childReqColumns2 ∪ ownRight)
-
-      PropRename -> do
-          fromRight <- childReqColumns2 ∪ ownReqColumns
-          return (na, fromRight)
-
-      PropFilter      -> do
-          cols      <- fst <$> fromPropPair ownReqColumns
-          fromRight <- childReqColumns2 ∪ VProp cols
-          return (na, fromRight)
-
-      PropReorder -> do
-          cols      <- fst <$> fromPropPair ownReqColumns
-          fromRight <- childReqColumns2 ∪ VProp cols
-          return (na, fromRight)
-
-      UnboxNested -> do
-          cols      <- fst <$> fromPropPair ownReqColumns
-          fromRight <- childReqColumns2 ∪ VProp cols
-          return (na, fromRight)
-
-      Append -> do
-          (cols, _, _) <- fromPropTriple ownReqColumns
-          fromLeft     <- (VProp cols) ∪ childReqColumns1
-          fromRight    <- (VProp cols) ∪ childReqColumns2
-          return (fromLeft, fromRight)
-
-      AppendS -> do
-          (cols, _, _) <- fromPropTriple ownReqColumns
-          fromLeft     <- (VProp cols) ∪ childReqColumns1
-          fromRight    <- (VProp cols) ∪ childReqColumns2
-          return (fromLeft, fromRight)
-
-      SelectPos _ -> do
-          (cols, _, _) <- fromPropTriple ownReqColumns
-          fromLeft     <- VProp cols ∪ childReqColumns1
-          return (fromLeft, one)
-
-      SelectPosS _ -> do
-          (cols, _, _) <- fromPropTriple ownReqColumns
-          fromLeft     <- VProp cols ∪ childReqColumns1
-          return (fromLeft, one)
-
-      Align -> do
-          cols <- fromProp ownReqColumns
-          (ownLeft, ownRight) <- partitionCols childBUProps1 childBUProps2 cols
-          (,) <$> (childReqColumns1 ∪ ownLeft) <*> (childReqColumns2 ∪ ownRight)
-
-      Zip -> do
-          cols <- fromProp ownReqColumns
-          (ownLeft, ownRight) <- partitionCols childBUProps1 childBUProps2 cols
-          (,) <$> (childReqColumns1 ∪ ownLeft) <*> (childReqColumns2 ∪ ownRight)
-
-      CartProduct -> do
-          (cols1, _, _)       <- fromPropTriple ownReqColumns
-          (ownLeft, ownRight) <- partitionCols childBUProps1 childBUProps2 cols1
-          (,) <$> (childReqColumns1 ∪ ownLeft) <*> (childReqColumns2 ∪ ownRight)
-
-      CartProductS -> do
-          (cols1, _, _)       <- fromPropTriple ownReqColumns
-          (ownLeft, ownRight) <- partitionCols childBUProps1 childBUProps2 cols1
-          (,) <$> (childReqColumns1 ∪ ownLeft) <*> (childReqColumns2 ∪ ownRight)
-
-      NestProductS -> do
-          cols1 <- fst <$> fromPropPair ownReqColumns
-          (ownLeft, ownRight) <- partitionCols childBUProps1 childBUProps2 cols1
-          (,) <$> (childReqColumns1 ∪ ownLeft) <*> (childReqColumns2 ∪ ownRight)
-
-      ThetaJoin p -> do
-          (cols1, _, _)               <- fromPropTriple ownReqColumns
-          (leftReqCols, rightReqCols) <- partitionCols childBUProps1 childBUProps2 cols1
-          leftReqCols'                <- (VProp $ Just $ reqLeftPredCols p) ∪ leftReqCols
-          rightReqCols'               <- (VProp $ Just $ reqRightPredCols p) ∪ rightReqCols
-          (,) <$> (childReqColumns1 ∪ leftReqCols') <*> (childReqColumns2 ∪ rightReqCols')
-
-      UnboxScalar -> do
-          cols1                       <- fromProp ownReqColumns
-          (leftReqCols, rightReqCols) <- partitionCols childBUProps1 childBUProps2 cols1
-          (,) <$> (childReqColumns1 ∪ leftReqCols) <*> (childReqColumns2 ∪ rightReqCols)
-
-      NestJoin p -> do
-          (cols1, _, _)               <- fromPropTriple ownReqColumns
-          (leftReqCols, rightReqCols) <- partitionCols childBUProps1 childBUProps2 cols1
-          leftReqCols'                <- (VProp $ Just $ reqLeftPredCols p) ∪ leftReqCols
-          rightReqCols'               <- (VProp $ Just $ reqRightPredCols p) ∪ rightReqCols
-          (,) <$> (childReqColumns1 ∪ leftReqCols') <*> (childReqColumns2 ∪ rightReqCols')
-      NestProduct -> do
-          (cols1, _, _)               <- fromPropTriple ownReqColumns
-          (leftReqCols, rightReqCols) <- partitionCols childBUProps1 childBUProps2 cols1
-          (,) <$> (childReqColumns1 ∪ leftReqCols) <*> (childReqColumns2 ∪ rightReqCols)
-
-      ThetaJoinS p -> do
-          (cols1, _, _)               <- fromPropTriple ownReqColumns
-          (leftReqCols, rightReqCols) <- partitionCols childBUProps1 childBUProps2 cols1
-          leftReqCols'                <- (VProp $ Just $ reqLeftPredCols p) ∪ leftReqCols
-          rightReqCols'               <- (VProp $ Just $ reqRightPredCols p) ∪ rightReqCols
-          (,) <$> (childReqColumns1 ∪ leftReqCols') <*> (childReqColumns2 ∪ rightReqCols')
-
-      NestJoinS p -> do
-          cols1                       <- fst <$> fromPropPair ownReqColumns
-          (leftReqCols, rightReqCols) <- partitionCols childBUProps1 childBUProps2 cols1
-          leftReqCols'                <- (VProp $ Just $ reqLeftPredCols p) ∪ leftReqCols
-          rightReqCols'               <- (VProp $ Just $ reqRightPredCols p) ∪ rightReqCols
-          (,) <$> (childReqColumns1 ∪ leftReqCols') <*> (childReqColumns2 ∪ rightReqCols')
-
-      ZipS -> do
-          (cols, _, _) <- fromPropTriple ownReqColumns
-          (ownLeft, ownRight) <- partitionCols childBUProps1 childBUProps2 cols
-          (,) <$> (childReqColumns1 ∪ ownLeft) <*> (childReqColumns2 ∪ ownRight)
-
-      -- For a semijoin, we only require the columns used in the join argument
-      -- from the right input.
-      SemiJoin p -> do
-          cols1     <- fst <$> fromPropPair ownReqColumns
-          fromLeft  <- ((VProp $ Just $ reqLeftPredCols p) ∪ VProp cols1) >>= (∪ childReqColumns1)
-          fromRight <- (VProp $ Just $ reqRightPredCols p) ∪ childReqColumns2
-          return (fromLeft, fromRight)
-
-      -- For a semijoin, we only require the columns used in the join argument
-      -- from the right input.
-      SemiJoinS p -> do
-          cols1     <- fst <$> fromPropPair ownReqColumns
-          fromLeft  <- ((VProp $ Just $ reqLeftPredCols p) ∪ VProp cols1) >>= (∪ childReqColumns1)
-          fromRight <- (VProp $ Just $ reqRightPredCols p) ∪ childReqColumns2
-          return (fromLeft, fromRight)
-
-      -- For a antijoin, we only require the columns used in the join argument
-      -- from the right input.
-      AntiJoin p -> do
-          cols1     <- fst <$> fromPropPair ownReqColumns
-          fromLeft  <- ((VProp $ Just $ reqLeftPredCols p) ∪ VProp cols1) >>= (∪ childReqColumns1)
-          fromRight <- (VProp $ Just $ reqRightPredCols p) ∪ childReqColumns2
-          return (fromLeft, fromRight)
-
-      -- For a antijoin, we only require the columns used in the join argument
-      -- from the right input.
-      AntiJoinS p -> do
-          cols1     <- fst <$> fromPropPair ownReqColumns
-          fromLeft  <- ((VProp $ Just $ reqLeftPredCols p) ∪ VProp cols1) >>= (∪ childReqColumns1)
-          fromRight <- (VProp $ Just $ reqRightPredCols p) ∪ childReqColumns2
-          return (fromLeft, fromRight)
-
-      TransposeS -> do
-          cols      <- snd <$> fromPropPair ownReqColumns
-          fromRight <- childReqColumns2 ∪ VProp cols
-          return (none, fromRight)
-
-inferReqColumnsTerOp :: VectorProp ReqCols
-                     -> VectorProp ReqCols
-                     -> VectorProp ReqCols
-                     -> VectorProp ReqCols
-                     -> TerOp
-                     -> Either String (VectorProp ReqCols, VectorProp ReqCols, VectorProp ReqCols)
-inferReqColumnsTerOp ownReqColumns _ childReqColumns2 childReqColumns3 op =
-    case op of
-        Combine -> do
-            (cols, _, _) <- fromPropTriple ownReqColumns
-            fromLeft     <- VProp cols ∪ childReqColumns2
-            fromRight    <- VProp cols ∪ childReqColumns3
-            return (one, fromLeft, fromRight)
diff --git a/src/Database/DSH/Optimizer/VL/Properties/TopDown.hs b/src/Database/DSH/Optimizer/VL/Properties/TopDown.hs
deleted file mode 100644
--- a/src/Database/DSH/Optimizer/VL/Properties/TopDown.hs
+++ /dev/null
@@ -1,185 +0,0 @@
-module Database.DSH.Optimizer.VL.Properties.TopDown(inferTopDownProperties) where
-
-import Control.Monad.State
-import Text.Printf
-  
-import qualified Data.IntMap as M
-
-import Database.Algebra.Dag.Common
-import Database.Algebra.Dag
-
-import Database.DSH.VL.Lang
-import Database.DSH.Optimizer.Common.Auxiliary
-import Database.DSH.Optimizer.VL.Properties.Types
-import Database.DSH.Optimizer.VL.Properties.ReqColumns
-  
-reqColumnsSeed :: ReqCols
-reqColumnsSeed = Nothing
-
-vPropSeed :: TopDownProps
-vPropSeed = TDProps { reqColumnsProp = VProp reqColumnsSeed }
-
-vPropPairSeed :: TopDownProps
-vPropPairSeed = TDProps { reqColumnsProp = VPropPair reqColumnsSeed reqColumnsSeed }
-
-vPropTripleSeed :: TopDownProps
-vPropTripleSeed = TDProps { reqColumnsProp = VPropTriple reqColumnsSeed reqColumnsSeed reqColumnsSeed }
-                  
-seed :: VL -> TopDownProps
-seed (NullaryOp _) = vPropSeed
-seed (UnOp op _)   =
-  case op of
-    WinFun _           -> vPropSeed
-    SelectPos1{}       -> vPropTripleSeed
-    SelectPos1S{}      -> vPropTripleSeed 
-    Reverse            -> vPropPairSeed
-    ReverseS           -> vPropPairSeed
-    UniqueS            -> vPropSeed
-    UnboxRename        -> vPropSeed
-    Segment            -> vPropSeed
-    Unsegment          -> vPropSeed
-    Select     _       -> vPropPairSeed
-    SortS _            -> vPropPairSeed
-    GroupS _           -> vPropTripleSeed
-    Project      _     -> vPropSeed
-    Aggr _             -> vPropSeed
-    AggrNonEmpty _     -> vPropSeed
-    AggrNonEmptyS _    -> vPropSeed
-    GroupAggr (_, _)   -> vPropSeed
-    R1                 -> vPropSeed
-    R2                 -> vPropSeed
-    R3                 -> vPropSeed
-    Number             -> vPropSeed
-    NumberS            -> vPropSeed
-    Transpose          -> vPropPairSeed
-    Reshape _          -> vPropPairSeed
-    ReshapeS _         -> vPropPairSeed
-
-seed (BinOp op _ _) = 
-  case op of
-    Append             -> vPropTripleSeed
-    AppendS            -> vPropTripleSeed
-    ZipS               -> vPropTripleSeed
-    DistLift           -> vPropPairSeed
-    PropFilter         -> vPropPairSeed
-    PropReorder        -> vPropPairSeed
-    UnboxNested        -> vPropPairSeed
-    UnboxScalar        -> vPropSeed
-    SelectPos _        -> vPropTripleSeed
-    SelectPosS _       -> vPropTripleSeed
-    PropRename         -> vPropSeed
-    AggrS _            -> vPropSeed
-    Zip                -> vPropSeed
-    Align              -> vPropSeed
-    CartProduct        -> vPropTripleSeed
-    CartProductS       -> vPropTripleSeed
-    ThetaJoin _        -> vPropTripleSeed
-    NestJoin _         -> vPropTripleSeed
-    NestProduct        -> vPropTripleSeed
-    ThetaJoinS _       -> vPropTripleSeed
-    SemiJoin _         -> vPropPairSeed
-    SemiJoinS _        -> vPropPairSeed
-    AntiJoin _         -> vPropPairSeed
-    AntiJoinS _        -> vPropPairSeed
-    NestJoinS _        -> vPropPairSeed
-    NestProductS       -> vPropPairSeed
-    TransposeS         -> vPropPairSeed
-    
-    
-seed (TerOp op _ _ _) =
-  case op of
-    Combine -> vPropTripleSeed
-    
-
-type InferenceState = NodeMap TopDownProps
-
-lookupProps :: AlgNode -> State InferenceState TopDownProps
-lookupProps n = do
-    m <- get
-    case M.lookup n m of
-        Just props -> return props
-        Nothing -> error "TopDown.lookupProps"
-
-replaceProps :: AlgNode -> TopDownProps -> State InferenceState ()
-replaceProps n p = modify (M.insert n p)
-
-inferUnOp :: BottomUpProps -> TopDownProps -> TopDownProps -> UnOp -> Either String TopDownProps
-inferUnOp childBUProps ownProps cp op = do
-    cols <- inferReqColumnsUnOp childBUProps
-                                (reqColumnsProp ownProps) 
-                                (reqColumnsProp cp) 
-                                op
-    return $ TDProps { reqColumnsProp = cols }
-
-inferBinOp :: BottomUpProps 
-           -> BottomUpProps
-           -> TopDownProps 
-           -> TopDownProps 
-           -> TopDownProps 
-           -> BinOp 
-           -> Either String (TopDownProps, TopDownProps)
-inferBinOp childBUProps1 childBUProps2 ownProps cp1 cp2 op = do
-    (crc1', crc2') <- inferReqColumnsBinOp childBUProps1 
-                                           childBUProps2 
-                                           (reqColumnsProp ownProps) 
-                                           (reqColumnsProp cp1) 
-                                           (reqColumnsProp cp2) op
-    let cp1' = TDProps { reqColumnsProp = crc1' }
-        cp2' = TDProps { reqColumnsProp = crc2' }
-    return (cp1', cp2')
-
-inferTerOp :: TopDownProps 
-           -> TopDownProps 
-           -> TopDownProps 
-           -> TopDownProps 
-           -> TerOp 
-           -> Either String (TopDownProps, TopDownProps, TopDownProps)
-inferTerOp ownProps cp1 cp2 cp3 op = do
-    (crc1', crc2', crc3') <- inferReqColumnsTerOp (reqColumnsProp ownProps) 
-                                                  (reqColumnsProp cp1) 
-                                                  (reqColumnsProp cp2) 
-                                                  (reqColumnsProp cp3) op
-    let cp1' = TDProps { reqColumnsProp = crc1' }
-        cp2' = TDProps { reqColumnsProp = crc2' }
-        cp3' = TDProps { reqColumnsProp = crc3' }
-    return (cp1', cp2', cp3')
-
-inferChildProperties :: NodeMap BottomUpProps -> AlgebraDag VL -> AlgNode -> State InferenceState ()
-inferChildProperties buPropMap d n = do
-    ownProps <- lookupProps n
-    case operator n d of
-        NullaryOp _ -> return ()
-        UnOp op c -> do
-            cp <- lookupProps c
-            let buProps = lookupUnsafe buPropMap "TopDown.infer" c
-            let cp' = checkError n [cp] d $ inferUnOp buProps ownProps cp op
-            replaceProps c cp'
-        BinOp op c1 c2 -> do
-            cp1 <- lookupProps c1
-            cp2 <- lookupProps c2
-            let buProps1 = lookupUnsafe buPropMap "TopDown.inferChildProperties" c1
-                buProps2 = lookupUnsafe buPropMap "TopDown.inferChildProperties" c2
-            let (cp1', cp2') = checkError n [cp1, cp2] d $ inferBinOp buProps1 buProps2 ownProps cp1 cp2 op
-            replaceProps c1 cp1'
-            replaceProps c2 cp2'
-        TerOp op c1 c2 c3 -> do
-          cp1 <- lookupProps c1
-          cp2 <- lookupProps c2
-          cp3 <- lookupProps c3
-          let (cp1', cp2', cp3') = checkError n [cp1, cp2, cp3] d $ inferTerOp ownProps cp1 cp2 cp3 op
-          replaceProps c1 cp1'
-          replaceProps c2 cp2'
-          replaceProps c3 cp3'
-
-checkError :: AlgNode -> [TopDownProps] -> AlgebraDag VL -> Either String p -> p
-checkError n childProps d (Left msg) = 
-    let completeMsg   = printf "Inference failed at node %d\n%s\n%s\n%s" n msg (show childProps) (show $ nodeMap d)
-    in error completeMsg
-checkError _ _ _ (Right props) = props
-    
--- | Infer properties during a top-down traversal.
-inferTopDownProperties :: NodeMap BottomUpProps -> [AlgNode] -> AlgebraDag VL -> NodeMap TopDownProps
-inferTopDownProperties buPropMap topOrderedNodes d = execState action initialMap 
-    where action = mapM_ (inferChildProperties buPropMap d) topOrderedNodes
-          initialMap = M.map seed $ nodeMap d
-          
diff --git a/src/Database/DSH/Optimizer/VL/Properties/Types.hs b/src/Database/DSH/Optimizer/VL/Properties/Types.hs
deleted file mode 100644
--- a/src/Database/DSH/Optimizer/VL/Properties/Types.hs
+++ /dev/null
@@ -1,127 +0,0 @@
-module Database.DSH.Optimizer.VL.Properties.Types where
-
-import           Text.PrettyPrint
-
-import           Database.DSH.VL.Lang
-import           Database.DSH.VL.Render.Dot
-
-data VectorProp a = VProp a
-                  | VPropPair a a
-                  | VPropTriple a a a
-
-instance Show a => Show (VectorProp a) where
-  show (VProp a) = show a
-  show (VPropPair a1 a2) = show (a1, a2)
-  show (VPropTriple a1 a2 a3) = show (a1, a2, a3)
-
-data VectorType = ValueVector Int
-                | RenameVector
-                | PropVector
-                deriving Show
-
-data Const = Const VLVal
-           | NoConst
-            deriving Show
-
-data ConstDescr = ConstDescr Int
-                | NonConstDescr
-
-data ConstPayload = ConstPL VLVal
-                  | NonConstPL
-                  deriving Show
-
-data ConstVec = DBVConst ConstDescr [ConstPayload]
-              | RenameVecConst SourceConstDescr TargetConstDescr
-              | PropVecConst SourceConstDescr TargetConstDescr
-              deriving Show
-
-newtype SourceConstDescr = SC ConstDescr deriving Show
-newtype TargetConstDescr = TC ConstDescr deriving Show
-
-data BottomUpProps = BUProps { emptyProp            :: VectorProp Bool
-                             -- Documents wether a vector is
-                             -- statically known to be not empty. For
-                             -- a flat vector (i.e. a vector with only
-                             -- one segment) t his property is true if
-                             -- we can statically decide that the
-                             -- vector is not empty. For an inner
-                             -- vector, i.e. a vector with multiple
-                             -- segments, it is true if *every*
-                             -- segment is non-empty.
-                             , nonEmptyProp         :: VectorProp Bool
-                             , constProp            :: VectorProp ConstVec
-                             , card1Prop            :: VectorProp Bool
-                             , vectorTypeProp       :: VectorProp VectorType
-                             } deriving (Show)
-
-
-type ReqCols = Maybe [DBCol]
-
-data TopDownProps = TDProps { reqColumnsProp :: VectorProp ReqCols } deriving (Show)
-
-data Properties = Properties { bu :: BottomUpProps
-                             , td :: TopDownProps
-                             }
-
-class Renderable a where
-  renderProp :: a -> Doc
-
-insertComma :: Doc -> Doc -> Doc
-insertComma d1 d2 = d1 <> comma <+> d2
-
-instance Renderable a => Renderable (VectorProp a) where
-  renderProp (VProp p)              = renderProp p
-  renderProp (VPropPair p1 p2)      = parens $ (renderProp p1) `insertComma` (renderProp p2)
-  renderProp (VPropTriple p1 p2 p3) = parens $ (renderProp p1) `insertComma` (renderProp p2) `insertComma` (renderProp p3)
-
-instance Renderable a => Renderable (Maybe a) where
-  renderProp (Just x) = renderProp x
-  renderProp Nothing  = text "na"
-
-instance Renderable Bool where
-  renderProp = text . show
-
-bracketList :: (a -> Doc) -> [a] -> Doc
-bracketList f = brackets . hsep . punctuate comma . map f
-
-instance Renderable Int where
-  renderProp = text . show
-
-instance Renderable a => Renderable [a] where
-  renderProp = bracketList renderProp
-
-instance Show ConstDescr where
-  show (ConstDescr v) = render $ int v
-  show NonConstDescr  = "NC"
-
-instance Renderable ConstVec where
-  renderProp (DBVConst d ps) = (text $ show d) <+> payload
-    where payload = bracketList id $ map renderPL $ foldr isConst [] $ zip [1..] ps
-          isConst (_, NonConstPL) vals   = vals
-          isConst (i, (ConstPL v)) vals  = (i, v) : vals
-
-          renderPL (i, v)  = int i <> colon <> renderTblVal v
-
-  renderProp (RenameVecConst (SC ds) (TC ts)) = (text $ show ds) <> text " -> " <> (text $ show ts)
-  renderProp (PropVecConst (SC ds) (TC ts)) = (text $ show ds) <> text " -> " <> (text $ show ts)
-
-instance Renderable VectorType where
-  renderProp = text . show
-
-instance Renderable BottomUpProps where
-  renderProp p = text "empty:" <+> (renderProp $ emptyProp p)
-                 $$ text "const:" <+> (renderProp $ constProp p)
-                 $$ text "schema:" <+> (renderProp $ vectorTypeProp p)
-
-instance Renderable TopDownProps where
-  renderProp p = text "reqCols:" <+> (text $ show $ reqColumnsProp p)
-
--- | Rendering function for the bottom-up properties container.
-renderBottomUpProps :: BottomUpProps -> [String]
-renderBottomUpProps ps = [render $ renderProp ps]
-
-renderTopDownProps :: TopDownProps -> [String]
-renderTopDownProps ps = [render $ renderProp ps]
-
-renderProperties  :: Properties -> [String]
-renderProperties ps = (renderBottomUpProps $ bu ps) ++ (renderTopDownProps $ td ps)
diff --git a/src/Database/DSH/Optimizer/VL/Properties/VectorType.hs b/src/Database/DSH/Optimizer/VL/Properties/VectorType.hs
deleted file mode 100644
--- a/src/Database/DSH/Optimizer/VL/Properties/VectorType.hs
+++ /dev/null
@@ -1,164 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-
--- FIXME introduce consistency checks for schema inference
-module Database.DSH.Optimizer.VL.Properties.VectorType where
-
-import           Control.Monad
-import           Control.Applicative
-import qualified Data.List.NonEmpty as N
-       
-import           Database.DSH.Optimizer.VL.Properties.Types
-  
-import           Database.DSH.VL.Lang
-  
-{- Implement more checks: check the input types for correctness -}
-
-vectorWidth :: VectorProp VectorType -> Int
-vectorWidth (VProp (ValueVector w))  = w
-vectorWidth _                        = error "vectorWidth: non-ValueVector input"
-
-inferVectorTypeNullOp :: NullOp -> Either String (VectorProp VectorType)
-inferVectorTypeNullOp op =
-  case op of
-    SingletonDescr      -> Right $ VProp $ ValueVector 0
-    Lit (_, t, _)       -> Right $ VProp $ ValueVector $ length t
-    TableRef (_, cs, _) -> Right $ VProp $ ValueVector $ length cs
-  
-unpack :: VectorProp VectorType -> Either String VectorType
-unpack (VProp s) = Right s
-unpack _         = Left "Input is not a single vector property" 
-
-inferVectorTypeUnOp :: VectorProp VectorType -> UnOp -> Either String (VectorProp VectorType)
-inferVectorTypeUnOp s op = 
-  case op of
-    WinFun _ -> do
-        ValueVector w <- unpack s
-        return $ VProp $ ValueVector $ w + 1
-    UniqueS -> VProp <$> unpack s
-    Aggr _ -> Right $ VProp $ ValueVector 1
-    AggrNonEmpty as -> Right $ VProp $ ValueVector $ N.length as
-    UnboxRename -> Right $ VProp $ RenameVector
-    Segment -> VProp <$> unpack s
-    Unsegment -> VProp <$> unpack s
-    Reverse -> liftM2 VPropPair (unpack s) (Right PropVector)
-    ReverseS -> liftM2 VPropPair (unpack s) (Right PropVector)
-    SelectPos1{} -> liftM3 VPropTriple (unpack s) (Right RenameVector) (Right RenameVector)
-    SelectPos1S{} -> liftM3 VPropTriple (unpack s) (Right RenameVector) (Right RenameVector)
-    R1 -> 
-      case s of
-        VPropPair s1 _ -> Right $ VProp s1
-        VPropTriple s1 _ _ -> Right $ VProp s1
-        _ -> Left "Input of R1 is not a tuple"
-    R2 -> 
-      case s of
-        VPropPair _ s2 -> Right $ VProp s2
-        VPropTriple _ s2 _ -> Right $ VProp s2
-        _ -> Left "Input of R2 is not a tuple"
-    R3 -> 
-      case s of
-        VPropTriple s3 _ _ -> Right $ VProp s3
-        _ -> Left "Input of R3 is not a tuple"
-
-    Project valProjs -> Right $ VProp $ ValueVector $ length valProjs
-
-    Select _ -> VPropPair <$> unpack s <*> (Right RenameVector)
-    SortS _  -> liftM2 VPropPair (unpack s) (Right PropVector)
-    AggrNonEmptyS as -> Right $ VProp $ ValueVector $ N.length as
-
-    GroupS es -> 
-      case s of
-        VProp t@(ValueVector _) -> 
-          Right $ VPropTriple (ValueVector $ length es) t PropVector
-        _                                                    -> 
-          Left "Input of GroupSimple is not a value vector"
-    GroupAggr (g, as) -> Right $ VProp $ ValueVector (length g + N.length as)
-    Number -> do
-        ValueVector w <- unpack s
-        return $ VProp $ ValueVector (w + 1)
-    NumberS -> do
-        ValueVector w <- unpack s
-        return $ VProp $ ValueVector (w + 1)
-
-    Reshape _ -> liftM2 VPropPair (return $ ValueVector 0) (unpack s)
-    ReshapeS _ -> liftM2 VPropPair (return $ ValueVector 0) (unpack s)
-    Transpose -> liftM2 VPropPair (return $ ValueVector 0) (unpack s)
-  
-reqValVectors :: VectorProp VectorType 
-                 -> VectorProp VectorType 
-                 -> (Int -> Int -> VectorProp VectorType)
-                 -> String 
-                 -> Either String (VectorProp VectorType)
-reqValVectors (VProp (ValueVector w1)) (VProp (ValueVector w2)) f _ =
-  Right $ f w1 w2
-reqValVectors _ _ _ e =
-  Left $ "Inputs of " ++ e ++ " are not ValueVectors"
-      
-inferVectorTypeBinOp :: VectorProp VectorType -> VectorProp VectorType -> BinOp -> Either String (VectorProp VectorType)
-inferVectorTypeBinOp s1 s2 op = 
-  case op of
-    AggrS _ -> return $ VProp $ ValueVector 1
-
-    DistLift -> do
-        ValueVector w1 <- unpack s1
-        ValueVector w2 <- unpack s2
-        return $ VPropPair (ValueVector $ w1 + w2) PropVector
-
-    PropRename -> Right s2
-    PropFilter -> liftM2 VPropPair (unpack s2) (Right RenameVector)
-    PropReorder -> liftM2 VPropPair (unpack s2) (Right PropVector)
-    UnboxNested -> liftM2 VPropPair (unpack s2) (Right RenameVector)
-    Append -> 
-      case (s1, s2) of
-        (VProp (ValueVector w1), VProp (ValueVector w2)) | w1 == w2 -> 
-          Right $ VPropTriple (ValueVector w1) RenameVector RenameVector
-        (VProp (ValueVector w1), VProp (ValueVector w2)) -> 
-          Left $ "Inputs of Append do not have the same width " ++ (show w1) ++ " " ++ (show w2)
-        v -> 
-          Left $ "Input of Append is not a ValueVector " ++ (show v)
-    AppendS -> 
-      case (s1, s2) of
-        (VProp (ValueVector w1), VProp (ValueVector w2)) | w1 == w2 -> 
-          Right $ VPropTriple (ValueVector w1) RenameVector RenameVector
-        (VProp (ValueVector w1), VProp (ValueVector w2)) -> 
-          Left $ "Inputs of Append do not have the same width " ++ (show w1) ++ " " ++ (show w2)
-        v -> 
-          Left $ "Input of Append is not a ValueVector " ++ (show v)
-
-    SelectPos _ -> liftM3 VPropTriple (unpack s1) (Right RenameVector) (Right RenameVector)
-    SelectPosS _ -> liftM3 VPropTriple (unpack s1) (Right RenameVector) (Right RenameVector)
-    Align ->
-      case (s1, s2) of
-        (VProp (ValueVector w1), VProp (ValueVector w2)) -> Right $ VProp $ ValueVector $ w1 + w2
-        _                                                -> Left "Inputs of Align are not ValueVectors"
-    Zip ->
-      case (s1, s2) of
-        (VProp (ValueVector w1), VProp (ValueVector w2)) -> Right $ VProp $ ValueVector $ w1 + w2
-        _                                                -> Left "Inputs of PairL are not ValueVectors"
-    ZipS -> reqValVectors s1 s2 (\w1 w2 -> VPropTriple (ValueVector $ w1 + w2) RenameVector RenameVector) "ZipL"
-    CartProduct -> reqValVectors s1 s2 (\w1 w2 -> VPropTriple (ValueVector $ w1 + w2) PropVector PropVector) "CartProduct"
-    CartProductS -> reqValVectors s1 s2 (\w1 w2 -> VPropTriple (ValueVector $ w1 + w2) PropVector PropVector) "CartProductS"
-    NestProductS -> reqValVectors s1 s2 (\w1 w2 -> VPropTriple (ValueVector $ w1 + w2) PropVector PropVector) "NestProductS"
-    ThetaJoin _ -> reqValVectors s1 s2 (\w1 w2 -> VPropTriple (ValueVector $ w1 + w2) PropVector PropVector) "ThetaJoin"
-    UnboxScalar -> reqValVectors s1 s2 (\w1 w2 -> VProp $ ValueVector $ w1 + w2) "UnboxScalar"
-    NestJoin _ -> reqValVectors s1 s2 (\w1 w2 -> VPropTriple (ValueVector $ w1 + w2) PropVector PropVector) "NestJoin"
-    NestProduct -> reqValVectors s1 s2 (\w1 w2 -> VPropTriple (ValueVector $ w1 + w2) PropVector PropVector) "NestProduct"
-    ThetaJoinS _ -> reqValVectors s1 s2 (\w1 w2 -> VPropTriple (ValueVector $ w1 + w2) PropVector PropVector) "ThetaJoinS"
-    NestJoinS _ -> reqValVectors s1 s2 (\w1 w2 -> VPropTriple (ValueVector $ w1 + w2) PropVector PropVector) "NestJoinS"
-    SemiJoin _ -> liftM2 VPropPair (unpack s1) (Right RenameVector)
-    SemiJoinS _ -> liftM2 VPropPair (unpack s1) (Right RenameVector)
-    AntiJoin _ -> liftM2 VPropPair (unpack s1) (Right RenameVector)
-    AntiJoinS _ -> liftM2 VPropPair (unpack s1) (Right RenameVector)
-
-    TransposeS -> liftM2 VPropPair (return $ ValueVector 0) (unpack s2)
-
-inferVectorTypeTerOp :: VectorProp VectorType -> VectorProp VectorType -> VectorProp VectorType -> TerOp -> Either String (VectorProp VectorType)
-inferVectorTypeTerOp _ s2 s3 op = 
-  case op of
-    Combine -> 
-      case (s2, s3) of
-        (VProp (ValueVector w1), VProp (ValueVector w2)) | w1 == w2 -> 
-          Right $ VPropTriple (ValueVector w1) RenameVector RenameVector
-        (VProp (ValueVector _), VProp (ValueVector _))              -> 
-          Left $ "Inputs of CombineVec do not have the same width"
-        _                                                           -> 
-          Left $ "Inputs of CombineVec are not ValueVectors/DescrVectors " ++ (show (s2, s3))
diff --git a/src/Database/DSH/Optimizer/VL/Rewrite/Aggregation.hs b/src/Database/DSH/Optimizer/VL/Rewrite/Aggregation.hs
deleted file mode 100644
--- a/src/Database/DSH/Optimizer/VL/Rewrite/Aggregation.hs
+++ /dev/null
@@ -1,218 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-module Database.DSH.Optimizer.VL.Rewrite.Aggregation(groupingToAggregation) where
-
-import           Control.Applicative
-import           Control.Monad
-import qualified Data.List.NonEmpty                         as N
-import           Data.Semigroup
-
-import           Database.Algebra.Dag.Common
-
-import           Database.DSH.Optimizer.Common.Rewrite
-import           Database.DSH.Optimizer.VL.Properties.Types
-import           Database.DSH.Optimizer.VL.Rewrite.Common
-import           Database.DSH.VL.Lang
-
-aggregationRules :: VLRuleSet ()
-aggregationRules = [ inlineAggrSProject
-                   , inlineAggrProject
-                   , inlineAggrNonEmptyProject
-                   , inlineAggrSNonEmptyProject
-                   , flatGrouping
-                   , mergeNonEmptyAggrs
-                   , mergeGroupAggr
-                   , mergeGroupWithGroupAggrLeft
-                   ]
-
-aggregationRulesBottomUp :: VLRuleSet BottomUpProps
-aggregationRulesBottomUp = [ nonEmptyAggr
-                           , nonEmptyAggrS
-                           ]
-
-groupingToAggregation :: VLRewrite Bool
-groupingToAggregation = iteratively $ sequenceRewrites [ applyToAll inferBottomUp aggregationRulesBottomUp
-                                                       , applyToAll noProps aggregationRules
-                                                       ]
-
--- FIXME this rewrite will no longer work: take the UnboxScalarS
--- operator into account.
-mergeNonEmptyAggrs :: VLRule ()
-mergeNonEmptyAggrs q =
-  $(dagPatMatch 'q "(AggrNonEmptyS afuns1 (qi1)) Zip (AggrNonEmptyS afuns2 (qi2))"
-    [| do
-        predicate $ $(v "qi1") == $(v "qi2")
-
-        return $ do
-            logRewrite "Aggregation.NonEmpty.Merge" q
-            let afuns  = $(v "afuns1") <> $(v "afuns2")
-            let aggrOp = UnOp (AggrNonEmptyS afuns) $(v "qi1")
-            void $ replaceWithNew q aggrOp |])
-
--- | If we can infer that the vector is not empty, we can employ a
--- simplified version of the aggregate operator that does not add a
--- default value for an empty input.
-nonEmptyAggr :: VLRule BottomUpProps
-nonEmptyAggr q =
-  $(dagPatMatch 'q "Aggr aggrFun (q1)"
-    [| do
-        VProp True <- nonEmptyProp <$> properties $(v "q1")
-
-        return $ do
-            logRewrite "Aggregation.NonEmpty.Aggr" q
-            let aggrOp = UnOp (AggrNonEmpty ($(v "aggrFun") N.:| [])) $(v "q1")
-            void $ replaceWithNew q aggrOp |])
-
--- | If we can infer that all segments (if there are any) are not
--- empty, we can employ a simplified version of the aggregate operator
--- that does not add default values for empty segments.
-nonEmptyAggrS :: VLRule BottomUpProps
-nonEmptyAggrS q =
-  $(dagPatMatch 'q "(_) AggrS aggrFun (q2)"
-    [| do
-        VProp True <- nonEmptyProp <$> properties $(v "q2")
-
-        return $ do
-            logRewrite "Aggregation.NonEmpty.AggrS" q
-            let aggrOp = UnOp (AggrNonEmptyS ($(v "aggrFun") N.:| [])) $(v "q2")
-            void $ replaceWithNew q aggrOp |])
-
--- | Merge a projection into a segmented aggregate operator.
-inlineAggrProject :: VLRule ()
-inlineAggrProject q =
-  $(dagPatMatch 'q "Aggr afun (Project proj (qi))"
-    [| do
-        let env = zip [1..] $(v "proj")
-        let afun' = mapAggrFun (mergeExpr env) $(v "afun")
-
-        return $ do
-            logRewrite "Aggregation.Normalize.Aggr.Project" q
-            void $ replaceWithNew q $ UnOp (Aggr afun') $(v "qi") |])
-
--- | Merge a projection into a segmented aggregate operator.
-inlineAggrSProject :: VLRule ()
-inlineAggrSProject q =
-  $(dagPatMatch 'q "(qo) AggrS afun (Project proj (qi))"
-    [| do
-        let env = zip [1..] $(v "proj")
-        let afun' = mapAggrFun (mergeExpr env) $(v "afun")
-
-        return $ do
-            logRewrite "Aggregation.Normalize.AggrS.Project" q
-            void $ replaceWithNew q $ BinOp (AggrS afun') $(v "qo") $(v "qi") |])
-
--- | Merge a projection into a non-empty aggregate operator. We
--- restrict this to only one aggregate function. Therefore, merging of
--- projections must happen before merging of aggregate operators
-inlineAggrNonEmptyProject :: VLRule ()
-inlineAggrNonEmptyProject q =
-  $(dagPatMatch 'q "AggrNonEmpty afuns (Project proj (qi))"
-    [| do
-        let env = zip [1..] $(v "proj")
-        let afuns' = fmap (mapAggrFun (mergeExpr env)) $(v "afuns")
-
-        return $ do
-            logRewrite "Aggregation.Normalize.AggrNonEmpty.Project" q
-            let aggrOp = UnOp (AggrNonEmpty afuns') $(v "qi")
-            void $ replaceWithNew q aggrOp |])
-
--- | Merge a projection into a non-empty segmented aggregate
--- operator. We restrict this to only one aggregate
--- function. Therefore, merging of projections must happen before
--- merging of aggregate operators
-inlineAggrSNonEmptyProject :: VLRule ()
-inlineAggrSNonEmptyProject q =
-  $(dagPatMatch 'q "AggrNonEmptyS afuns (Project proj (qi))"
-    [| do
-        let env = zip [1..] $(v "proj")
-        let afuns' = fmap (mapAggrFun (mergeExpr env)) $(v "afuns")
-
-        return $ do
-            logRewrite "Aggregation.Normalize.AggrNonEmptyS.Project" q
-            let aggrOp = UnOp (AggrNonEmptyS afuns') $(v "qi")
-            void $ replaceWithNew q aggrOp |])
-
--- We rewrite a combination of GroupBy and aggregation operators into a single
--- VecAggr operator if the following conditions hold:
---
--- 1. The R2 output of GroupBy is only consumed by aggregation operators (MaxL,
---    MinL, VecSumL, LengthSeg)
--- 2. The grouping criteria is a simple column projection from the input vector
-flatGrouping :: VLRule ()
-flatGrouping q =
-  $(dagPatMatch 'q "(R1 (qg)) UnboxScalar (AggrNonEmptyS afuns (R2 (qg1=GroupS groupExprs (q1))))"
-    [| do
-
-        -- Ensure that the aggregate results are unboxed using the
-        -- outer vector of the grouping operator.
-        predicate $ $(v "qg") == $(v "qg1")
-
-        return $ do
-          logRewrite "Aggregation.Grouping.Aggr" q
-          void $ replaceWithNew q $ UnOp (GroupAggr ($(v "groupExprs"), $(v "afuns"))) $(v "q1") |])
-
-mergeGroupAggr :: VLRule ()
-mergeGroupAggr q =
-  $(dagPatMatch 'q "(GroupAggr args1 (q1)) Align (GroupAggr args2 (q2))"
-    [| do
-        let (ges1, afuns1) = $(v "args1")
-        let (ges2, afuns2) = $(v "args2")
-
-        -- The rewrite can be applied if the same input is grouped
-        -- according to the same grouping expressions.
-        predicate $ ges1 == ges2
-        predicate $ $(v "q1") == $(v "q2")
-    
-        return $ do
-          logRewrite "Aggregation.Normalize.MergeGroupAggr" q
-          groupNode <- insert $ UnOp (GroupAggr ($(v "ges1"), ($(v "afuns1") <> $(v "afuns2")))) $(v "q1")
-
-          -- Reconstruct the schema produced by Zip. Note that this
-          -- duplicates the grouping columns.
-          let groupWidth = length $(v "ges1")
-              aggrWidth1 = N.length afuns1
-              aggrWidth2 = N.length afuns2
-              groupCols  = [ Column c | c <- [1 .. groupWidth]]
-
-          let proj = groupCols
-                     ++
-                     [ Column $ c + groupWidth | c <- [1 .. aggrWidth1] ]
-                     ++
-                     groupCols
-                     ++
-                     [ Column $ c + groupWidth + aggrWidth1 | c <- [1 .. aggrWidth2] ]
-
-          void $ replaceWithNew q $ UnOp (Project proj) groupNode |])
-
--- | This is a cleanup rewrite: It applies in a situation when
--- aggregates have already been merged with GroupScalarS into
--- GroupAggr. If the GroupAggr output is combined with the R1 output
--- of GroupScalarS on the same input and grouping expressions via Zip,
--- the effect is that only the grouping expressions are duplicated.
-mergeGroupWithGroupAggrLeft :: VLRule ()
-mergeGroupWithGroupAggrLeft q =
-  $(dagPatMatch 'q "(R1 (GroupS ges (q1))) Align (GroupAggr args (q2))"
-    [| do
-        let (ges', afuns) = $(v "args")
-    
-        -- Input vectors and grouping expressions have to be the same.
-        predicate $ $(v "q1") == $(v "q2")
-        predicate $ $(v "ges") == ges'
-
-        return $ do
-            logRewrite "Aggregation.Normalize.MergeGroupScalars" q
-            
-            -- To keep the schema, we have to duplicate the grouping
-            -- columns.
-            let groupWidth = length ges'
-                aggrWidth  = N.length afuns
-                groupCols  = [ Column c | c <- [1..groupWidth] ]
-                proj       = groupCols 
-                             ++ 
-                             groupCols
-                             ++
-                             [ Column $ c + groupWidth | c <- [1..aggrWidth] ]
-
-            groupNode <- insert $ UnOp (GroupAggr (ges', afuns)) $(v "q1")
-            void $ replaceWithNew q $ UnOp (Project proj) groupNode |])
-                     
-
diff --git a/src/Database/DSH/Optimizer/VL/Rewrite/Common.hs b/src/Database/DSH/Optimizer/VL/Rewrite/Common.hs
deleted file mode 100644
--- a/src/Database/DSH/Optimizer/VL/Rewrite/Common.hs
+++ /dev/null
@@ -1,115 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-module Database.DSH.Optimizer.VL.Rewrite.Common where
-
-import qualified Data.IntMap                                   as M
-
-import           Control.Monad
-
-import           Database.Algebra.Dag.Common
-
-import           Database.DSH.Common.QueryPlan
-import           Database.DSH.Impossible
-
-import           Database.DSH.Optimizer.Common.Rewrite
-import           Database.DSH.VL.Lang
-import           Database.DSH.VL.Vector
-
-import           Database.DSH.Optimizer.VL.Properties.BottomUp
-import           Database.DSH.Optimizer.VL.Properties.TopDown
-import           Database.DSH.Optimizer.VL.Properties.Types
-
-  -- Type abbreviations for convenience
-type VLRewrite p = Rewrite VL (Shape VLDVec) p
-type VLRule p = Rule VL p (Shape VLDVec)
-type VLRuleSet p = RuleSet VL p (Shape VLDVec)
-type VLMatch p = Match VL p (Shape VLDVec)
-
-inferBottomUp :: VLRewrite (NodeMap BottomUpProps)
-inferBottomUp = do
-  props <- infer inferBottomUpProperties
-  return props
-
-inferTopDown :: VLRewrite (NodeMap TopDownProps)
-inferTopDown = do
-  to <- topsort
-  buPropMap <- infer inferBottomUpProperties
-  props <- infer (inferTopDownProperties buPropMap to)
-  return props
-
-inferProperties :: VLRewrite (NodeMap Properties)
-inferProperties = do
-  buMap <- inferBottomUp
-  tdMap <- inferTopDown
-  return $ M.intersectionWith Properties buMap tdMap
-
-noProps :: Monad m => m (M.IntMap a)
-noProps = return M.empty
-
----------------------------------------------------------------------------------
--- Rewrite helper functions
-
-lookupR1Parents :: AlgNode -> VLRewrite [AlgNode]
-lookupR1Parents q = do
-  let isR1 q' = do
-        o <- operator q'
-        case o of
-          UnOp R1 _ -> return True
-          _         -> return False
-
-  ps <- parents q
-  filterM isR1 ps
-
-lookupR2Parents :: AlgNode -> VLRewrite [AlgNode]
-lookupR2Parents q = do
-  let isR2 q' = do
-        o <- operator q'
-        case o of
-          UnOp R2 _ -> return True
-          _         -> return False
-
-  ps <- parents q
-  filterM isR2 ps
-
-mergeExpr :: [(DBCol, Expr)] -> Expr -> Expr
-mergeExpr env expr =
-    case expr of
-        BinApp o e1 e2 -> BinApp o (mergeExpr env e1) (mergeExpr env e2)
-        UnApp o e1     -> UnApp o (mergeExpr env e1)
-        Column c       -> case lookup c env of
-                               Just expr' -> expr'
-                               Nothing    -> $impossible
-        If c t e       -> If (mergeExpr env c) (mergeExpr env t) (mergeExpr env e)
-        Constant _     -> expr
-
--- | Unwrap a constant value
-constVal :: Monad m => (VLVal -> a) -> ConstPayload -> m a
-constVal wrap (ConstPL val) = return $ wrap val
-constVal _             _    = fail "no match"
-
-mapAggrFun :: (Expr -> Expr) -> AggrFun -> AggrFun
-mapAggrFun f (AggrMax e) = AggrMax $ f e
-mapAggrFun f (AggrSum t e) = AggrSum t $ f e
-mapAggrFun f (AggrMin e) = AggrMin $ f e
-mapAggrFun f (AggrAvg e) = AggrAvg $ f e
-mapAggrFun f (AggrAny e) = AggrAny $ f e
-mapAggrFun f (AggrAll e) = AggrAll $ f e
-mapAggrFun _ AggrCount   = AggrCount
-
-mapWinFun :: (Expr -> Expr) -> WinFun -> WinFun
-mapWinFun f (WinMax e)        = WinMax $ f e
-mapWinFun f (WinSum e)        = WinSum $ f e
-mapWinFun f (WinMin e)        = WinMin $ f e
-mapWinFun f (WinAvg e)        = WinAvg $ f e
-mapWinFun f (WinAny e)        = WinAny $ f e
-mapWinFun f (WinAll e)        = WinAll $ f e
-mapWinFun f (WinFirstValue e) = WinFirstValue $ f e
-mapWinFun _ WinCount          = WinCount
-
-mapExprCols :: (DBCol -> DBCol) -> Expr -> Expr
-mapExprCols f (BinApp op e1 e2) = BinApp op (mapExprCols f e1) (mapExprCols f e2)
-mapExprCols f (UnApp op e)      = UnApp op (mapExprCols f e)
-mapExprCols f (Column c)        = Column $ f c
-mapExprCols _ (Constant val)    = Constant val
-mapExprCols f (If c t e)        = If (mapExprCols f c) 
-                                     (mapExprCols f t) 
-                                     (mapExprCols f e)
diff --git a/src/Database/DSH/Optimizer/VL/Rewrite/Expressions.hs b/src/Database/DSH/Optimizer/VL/Rewrite/Expressions.hs
deleted file mode 100644
--- a/src/Database/DSH/Optimizer/VL/Rewrite/Expressions.hs
+++ /dev/null
@@ -1,119 +0,0 @@
-{-# LANGUAGE TemplateHaskell  #-}
-{-# LANGUAGE ParallelListComp #-}
-
-module Database.DSH.Optimizer.VL.Rewrite.Expressions where
-
--- This module contains rewrites which aim to simplify and merge complex expressions
--- which are expressed through multiple operators.
-
-import Control.Monad
-import Control.Applicative
-import Data.Maybe
-
-import Database.Algebra.Dag.Common
-
-import Database.DSH.VL.Lang
-import Database.DSH.Optimizer.Common.Rewrite
-import Database.DSH.Optimizer.VL.Properties.Types
-import Database.DSH.Optimizer.VL.Rewrite.Common
-
-optExpressions :: VLRewrite Bool
-optExpressions = iteratively $ applyToAll inferBottomUp expressionRules
-
-expressionRules :: VLRuleSet BottomUpProps
-expressionRules = [ mergeExpr1
-                  , identityProject
-                  , mergeSelectProject
-                  ]
-
-mergeExpr1 :: VLRule BottomUpProps
-mergeExpr1 q =
-  $(dagPatMatch 'q "Project es1 (Project es2 (q1))"
-    [| do
-
-        return $ do
-          logRewrite "Expr.Merge.11" q
-          let env  = zip [1..] $(v "es2")
-              es1' = map (mergeExpr env) $(v "es1")
-          void $ replaceWithNew q $ UnOp (Project es1') $(v "q1") |])
-
-mergeSelectProject :: VLRule BottomUpProps
-mergeSelectProject q =
-  $(dagPatMatch 'q "R1 (qs=Select p (Project projs (q1)))"
-     [| do
-        return $ do
-          logRewrite "Expr.Merge.Select" q
-          let env = zip [1..] $(v "projs")
-          let p'  = mergeExpr env $(v "p")
-          selectNode <- insert $ UnOp (Select p') $(v "q1")
-          r1Node     <- insert $ UnOp R1 selectNode
-          void $ replaceWithNew q $ UnOp (Project $(v "projs")) r1Node
-
-          r2Parents <- lookupR2Parents $(v "qs")
-
-          -- If there are any R2 nodes linking to the original
-          -- Restrict operator (i.e. there are inner vectors to which
-          -- changes must be propagated), they have to be rewired to
-          -- the new Select operator.
-          when (not $ null r2Parents) $ do
-            qr2' <- insert $ UnOp R2 selectNode
-            mapM_ (\qr2 -> replace qr2 qr2') r2Parents |])
-
-identityProject :: VLRule BottomUpProps
-identityProject q =
-  $(dagPatMatch 'q "Project ps (q1)"
-    [| do
-        VProp (ValueVector w) <- vectorTypeProp <$> properties $(v "q1")
-        predicate $ length $(v "ps") == w
-
-        let sameCol :: (Int, Expr) -> Bool
-            sameCol (i, Column i') = i == i'
-            sameCol _               = False
-
-        predicate $ all sameCol (zip [1..] $(v "ps"))
-
-        rs <- getRootNodes
-        predicate $ not $ q `elem` rs
-
-        return $ do
-          logRewrite "Project.Identity" q
-          replace q $(v "q1") |])
-
-------------------------------------------------------------------------------
--- Constant expression inputs
-
-liftPairRight :: Monad m => (a, m b) -> m (a, b)
-liftPairRight (a, mb) = mb >>= \b -> return (a, b)
-
-mapPair :: (a -> c) -> (b -> d) -> (a, b) -> (c, d)
-mapPair f g (a, b) = (f a, g b)
-
-insertConstants :: [(DBCol, VLVal)] -> Expr -> Expr
-insertConstants env expr =
-    case expr of
-        BinApp o e1 e2 -> BinApp o (insertConstants env e1) (insertConstants env e2)
-        UnApp o e1     -> UnApp o (insertConstants env e1)
-        Column c       -> case lookup c env of
-                               Just val -> Constant val
-                               Nothing  -> Column c
-        If c t e       -> If (insertConstants env c) (insertConstants env t) (insertConstants env e)
-        Constant _     -> expr
-
-constProject :: VLRule BottomUpProps
-constProject q =
-  $(dagPatMatch 'q "Project projs (q1)"
-    [| do
-        VProp (DBVConst _ constCols) <- constProp <$> properties $(v "q1")
-        let envEntry = liftPairRight . mapPair id (constVal id)
-        let constEnv = mapMaybe envEntry $ zip [1..] constCols
-
-        predicate $ not $ null constEnv
-
-        let projs' = map (insertConstants constEnv) $(v "projs")
-
-        -- To avoid rewriting loops, ensure that a change occured.
-        predicate $ projs' /= $(v "projs")
-
-        return $ do
-          logRewrite "Expr.Project.Const" q
-          void $ replaceWithNew q $ UnOp (Project projs') $(v "q1") |])
diff --git a/src/Database/DSH/Optimizer/VL/Rewrite/PruneEmpty.hs b/src/Database/DSH/Optimizer/VL/Rewrite/PruneEmpty.hs
deleted file mode 100644
--- a/src/Database/DSH/Optimizer/VL/Rewrite/PruneEmpty.hs
+++ /dev/null
@@ -1,108 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-
-module Database.DSH.Optimizer.VL.Rewrite.PruneEmpty(pruneEmpty) where
-       
-import           Control.Applicative
-import           Control.Monad
-
-import           Database.DSH.Optimizer.Common.Rewrite
-import           Database.DSH.Optimizer.VL.Properties.Types
-import           Database.DSH.Optimizer.VL.Rewrite.Common
-
-import           Database.Algebra.Dag.Common
-import           Database.DSH.VL.Lang
-
-pruneEmpty :: VLRewrite Bool
-pruneEmpty = applyToAll inferBottomUp emptyRules
-
-emptyRules :: VLRuleSet BottomUpProps
-emptyRules = [ emptyAppendLeftR1
-             -- , emptyAppendLeftR2
-             -- , emptyAppendLeftR3
-             , emptyAppendRightR1
-             -- , emptyAppendRightR2
-             -- , emptyAppendRightR3
-             ]
-
-isEmpty :: AlgNode -> VLMatch BottomUpProps Bool
-isEmpty q = do
-  ps <- liftM emptyProp $ properties q
-  case ps of
-    VProp b -> return b
-    x       -> error $ "PruneEmpty.isEmpty: non-vector input " ++ show x
-
-{- If the left input is empty and the other is not, the resulting value vector
-is simply the right input. -}
-emptyAppendLeftR1 :: VLRule BottomUpProps
-emptyAppendLeftR1 q =
-  $(dagPatMatch 'q "R1 ((q1) [Append | AppendS] (q2))"
-    [| do
-        predicate =<< ((&&) <$> (isEmpty $(v "q1")) <*> (not <$> isEmpty $(v "q2")))
-
-        return $ do
-          logRewrite "Empty.Append.Left.R1" q
-          replace q $(v "q2") |])
-
--- FIXME re-add rules when 
-{-
--- If the left input is empty, renaming will make the inner vector
--- empty as well.
-emptyAppendLeftR2 :: VLRule BottomUpProps
-emptyAppendLeftR2 q =
-  $(dagPatMatch 'q "(R2 ((q1) Append (q2))) PropRename (qv)"
-    [| do
-        predicate =<< ((&&) <$> (isEmpty $(v "q1")) <*> (not <$> isEmpty $(v "q2")))
-
-        VProp (ValueVector w) <- vectorTypeProp <$> properties $(v "qv")
-
-        return $ do
-          logRewrite "Empty.Append.Left.R2" q
-          void $ replaceWithNew q (NullaryOp $ Empty w) |])
-
--- If the left input is empty, the rename vector for the right inner
--- vectors is simply identity
-emptyAppendLeftR3 :: VLRule BottomUpProps
-emptyAppendLeftR3 q = 
-  $(dagPatMatch 'q "(R3 ((q1) Append (q2))) PropRename (qv)" 
-    [| do 
-        predicate =<< ((&&) <$> (isEmpty $(v "q1")) <*> (not <$> isEmpty $(v "q2")))
-
-        return $ do
-          logRewrite "Empty.Append.Left.R3" q
-          replace q $(v "qv") |])
--}
-
-emptyAppendRightR1 :: VLRule BottomUpProps
-emptyAppendRightR1 q =
-  $(dagPatMatch 'q "R1 ((q1) [Append | AppendS] (q2))"
-    [| do
-        predicate =<< ((&&) <$> (isEmpty $(v "q2")) <*> (not <$> isEmpty $(v "q1")))
-        return $ do
-          logRewrite "Empty.Append.Right.R1" q
-          replace q $(v "q1") |])
-
-{-
--- If the right input is empty, renaming will make the inner vector
--- empty as well.
-emptyAppendRightR3 :: VLRule BottomUpProps
-emptyAppendRightR3 q =
-  $(dagPatMatch 'q "(R3 ((q1) Append (q2))) PropRename (qv)"
-    [| do
-        predicate =<< ((&&) <$> (not <$> isEmpty $(v "q1")) <*> (isEmpty $(v "q2")))
-        VProp (ValueVector w) <- vectorTypeProp <$> properties $(v "qv")
-
-        return $ do
-          logRewrite "Empty.Append.Right.R3" q
-          void $ replaceWithNew q $ NullaryOp $ Empty w |])
-
--- If the right input is empty, the rename vector for the left inner
--- vectors is simply identity
-emptyAppendRightR2 :: VLRule BottomUpProps
-emptyAppendRightR2 q =
-  $(dagPatMatch 'q "(R2 ((q1) Append (q2))) PropRename (qv)"
-    [| do
-        predicate =<< ((&&) <$> (isEmpty $(v "q2")) <*> (not <$> isEmpty $(v "q1")))
-        return $ do
-          logRewrite "Empty.Append.Right.R2" q
-          void $ replace q $(v "qv") |])
--}
diff --git a/src/Database/DSH/Optimizer/VL/Rewrite/Redundant.hs b/src/Database/DSH/Optimizer/VL/Rewrite/Redundant.hs
deleted file mode 100644
--- a/src/Database/DSH/Optimizer/VL/Rewrite/Redundant.hs
+++ /dev/null
@@ -1,965 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-
-module Database.DSH.Optimizer.VL.Rewrite.Redundant (removeRedundancy) where
-
-import Debug.Trace
-
-import           Control.Applicative
-import           Control.Monad
-
-import           Database.Algebra.Dag.Common
-
-import           Database.DSH.Common.Lang
-import           Database.DSH.Impossible
-import           Database.DSH.Optimizer.Common.Rewrite
-import           Database.DSH.Optimizer.VL.Properties.Types
-import           Database.DSH.Optimizer.VL.Properties.VectorType
-import           Database.DSH.Optimizer.VL.Rewrite.Common
-import           Database.DSH.Optimizer.VL.Rewrite.Expressions
-import           Database.DSH.Optimizer.VL.Rewrite.Aggregation
-import           Database.DSH.Optimizer.VL.Rewrite.Window
-import           Database.DSH.VL.Lang
-
-removeRedundancy :: VLRewrite Bool
-removeRedundancy =
-    iteratively $ sequenceRewrites [ cleanup
-                                   , applyToAll noProps redundantRules
-                                   , applyToAll inferBottomUp redundantRulesBottomUp
-                                   , applyToAll inferProperties redundantRulesAllProps
-                                   , groupingToAggregation
-                                   ]
-
-cleanup :: VLRewrite Bool
-cleanup = iteratively $ sequenceRewrites [ optExpressions ]
-
-redundantRules :: VLRuleSet ()
-redundantRules = [ pullProjectPropRename
-                 , pullProjectPropReorder
-                 , pullProjectSelectPos1S
-                 , pullProjectPropFilter
-                 , pullProjectUnboxRename
-                 , pullProjectAggrS
-                 , scalarConditional
-                 ]
-
-redundantRulesBottomUp :: VLRuleSet BottomUpProps
-redundantRulesBottomUp = [ cartProdConstant
-                         , sameInputZip
-                         , sameInputZipProject
-                         , sameInputZipProjectLeft
-                         , sameInputZipProjectRight
-                         , zipProjectLeft
-                         , zipProjectRight
-                         , distLiftProjectLeft
-                         , distLiftProjectRight
-                         , distLiftNestProduct
-                         , distLiftNestJoin
-                         , distLiftStacked
-                         , distLiftSelect
-                         , alignedDistLift
-                         , selectConstPos
-                         , selectConstPosS
-                         , zipConstLeft
-                         , zipConstRight
-                         , alignConstLeft
-                         , alignConstRight
-                         , zipZipLeft
-                         , zipWinLeft
-                         , zipWinRight
-                         , zipWinRightPush
-                         , zipUnboxScalarRight
-                         , zipUnboxScalarLeft
-                         , alignCartProdRight
-                         , propProductCard1Right
-                         , runningAggWin
-                         , inlineWinAggrProject
-                         , pullProjectNumber
-                         , constDistLift
-                         , nestJoinChain
-                         , pullProjectUnboxScalarLeft
-                         , pullProjectUnboxScalarRight
-                         , pullProjectNestJoinLeft
-                         , pullProjectNestJoinRight
-                         , selectCartProd
-                         ]
-
-redundantRulesAllProps :: VLRuleSet Properties
-redundantRulesAllProps = [ unreferencedDistLift
-                         , firstValueWin
-                         , notReqNumber
-                         ]
-
---------------------------------------------------------------------------------
--- 
-
--- | Replace a 'CartProduct' operator with a projection if its right
--- input is constant and has cardinality one.
-cartProdConstant :: VLRule BottomUpProps
-cartProdConstant q =
-  $(dagPatMatch 'q "R1 ((q1) CartProduct (q2))"
-    [| do
-        qvProps <- properties $(v "q2")
-
-        VProp True              <- return $ card1Prop qvProps
-        VProp (DBVConst _ cols) <- return $ constProp qvProps
-        constProjs              <- mapM (constVal Constant) cols
-
-        -- Preserve columns from the left input
-        w1 <- liftM (vectorWidth . vectorTypeProp) $ properties $(v "q1")
-        let proj = map Column [1..w1] ++ constProjs
-
-        return $ do
-          logRewrite "Redundant.CartProduct.Constant" q
-          void $ replaceWithNew q $ UnOp (Project proj) $(v "q1") |])
-
-unwrapConstVal :: ConstPayload -> VLMatch p VLVal
-unwrapConstVal (ConstPL val) = return val
-unwrapConstVal  NonConstPL   = fail "not a constant"
-
--- | If the left input of an distLift is constant, a normal projection
--- can be used because the DistLift operator keeps the shape of the right
--- input.
-constDistLift :: VLRule BottomUpProps
-constDistLift q =
-  $(dagPatMatch 'q "R1 ((q1) DistLift (q2))"
-    [| do 
-         VProp (DBVConst _ constCols) <- constProp <$> properties $(v "q1")
-         VProp (ValueVector w)        <- vectorTypeProp <$> properties $(v "q2")
-         constVals                    <- mapM unwrapConstVal constCols
-         
-         return $ do 
-              logRewrite "Redundant.Const.DistLift" q
-              let proj = map Constant constVals ++ map Column [1..w]
-              void $ replaceWithNew q $ UnOp (Project proj) $(v "q2") |])
-       
--- | If a vector is distributed over an inner vector in a segmented
--- way, check if the vector's columns are actually referenced/required
--- downstream. If not, we can remove the DistLift altogether, as the
--- shape of the inner vector is not changed by DistLift.
-unreferencedDistLift :: VLRule Properties
-unreferencedDistLift q =
-  $(dagPatMatch 'q  "R1 ((q1) DistLift (q2))"
-    [| do
-        VProp (Just reqCols)   <- reqColumnsProp <$> td <$> properties q
-        VProp (ValueVector w1) <- vectorTypeProp <$> bu <$> properties $(v "q1")
-        VProp (ValueVector w2) <- vectorTypeProp <$> bu <$> properties $(v "q2")
-
-        -- Check that only columns from the right input are required
-        predicate $ all (> w1) reqCols
-
-        return $ do
-          logRewrite "Redundant.Unreferenced.DistLift" q
-
-          -- FIXME HACKHACKHACK
-          let padProj = [ Constant $ VLInt 0xdeadbeef | _ <- [1..w1] ]
-                        ++
-                        [ Column i | i <- [1..w2] ]
-
-          void $ replaceWithNew q $ UnOp (Project padProj) $(v "q2") |])
-
--- | Remove a DistLift if the outer vector is aligned with a
--- NestProduct that uses the same outer vector.
-distLiftNestProduct :: VLRule BottomUpProps
-distLiftNestProduct q =
-  $(dagPatMatch 'q "R1 ((qo) DistLift (R1 ((qo1) NestProduct (qi))))"
-    [| do
-        predicate $ $(v "qo") == $(v "qo1")
-
-        w1 <- liftM (vectorWidth . vectorTypeProp) $ properties $(v "qo")
-        w2 <- liftM (vectorWidth . vectorTypeProp) $ properties $(v "qi")
-
-        return $ do
-            logRewrite "Redundant.DistLift.NestProduct" q
-            -- Preserve the original schema
-            let proj = map Column $ [1..w1] ++ [1..w1] ++ [w1+1..w1+w2]
-            prodNode <- insert $ BinOp NestProduct $(v "qo") $(v "qi")
-            r1Node   <- insert $ UnOp R1 prodNode
-            void $ replaceWithNew q $ UnOp (Project proj) r1Node |])
-
--- | Remove a DistLift if the outer vector is aligned with a
--- NestJoin that uses the same outer vector.
-distLiftNestJoin :: VLRule BottomUpProps
-distLiftNestJoin q =
-  $(dagPatMatch 'q "R1 ((qo) DistLift (R1 ((qo1) NestJoin p (qi))))"
-    [| do
-        predicate $ $(v "qo") == $(v "qo1")
-
-        w1 <- liftM (vectorWidth . vectorTypeProp) $ properties $(v "qo")
-        w2 <- liftM (vectorWidth . vectorTypeProp) $ properties $(v "qi")
-
-        return $ do
-            logRewrite "Redundant.DistLift.NestJoin" q
-            -- Preserve the original schema
-            let proj = map Column $ [1..w1] ++ [1..w1] ++ [w1+1..w1+w2]
-            prodNode <- insert $ BinOp (NestJoin $(v "p")) $(v "qo") $(v "qi")
-            r1Node   <- insert $ UnOp R1 prodNode
-            void $ replaceWithNew q $ UnOp (Project proj) r1Node |])
-
-distLiftProjectLeft :: VLRule BottomUpProps
-distLiftProjectLeft q =
-  $(dagPatMatch 'q "R1 ((Project ps1 (q1)) DistLift (q2))"
-    [| do
-        w1 <- liftM (vectorWidth . vectorTypeProp) $ properties $(v "q1")
-        w2 <- liftM (vectorWidth . vectorTypeProp) $ properties $(v "q2")
-
-        return $ do
-          logRewrite "Redundant.DistLift.Project.Left" q
-          -- Take the projection expressions from the left and the
-          -- shifted columns from the right.
-          let proj = $(v "ps1") ++ [ Column $ c + w1 | c <- [1 .. w2]]
-          distNode <- insert $ BinOp DistLift $(v "q1") $(v "q2")
-          r1Node   <- insert $ UnOp R1 distNode
-          void $ replaceWithNew q $ UnOp (Project proj) r1Node |])
-
-distLiftProjectRight :: VLRule BottomUpProps
-distLiftProjectRight q =
-  $(dagPatMatch 'q "R1 ((q1) DistLift (Project p2 (q2)))"
-    [| do
-        w1 <- liftM (vectorWidth . vectorTypeProp) $ properties $(v "q1")
-
-        return $ do
-          logRewrite "Redundant.DistLift.Project.Right" q
-          -- Take the columns from the left and the expressions from
-          -- the right projection. Since expressions are applied after
-          -- the zip, their column references have to be shifted.
-          let proj = [Column c | c <- [1..w1]] ++ [ mapExprCols (+ w1) e | e <- $(v "p2") ]
-          distNode <- insert $ BinOp DistLift $(v "q1") $(v "q2")
-          r1Node   <- insert $ UnOp R1 distNode
-          void $ replaceWithNew q $ UnOp (Project proj) r1Node |])
-
--- If the same outer vector is propagated twice to an inner vector,
--- one DistLift can be removed. Reasoning: DistLift does not change
--- the shape of the inner vector.
-distLiftStacked :: VLRule BottomUpProps
-distLiftStacked q =
-  $(dagPatMatch 'q "R1 ((q1) DistLift (r1=R1 ((q11) DistLift (q2))))"
-     [| do
-         predicate $ $(v "q1") == $(v "q11")
-         w1 <- liftM (vectorWidth . vectorTypeProp) $ properties $(v "q1")
-         w2 <- liftM (vectorWidth . vectorTypeProp) $ properties $(v "q2")
-
-         return $ do
-             logRewrite "Redundant.DistLift.Stacked" q
-             let proj = map Column $ [1..w1] ++ [1..w1] ++ [w1+1..w1+w2]
-             void $ replaceWithNew q $ UnOp (Project proj) $(v "r1") |])
-
--- | Pull a selection through a DistLift. The reasoning for
--- correctness is simple: It does not matter wether an element of an
--- inner segment is removed before or after DistLift (on relational
--- level, DistLift maps to join which commutes with selection). The
--- "use case" for this rewrite is not well thought-through yet: We
--- want to push down DistLift to eliminate it or merge it with other
--- operators (e.g. DistLift.Stacked). The usual wisdom would suggest
--- to push selections down, though.
-distLiftSelect :: VLRule BottomUpProps
-distLiftSelect q =
-  $(dagPatMatch 'q "R1 ((q1) DistLift (R1 (Select p (q2))))"
-     [| do
-         w1 <- liftM (vectorWidth . vectorTypeProp) $ properties $(v "q1")
-         return $ do
-             logRewrite "Redundant.DistLift.Select" q
-             let p' = shiftExprCols w1 $(v "p")
-             distNode <- insert $ BinOp DistLift $(v "q1") $(v "q2")
-             distR1   <- insert $ UnOp R1 distNode
-             selNode  <- insert $ UnOp (Select p') distR1
-             void $ replaceWithNew q $ UnOp R1 selNode |])
-
--- | When a DistLift result is aligned with the right (inner) DistLift
--- input, we can eliminate the Align. Reasoning: DistLift does not
--- change the shape of the vector, only adds columns from its right
--- input.
-alignedDistLift :: VLRule BottomUpProps
-alignedDistLift q =
-  $(dagPatMatch 'q "(q21) Align (qr1=R1 ((q1) DistLift (q22)))"
-    [| do
-        predicate $ $(v "q21") == $(v "q22")
-        w1 <- liftM (vectorWidth . vectorTypeProp) $ properties $(v "q1")
-        w2 <- liftM (vectorWidth . vectorTypeProp) $ properties $(v "q21")
-        
-        return $ do
-            logRewrite "Redundant.DistLift.Align" q
-            let proj = map Column $
-                       [w1+1..w1+w2]
-                       ++
-                       [1..w1]
-                       ++
-                       [w1+1..w1+w2]
-            void $ replaceWithNew q $ UnOp (Project proj) $(v "qr1") |])
-
---------------------------------------------------------------------------------
--- Zip and Align rewrites. 
-
--- Note that the rewrites valid for Zip are a subset of the rewrites
--- valid for Align. In the case of Align, we statically know that both
--- inputs have the same length and can be positionally aligned without
--- discarding elements.
-
--- | Replace a Zip operator with a projection if both inputs are the
--- same.
-sameInputZip :: VLRule BottomUpProps
-sameInputZip q =
-  $(dagPatMatch 'q "(q1) [Zip | Align] (q2)"
-    [| do
-        predicate $ $(v "q1") == $(v "q2")
-        w <- liftM (vectorWidth . vectorTypeProp) $ properties $(v "q1")
-
-        return $ do
-          logRewrite "Redundant.Zip/Align.Self" q
-          let ps = map Column [1 .. w]
-          void $ replaceWithNew q $ UnOp (Project (ps ++ ps)) $(v "q1") |])
-
-sameInputZipProject :: VLRule BottomUpProps
-sameInputZipProject q =
-  $(dagPatMatch 'q "(Project ps1 (q1)) [Zip | Align] (Project ps2 (q2))"
-    [| do
-        predicate $ $(v "q1") == $(v "q2")
-
-        return $ do
-          logRewrite "Redundant.Zip/Align.Self.Project" q
-          void $ replaceWithNew q $ UnOp (Project ($(v "ps1") ++ $(v "ps2"))) $(v "q1") |])
-
-sameInputZipProjectLeft :: VLRule BottomUpProps
-sameInputZipProjectLeft q =
-  $(dagPatMatch 'q "(Project ps1 (q1)) [Zip | Align] (q2)"
-    [| do
-        predicate $ $(v "q1") == $(v "q2")
-        w1 <- liftM (vectorWidth . vectorTypeProp) $ properties $(v "q1")
-
-        return $ do
-          logRewrite "Redundant.Zip/Align.Self.Project.Left" q
-          let proj = $(v "ps1") ++ (map Column [1..w1])
-          void $ replaceWithNew q $ UnOp (Project proj) $(v "q1") |])
-
-sameInputZipProjectRight :: VLRule BottomUpProps
-sameInputZipProjectRight q =
-  $(dagPatMatch 'q "(q1) [Zip | Align] (Project ps2 (q2))"
-    [| do
-        predicate $ $(v "q1") == $(v "q2")
-        w <- liftM (vectorWidth . vectorTypeProp) $ properties $(v "q1")
-
-        return $ do
-          logRewrite "Redundant.Zip/Align.Self.Project.Right" q
-          let proj = (map Column [1 .. w]) ++ $(v "ps2")
-          void $ replaceWithNew q $ UnOp (Project proj) $(v "q1") |])
-
-zipProjectLeft :: VLRule BottomUpProps
-zipProjectLeft q =
-  $(dagPatMatch 'q "(Project ps1 (q1)) [Zip | Align]@op (q2)"
-    [| do
-        w1 <- liftM (vectorWidth . vectorTypeProp) $ properties $(v "q1")
-        w2 <- liftM (vectorWidth . vectorTypeProp) $ properties $(v "q2")
-
-        return $ do
-          logRewrite "Redundant.Zip/Align.Project.Left" q
-          -- Take the projection expressions from the left and the
-          -- shifted columns from the right.
-          let proj = $(v "ps1") ++ [ Column $ c + w1 | c <- [1 .. w2]]
-          zipNode <- insert $ BinOp $(v "op") $(v "q1") $(v "q2")
-          void $ replaceWithNew q $ UnOp (Project proj) zipNode |])
-
-zipProjectRight :: VLRule BottomUpProps
-zipProjectRight q =
-  $(dagPatMatch 'q "(q1) [Zip | Align]@op (Project p2 (q2))"
-    [| do
-        w1 <- liftM (vectorWidth . vectorTypeProp) $ properties $(v "q1")
-
-        return $ do
-          logRewrite "Redundant.Zip/Align.Project.Right" q
-          -- Take the columns from the left and the expressions from
-          -- the right projection. Since expressions are applied after
-          -- the zip, their column references have to be shifted.
-          let proj = [Column c | c <- [1..w1]] ++ [ mapExprCols (+ w1) e | e <- $(v "p2") ]
-          zipNode <- insert $ BinOp $(v "op") $(v "q1") $(v "q2")
-          void $ replaceWithNew q $ UnOp (Project proj) zipNode |])
-
-fromConst :: Monad m => ConstPayload -> m VLVal
-fromConst (ConstPL val) = return val
-fromConst NonConstPL    = fail "not a constant"
-
--- | This rewrite is valid because we statically know that both
--- vectors have the same length.
-alignConstLeft :: VLRule BottomUpProps
-alignConstLeft q =
-  $(dagPatMatch 'q "(q1) Align (q2)"
-    [| do
-        VProp (DBVConst _ ps) <- constProp <$> properties $(v "q1")
-        w2                    <- vectorWidth <$> vectorTypeProp <$> properties $(v "q2")
-
-        vals                  <- mapM fromConst ps
-
-        return $ do
-            logRewrite "Redundant.Align.Constant.Left" q
-            let proj = map Constant vals ++ map Column [1..w2]
-            void $ replaceWithNew q $ UnOp (Project proj) $(v "q2") |])
-
-alignConstRight :: VLRule BottomUpProps
-alignConstRight q =
-  $(dagPatMatch 'q "(q1) Align (q2)"
-    [| do
-        w1                    <- vectorWidth <$> vectorTypeProp <$> properties $(v "q1")
-
-        VProp (DBVConst _ ps) <- constProp <$> properties $(v "q2")
-
-
-        vals                  <- mapM fromConst ps
-
-        return $ do
-            logRewrite "Redundant.Align.Constant.Right" q
-            let proj = map Column [1..w1] ++ map Constant vals
-            void $ replaceWithNew q $ UnOp (Project proj) $(v "q1") |])
-
--- | In contrast to the 'Align' version ('alignConstLeft') this
--- rewrite is only valid if we can statically determine that both
--- input vectors have the same length. If the constant vector was
--- shorter, overhanging elements from the non-constant vector would
--- need to be discarded. In general, we can only determine equal
--- length for the special case of length one.
-zipConstLeft :: VLRule BottomUpProps
-zipConstLeft q =
-  $(dagPatMatch 'q "(q1) Zip (q2)"
-    [| do
-        prop1                 <- properties $(v "q1")
-        VProp card1           <- return $ card1Prop prop1
-        VProp (DBVConst _ ps) <- return $ constProp prop1
-
-        prop2                 <- properties $(v "q2")
-        VProp card2           <- return $ card1Prop prop2
-        w2                    <- vectorWidth <$> vectorTypeProp <$> properties $(v "q2")
-
-        vals                  <- mapM fromConst ps
-        predicate $ card1 && card2
-
-        return $ do
-            logRewrite "Redundant.Zip.Constant.Left" q
-            let proj = map Constant vals ++ map Column [1..w2]
-            void $ replaceWithNew q $ UnOp (Project proj) $(v "q2") |])
-
-zipConstRight :: VLRule BottomUpProps
-zipConstRight q =
-  $(dagPatMatch 'q "(q1) Zip (q2)"
-    [| do
-        prop1                 <- properties $(v "q1")
-        VProp card1           <- return $ card1Prop prop1
-        w1                    <- vectorWidth <$> vectorTypeProp <$> properties $(v "q1")
-
-        prop2                 <- properties $(v "q2")
-        VProp card2           <- return $ card1Prop prop2
-        VProp (DBVConst _ ps) <- return $ constProp prop2
-
-
-        vals                  <- mapM fromConst ps
-        predicate $ card1 && card2
-
-        return $ do
-            logRewrite "Redundant.Zip.Constant.Right" q
-            let proj = map Column [1..w1] ++ map Constant vals
-            void $ replaceWithNew q $ UnOp (Project proj) $(v "q1") |])
-
-zipZipLeft :: VLRule BottomUpProps
-zipZipLeft q =
-  $(dagPatMatch 'q "(q1) Zip (qz=(q11) [Zip | Align] (_))"
-     [| do
-         predicate $ $(v "q1") == $(v "q11")
-
-         w1 <- vectorWidth <$> vectorTypeProp <$> properties $(v "q1")
-         wz <- vectorWidth <$> vectorTypeProp <$> properties $(v "qz")
-        
-         return $ do
-             logRewrite "Redundant.Zip/Align.Zip.Left" q
-             let proj = map Column $ [1..w1] ++ [1..wz]
-             void $ replaceWithNew q $ UnOp (Project proj) $(v "qz") |])
-
-zipWinRight :: VLRule BottomUpProps
-zipWinRight q =
-  $(dagPatMatch 'q "(q1) [Zip | Align] (qw=WinFun _ (q2))"
-     [| do
-         predicate $ $(v "q1") == $(v "q2")
-         
-         w <- vectorWidth <$> vectorTypeProp <$> properties $(v "q1")
-         
-         return $ do
-             logRewrite "Redundant.Zip.Self.Win.Right" q
-             -- We get all columns from the left input. The WinAggr
-             -- operator produces the input column followed the window
-             -- function result.
-             let proj = map Column $ [1 .. w] ++ [1 .. w] ++ [w+1]
-             logGeneral ("zipWinRight " ++ show proj)
-             void $ replaceWithNew q $ UnOp (Project proj) $(v "qw") |])
-
-zipWinLeft :: VLRule BottomUpProps
-zipWinLeft q =
-  $(dagPatMatch 'q "(qw=WinFun _ (q1)) [Zip | Align] (q2)"
-     [| do
-         predicate $ $(v "q1") == $(v "q2")
-         
-         w <- vectorWidth <$> vectorTypeProp <$> properties $(v "q1")
-         
-         return $ do
-             logRewrite "Redundant.Zip.Self.Win.Left" q
-             -- We get all input columns plus the window function
-             -- output from the left. From the right we get all input
-             -- columns.
-             let proj = map Column $ [1 .. w] ++ [w+1] ++ [1 .. w]
-             void $ replaceWithNew q $ UnOp (Project proj) $(v "qw") |])
-
-isPrecedingFrameSpec :: FrameSpec -> Bool
-isPrecedingFrameSpec fs =
-    case fs of
-        FAllPreceding -> True
-        FNPreceding _ -> True
-
-zipWinRightPush :: VLRule BottomUpProps
-zipWinRightPush q =
-  $(dagPatMatch 'q "(q1) Zip (WinFun args (q2))"
-    [| do
-        let (winFun, frameSpec) = $(v "args")
-        predicate $ isPrecedingFrameSpec frameSpec
-        w1 <- vectorWidth <$> vectorTypeProp <$> properties $(v "q1")
-
-        return $ do
-            logRewrite "Redundant.Zip.Win.Right" q
-            zipNode <- insert $ BinOp Zip $(v "q1") $(v "q2")
-            let winFun' = mapWinFun (mapExprCols (\c -> c + w1)) winFun
-                args'   = (winFun', frameSpec)
-            void $ replaceWithNew q $ UnOp (WinFun args') zipNode |])
-
--- | If singleton scalar elements in an inner vector (with singleton
--- segments) are unboxed using an outer vector and then zipped with
--- the same outer vector, we can eliminate the zip, because the
--- positional alignment is implicitly performed by the UnboxScalar
--- operator. We exploit the fact that UnboxScalar is only a
--- specialized join which nevertheless produces payload columns from
--- both inputs.
-zipUnboxScalarRight :: VLRule BottomUpProps
-zipUnboxScalarRight q = 
-  $(dagPatMatch 'q "(q11) Align (qu=(q12) UnboxScalar (q2))"
-     [| do
-         predicate $ $(v "q11") == $(v "q12")
-
-         leftWidth  <- vectorWidth <$> vectorTypeProp <$> properties $(v "q11")
-         rightWidth <- vectorWidth <$> vectorTypeProp <$> properties $(v "q2")
-
-         return $ do
-             logRewrite "Redundant.Align.UnboxScalar.Right" q
-             
-
-             -- Keep the original schema intact by duplicating columns
-             -- from the left input (UnboxScalar produces columns from
-             -- its left and right inputs).
-             let outputCols = -- Two times the left input columns
-                              [1..leftWidth] ++ [1..leftWidth] 
-                              -- Followed by the right input columns
-                              ++ [ leftWidth+1..rightWidth+leftWidth ]
-                 proj       = map Column outputCols
-
-             -- Keep only the unboxing operator, together with a
-             -- projection that keeps the original output schema
-             -- intact.
-             void $ replaceWithNew q $ UnOp (Project proj) $(v "qu") |])
-
--- | See Align.UnboxScalar.Right
-zipUnboxScalarLeft :: VLRule BottomUpProps
-zipUnboxScalarLeft q = 
-  $(dagPatMatch 'q "(qu=(q11) UnboxScalar (q2)) Align (q12)"
-     [| do
-         predicate $ $(v "q11") == $(v "q12")
-
-         leftWidth  <- vectorWidth <$> vectorTypeProp <$> properties $(v "q11")
-         rightWidth <- vectorWidth <$> vectorTypeProp <$> properties $(v "q2")
-
-         return $ do
-             logRewrite "Redundant.Align.UnboxScalar.Left" q
-             
-
-             -- Keep the original schema intact by duplicating columns
-             -- from the left input (UnboxScalar produces columns from
-             -- its left and right inputs).
-             let outputCols = -- The left (outer) columns
-                              [1..leftWidth]
-                              -- Followed by the right (inner) input columns
-                              ++ [ leftWidth+1..rightWidth+leftWidth ]
-                              -- Followed by the left (outer columns) again
-                              -- (originally produced by Align)
-                              ++ [1..leftWidth]
-                 proj       = map Column outputCols
-
-             -- Keep only the unboxing operator, together with a
-             -- projection that keeps the original output schema
-             -- intact.
-             void $ replaceWithNew q $ UnOp (Project proj) $(v "qu") |])
-
--- | A CartProduct output is aligned with some other vector. If one of
--- the CartProduct inputs has cardinality one, the other CartProduct
--- input determines the length of the result vector. From the original
--- structure we can derive that 'q11' and the CartProduct result are
--- aligned. Consequentially, 'q11 and 'q12' (the left CartProduct
--- input) must be aligned as well.
-alignCartProdRight :: VLRule BottomUpProps
-alignCartProdRight q =
-  $(dagPatMatch 'q "(q11) Align (R1 ((q12) CartProduct (q2)))"
-    [| do
-        VProp True <- card1Prop <$> properties $(v "q2")
-        return $ do
-            logRewrite "Redundant.Align.CartProduct.Card1.Right" q
-            alignNode <- insert $ BinOp Align $(v "q11") $(v "q12")
-            prodNode  <- insert $ BinOp CartProduct alignNode $(v "q2")
-            void $ replaceWithNew q $ UnOp R1 prodNode |])
-
---------------------------------------------------------------------------------
--- Scalar conditionals
-
--- | Under a number of conditions, a combination of Combine and Select
--- (Restrict) operators implements a scalar conditional that can be
--- simply mapped to an 'if' expression evaluated on the input vector.
-scalarConditional :: VLRule ()
-scalarConditional q =
-  $(dagPatMatch 'q "R1 (Combine (Project predProj (q1)) (Project thenProj (R1 (Select pred2 (q2)))) (Project elseProj (R1 (Select negPred (q3)))))"
-    [| do
-        -- All branches must work on the same input vector
-        predicate $ $(v "q1") == $(v "q2") && $(v "q1") == $(v "q3")
-
-        -- The condition projection as well as the projections for
-        -- then and else branches must produce single columns.
-        [predExpr] <- return $(v "predProj")
-        [thenExpr] <- return $(v "thenProj")
-        [elseExpr] <- return $(v "elseProj")
-
-        -- The condition for the boolean vector must be the same as
-        -- the selection condition for the then-branch.
-        predicate $ predExpr == $(v "pred2")
-
-        -- The selection condition must be the negated form of the
-        -- then-condition.
-        predicate $ (UnApp (SUBoolOp Not) predExpr) == $(v "negPred")
-
-        return $ do
-          logRewrite "Redundant.ScalarConditional" q
-          void $ replaceWithNew q $ UnOp (Project [If predExpr thenExpr elseExpr]) $(v "q1") |])
-
-------------------------------------------------------------------------------
--- Projection pullup
-
-inlineJoinPredLeft :: [(DBCol, Expr)] -> JoinPredicate Expr -> JoinPredicate Expr
-inlineJoinPredLeft env (JoinPred conjs) = JoinPred $ fmap inlineLeft conjs
-  where
-    inlineLeft :: JoinConjunct Expr -> JoinConjunct Expr
-    inlineLeft (JoinConjunct le op re) = JoinConjunct (mergeExpr env le) op re
-
-inlineJoinPredRight :: [(DBCol, Expr)] -> JoinPredicate Expr -> JoinPredicate Expr
-inlineJoinPredRight env (JoinPred conjs) = JoinPred $ fmap inlineRight conjs
-  where
-    inlineRight :: JoinConjunct Expr -> JoinConjunct Expr
-    inlineRight (JoinConjunct le op re) = JoinConjunct le op (mergeExpr env re)
-
-pullProjectNestJoinLeft :: VLRule BottomUpProps
-pullProjectNestJoinLeft q =
-  $(dagPatMatch 'q "R1 ((Project proj (q1)) NestJoin p (q2))"
-    [| do
-        leftWidth  <- vectorWidth <$> vectorTypeProp <$> properties $(v "q1")
-        rightWidth <- vectorWidth <$> vectorTypeProp <$> properties $(v "q2")
-
-        return $ do
-            logRewrite "Redundant.Project.NestJoin.Left" q
-            let proj' = $(v "proj") ++ map Column [leftWidth + 1 .. leftWidth + rightWidth]
-                p'    = inlineJoinPredLeft (zip [1..] $(v "proj")) $(v "p")
-
-            joinNode <- insert $ BinOp (NestJoin p') $(v "q1") $(v "q2")
-            r1Node   <- insert $ UnOp R1 joinNode
-            void $ replaceWithNew q $ UnOp (Project proj') r1Node
-
-            -- FIXME relink R2 and R3 parents 
-            |])
-
-pullProjectNestJoinRight :: VLRule BottomUpProps
-pullProjectNestJoinRight q =
-  $(dagPatMatch 'q "R1 ((q1) NestJoin p (Project proj (q2)))"
-    [| do
-        leftWidth  <- vectorWidth <$> vectorTypeProp <$> properties $(v "q1")
-
-        return $ do
-            logRewrite "Redundant.Project.NestJoin.Right" q
-            let proj' = map Column [1..leftWidth] ++ map (shiftExprCols leftWidth) $(v "proj")
-                p'    = inlineJoinPredRight (zip [1..] $(v "proj")) $(v "p")
-
-            joinNode <- insert $ BinOp (NestJoin p') $(v "q1") $(v "q2")
-            r1Node   <- insert $ UnOp R1 joinNode
-            void $ replaceWithNew q $ UnOp (Project proj') r1Node
-
-            -- FIXME relink R2 and R3 parents 
-            |])
-        
-
-pullProjectNumber :: VLRule BottomUpProps
-pullProjectNumber q =
-  $(dagPatMatch 'q "Number (Project proj (q1))"
-    [| do
-         w <- vectorWidth <$> vectorTypeProp <$> properties $(v "q1")
-
-         return $ do
-             logRewrite "Redundant.Project.Number" q
-
-             -- We have to preserve the numbering column in the
-             -- pulled-up projection.
-             let proj' = $(v "proj") ++ [Column $ w + 1]
-             numberNode <- insert $ UnOp Number $(v "q1")
-             void $ replaceWithNew q $ UnOp (Project proj') numberNode |])
-
--- Motivation: In order to eliminate or pull up sorting operations in
--- VL rewrites or subsequent stages, payload columns which might
--- induce sort order should be available as long as possible. We
--- assume that the cost of having unrequired columns around is
--- negligible (best case: column store).
-
-pullProjectPropRename :: VLRule ()
-pullProjectPropRename q =
-  $(dagPatMatch 'q "(qp) PropRename (Project proj (qv))"
-    [| do
-         return $ do
-           logRewrite "Redundant.Project.PropRename" q
-           renameNode <- insert $ BinOp PropRename $(v "qp") $(v "qv")
-           void $ replaceWithNew q $ UnOp (Project $(v "proj")) renameNode |])
-
-pullProjectUnboxScalarLeft :: VLRule BottomUpProps
-pullProjectUnboxScalarLeft q =
-  $(dagPatMatch 'q "(Project proj (q1)) UnboxScalar (q2)"
-    [| do 
-         leftWidth  <- vectorWidth <$> vectorTypeProp <$> properties $(v "q1")
-         rightWidth <- vectorWidth <$> vectorTypeProp <$> properties $(v "q2")
-
-         return $ do
-           logRewrite "Redundant.Project.UnboxScalar" q
-
-           -- Employ projection expressions on top of the unboxing
-           -- operator, add right input columns.
-           let proj' = $(v "proj") ++ map Column [ leftWidth + 1 .. leftWidth + rightWidth ]
-           unboxNode <- insert $ BinOp UnboxScalar $(v "q1") $(v "q2")
-
-           void $ replaceWithNew q $ UnOp (Project proj') unboxNode |])
-
-pullProjectUnboxScalarRight :: VLRule BottomUpProps
-pullProjectUnboxScalarRight q =
-  $(dagPatMatch 'q "(q1) UnboxScalar (Project proj (q2))"
-    [| do 
-         leftWidth  <- vectorWidth <$> vectorTypeProp <$> properties $(v "q1")
-
-         return $ do
-           logRewrite "Redundant.Project.UnboxScalar" q
-
-           -- Preserve left input columns on top of the unboxing
-           -- operator and add right input expressions with shifted
-           -- columns.
-           let proj' = map Column [1..leftWidth]
-                       ++
-                       [ mapExprCols (+ leftWidth) e | e <- $(v "proj") ]
-
-           unboxNode <- insert $ BinOp UnboxScalar $(v "q1") $(v "q2")
-
-           void $ replaceWithNew q $ UnOp (Project proj') unboxNode |])
-    
-pullProjectPropReorder :: VLRule ()
-pullProjectPropReorder q =
-  $(dagPatMatch 'q "R1 ((qp) PropReorder (Project proj (qv)))"
-    [| do
-         return $ do
-           logRewrite "Redundant.Project.Reorder" q
-           reorderNode <- insert $ BinOp PropReorder $(v "qp") $(v "qv")
-           r1Node      <- insert $ UnOp R1 reorderNode
-           void $ replaceWithNew q $ UnOp (Project $(v "proj")) r1Node |])
-
-pullProjectSelectPos1S :: VLRule ()
-pullProjectSelectPos1S q =
-  $(dagPatMatch 'q "R1 (qs=SelectPos1S args (Project proj (q1)))"
-    [| do
-         return $ do
-           logRewrite "Redundant.Project.SelectPos1S" q
-           selectNode  <- insert $ UnOp (SelectPos1S $(v "args")) $(v "q1")
-           r1Node      <- insert $ UnOp R1 selectNode
-           void $ replaceWithNew q $ UnOp (Project $(v "proj")) r1Node |])
-
-pullProjectPropFilter :: VLRule ()
-pullProjectPropFilter q =
-  $(dagPatMatch 'q "R1 ((q1) PropFilter (Project proj (q2)))"
-    [| do
-         return $ do
-           logRewrite "Redundant.Project.PropFilter" q
-           filterNode <- insert $ BinOp PropFilter $(v "q1") $(v "q2")
-           r1Node     <- insert $ UnOp R1 filterNode
-           void $ replaceWithNew q $ UnOp (Project $(v "proj")) r1Node |])
-
-pullProjectUnboxRename :: VLRule ()
-pullProjectUnboxRename q =
-  $(dagPatMatch 'q "UnboxRename (Project _ (q1))"
-    [| do
-         return $ do
-           logRewrite "Redundant.Project.UnboxRename" q
-           void $ replaceWithNew q $ UnOp UnboxRename $(v "q1") |])
-
--- | Any projections on the left input of AggrS are irrelevant, as
--- only the segment information are required from the vector.
-pullProjectAggrS :: VLRule ()
-pullProjectAggrS q =
-  $(dagPatMatch 'q "(Project _ (q1)) AggrS args (q2)"
-    [| do
-        return $ do
-            logRewrite "Redundant.Project.AggrS" q
-            void $ replaceWithNew q $ BinOp (AggrS $(v "args")) $(v "q1") $(v "q2") |])
-
---------------------------------------------------------------------------------
--- Positional selection on constants
-
-selectConstPos :: VLRule BottomUpProps
-selectConstPos q =
-  $(dagPatMatch 'q "(q1) SelectPos op (qp)"
-    [| do
-         VProp (DBVConst _ constCols) <- constProp <$> properties $(v "qp")
-         pos <- case constCols of
-                    [ConstPL (VLInt p)] -> return p
-                    [NonConstPL]        -> fail "no match"
-                    _                   -> $impossible
-
-         return $ do
-           logRewrite "Redundant.SelectPos.Constant" q
-           void $ replaceWithNew q $ UnOp (SelectPos1 ($(v "op"), pos)) $(v "q1") |])
-
-selectConstPosS :: VLRule BottomUpProps
-selectConstPosS q =
-  $(dagPatMatch 'q "(q1) SelectPosS op (qp)"
-    [| do
-         VProp (DBVConst _ constCols) <- constProp <$> properties $(v "qp")
-         pos <- case constCols of
-                    [ConstPL (VLInt p)] -> return p
-                    [NonConstPL]        -> fail "no match"
-                    _                   -> $impossible
-
-         return $ do
-           logRewrite "Redundant.SelectPosS.Constant" q
-           void $ replaceWithNew q $ UnOp (SelectPos1S ($(v "op"), pos)) $(v "q1") |])
-
---------------------------------------------------------------------------------
--- Rewrites that deal with nested structures and propagation vectors.
-
--- | When the right input of a cartesian product has cardinality one,
--- the cardinality of the right input does not change and the
--- propagation vector for the left input is a NOOP.
-propProductCard1Right :: VLRule BottomUpProps
-propProductCard1Right q =
-  $(dagPatMatch 'q "R1 ((R2 ((_) CartProduct (q2))) PropReorder (qi))"
-    [| do
-        VProp True <- card1Prop <$> properties $(v "q2")
-        
-        return $ do
-          logRewrite "Redundant.Prop.CartProduct.Card1.Right" q
-          void $ replace q $(v "qi") |])
-
--- | Turn a right-deep nestjoin tree into a left-deep one.
--- 
--- A comprehension of the form
--- @
--- [ [ [ e x y z | z <- zs, p2 y z ]
---   | y <- ys
---   , p1 x y
---   ]
--- | x <- xs
--- ]
--- @
--- 
--- is first rewritten into a right-deep chain of nestjoins: 'xs △ (ys △ zs)'. 
--- Bottom-up compilation of this expression to VL (vectorization) results in 
--- a rather awkward plan, though: The inner nestjoin is computed independent
--- of values of 'x'. The join result is then re-shaped using the propagation
--- vector from the nestjoin of the outer relations 'xs' and 'ys'. This pattern
--- is problematic for multiple reasons: PropReorder is an expensive operation as 
--- it involves re-ordering semantically, leading to a hard-to-eliminate rownum.
--- On the plan level, we do not get a left- or right-deep join tree of thetajoins,
--- but two independent joins between the two pairs of input relations whose results
--- are connected using an additional join (PropReorder). This means that the two
--- base joins will be executed on the full base tables, without being able to profit
--- from a reduced cardinality in one of the join results.
--- 
--- NestJoin does not exhibit useful algebraic properties, most notably it is neither
--- associate nor commutative. It turns out however that we can turn the pattern
--- described above into a proper left-deep sequence of nestjoins if we consider
--- the flat (vectorized) representation. The output of 'xs △ ys' is nestjoined
--- with the innermost input 'zs'. This gives us exactly the representation of
--- the nested output that we need. Semantically, 'zs' is not joined with all
--- tuples in 'ys', but only with those that survive the (outer) join with 'xs'. 
--- As usual, a proper join tree should give the engine the freedom to re-arrange 
--- the joins and drive them in a pipelined manner.
-nestJoinChain :: VLRule BottomUpProps
-nestJoinChain q =
-  $(dagPatMatch 'q "R1 ((R3 (lj=(xs) NestJoin _ (ys))) PropReorder (R1 ((ys1) NestJoin p (zs))))"
-   [| do
-       xsWidth <- vectorWidth <$> vectorTypeProp <$> properties $(v "xs")
-       ysWidth <- vectorWidth <$> vectorTypeProp <$> properties $(v "ys")
-       zsWidth <- vectorWidth <$> vectorTypeProp <$> properties $(v "zs")
-
-       predicate $ $(v "ys") == $(v "ys1")
-       return $ do
-         logRewrite "Redundant.Prop.NestJoinChain" q
-
-
-         let innermostCols = map Column [ xsWidth + 1 .. xsWidth + ysWidth + zsWidth ]
-  
-             -- As the left input of the top nestjoin now includes the
-             -- columns from xs, we have to shift column references in
-             -- the left predicate side.
-             JoinPred conjs = $(v "p")
-             p' = JoinPred $ fmap (shiftJoinPredCols xsWidth 0) conjs
-
-         -- The R1 node on the left nest join might already exist, but
-         -- we simply rely on hash consing.
-         leftJoinR1  <- insert $ UnOp R1 $(v "lj")
-         rightJoin   <- insert $ BinOp (NestJoin p') leftJoinR1 $(v "zs")
-         rightJoinR1 <- insert $ UnOp R1 rightJoin
-  
-         -- Because the original produced only the columns of ys and
-         -- zs in the PropReorder output, we have to remove the xs
-         -- columns from the top NestJoin.
-         void $ replaceWithNew q $ UnOp (Project innermostCols) rightJoinR1 |])
-
-shiftJoinPredCols :: Int -> Int -> JoinConjunct Expr -> JoinConjunct Expr
-shiftJoinPredCols leftOffset rightOffset (JoinConjunct leftExpr op rightExpr) =
-    JoinConjunct (shiftExprCols leftOffset leftExpr) op (shiftExprCols rightOffset rightExpr)
-
---------------------------------------------------------------------------------
--- Eliminating operators whose output is not required
-
-notReqNumber :: VLRule Properties
-notReqNumber q =
-  $(dagPatMatch 'q "Number (q1)"
-    [| do
-        w <- vectorWidth <$> vectorTypeProp <$> bu <$> properties $(v "q1")
-        VProp (Just reqCols) <- reqColumnsProp <$> td <$> properties $(v "q")
-
-        -- The number output in column w + 1 must not be required
-        predicate $ all (<= w) reqCols
-
-        return $ do
-          logRewrite "Redundant.Req.Number" q
-          -- Add a dummy column instead of the number output to keep
-          -- column references intact.
-          let proj = map Column [1..w] ++ [Constant $ VLInt 0xdeadbeef]
-          void $ replaceWithNew q $ UnOp (Project proj) $(v "q1") |])
-
---------------------------------------------------------------------------------
--- Classical relational algebra rewrites
-
--- | Merge a selection that refers to both sides of a cartesian
--- product operators' inputs into a join.
-selectCartProd :: VLRule BottomUpProps
-selectCartProd q =
-  $(dagPatMatch 'q "R1 (Select p (R1 ((q1) CartProduct (q2))))"
-    [| do
-        wl <- vectorWidth <$> vectorTypeProp <$> properties $(v "q1")
-        BinApp (SBRelOp op) (Column lc) (Column rc)  <- return $(v "p")
-  
-        -- The left operand column has to be from the left input, the
-        -- right operand from the right input.
-        predicate $ lc <= wl
-        predicate $ rc > wl
-
-        return $ do
-            logRewrite "Redundant.Relational.Join" q
-            let joinPred = singlePred $ JoinConjunct (Column lc) op (Column $ rc - wl)
-            joinNode <- insert $ BinOp (ThetaJoin joinPred) $(v "q1") $(v "q2")
-            void $ replaceWithNew q $ UnOp R1 joinNode |])
diff --git a/src/Database/DSH/Optimizer/VL/Rewrite/Unused.hs b/src/Database/DSH/Optimizer/VL/Rewrite/Unused.hs
deleted file mode 100644
--- a/src/Database/DSH/Optimizer/VL/Rewrite/Unused.hs
+++ /dev/null
@@ -1,48 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-
-{- Based on the ReqColumns property, remove columns or entire operators which
-produce value vectors but whose payload output is not needed downstream. This
-is of course only sound if the operator in question does not change the vertical
-layout.  -}
-
-module Database.DSH.Optimizer.VL.Rewrite.Unused where
-
-{-
-import           Control.Applicative
-
-import           Database.Algebra.Dag.Common
-import           Database.Algebra.VL.Data
-
-import           Database.DSH.Optimizer.Common.Rewrite
-import           Database.DSH.Optimizer.VL.Properties.Types
-import           Database.DSH.Optimizer.VL.Rewrite.Common
-
-pruneUnused :: VLRewrite Bool
-pruneUnused = applyToAll inferTopDown [ {- unusedProject -} ]
-
--}
-
-{-
-
-FIXME seems a bit fishy
-
-unusedProject :: VLRule TopDownProps
-unusedProject q =
-  $(pattern 'q "[ProjectL | Project] _ (q1)"
-    [| do
-      -- Don't remove top-level projections. They ensure that all required
-      -- columns required for the result type are actually there.
-      predicate =<< not <$> elem q <$> getRootNodes
-
-      reqColumns <- reqColumnsProp <$> properties q
-      
-      case reqColumns of
-        VProp (Just []) -> return ()
-        VProp (Just _)  -> fail "no match"
-        p               -> error ("Unused.Project: " ++ show p)
-        
-
-      return $ do
-        logRewrite "Unused.Project" q
-        replace q $(v "q1") |])
--}
diff --git a/src/Database/DSH/Optimizer/VL/Rewrite/Window.hs b/src/Database/DSH/Optimizer/VL/Rewrite/Window.hs
deleted file mode 100644
--- a/src/Database/DSH/Optimizer/VL/Rewrite/Window.hs
+++ /dev/null
@@ -1,159 +0,0 @@
-{-# LANGUAGE PatternSynonyms #-}
-{-# LANGUAGE TemplateHaskell #-}
-module Database.DSH.Optimizer.VL.Rewrite.Window where
-
-import           Control.Applicative
-import           Control.Monad
-import           Data.List.NonEmpty                              (NonEmpty (..))
-
-import           Database.Algebra.Dag.Common
-
-import           Database.DSH.Common.Lang
-import           Database.DSH.Optimizer.Common.Rewrite
-import           Database.DSH.Optimizer.VL.Properties.ReqColumns
-import           Database.DSH.Optimizer.VL.Properties.Types
-import           Database.DSH.Optimizer.VL.Properties.VectorType
-import           Database.DSH.Optimizer.VL.Rewrite.Common
-import           Database.DSH.VL.Lang
-
-pattern SingleJoinPred e1 op e2 = JoinPred ((JoinConjunct e1 op e2) :| [])
-pattern DoubleJoinPred e11 op1 e12 e21 op2 e22 = JoinPred ((JoinConjunct e11 op1 e12)
-                                                           :|
-                                                           [JoinConjunct e21 op2 e22])
-pattern AddExpr e1 e2 = BinApp (SBNumOp Add) e1 e2
-pattern SubExpr e1 e2 = BinApp (SBNumOp Sub) e1 e2
-
-aggrToWinFun :: AggrFun -> WinFun
-aggrToWinFun (AggrSum _ e) = WinSum e
-aggrToWinFun (AggrMin e)   = WinMin e
-aggrToWinFun (AggrMax e)   = WinMax e
-aggrToWinFun (AggrAvg e)   = WinAvg e
-aggrToWinFun (AggrAll e)   = WinAll e
-aggrToWinFun (AggrAny e)   = WinAny e
-aggrToWinFun AggrCount     = WinCount
-
--- Turn a running aggregate based on a self-join into a window operator.
-runningAggWin :: VLRule BottomUpProps
-runningAggWin q =
-  $(dagPatMatch 'q "(qo) UnboxScalar ((_) AggrS afun (R1 ((qn=Number (q1)) NestJoin p (Number (q2)))))"
-    [| do
-        predicate $ $(v "q1") == $(v "q2")
-        predicate $ $(v "qo") == $(v "qn")
-
-        w <- vectorWidth <$> vectorTypeProp <$> properties $(v "q1")
-
-        -- We require a range predicate on the positions generated by
-        -- Number.
-        -- FIXME allow other forms of window specifications
-        SingleJoinPred (Column nrCol) GtE (Column nrCol') <- return $(v "p")
-        predicate $ nrCol == w + 1 && nrCol' == w + 1
-
-        -- The aggregate should only reference columns from the right
-        -- ThetaJoin input, i.e. columns from the partition generated
-        -- for a input tuple.
-        let isWindowColumn c = c >= w + 2 && c <= 2 * w + 1
-        predicate $ all isWindowColumn (aggrReqCols $(v "afun"))
-
-        return $ do
-            logRewrite "Window.RunningAggr" q
-            -- Shift column references in aggregate functions so that
-            -- they are applied to partition columns.
-            let afun' = aggrToWinFun $ mapAggrFun (mapExprCols (\c -> c - (w + 1))) $(v "afun")
-                
-            void $ replaceWithNew q $ UnOp (WinFun (afun', FAllPreceding)) $(v "qn") |])
-
--- | Employ a window function that maps to SQL's first_value when the
--- 'head' combinator is employed on a nestjoin-generated window.
--- 
--- FIXME this rewrite is currently extremely ugly and fragile: We map
--- directly to first_value which produces only one value, but start
--- with head one potentially broader inputs. To bring them into sync,
--- we demand that only one column is required downstream and produce
--- that column. This involves too much fiddling with column
--- offsets. It would be less dramatic if we had name-based columns
--- (which we should really do).
-firstValueWin :: VLRule Properties
-firstValueWin q =
-  $(dagPatMatch 'q "(UnboxRename (Number (q1))) PropRename (R1 (SelectPos1S selectArgs (R1 ((Number (q2)) NestJoin joinPred (Number (q3))))))"
-    [| do
-        predicate $ $(v "q1") == $(v "q2") && $(v "q1") == $(v "q3")
-
-        inputWidth <- vectorWidth <$> vectorTypeProp <$> bu <$> properties $(v "q1")
-        resWidth   <- vectorWidth <$> vectorTypeProp <$> bu <$> properties $(v "q1")
-
-        VProp (Just [resCol]) <- reqColumnsProp <$> td <$> properties $(v "q")
-
-        -- Perform a sanity check (because this rewrite is rather
-        -- insane): the required column must originate from the inner
-        -- window created by the nestjoin and must not be the
-        -- numbering column.
-        predicate $ resCol > inputWidth + 1
-        predicate $ resCol < 2 * inputWidth + 2
-       
-        -- The evaluation of first_value produces only a single value
-        -- for each input column. To employ first_value, the input has
-        -- to consist of a single column.
-
-        -- We expect the VL representation of 'head'
-        (SBRelOp Eq, 1) <- return $(v "selectArgs")
-  
-        -- We expect a window specification that for each element
-        -- includes its predecessor (if there is one) and the element
-        -- itself.
-        DoubleJoinPred e11 op1 e12 e21 op2 e22                   <- return $(v "joinPred")
-        (SubExpr (Column nrCol) frameOffset, LtE, Column nrCol') <- return (e11, op1, e12)
-        (Column nrCol'', GtE, Column nrCol''')                   <- return (e21, op2, e22)
-        Constant (VLInt offset)                                  <- return frameOffset
-
-        -- Check that all (assumed) numbering columns are actually the
-        -- column added by the Number operator.
-        predicate $ all (== (inputWidth + 1)) [nrCol, nrCol', nrCol'', nrCol''']
-
-        return $ do
-            logRewrite "Window.FirstValue" q
-            let -- The input column for FirstValue is the column in
-                -- the inner window mapped to the input vector's
-                -- layout.
-                inputCol     = resCol - (inputWidth + 1)
-                winArgs      = (WinFirstValue $ Column inputCol, (FNPreceding offset))
-                placeHolders = repeat $ Constant $ VLInt 0xdeadbeef
-  
-                -- Now comes the ugly stuff: to keep the schema intact
-                -- (since columns are referred to by offset), we have
-                -- to keep columns that are not required in place and
-                -- replace them with placeholders.
-                proj         = -- Unreferenced columns in front of the
-                               -- required column
-                               take (resCol - 1) placeHolders 
-                               -- The required column (which is added
-                               -- by WinFun to the input columns
-                               ++ [Column (inputWidth + 1)]
-                               -- Unrefeferenced columns after the
-                               -- required column
-                               ++ take (resWidth - resCol) placeHolders
-            winNode <- insert $ UnOp (WinFun winArgs) $(v "q1")
-            void $ replaceWithNew q $ UnOp (Project proj) winNode |])
-
-inlineWinAggrProject :: VLRule BottomUpProps
-inlineWinAggrProject q =
-  $(dagPatMatch 'q "WinFun args (Project proj (q1))"
-    [| do
-        w <- vectorWidth <$> vectorTypeProp <$> properties $(v "q1")
-
-        return $ do
-            logRewrite "Window.RunningAggr.Project" q
-
-            let (afun, frameSpec) = $(v "args")
-                env               = zip [1..] $(v "proj")
-                -- Inline column expressions from the projection into
-                -- the window function.
-                afun'             = mapWinFun (mergeExpr env) afun
-
-                -- WinAggr /adds/ the window function output to the
-                -- input columns. We have to provide the schema of the
-                -- input projection to which the window function
-                -- output is added.
-                proj' = $(v "proj") ++ [Column $ w + 1]
-
-            winNode <- insert $ UnOp (WinFun (afun', frameSpec)) $(v "q1") 
-            void $ replaceWithNew q $ UnOp (Project proj') winNode |])
diff --git a/src/Database/DSH/Tests.hs b/src/Database/DSH/Tests.hs
new file mode 100644
--- /dev/null
+++ b/src/Database/DSH/Tests.hs
@@ -0,0 +1,47 @@
+-- | Generic DSH test queries that can be run by any backend for
+-- concrete testing.
+module Database.DSH.Tests
+    ( defaultTests
+    , runTests
+    , module Database.DSH.Tests.ComprehensionTests
+    , module Database.DSH.Tests.CombinatorTests
+    ) where
+
+import qualified Data.List                             as L
+import           System.Environment
+
+import           Test.Framework
+
+import           Database.DSH.Backend
+import           Database.DSH.Tests.CombinatorTests
+import           Database.DSH.Tests.ComprehensionTests
+import           Database.DSH.Tests.LawTests
+
+-- | Convenience function for running tests
+runTests :: Backend c => c -> [c -> Test] -> IO ()
+runTests conn tests = do
+    args <- getArgs
+    let args' = if or $ map (L.isPrefixOf "-s") args
+                then args
+                else "-s5":args
+    defaultMainWithArgs (map (\t -> t conn) tests) args'
+
+-- | All available tests in one package.
+defaultTests :: Backend c => [c -> Test]
+defaultTests =
+    [ tests_types
+    , tests_tuples
+    , tests_join_hunit
+    , tests_nest_head_hunit
+    , tests_nest_guard_hunit
+    , tests_combinators_hunit
+    , tests_comprehensions
+    , tests_lifted_joins
+    , tests_boolean
+    , tests_numerics
+    , tests_maybe
+    , tests_either
+    , tests_lists
+    , tests_lifted
+    , tests_laws
+    ]
diff --git a/src/Database/DSH/Tests/CombinatorTests.hs b/src/Database/DSH/Tests/CombinatorTests.hs
new file mode 100644
--- /dev/null
+++ b/src/Database/DSH/Tests/CombinatorTests.hs
@@ -0,0 +1,1237 @@
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE FlexibleInstances     #-}
+{-# LANGUAGE GADTs                 #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TemplateHaskell       #-}
+{-# LANGUAGE TypeFamilies          #-}
+{-# LANGUAGE ViewPatterns          #-}
+
+-- | Tests on individual query combinators.
+module Database.DSH.Tests.CombinatorTests
+    ( tests_types
+    , tests_boolean
+    , tests_tuples
+    , tests_numerics
+    , tests_maybe
+    , tests_either
+    , tests_lists
+    , tests_lifted
+    , tests_combinators_hunit
+    ) where
+
+
+import qualified Data.Decimal                   as D
+import           Data.Either
+import           Data.List
+import           Data.Maybe
+import           Data.Text                      (Text)
+import qualified Data.Time.Calendar             as C
+import           Data.Word
+import           GHC.Exts
+
+import           Test.Framework                 (Test, testGroup)
+import           Test.Framework.Providers.HUnit
+import           Test.HUnit                     (Assertion)
+import           Test.QuickCheck
+
+import qualified Database.DSH                   as Q
+import           Database.DSH.Backend
+import           Database.DSH.Tests.Common
+
+{-
+data D0 = C01 deriving (Eq,Ord,Show)
+
+derive makeArbitrary ''D0
+Q.deriveDSH ''D0
+
+data D1 a = C11 a deriving (Eq,Ord,Show)
+
+derive makeArbitrary ''D1
+Q.deriveDSH ''D1
+
+data D2 a b = C21 a b b a deriving (Eq,Ord,Show)
+
+derive makeArbitrary ''D2
+Q.deriveDSH ''D2
+
+data D3 = C31
+        | C32
+        deriving (Eq,Ord,Show)
+
+derive makeArbitrary ''D3
+Q.deriveDSH ''D3
+
+data D4 a = C41 a
+          | C42
+          deriving (Eq,Ord,Show)
+
+derive makeArbitrary ''D4
+Q.deriveDSH ''D4
+
+data D5 a = C51 a
+          | C52
+          | C53 a a
+          | C54 a a a
+          deriving (Eq,Ord,Show)
+
+derive makeArbitrary ''D5
+Q.deriveDSH ''D5
+
+data D6 a b c d e = C61 { c611 :: a, c612 :: (a,b,c,d) }
+                  | C62
+                  | C63 a b
+                  | C64 (a,b,c)
+                  | C65 a b c d e
+                  deriving (Eq,Ord,Show)
+
+derive makeArbitrary ''D6
+Q.deriveDSH ''D6
+
+-}
+
+tests_types :: Backend c => c -> Test
+tests_types conn = testGroup "Supported Types"
+  [ testPropertyConn conn "()"                        prop_unit
+  , testPropertyConn conn "Bool"                      prop_bool
+  , testPropertyConn conn "Char"                      prop_char
+  , testPropertyConn conn "Text"                      prop_text
+  , testPropertyConn conn "Day"                       prop_day
+  , testPropertyConn conn "Decimal"                   prop_decimal
+  , testPropertyConn conn "Integer"                   prop_integer
+  , testPropertyConn conn "Double"                    prop_double
+  , testPropertyConn conn "[Integer]"                 prop_list_integer_1
+  , testPropertyConn conn "[[Integer]]"               prop_list_integer_2
+  , testPropertyConn conn "[[[Integer]]]"             prop_list_integer_3
+  , testPropertyConn conn "[(Integer, Integer)]"      prop_list_tuple_integer
+  , testPropertyConn conn "([], [])"                  prop_tuple_list_integer
+  , testPropertyConn conn "(,[])"                     prop_tuple_integer_list
+  , testPropertyConn conn "(,[],)"                    prop_tuple_integer_list_integer
+  , testPropertyConn conn "Maybe Integer"             prop_maybe_integer
+  , testPropertyConn conn "Either Integer Integer"    prop_either_integer
+  , testPropertyConn conn "(Int, Int, Int, Int)"      prop_tuple4
+  , testPropertyConn conn "(Int, Int, Int, Int, Int)" prop_tuple5
+{-
+  , testProperty "D0" $ prop_d0
+  , testProperty "D1" $ prop_d1
+  , testProperty "D2" $ prop_d2
+  , testProperty "D3" $ prop_d3
+  , testProperty "D4" $ prop_d4
+  , testProperty "D5" $ prop_d5
+  , testProperty "D6" $ prop_d6
+-}
+  ]
+
+tests_boolean :: Backend c => c -> Test
+tests_boolean conn = testGroup "Equality, Boolean Logic and Ordering"
+    [ testPropertyConn conn "&&"                              prop_infix_and
+    , testPropertyConn conn "||"                              prop_infix_or
+    , testPropertyConn conn "not"                             prop_not
+    , testPropertyConn conn "eq"                              prop_eq
+    , testPropertyConn conn "neq"                             prop_neq
+    , testPropertyConn conn "cond"                            prop_cond
+    , testPropertyConn conn "cond tuples"                     prop_cond_tuples
+    , testPropertyConn conn "cond ([[Integer]], [[Integer]])" prop_cond_list_tuples
+    , testPropertyConn conn "lt"                              prop_lt
+    , testPropertyConn conn "lte"                             prop_lte
+    , testPropertyConn conn "gt"                              prop_gt
+    , testPropertyConn conn "gte"                             prop_gte
+    , testPropertyConn conn "min_integer"                     prop_min_integer
+    , testPropertyConn conn "min_double"                      prop_min_double
+    , testPropertyConn conn "max_integer"                     prop_max_integer
+    , testPropertyConn conn "max_double"                      prop_max_double
+    ]
+
+tests_tuples :: Backend c => c -> Test
+tests_tuples conn = testGroup "Tuples"
+    [ testPropertyConn conn "fst"          prop_fst
+    , testPropertyConn conn "snd"          prop_snd
+    , testPropertyConn conn "fst ([], [])" prop_fst_nested
+    , testPropertyConn conn "snd ([], [])" prop_snd_nested
+    , testPropertyConn conn "tup3_1"       prop_tup3_1
+    , testPropertyConn conn "tup3_2"       prop_tup3_2
+    , testPropertyConn conn "tup3_3"       prop_tup3_3
+    , testPropertyConn conn "tup4_2"       prop_tup4_2
+    , testPropertyConn conn "tup4_4"       prop_tup4_4
+    , testPropertyConn conn "tup3_nested"  prop_tup3_nested
+    , testPropertyConn conn "tup4_tup3"    prop_tup4_tup3
+    ]
+
+tests_numerics :: Backend c => c -> Test
+tests_numerics conn = testGroup "Numerics"
+    [ testPropertyConn conn "add_integer"         prop_add_integer
+    , testPropertyConn conn "add_double"          prop_add_double
+    , testPropertyConn conn "mul_integer"         prop_mul_integer
+    , testPropertyConn conn "mul_double"          prop_mul_double
+    , testPropertyConn conn "div_double"          prop_div_double
+    , testPropertyConn conn "integer_to_double"   prop_integer_to_double
+    , testPropertyConn conn "integer_to_double_+" prop_integer_to_double_arith
+    , testPropertyConn conn "abs_integer"         prop_abs_integer
+    , testPropertyConn conn "abs_double"          prop_abs_double
+    , testPropertyConn conn "signum_integer"      prop_signum_integer
+    , testPropertyConn conn "signum_double"       prop_signum_double
+    , testPropertyConn conn "negate_integer"      prop_negate_integer
+    , testPropertyConn conn "negate_double"       prop_negate_double
+    , testPropertyConn conn "trig_sin"            prop_trig_sin
+    , testPropertyConn conn "trig_cos"            prop_trig_cos
+    , testPropertyConn conn "trig_tan"            prop_trig_tan
+    , testPropertyConn conn "trig_asin"           prop_trig_asin
+    , testPropertyConn conn "trig_acos"           prop_trig_acos
+    , testPropertyConn conn "trig_atan"           prop_trig_atan
+    , testPropertyConn conn "sqrt"                prop_sqrt
+    , testPropertyConn conn "log"                 prop_log
+    , testPropertyConn conn "exp"                 prop_exp
+    ]
+
+tests_maybe :: Backend c => c -> Test
+tests_maybe conn = testGroup "Maybe"
+    [ testPropertyConn conn "maybe"       prop_maybe
+    , testPropertyConn conn "just"        prop_just
+    , testPropertyConn conn "isJust"      prop_isJust
+    , testPropertyConn conn "isNothing"   prop_isNothing
+    , testPropertyConn conn "fromJust"    prop_fromJust
+    , testPropertyConn conn "fromMaybe"   prop_fromMaybe
+    , testPropertyConn conn "listToMaybe" prop_listToMaybe
+    , testPropertyConn conn "maybeToList" prop_maybeToList
+    , testPropertyConn conn "catMaybes"   prop_catMaybes
+    , testPropertyConn conn "mapMaybe"    prop_mapMaybe
+    ]
+
+tests_either :: Backend c => c -> Test
+tests_either conn = testGroup "Either"
+    [ testPropertyConn conn "left"             prop_left
+    , testPropertyConn conn "right"            prop_right
+    , testPropertyConn conn "isLeft"           prop_isLeft
+    , testPropertyConn conn "isRight"          prop_isRight
+    , testPropertyConn conn "either"           prop_either
+    , testPropertyConn conn "lefts"            prop_lefts
+    , testPropertyConn conn "rights"           prop_rights
+    , testPropertyConn conn "partitionEithers" prop_partitionEithers
+    ]
+
+tests_lists :: Backend c => c -> Test
+tests_lists conn = testGroup "Lists"
+    [ testPropertyConn conn "singleton" prop_singleton
+    , testPropertyConn conn "head"                         prop_head
+    , testPropertyConn conn "tail"                         prop_tail
+    , testPropertyConn conn "cons"                         prop_cons
+    , testPropertyConn conn "snoc"                         prop_snoc
+    , testPropertyConn conn "take"                         prop_take
+    , testPropertyConn conn "drop"                         prop_drop
+    , testPropertyConn conn "take ++ drop"                 prop_takedrop
+    , testPropertyConn conn "map"                          prop_map
+    , testPropertyConn conn "filter"                       prop_filter
+    , testPropertyConn conn "filter > 42"                  prop_filter_gt
+    , testPropertyConn conn "filter > 42 (,[])"            prop_filter_gt_nested
+    , testPropertyConn conn "the"                          prop_the
+    , testPropertyConn conn "last"                         prop_last
+    , testPropertyConn conn "init"                         prop_init
+    , testPropertyConn conn "null"                         prop_null
+    , testPropertyConn conn "length"                       prop_length
+    , testPropertyConn conn "length tuple list"            prop_length_tuple
+    , testPropertyConn conn "index [Integer]"              prop_index
+    , testPropertyConn conn "index [(Integer, [Integer])]" prop_index_pair
+    , testPropertyConn conn "index [[]]"                   prop_index_nest
+    , testPropertyConn conn "reverse"                      prop_reverse
+    , testPropertyConn conn "reverse [[]]"                 prop_reverse_nest
+    , testPropertyConn conn "append"                       prop_append
+    , testPropertyConn conn "append nest"                  prop_append_nest
+    , testPropertyConn conn "groupWith"                    prop_groupWith
+    , testPropertyConn conn "groupWithKey"                 prop_groupWithKey
+    , testPropertyConn conn "groupWith length"             prop_groupWith_length
+    , testPropertyConn conn "groupWithKey length"          prop_groupWithKey_length
+    , testPropertyConn conn "sortWith"                     prop_sortWith
+    , testPropertyConn conn "sortWith [(,)]"               prop_sortWith_pair
+    , testPropertyConn conn "sortWith [(,[])]"             prop_sortWith_nest
+    , testPropertyConn conn "and"                          prop_and
+    , testPropertyConn conn "or"                           prop_or
+    , testPropertyConn conn "any_zero"                     prop_any_zero
+    , testPropertyConn conn "all_zero"                     prop_all_zero
+    , testPropertyConn conn "sum_integer"                  prop_sum_integer
+    , testPropertyConn conn "sum_double"                   prop_sum_double
+    , testPropertyConn conn "avg_double"                   prop_avg_double
+    , testPropertyConn conn "concat"                       prop_concat
+    , testPropertyConn conn "concatMap"                    prop_concatMap
+    , testPropertyConn conn "maximum"                      prop_maximum
+    , testPropertyConn conn "minimum"                      prop_minimum
+    , testPropertyConn conn "splitAt"                      prop_splitAt
+    , testPropertyConn conn "takeWhile"                    prop_takeWhile
+    , testPropertyConn conn "dropWhile"                    prop_dropWhile
+    , testPropertyConn conn "span"                         prop_span
+    , testPropertyConn conn "break"                        prop_break
+    , testPropertyConn conn "elem"                         prop_elem
+    , testPropertyConn conn "notElem"                      prop_notElem
+    , testPropertyConn conn "lookup"                       prop_lookup
+    , testPropertyConn conn "zip"                          prop_zip
+    , testPropertyConn conn "zip tuple1"                   prop_zip_tuple1
+    , testPropertyConn conn "zip tuple2"                   prop_zip_tuple2
+    , testPropertyConn conn "zip nested"                   prop_zip_nested
+    , testPropertyConn conn "zip3"                         prop_zip3
+    , testPropertyConn conn "zipWith"                      prop_zipWith
+    , testPropertyConn conn "zipWith3"                     prop_zipWith3
+    , testPropertyConn conn "unzip"                        prop_unzip
+    , testPropertyConn conn "unzip3"                       prop_unzip3
+    , testPropertyConn conn "nub"                          prop_nub
+    , testPropertyConn conn "number"                       prop_number
+    ]
+
+tests_lifted :: Backend c => c -> Test
+tests_lifted conn = testGroup "Lifted operations"
+    [ testPropertyConn conn "Lifted &&"                             prop_infix_map_and
+    , testPropertyConn conn "Lifted ||"                             prop_infix_map_or
+    , testPropertyConn conn "Lifted not"                            prop_map_not
+    , testPropertyConn conn "Lifted eq"                             prop_map_eq
+    , testPropertyConn conn "Lifted neq"                            prop_map_neq
+    , testPropertyConn conn "Lifted cond"                           prop_map_cond
+    , testPropertyConn conn "Lifted cond tuples"                    prop_map_cond_tuples
+    , testPropertyConn conn "Lifted cond + concat"                  prop_concatmapcond
+    , testPropertyConn conn "Lifted lt"                             prop_map_lt
+    , testPropertyConn conn "Lifted lte"                            prop_map_lte
+    , testPropertyConn conn "Lifted gt"                             prop_map_gt
+    , testPropertyConn conn "Lifted gte"                            prop_map_gte
+    , testPropertyConn conn "Lifted cons"                           prop_map_cons
+    , testPropertyConn conn "Lifted concat"                         prop_map_concat
+    , testPropertyConn conn "Lifted fst"                            prop_map_fst
+    , testPropertyConn conn "Lifted snd"                            prop_map_snd
+    , testPropertyConn conn "Lifted the"                            prop_map_the
+    --, testPropertyConn conn "Lifed and"                           prop_map_and
+    , testPropertyConn conn "map (map (*2))"                        prop_map_map_mul
+    , testPropertyConn conn "map (map (map (*2)))"                  prop_map_map_map_mul
+    , testPropertyConn conn "map (\\x -> map (\\y -> x + y) ..) .." prop_map_map_add
+    , testPropertyConn conn "Lifted groupWith"                      prop_map_groupWith
+    , testPropertyConn conn "Lifted groupWithKey"                   prop_map_groupWithKey
+    , testPropertyConn conn "Lifted sortWith"                       prop_map_sortWith
+    , testPropertyConn conn "Lifted sortWith [(,)]"                 prop_map_sortWith_pair
+    , testPropertyConn conn "Lifted sortWith [(,[])]"               prop_map_sortWith_nest
+    , testPropertyConn conn "Lifted sortWith length"                prop_map_sortWith_length
+    , testPropertyConn conn "Lifted groupWithKey length"            prop_map_groupWithKey_length
+    , testPropertyConn conn "Lifted length"                         prop_map_length
+    , testPropertyConn conn "Lifted length on [[(a,b)]]"            prop_map_length_tuple
+    , testPropertyConn conn "Sortwith length nested"                prop_sortWith_length_nest
+    , testPropertyConn conn "GroupWithKey length nested"            prop_groupWithKey_length_nest
+    , testPropertyConn conn "Lift minimum"                          prop_map_minimum
+    , testPropertyConn conn "map (map minimum)"                     prop_map_map_minimum
+    , testPropertyConn conn "Lift maximum"                          prop_map_maximum
+    , testPropertyConn conn "map (map maximum)"                     prop_map_map_maximum
+    , testPropertyConn conn "map integer_to_double"                 prop_map_integer_to_double
+    , testPropertyConn conn "map tail"                              prop_map_tail
+    , testPropertyConn conn "map unzip"                             prop_map_unzip
+    , testPropertyConn conn "map reverse"                           prop_map_reverse
+    , testPropertyConn conn "map reverse [[]]"                      prop_map_reverse_nest
+    , testPropertyConn conn "map and"                               prop_map_and
+    , testPropertyConn conn "map (map and)"                         prop_map_map_and
+    , testPropertyConn conn "map sum"                               prop_map_sum
+    , testPropertyConn conn "map avg"                               prop_map_avg
+    , testPropertyConn conn "map (map sum)"                         prop_map_map_sum
+    , testPropertyConn conn "map or"                                prop_map_or
+    , testPropertyConn conn "map (map or)"                          prop_map_map_or
+    , testPropertyConn conn "map any zero"                          prop_map_any_zero
+    , testPropertyConn conn "map all zero"                          prop_map_all_zero
+    , testPropertyConn conn "map filter"                            prop_map_filter
+    , testPropertyConn conn "map filter > 42"                       prop_map_filter_gt
+    , testPropertyConn conn "map filter > 42 (,[])"                 prop_map_filter_gt_nested
+    , testPropertyConn conn "map append"                            prop_map_append
+    , testPropertyConn conn "map index"                             prop_map_index
+    , testPropertyConn conn "map index [[]]"                        prop_map_index_nest
+    , testPropertyConn conn "map init"                              prop_map_init
+    , testPropertyConn conn "map last"                              prop_map_last
+    , testPropertyConn conn "map null"                              prop_map_null
+    , testPropertyConn conn "map nub"                               prop_map_nub
+    , testPropertyConn conn "map snoc"                              prop_map_snoc
+    , testPropertyConn conn "map take"                              prop_map_take
+    , testPropertyConn conn "map drop"                              prop_map_drop
+    , testPropertyConn conn "map zip"                               prop_map_zip
+    , testPropertyConn conn "map takeWhile"                         prop_map_takeWhile
+    , testPropertyConn conn "map dropWhile"                         prop_map_dropWhile
+    , testPropertyConn conn "map span"                              prop_map_span
+    , testPropertyConn conn "map break"                             prop_map_break
+    , testPropertyConn conn "map number"                            prop_map_number
+    , testPropertyConn conn "map sin"                               prop_map_trig_sin
+    , testPropertyConn conn "map cos"                               prop_map_trig_cos
+    , testPropertyConn conn "map tan"                               prop_map_trig_tan
+    , testPropertyConn conn "map asin"                              prop_map_trig_asin
+    , testPropertyConn conn "map acos"                              prop_map_trig_acos
+    , testPropertyConn conn "map atan"                              prop_map_trig_atan
+    , testPropertyConn conn "map log"                               prop_map_log
+    , testPropertyConn conn "map exp"                               prop_map_exp
+    , testPropertyConn conn "map sqrt"                              prop_map_sqrt
+    ]
+
+tests_combinators_hunit :: Backend c => c -> Test
+tests_combinators_hunit conn = testGroup "HUnit combinators"
+    [ testCase "hnegative_sum"     (hnegative_sum conn)
+    , testCase "hnegative_map_sum" (hnegative_map_sum conn)
+    ]
+
+-- * Supported Types
+
+prop_unit :: Backend c => () -> c -> Property
+prop_unit = makePropEq id id
+
+prop_bool :: Backend c => Bool -> c -> Property
+prop_bool = makePropEq id id
+
+prop_integer :: Backend c => Integer -> c -> Property
+prop_integer = makePropEq id id
+
+prop_double :: Backend c => Double -> c -> Property
+prop_double = makePropDouble id id
+
+prop_char :: Backend c => Char -> c -> Property
+prop_char c conn = c /= '\0' ==> makePropEq id id c conn
+
+prop_text :: Backend c => Text -> c -> Property
+prop_text t conn = makePropEq id id (filterNullChar t) conn
+
+prop_day :: Backend c => C.Day -> c -> Property
+prop_day d conn = makePropEq id id d conn
+
+prop_decimal :: Backend c => (Positive Word8, Integer) -> c -> Property
+prop_decimal (p, m) conn = makePropEq id id (D.Decimal (getPositive p) m) conn
+
+prop_list_integer_1 :: Backend c => [Integer] -> c -> Property
+prop_list_integer_1 = makePropEq id id
+
+prop_list_integer_2 :: Backend c => [[Integer]] -> c -> Property
+prop_list_integer_2 = makePropEq id id
+
+prop_list_integer_3 :: Backend c => [[[Integer]]] -> c -> Property
+prop_list_integer_3 = makePropEq id id
+
+prop_list_tuple_integer :: Backend c => [(Integer, Integer)] -> c -> Property
+prop_list_tuple_integer = makePropEq id id
+
+prop_maybe_integer :: Backend c => Maybe Integer -> c -> Property
+prop_maybe_integer = makePropEq id id
+
+prop_tuple_list_integer :: Backend c => ([Integer], [Integer]) -> c -> Property
+prop_tuple_list_integer = makePropEq id id
+
+prop_tuple_integer_list :: Backend c => (Integer, [Integer]) -> c -> Property
+prop_tuple_integer_list = makePropEq id id
+
+prop_tuple_integer_list_integer :: Backend c => (Integer, [Integer], Integer) -> c -> Property
+prop_tuple_integer_list_integer = makePropEq id id
+
+prop_either_integer :: Backend c => Either Integer Integer -> c -> Property
+prop_either_integer = makePropEq id id
+
+prop_tuple4 :: Backend c => [(Integer, Integer, Integer, Integer)] -> c -> Property
+prop_tuple4 = makePropEq (Q.map (\(Q.view -> (a, b, c, d)) -> Q.tup4 (a + c) (b - d) b d))
+                         (map (\(a, b, c, d) -> (a + c, b - d, b, d)))
+
+prop_tuple5 :: Backend c => [(Integer, Integer, Integer, Integer, Integer)] -> c -> Property
+prop_tuple5 = makePropEq (Q.map (\(Q.view -> (a, _, c, _, e)) -> Q.tup3 a c e))
+                         (map (\(a, _, c, _, e) -> (a, c, e)))
+
+-- {-
+
+-- prop_d0 :: Backend c => D0 -> c -> Property
+-- prop_d0 = makePropEq id id
+
+-- prop_d1 :: Backend c => D1 Integer -> c -> Property
+-- prop_d1 = makePropEq id id
+
+-- prop_d2 :: Backend c => D2 Integer Integer -> c -> Property
+-- prop_d2 = makePropEq id id
+
+-- prop_d3 :: Backend c => D3 -> c -> Property
+-- prop_d3 = makePropEq id id
+
+-- prop_d4 :: Backend c => D4 Integer -> c -> Property
+-- prop_d4 = makePropEq id id
+
+-- prop_d5 :: Backend c => D5 Integer -> c -> Property
+-- prop_d5 = makePropEq id id
+
+-- prop_d6 :: Backend c => D6 Integer Integer Integer Integer Integer -> c -> Property
+-- prop_d6 = makePropEq id id
+
+-- -}
+
+-- * Equality, Boolean Logic and Ordering
+
+prop_infix_and :: Backend c => (Bool,Bool) -> c -> Property
+prop_infix_and = makePropEq (uncurryQ (Q.&&)) (uncurry (&&))
+
+prop_infix_map_and :: Backend c => (Bool, [Bool]) -> c -> Property
+prop_infix_map_and = makePropEq (\x -> Q.map ((Q.fst x) Q.&&) $ Q.snd x) (\(x,xs) -> map (x &&) xs)
+
+prop_infix_or :: Backend c => (Bool,Bool) -> c -> Property
+prop_infix_or = makePropEq (uncurryQ (Q.||)) (uncurry (||))
+
+prop_infix_map_or :: Backend c => (Bool, [Bool]) -> c -> Property
+prop_infix_map_or = makePropEq (\x -> Q.map ((Q.fst x) Q.||) $ Q.snd x) (\(x,xs) -> map (x ||) xs)
+
+prop_not :: Backend c => Bool -> c -> Property
+prop_not = makePropEq Q.not not
+
+prop_map_not :: Backend c => [Bool] -> c -> Property
+prop_map_not = makePropEq (Q.map Q.not) (map not)
+
+prop_eq :: Backend c => (Integer,Integer) -> c -> Property
+prop_eq = makePropEq (uncurryQ (Q.==)) (uncurry (==))
+
+prop_map_eq :: Backend c => (Integer, [Integer]) -> c -> Property
+prop_map_eq = makePropEq (\x -> Q.map ((Q.fst x) Q.==) $ Q.snd x) (\(x,xs) -> map (x ==) xs)
+
+prop_neq :: Backend c => (Integer,Integer) -> c -> Property
+prop_neq = makePropEq (uncurryQ (Q./=)) (uncurry (/=))
+
+prop_map_neq :: Backend c => (Integer, [Integer]) -> c -> Property
+prop_map_neq = makePropEq (\x -> Q.map ((Q.fst x) Q./=) $ Q.snd x) (\(x,xs) -> map (x /=) xs)
+
+prop_cond :: Backend c => Bool -> c -> Property
+prop_cond = makePropEq (\b -> Q.cond b 0 1) (\b -> if b then (0 :: Integer) else 1)
+
+prop_cond_tuples :: Backend c => (Bool, (Integer, Integer)) -> c -> Property
+prop_cond_tuples = makePropEq (\b -> Q.cond (Q.fst b)
+                                          (Q.pair (Q.fst $ Q.snd b) (Q.fst $ Q.snd b))
+                                          (Q.pair (Q.snd $ Q.snd b) (Q.snd $ Q.snd b)))
+                            (\b -> if fst b
+                                   then (fst $ snd b, fst $ snd b)
+                                   else (snd $ snd b, snd $ snd b))
+
+prop_cond_list_tuples :: Backend c => (Bool, ([[Integer]], [[Integer]])) -> c -> Property
+prop_cond_list_tuples = makePropEq (\b -> Q.cond (Q.fst b)
+                                               (Q.pair (Q.fst $ Q.snd b) (Q.fst $ Q.snd b))
+                                               (Q.pair (Q.snd $ Q.snd b) (Q.snd $ Q.snd b)))
+                                 (\b -> if fst b
+                                        then (fst $ snd b, fst $ snd b)
+                                        else (snd $ snd b, snd $ snd b))
+
+prop_map_cond :: Backend c => [Bool] -> c -> Property
+prop_map_cond = makePropEq (Q.map (\b -> Q.cond b (0 :: Q.Q Integer) 1))
+                         (map (\b -> if b then 0 else 1))
+
+prop_map_cond_tuples :: Backend c => [Bool] -> c -> Property
+prop_map_cond_tuples = makePropEq (Q.map (\b -> Q.cond b
+                                                     (Q.toQ (0, 10) :: Q.Q (Integer, Integer))
+                                                     (Q.toQ (1, 11))))
+                                (map (\b -> if b
+                                            then (0, 10)
+                                            else (1, 11)))
+
+prop_concatmapcond :: Backend c => [Integer] -> c -> Property
+prop_concatmapcond l1 conn =
+    makePropEq q n l1 conn
+        where q l = Q.concatMap (\x -> Q.cond ((Q.>) x (Q.toQ 0)) (x Q.<| el) el) l
+              n l = concatMap (\x -> if x > 0 then [x] else []) l
+              el = Q.toQ []
+
+prop_lt :: Backend c => (Integer, Integer) -> c -> Property
+prop_lt = makePropEq (uncurryQ (Q.<)) (uncurry (<))
+
+prop_map_lt :: Backend c => (Integer, [Integer]) -> c -> Property
+prop_map_lt = makePropEq (\x -> Q.map ((Q.fst x) Q.<) $ Q.snd x) (\(x,xs) -> map (x <) xs)
+
+prop_lte :: Backend c => (Integer, Integer) -> c -> Property
+prop_lte = makePropEq (uncurryQ (Q.<=)) (uncurry (<=))
+
+prop_map_lte :: Backend c => (Integer, [Integer]) -> c -> Property
+prop_map_lte = makePropEq (\x -> Q.map ((Q.fst x) Q.<=) $ Q.snd x) (\(x,xs) -> map (x <=) xs)
+
+prop_gt :: Backend c => (Integer, Integer) -> c -> Property
+prop_gt = makePropEq (uncurryQ (Q.>)) (uncurry (>))
+
+prop_map_gt :: Backend c => (Integer, [Integer]) -> c -> Property
+prop_map_gt = makePropEq (\x -> Q.map ((Q.fst x) Q.>) $ Q.snd x) (\(x,xs) -> map (x >) xs)
+
+prop_gte :: Backend c => (Integer, Integer) -> c -> Property
+prop_gte = makePropEq (uncurryQ (Q.>=)) (uncurry (>=))
+
+prop_map_gte :: Backend c => (Integer, [Integer]) -> c -> Property
+prop_map_gte = makePropEq (\x -> Q.map ((Q.fst x) Q.>=) $ Q.snd x) (\(x,xs) -> map (x >=) xs)
+
+prop_min_integer :: Backend c => (Integer,Integer) -> c -> Property
+prop_min_integer = makePropEq (uncurryQ Q.min) (uncurry min)
+
+prop_max_integer :: Backend c => (Integer,Integer) -> c -> Property
+prop_max_integer = makePropEq (uncurryQ Q.max) (uncurry max)
+
+prop_min_double :: Backend c => (Double,Double) -> c -> Property
+prop_min_double = makePropDouble (uncurryQ Q.min) (uncurry min)
+
+prop_max_double :: Backend c => (Double,Double) -> c -> Property
+prop_max_double = makePropDouble (uncurryQ Q.max) (uncurry max)
+
+-- * Maybe
+
+prop_maybe :: Backend c => (Integer, Maybe Integer) -> c -> Property
+prop_maybe =  makePropEq (\a -> Q.maybe (Q.fst a) id (Q.snd a)) (\(i,mi) -> maybe i id mi)
+
+prop_just :: Backend c => Integer -> c -> Property
+prop_just = makePropEq Q.just Just
+
+prop_isJust :: Backend c => Maybe Integer -> c -> Property
+prop_isJust = makePropEq Q.isJust isJust
+
+prop_isNothing :: Backend c => Maybe Integer -> c -> Property
+prop_isNothing = makePropEq Q.isNothing isNothing
+
+prop_fromJust :: Backend c => Integer -> c -> Property
+prop_fromJust i conn = makePropEq Q.fromJust fromJust (Just i) conn
+
+prop_fromMaybe :: Backend c => (Integer,Maybe Integer) -> c -> Property
+prop_fromMaybe = makePropEq (uncurryQ Q.fromMaybe) (uncurry fromMaybe)
+
+prop_listToMaybe :: Backend c => [Integer] -> c -> Property
+prop_listToMaybe = makePropEq Q.listToMaybe listToMaybe
+
+prop_maybeToList :: Backend c => Maybe Integer -> c -> Property
+prop_maybeToList = makePropEq Q.maybeToList maybeToList
+
+prop_catMaybes :: Backend c => [Maybe Integer] -> c -> Property
+prop_catMaybes = makePropEq Q.catMaybes catMaybes
+
+prop_mapMaybe :: Backend c => [Maybe Integer] -> c -> Property
+prop_mapMaybe = makePropEq (Q.mapMaybe id) (mapMaybe id)
+
+-- * Either
+
+prop_left :: Backend c => Integer -> c -> Property
+prop_left = makePropEq (Q.left :: Q.Q Integer -> Q.Q (Either Integer Integer)) Left
+
+prop_right :: Backend c => Integer -> c -> Property
+prop_right = makePropEq (Q.right :: Q.Q Integer -> Q.Q (Either Integer Integer)) Right
+
+prop_isLeft :: Backend c => Either Integer Integer -> c -> Property
+prop_isLeft = makePropEq Q.isLeft (\e -> case e of {Left _ -> True; Right _ -> False;})
+
+prop_isRight :: Backend c => Either Integer Integer -> c -> Property
+prop_isRight = makePropEq Q.isRight (\e -> case e of {Left _ -> False; Right _ -> True;})
+
+prop_either :: Backend c => Either Integer Integer -> c -> Property
+prop_either =  makePropEq (Q.either id id) (either id id)
+
+prop_lefts :: Backend c => [Either Integer Integer] -> c -> Property
+prop_lefts =  makePropEq Q.lefts lefts
+
+prop_rights :: Backend c => [Either Integer Integer] -> c -> Property
+prop_rights =  makePropEq Q.rights rights
+
+prop_partitionEithers :: Backend c => [Either Integer Integer] -> c -> Property
+prop_partitionEithers =  makePropEq Q.partitionEithers partitionEithers
+
+-- * Lists
+
+prop_cons :: Backend c => (Integer, [Integer]) -> c -> Property
+prop_cons = makePropEq (uncurryQ (Q.<|)) (uncurry (:))
+
+prop_map_cons :: Backend c => (Integer, [[Integer]]) -> c -> Property
+prop_map_cons = makePropEq (\x -> Q.map ((Q.fst x) Q.<|) $ Q.snd x)
+                         (\(x,xs) -> map (x:) xs)
+
+prop_snoc :: Backend c => ([Integer], Integer) -> c -> Property
+prop_snoc = makePropEq (uncurryQ (Q.|>)) (\(a,b) -> a ++ [b])
+
+prop_map_snoc :: Backend c => ([Integer], [Integer]) -> c -> Property
+prop_map_snoc = makePropEq (\z -> Q.map ((Q.fst z) Q.|>) (Q.snd z)) (\(a,b) -> map (\z -> a ++ [z]) b)
+
+prop_singleton :: Backend c => Integer -> c -> Property
+prop_singleton = makePropEq Q.singleton (: [])
+
+prop_head :: Backend c => NonEmptyList Integer -> c -> Property
+prop_head (NonEmpty is) = makePropEq Q.head head is
+
+prop_tail :: Backend c => NonEmptyList Integer -> c -> Property
+prop_tail (NonEmpty is) = makePropEq Q.tail tail is
+
+prop_last :: Backend c => NonEmptyList Integer -> c -> Property
+prop_last (NonEmpty is) = makePropEq Q.last last is
+
+prop_map_last :: Backend c => [NonEmptyList Integer] -> c -> Property
+prop_map_last ps =
+    makePropEq (Q.map Q.last) (map last) (map getNonEmpty ps)
+
+prop_init :: Backend c => NonEmptyList Integer -> c -> Property
+prop_init (NonEmpty is) = makePropEq Q.init init is
+
+prop_map_init  :: Backend c => [NonEmptyList Integer] -> c -> Property
+prop_map_init ps =
+    makePropEq (Q.map Q.init) (map init) (map getNonEmpty ps)
+
+prop_the   :: Backend c => (Positive Int, Integer) -> c -> Property
+prop_the (n, i) conn =
+    let l = replicate (getPositive n) i
+    in makePropEq Q.head the l conn
+
+prop_map_the :: Backend c => [(Positive Int, Integer)] -> c -> Property
+prop_map_the ps conn =
+    let xss = map (\(Positive n, i) -> replicate n i) ps
+    in makePropEq (Q.map Q.head) (map the) xss conn
+
+prop_map_tail :: Backend c => [NonEmptyList Integer] -> c -> Property
+prop_map_tail ps conn =
+    makePropEq (Q.map Q.tail) (map tail) (map getNonEmpty ps) conn
+
+prop_index :: Backend c => ([Integer], NonNegative Integer)  -> c -> Property
+prop_index (l, NonNegative i) conn =
+    i < fromIntegral (length l)
+    ==>
+    makePropEq (uncurryQ (Q.!!))
+               (\(a,b) -> a !! fromIntegral b)
+               (l, i)
+               conn
+
+prop_index_pair :: Backend c => ([(Integer, [Integer])], NonNegative Integer) -> c -> Property
+prop_index_pair (l, NonNegative i) conn =
+    i < fromIntegral (length l)
+    ==>
+    makePropEq (uncurryQ (Q.!!))
+               (\(a,b) -> a !! fromIntegral b)
+               (l, i)
+               conn
+
+prop_index_nest :: Backend c => ([[Integer]], NonNegative Integer)  -> c -> Property
+prop_index_nest (l, NonNegative i) conn =
+    i < fromIntegral (length l)
+    ==>
+    makePropEq (uncurryQ (Q.!!))
+               (\(a,b) -> a !! fromIntegral b)
+               (l, i)
+               conn
+
+prop_map_index :: Backend c => ([Integer], [NonNegative Integer])  -> c -> Property
+prop_map_index (l, is) conn =
+    and [i < 3 * fromIntegral (length l) | NonNegative i <-  is]
+    ==>
+    makePropEq (\z -> Q.map (((Q.fst z) Q.++ (Q.fst z) Q.++ (Q.fst z)) Q.!!)
+                            (Q.snd z))
+               (\(a,b) -> map ((a ++ a ++ a) !!)
+                              (map fromIntegral b))
+               (l, map getNonNegative is)
+               conn
+
+prop_map_index_nest :: Backend c => ([[Integer]], [NonNegative Integer])  -> c -> Property
+prop_map_index_nest (l, is) conn =
+    and [i < 3 * fromIntegral (length l) | NonNegative i <-  is]
+    ==> makePropEq (\z -> Q.map (((Q.fst z) Q.++ (Q.fst z) Q.++ (Q.fst z)) Q.!!)
+                                (Q.snd z))
+                   (\(a,b) -> map ((a ++ a ++ a) !!) (map fromIntegral b))
+                   (l, map getNonNegative is)
+                   conn
+
+prop_take :: Backend c => (Integer, [Integer]) -> c -> Property
+prop_take = makePropEq (uncurryQ Q.take) (\(n,l) -> take (fromIntegral n) l)
+
+prop_map_take :: Backend c => (Integer, [[Integer]]) -> c -> Property
+prop_map_take = makePropEq (\z -> Q.map (Q.take $ Q.fst z) $ Q.snd z)
+                           (\(n,l) -> map (take (fromIntegral n)) l)
+
+prop_drop :: Backend c => (Integer, [Integer]) -> c -> Property
+prop_drop = makePropEq (uncurryQ Q.drop) (\(n,l) -> drop (fromIntegral n) l)
+
+prop_map_drop :: Backend c => (Integer, [[Integer]]) -> c -> Property
+prop_map_drop = makePropEq (\z -> Q.map (Q.drop $ Q.fst z) $ Q.snd z)
+                           (\(n,l) -> map (drop (fromIntegral n)) l)
+
+prop_takedrop :: Backend c => (Integer, [Integer]) -> c -> Property
+prop_takedrop = makePropEq takedrop_q takedrop
+  where
+    takedrop_q p    = Q.append ((Q.take (Q.fst p)) (Q.snd p))
+                               ((Q.drop (Q.fst p)) (Q.snd p))
+    takedrop (n, l) = (take (fromIntegral n) l)
+                      ++
+                      (drop (fromIntegral n) l)
+
+prop_map :: Backend c => [Integer] -> c -> Property
+prop_map = makePropEq (Q.map id) (map id)
+
+prop_map_map_mul :: Backend c => [[Integer]] -> c -> Property
+prop_map_map_mul = makePropEq (Q.map (Q.map (*2))) (map (map (*2)))
+
+prop_map_map_add :: Backend c => ([Integer], [Integer]) -> c -> Property
+prop_map_map_add = makePropEq (\z -> Q.map (\x -> (Q.map (\y -> x + y) $ Q.snd z))
+                                           (Q.fst z))
+                              (\(l,r) -> map (\x -> map (\y -> x + y) r) l)
+
+prop_map_map_map_mul :: Backend c => [[[Integer]]] -> c -> Property
+prop_map_map_map_mul = makePropEq (Q.map (Q.map (Q.map (*2)))) (map (map (map (*2))))
+
+prop_append :: Backend c => ([Integer], [Integer]) -> c -> Property
+prop_append = makePropEq (uncurryQ (Q.++)) (uncurry (++))
+
+prop_append_nest :: Backend c => ([[Integer]], [[Integer]]) -> c -> Property
+prop_append_nest = makePropEq (uncurryQ (Q.append)) (\(a,b) -> a ++ b)
+
+prop_map_append :: Backend c => ([Integer], [[Integer]]) -> c -> Property
+prop_map_append = makePropEq (\z -> Q.map (Q.fst z Q.++) (Q.snd z)) (\(a,b) -> map (a ++) b)
+
+prop_filter :: Backend c => [Integer] -> c -> Property
+prop_filter = makePropEq (Q.filter (const $ Q.toQ True)) (filter $ const True)
+
+prop_filter_gt :: Backend c => [Integer] -> c -> Property
+prop_filter_gt = makePropEq (Q.filter (Q.> 42)) (filter (> 42))
+
+prop_filter_gt_nested :: Backend c => [(Integer, [Integer])] -> c -> Property
+prop_filter_gt_nested = makePropEq (Q.filter ((Q.> 42) . Q.fst)) (filter ((> 42) . fst))
+
+prop_map_filter :: Backend c => [[Integer]] -> c -> Property
+prop_map_filter = makePropEq (Q.map (Q.filter (const $ Q.toQ True))) (map (filter $ const True))
+
+prop_map_filter_gt :: Backend c => [[Integer]] -> c -> Property
+prop_map_filter_gt = makePropEq (Q.map (Q.filter (Q.> 42))) (map (filter (> 42)))
+
+prop_map_filter_gt_nested :: Backend c => [[(Integer, [Integer])]] -> c -> Property
+prop_map_filter_gt_nested = makePropEq (Q.map (Q.filter ((Q.> 42) . Q.fst))) (map (filter ((> 42) . fst)))
+
+prop_groupWith :: Backend c => [Integer] -> c -> Property
+prop_groupWith = makePropEq (Q.groupWith id) (groupWith id)
+
+groupWithKey :: Ord b => (a -> b) -> [a] -> [(b, [a])]
+groupWithKey p as = map (\g -> (the $ map p g, g)) $ groupWith p as
+
+prop_groupWithKey :: Backend c => [Integer] -> c -> Property
+prop_groupWithKey = makePropEq (Q.groupWithKey id) (groupWithKey id)
+
+prop_map_groupWith :: Backend c => [[Integer]] -> c -> Property
+prop_map_groupWith = makePropEq (Q.map (Q.groupWith id)) (map (groupWith id))
+
+prop_map_groupWithKey :: Backend c => [[Integer]] -> c -> Property
+prop_map_groupWithKey = makePropEq (Q.map (Q.groupWithKey id)) (map (groupWithKey id))
+
+prop_groupWith_length :: Backend c => [[Integer]] -> c -> Property
+prop_groupWith_length = makePropEq (Q.groupWith Q.length) (groupWith length)
+
+prop_groupWithKey_length :: Backend c => [[Integer]] -> c -> Property
+prop_groupWithKey_length = makePropEq (Q.groupWithKey Q.length) (groupWithKey (fromIntegral . length))
+
+prop_sortWith  :: Backend c => [Integer] -> c -> Property
+prop_sortWith = makePropEq (Q.sortWith id) (sortWith id)
+
+prop_sortWith_pair :: Backend c => [(Integer, Integer)] -> c -> Property
+prop_sortWith_pair = makePropEq (Q.sortWith Q.fst) (sortWith fst)
+
+prop_sortWith_nest  :: Backend c => [(Integer, [Integer])] -> c -> Property
+prop_sortWith_nest = makePropEq (Q.sortWith Q.fst) (sortWith fst)
+
+prop_map_sortWith :: Backend c => [[Integer]] -> c -> Property
+prop_map_sortWith = makePropEq (Q.map (Q.sortWith id)) (map (sortWith id))
+
+prop_map_sortWith_pair :: Backend c => [[(Integer, Integer)]] -> c -> Property
+prop_map_sortWith_pair = makePropEq (Q.map (Q.sortWith Q.fst)) (map (sortWith fst))
+
+prop_map_sortWith_nest :: Backend c => [[(Integer, [Integer])]] -> c -> Property
+prop_map_sortWith_nest = makePropEq (Q.map (Q.sortWith Q.fst)) (map (sortWith fst))
+
+prop_map_sortWith_length :: Backend c => [[[Integer]]] -> c -> Property
+prop_map_sortWith_length = makePropEq (Q.map (Q.sortWith Q.length)) (map (sortWith length))
+
+-- prop_map_groupWith_length :: Backend c => [[[Integer]]] -> c -> Property
+-- prop_map_groupWith_length = makePropEq (Q.map (Q.groupWith Q.length)) (map (groupWith length))
+
+prop_map_groupWithKey_length :: Backend c => [[[Integer]]] -> c -> Property
+prop_map_groupWithKey_length = makePropEq (Q.map (Q.groupWithKey Q.length)) (map (groupWithKey (fromIntegral . length)))
+
+prop_sortWith_length_nest  :: Backend c => [[[Integer]]] -> c -> Property
+prop_sortWith_length_nest = makePropEq (Q.sortWith Q.length) (sortWith length)
+
+-- prop_groupWith_length_nest :: Backend c => [[[Integer]]] -> c -> Property
+-- prop_groupWith_length_nest = makePropEq (Q.groupWith Q.length) (groupWith length)
+
+prop_groupWithKey_length_nest :: Backend c => [[[Integer]]] -> c -> Property
+prop_groupWithKey_length_nest = makePropEq (Q.groupWithKey Q.length) (groupWithKey (fromIntegral . length))
+
+prop_null :: Backend c => [Integer] -> c -> Property
+prop_null = makePropEq Q.null null
+
+prop_map_null :: Backend c => [[Integer]] -> c -> Property
+prop_map_null = makePropEq (Q.map Q.null) (map null)
+
+prop_length :: Backend c => [Integer] -> c -> Property
+prop_length = makePropEq Q.length ((fromIntegral :: Int -> Integer) . length)
+
+prop_length_tuple :: Backend c => [(Integer, Integer)] -> c -> Property
+prop_length_tuple = makePropEq Q.length (fromIntegral . length)
+
+prop_map_length :: Backend c => [[Integer]] -> c -> Property
+prop_map_length = makePropEq (Q.map Q.length) (map (fromIntegral . length))
+
+prop_map_minimum :: Backend c => [NonEmptyList Integer] -> c -> Property
+prop_map_minimum ps conn =
+    makePropEq (Q.map Q.minimum)
+               (map (fromIntegral . minimum))
+               (map getNonEmpty ps)
+               conn
+
+prop_map_maximum :: Backend c => [NonEmptyList Integer] -> c -> Property
+prop_map_maximum ps conn =
+    makePropEq (Q.map Q.maximum)
+               (map (fromIntegral . maximum))
+               (map getNonEmpty ps)
+               conn
+
+prop_map_map_minimum :: Backend c => [[NonEmptyList Integer]] -> c -> Property
+prop_map_map_minimum ps conn =
+    makePropEq (Q.map (Q.map Q.minimum))
+               (map (map(fromIntegral . minimum)))
+               (map (map getNonEmpty) ps)
+               conn
+
+prop_map_map_maximum :: Backend c => [[NonEmptyList Integer]] -> c -> Property
+prop_map_map_maximum ps conn =
+    makePropEq (Q.map (Q.map Q.maximum))
+               (map (map(fromIntegral . maximum)))
+               (map (map getNonEmpty) ps)
+               conn
+
+
+prop_map_length_tuple :: Backend c => [[(Integer, Integer)]] -> c -> Property
+prop_map_length_tuple = makePropEq (Q.map Q.length) (map (fromIntegral . length))
+
+prop_reverse :: Backend c => [Integer] -> c -> Property
+prop_reverse = makePropEq Q.reverse reverse
+
+prop_reverse_nest :: Backend c => [[Integer]] -> c -> Property
+prop_reverse_nest = makePropEq Q.reverse reverse
+
+prop_map_reverse :: Backend c => [[Integer]] -> c -> Property
+prop_map_reverse = makePropEq (Q.map Q.reverse) (map reverse)
+
+prop_map_reverse_nest :: Backend c => [[[Integer]]] -> c -> Property
+prop_map_reverse_nest = makePropEq (Q.map Q.reverse) (map reverse)
+
+prop_and :: Backend c => [Bool] -> c -> Property
+prop_and = makePropEq Q.and and
+
+prop_map_and :: Backend c => [[Bool]] -> c -> Property
+prop_map_and = makePropEq (Q.map Q.and) (map and)
+
+prop_map_map_and :: Backend c => [[[Bool]]] -> c -> Property
+prop_map_map_and = makePropEq (Q.map (Q.map Q.and)) (map (map and))
+
+prop_or :: Backend c => [Bool] -> c -> Property
+prop_or = makePropEq Q.or or
+
+prop_map_or :: Backend c => [[Bool]] -> c -> Property
+prop_map_or = makePropEq (Q.map Q.or) (map or)
+
+prop_map_map_or :: Backend c => [[[Bool]]] -> c -> Property
+prop_map_map_or = makePropEq (Q.map (Q.map Q.or)) (map (map or))
+
+prop_any_zero :: Backend c => [Integer] -> c -> Property
+prop_any_zero = makePropEq (Q.any (Q.== 0)) (any (== 0))
+
+prop_map_any_zero :: Backend c => [[Integer]] -> c -> Property
+prop_map_any_zero = makePropEq (Q.map (Q.any (Q.== 0))) (map (any (== 0)))
+
+prop_all_zero :: Backend c => [Integer] -> c -> Property
+prop_all_zero = makePropEq (Q.all (Q.== 0)) (all (== 0))
+
+prop_map_all_zero :: Backend c => [[Integer]] -> c -> Property
+prop_map_all_zero = makePropEq (Q.map (Q.all (Q.== 0))) (map (all (== 0)))
+
+prop_sum_integer :: Backend c => [Integer] -> c -> Property
+prop_sum_integer = makePropEq Q.sum sum
+
+prop_map_sum :: Backend c => [[Integer]] -> c -> Property
+prop_map_sum = makePropEq (Q.map Q.sum) (map sum)
+
+prop_map_avg :: Backend c => [NonEmptyList Double] -> c -> Property
+prop_map_avg is conn =
+    makePropDoubles (Q.map Q.avg) (map avgDouble) (map getNonEmpty is) conn
+
+prop_map_map_sum :: Backend c => [[[Integer]]] -> c -> Property
+prop_map_map_sum = makePropEq (Q.map (Q.map Q.sum)) (map (map sum))
+
+-- prop_map_map_avg :: Backend c => [[NonEmptyList Integer]] -> c -> Property
+-- prop_map_map_avg is conn =
+--     makePropEq (Q.map (Q.map Q.avg))
+--                (map (map avgInt))
+--                (map (map getNonEmpty) is)
+--                conn
+
+prop_sum_double :: Backend c => [Double] -> c -> Property
+prop_sum_double = makePropDouble Q.sum sum
+
+avgDouble :: [Double] -> Double
+avgDouble ds = sum ds / (fromIntegral $ length ds)
+
+prop_avg_double :: Backend c => NonEmptyList Double -> c -> Property
+prop_avg_double ds conn = makePropDouble Q.avg avgDouble (getNonEmpty ds) conn
+
+prop_concat :: Backend c => [[Integer]] -> c -> Property
+prop_concat = makePropEq Q.concat concat
+
+prop_map_concat :: Backend c => [[[Integer]]] -> c -> Property
+prop_map_concat = makePropEq (Q.map Q.concat) (map concat)
+
+prop_concatMap :: Backend c => [Integer] -> c -> Property
+prop_concatMap = makePropEq (Q.concatMap Q.singleton) (concatMap (: []))
+
+prop_maximum :: Backend c => NonEmptyList Integer -> c -> Property
+prop_maximum (NonEmpty is) = makePropEq Q.maximum maximum is
+
+prop_minimum :: Backend c => NonEmptyList Integer -> c -> Property
+prop_minimum (NonEmpty is) = makePropEq Q.minimum minimum is
+
+prop_splitAt :: Backend c => (Integer, [Integer]) -> c -> Property
+prop_splitAt = makePropEq (uncurryQ Q.splitAt) (\(a,b) -> splitAt (fromIntegral a) b)
+
+prop_takeWhile :: Backend c => (Integer, [Integer]) -> c -> Property
+prop_takeWhile = makePropEq (uncurryQ $ Q.takeWhile . (Q.==))
+                          (uncurry  $   takeWhile . (==))
+
+prop_dropWhile :: Backend c => (Integer, [Integer]) -> c -> Property
+prop_dropWhile = makePropEq (uncurryQ $ Q.dropWhile . (Q.==))
+                          (uncurry  $   dropWhile . (==))
+
+prop_map_takeWhile :: Backend c => (Integer, [[Integer]]) -> c -> Property
+prop_map_takeWhile = makePropEq (\z -> Q.map (Q.takeWhile (Q.fst z Q.==)) (Q.snd z))
+                              (\z -> map (takeWhile (fst z ==)) (snd z))
+
+prop_map_dropWhile :: Backend c => (Integer, [[Integer]]) -> c -> Property
+prop_map_dropWhile = makePropEq (\z -> Q.map (Q.dropWhile (Q.fst z Q.==)) (Q.snd z))
+                              (\z -> map (dropWhile (fst z ==)) (snd z))
+
+prop_span :: Backend c => (Integer, [Integer]) -> c -> Property
+prop_span = makePropEq (uncurryQ $ Q.span . (Q.==))
+                     (uncurry   $   span . (==) . fromIntegral)
+
+prop_map_span :: Backend c => (Integer, [[Integer]]) -> c -> Property
+prop_map_span = makePropEq (\z -> Q.map (Q.span ((Q.fst z) Q.==)) (Q.snd z))
+                         (\z -> map (span (fst z ==)) (snd z))
+
+prop_break :: Backend c => (Integer, [Integer]) -> c -> Property
+prop_break = makePropEq (uncurryQ $ Q.break . (Q.==))
+                      (uncurry   $   break . (==) . fromIntegral)
+
+prop_map_break :: Backend c => (Integer, [[Integer]]) -> c -> Property
+prop_map_break = makePropEq (\z -> Q.map (Q.break ((Q.fst z) Q.==)) (Q.snd z))
+                          (\z -> map (break (fst z ==)) (snd z))
+
+prop_elem :: Backend c => (Integer, [Integer]) -> c -> Property
+prop_elem = makePropEq (uncurryQ Q.elem)
+                     (uncurry    elem)
+
+prop_notElem :: Backend c => (Integer, [Integer]) -> c -> Property
+prop_notElem = makePropEq (uncurryQ Q.notElem)
+                        (uncurry    notElem)
+
+prop_lookup :: Backend c => (Integer, [(Integer,Integer)]) -> c -> Property
+prop_lookup = makePropEq (uncurryQ Q.lookup)
+                       (uncurry    lookup)
+
+prop_zip :: Backend c => ([Integer], [Integer]) -> c -> Property
+prop_zip = makePropEq (uncurryQ Q.zip) (uncurry zip)
+
+prop_zip_nested :: Backend c => ([Integer], [(Integer, [Integer])]) -> c -> Property
+prop_zip_nested = makePropEq (uncurryQ Q.zip) (uncurry zip)
+
+prop_zip_tuple1 :: Backend c => ([Integer], [(Text, Double)]) -> c -> Property
+prop_zip_tuple1 (xs, tds) =
+    makePropEq (uncurryQ Q.zip) (uncurry zip) (xs, tds')
+  where
+    tds' = map (\(t, d) -> (filterNullChar t, d)) tds
+
+prop_zip_tuple2 :: Backend c
+                => ([(Integer, Integer)], [(Text, Double)])
+                -> c
+                -> Property
+prop_zip_tuple2 (xs, tds) =
+    makePropEq (uncurryQ Q.zip) (uncurry zip) (xs, tds')
+  where
+    tds' = map (\(t, d) -> (filterNullChar t, d)) tds
+
+prop_map_zip :: Backend c => ([Integer], [[Integer]]) -> c -> Property
+prop_map_zip = makePropEq (\z -> Q.map (Q.zip $ Q.fst z) $ Q.snd z) (\(x, y) -> map (zip x) y)
+
+prop_zipWith :: Backend c => ([Integer], [Integer]) -> c -> Property
+prop_zipWith = makePropEq (uncurryQ $ Q.zipWith (+)) (uncurry $ zipWith (+))
+
+prop_unzip :: Backend c => [(Integer, Integer)] -> c -> Property
+prop_unzip = makePropEq Q.unzip unzip
+
+prop_map_unzip :: Backend c => [[(Integer, Integer)]] -> c -> Property
+prop_map_unzip = makePropEq (Q.map Q.unzip) (map unzip)
+
+prop_zip3 :: Backend c => ([Integer], [Integer],[Integer]) -> c -> Property
+prop_zip3 = makePropEq (\q -> (case Q.view q of (as,bs,cs) -> Q.zip3 as bs cs))
+                     (\(as,bs,cs) -> zip3 as bs cs)
+
+prop_zipWith3 :: Backend c => ([Integer], [Integer],[Integer]) -> c -> Property
+prop_zipWith3 = makePropEq (\q -> (case Q.view q of (as,bs,cs) -> Q.zipWith3 (\a b c -> a + b + c) as bs cs))
+                         (\(as,bs,cs) -> zipWith3 (\a b c -> a + b + c) as bs cs)
+
+prop_unzip3 :: Backend c => [(Integer, Integer, Integer)] -> c -> Property
+prop_unzip3 = makePropEq Q.unzip3 unzip3
+
+prop_nub :: Backend c => [Integer] -> c -> Property
+prop_nub = makePropEq Q.nub nub
+
+prop_map_nub :: Backend c => [[(Integer, Integer)]] -> c -> Property
+prop_map_nub = makePropEq (Q.map Q.nub) (map nub)
+
+-- * Tuples
+
+prop_fst :: Backend c => (Integer, Integer) -> c -> Property
+prop_fst = makePropEq Q.fst fst
+
+prop_fst_nested :: Backend c => ([Integer], [Integer]) -> c -> Property
+prop_fst_nested = makePropEq Q.fst fst
+
+prop_map_fst :: Backend c => [(Integer, Integer)] -> c -> Property
+prop_map_fst = makePropEq (Q.map Q.fst) (map fst)
+
+prop_snd :: Backend c => (Integer, Integer) -> c -> Property
+prop_snd = makePropEq Q.snd snd
+
+prop_map_snd :: Backend c => [(Integer, Integer)] -> c -> Property
+prop_map_snd = makePropEq (Q.map Q.snd) (map snd)
+
+prop_snd_nested :: Backend c => ([Integer], [Integer]) -> c -> Property
+prop_snd_nested = makePropEq Q.snd snd
+
+prop_tup3_1 :: Backend c => (Integer, Integer, Integer) -> c -> Property
+prop_tup3_1 = makePropEq (\q -> case Q.view q of (a, _, _) -> a) (\(a, _, _) -> a)
+
+prop_tup3_2 :: Backend c => (Integer, Integer, Integer) -> c -> Property
+prop_tup3_2 = makePropEq (\q -> case Q.view q of (_, b, _) -> b) (\(_, b, _) -> b)
+
+prop_tup3_3 :: Backend c => (Integer, Integer, Integer) -> c -> Property
+prop_tup3_3 = makePropEq (\q -> case Q.view q of (_, _, c) -> c) (\(_, _, c) -> c)
+
+prop_tup4_2 :: Backend c => (Integer, Integer, Integer, Integer) -> c -> Property
+prop_tup4_2 = makePropEq (\q -> case Q.view q of (_, b, _, _) -> b) (\(_, b, _, _) -> b)
+
+prop_tup4_4 :: Backend c => (Integer, Integer, Integer, Integer) -> c -> Property
+prop_tup4_4 = makePropEq (\q -> case Q.view q of (_, _, _, d) -> d) (\(_, _, _, d) -> d)
+
+prop_tup3_nested :: Backend c => (Integer, [Integer], Integer) -> c -> Property
+prop_tup3_nested = makePropEq (\q -> case Q.view q of (_, b, _) -> b) (\(_, b, _) -> b)
+
+prop_tup4_tup3 :: Backend c => (Integer, Integer, Integer, Integer) -> c -> Property
+prop_tup4_tup3 = makePropEq (\q -> case Q.view q of (a, b, _, d) -> Q.tup3 a b d)
+                          (\(a, b, _, d) -> (a, b, d))
+
+-- * Numerics
+
+prop_add_integer :: Backend c => (Integer,Integer) -> c -> Property
+prop_add_integer = makePropEq (uncurryQ (+)) (uncurry (+))
+
+prop_add_double :: Backend c => (Double,Double) -> c -> Property
+prop_add_double = makePropDouble (uncurryQ (+)) (uncurry (+))
+
+prop_mul_integer :: Backend c => (Integer,Integer) -> c -> Property
+prop_mul_integer = makePropEq (uncurryQ (*)) (uncurry (*))
+
+prop_mul_double :: Backend c => (Double,Double) -> c -> Property
+prop_mul_double = makePropDouble (uncurryQ (*)) (uncurry (*))
+
+prop_div_double :: Backend c => (Double,NonZero Double) -> c -> Property
+prop_div_double (x,NonZero y) conn =
+    makePropDouble (uncurryQ (/)) (uncurry (/)) (x,y) conn
+
+prop_integer_to_double :: Backend c => Integer -> c -> Property
+prop_integer_to_double = makePropDouble Q.integerToDouble fromInteger
+
+prop_integer_to_double_arith :: Backend c => (Integer, Double) -> c -> Property
+prop_integer_to_double_arith = makePropDouble (\x -> (Q.integerToDouble (Q.fst x)) + (Q.snd x))
+                                              (\(i, d) -> fromInteger i + d)
+
+prop_map_integer_to_double :: Backend c => [Integer] -> c -> Property
+prop_map_integer_to_double = makePropDoubles (Q.map Q.integerToDouble) (map fromInteger)
+
+prop_abs_integer :: Backend c => Integer -> c -> Property
+prop_abs_integer = makePropEq Q.abs abs
+
+prop_abs_double :: Backend c => Double -> c -> Property
+prop_abs_double = makePropDouble Q.abs abs
+
+prop_signum_integer :: Backend c => Integer -> c -> Property
+prop_signum_integer = makePropEq Q.signum signum
+
+prop_signum_double :: Backend c => Double -> c -> Property
+prop_signum_double = makePropDouble Q.signum signum
+
+prop_negate_integer :: Backend c => Integer -> c -> Property
+prop_negate_integer = makePropEq Q.negate negate
+
+prop_negate_double :: Backend c => Double -> c -> Property
+prop_negate_double = makePropDouble Q.negate negate
+
+prop_trig_sin :: Backend c => Double -> c -> Property
+prop_trig_sin = makePropDouble Q.sin sin
+
+prop_trig_cos :: Backend c => Double -> c -> Property
+prop_trig_cos = makePropDouble Q.cos cos
+
+prop_trig_tan :: Backend c => Double -> c -> Property
+prop_trig_tan = makePropDouble Q.tan tan
+
+prop_exp :: Backend c => Double -> c -> Property
+prop_exp = makePropDouble Q.exp exp
+
+prop_log :: Backend c => Positive Double -> c -> Property
+prop_log (Positive d) conn = makePropDouble Q.log log d conn
+
+prop_sqrt :: Backend c => Positive Double -> c -> Property
+prop_sqrt (Positive d) conn = makePropDouble Q.sqrt sqrt d conn
+
+arc :: Double -> Bool
+arc d = d >= -1 && d <= 1
+
+prop_trig_asin :: Backend c => Double -> c -> Property
+prop_trig_asin d conn = arc d ==>  makePropDouble Q.asin asin d conn
+
+prop_trig_acos :: Backend c => Double -> c -> Property
+prop_trig_acos d conn = arc d ==> makePropDouble Q.acos acos d conn
+
+prop_trig_atan :: Backend c => Double -> c -> Property
+prop_trig_atan = makePropDouble Q.atan atan
+
+prop_number :: Backend c => [Integer] -> c -> Property
+prop_number = makePropEq (Q.map Q.snd . Q.number) (\xs -> map snd $ zip xs [1..])
+
+prop_map_number :: Backend c => [[Integer]] -> c -> Property
+prop_map_number = makePropEq (Q.map (Q.map Q.snd . Q.number))
+                            (map (\xs -> map snd $ zip xs [1..]))
+
+
+prop_map_trig_sin :: Backend c => [Double] -> c -> Property
+prop_map_trig_sin = makePropDoubles (Q.map Q.sin) (map sin)
+
+prop_map_trig_cos :: Backend c => [Double] -> c -> Property
+prop_map_trig_cos = makePropDoubles (Q.map Q.cos) (map cos)
+
+prop_map_trig_tan :: Backend c => [Double] -> c -> Property
+prop_map_trig_tan = makePropDoubles (Q.map Q.tan) (map tan)
+
+prop_map_trig_asin :: Backend c => [Double] -> c -> Property
+prop_map_trig_asin ds conn = all arc ds
+                             ==>
+                             makePropDoubles (Q.map Q.asin) (map asin) ds conn
+
+prop_map_trig_acos :: Backend c => [Double] -> c -> Property
+prop_map_trig_acos ds conn = all arc ds
+                             ==>
+                             makePropDoubles (Q.map Q.acos) (map acos) ds conn
+
+prop_map_trig_atan :: Backend c => [Double] -> c -> Property
+prop_map_trig_atan = makePropDoubles (Q.map Q.atan) (map atan)
+
+prop_map_exp :: Backend c => [Double] -> c -> Property
+prop_map_exp = makePropDoubles (Q.map Q.exp) (map exp)
+
+prop_map_log :: Backend c => [Positive Double] -> c -> Property
+prop_map_log ds conn = noShrinking $
+    makePropDoubles (Q.map Q.log) (map log) (map getPositive ds) conn
+
+prop_map_sqrt :: Backend c => [Positive Double] -> c -> Property
+prop_map_sqrt ds conn =
+    makePropDoubles (Q.map Q.sqrt) (map sqrt) (map getPositive ds) conn
+
+hnegative_sum :: Backend c => c -> Assertion
+hnegative_sum conn = makeEqAssertion "hnegative_sum" (Q.sum (Q.toQ xs)) (sum xs) conn
+  where
+    xs :: [Integer]
+    xs = [-1, -4, -5, 2]
+
+hnegative_map_sum :: Backend c => c -> Assertion
+hnegative_map_sum conn = makeEqAssertion "hnegative_map_sum"
+                                         (Q.map Q.sum (Q.toQ xss))
+                                         (map sum xss)
+                                         conn
+  where
+    xss :: [[Integer]]
+    xss = [[10, 20, 30], [-10, -20, -30], [], [0]]
diff --git a/src/Database/DSH/Tests/Common.hs b/src/Database/DSH/Tests/Common.hs
new file mode 100644
--- /dev/null
+++ b/src/Database/DSH/Tests/Common.hs
@@ -0,0 +1,108 @@
+{-# LANGUAGE FlexibleContexts     #-}
+{-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+
+-- | Helpers for the construction of DSH test cases.
+module Database.DSH.Tests.Common
+    ( makePropEq
+    , makePropDouble
+    , makePropDoubles
+    , makeEqAssertion
+    , testPropertyConn
+    , uncurryQ
+    , filterNullChar
+    ) where
+
+import qualified Data.Text                            as T
+import qualified Data.Time.Calendar                   as C
+import qualified Data.Decimal                         as D
+
+import           Test.Framework
+import           Test.Framework.Providers.QuickCheck2
+import           Test.HUnit                           (Assertion, assertEqual)
+import           Test.QuickCheck
+import           Test.QuickCheck.Monadic
+
+
+import qualified Database.DSH                         as Q
+import           Database.DSH.Backend
+import           Database.DSH.Compiler
+
+instance Arbitrary T.Text where
+  arbitrary = fmap T.pack arbitrary
+
+instance Arbitrary C.Day where
+  arbitrary = C.ModifiedJulianDay <$> choose (25000, 80000)
+
+instance Arbitrary D.Decimal where
+  arbitrary = D.Decimal <$> choose (1,8) <*> choose (1,10^(6 :: Int))
+
+uncurryQ :: (Q.QA a, Q.QA b) => (Q.Q a -> Q.Q b -> Q.Q c) -> Q.Q (a,b) -> Q.Q c
+uncurryQ f = uncurry f . Q.view
+
+filterNullChar :: T.Text -> T.Text
+filterNullChar = T.filter (/= '\0')
+
+eps :: Double
+eps = 1.0E-3
+
+-- | A simple property that should hold for a DSH query: Given any
+-- input, its result should be the same as the corresponding native
+-- Haskell code. 'The same' is defined by a predicate.
+makeProp :: (Q.QA a, Q.QA b, Show a, Show b, Backend c)
+         => (b -> b -> Bool)
+         -> (Q.Q a -> Q.Q b)
+         -> (a -> b)
+         -> a
+         -> c
+         -> Property
+makeProp eq f1 f2 arg conn = monadicIO $ do
+    db <- run $ runQ conn $ f1 (Q.toQ arg)
+    let hs = f2 arg
+    assert $ db `eq` hs
+
+-- | Compare query result and native result by equality.
+makePropEq :: (Eq b, Q.QA a, Q.QA b, Show a, Show b, Backend c)
+           => (Q.Q a -> Q.Q b)
+           -> (a -> b)
+           -> a
+           -> c
+           -> Property
+makePropEq f1 f2 arg conn = makeProp (==) f1 f2 arg conn
+
+-- | Compare the double query result and native result.
+makePropDouble :: (Q.QA a, Show a, Backend c)
+               => (Q.Q a -> Q.Q Double)
+               -> (a -> Double)
+               -> a
+               -> c
+               -> Property
+makePropDouble f1 f2 arg conn = makeProp delta f1 f2 arg conn
+  where
+    delta a b = abs (a - b) < eps
+
+makePropDoubles :: (Q.QA a, Show a, Backend c)
+                => (Q.Q a -> Q.Q [Double])
+                -> (a -> [Double])
+                -> a
+                -> c
+                -> Property
+makePropDoubles f1 f2 arg conn = makeProp deltaList f1 f2 arg conn
+  where
+    delta a b       = abs (a - b) < eps
+    deltaList as bs = and $ zipWith delta as bs
+
+-- | Equality HUnit assertion
+makeEqAssertion :: (Show a, Eq a, Q.QA a, Backend c)
+                => String
+                -> Q.Q a
+                -> a
+                -> c
+                -> Assertion
+makeEqAssertion msg q expRes conn = do
+    actualRes <- runQ conn q
+    assertEqual msg expRes actualRes
+
+testPropertyConn :: (Show a, Arbitrary a, Backend c)
+                 => c -> TestName -> (a -> c -> Property) -> Test
+testPropertyConn conn name t = testProperty name (\a -> t a conn)
diff --git a/src/Database/DSH/Tests/ComprehensionTests.hs b/src/Database/DSH/Tests/ComprehensionTests.hs
new file mode 100644
--- /dev/null
+++ b/src/Database/DSH/Tests/ComprehensionTests.hs
@@ -0,0 +1,606 @@
+-- | Tests on certain aspects of comprehension nesting.
+module Database.DSH.Tests.ComprehensionTests
+    ( tests_comprehensions
+    , tests_lifted_joins
+    , tests_join_hunit
+    , tests_nest_head_hunit
+    , tests_nest_guard_hunit
+    ) where
+
+import           GHC.Exts
+
+import           Test.Framework                       (Test, testGroup)
+import           Test.Framework.Providers.HUnit
+import           Test.Framework.Providers.QuickCheck2 (testProperty)
+import           Test.HUnit                           (Assertion)
+import           Test.QuickCheck
+
+import           Database.DSH.Backend
+import           Database.DSH.Tests.Common
+import qualified Database.DSH.Tests.DSHComprehensions as C
+
+
+tests_comprehensions :: Backend c => c -> Test
+tests_comprehensions conn = testGroup "Comprehensions"
+    [ testProperty "cartprod" (\a -> prop_cartprod a conn)
+    , testProperty "eqjoin" (\a -> prop_eqjoin a conn)
+    , testProperty "eqjoinproj" (\a -> prop_eqjoinproj a conn)
+    , testProperty "eqjoinpred" (\a -> prop_eqjoinpred a conn)
+    , testProperty "eqjointuples" (\a -> prop_eqjointuples a conn)
+    , testProperty "thetajoin_eq" (\a -> prop_thetajoin_eq a conn)
+    , testProperty "thetajoin_neq" (\a -> prop_thetajoin_neq a conn)
+    , testProperty "eqjoin3" (\a -> prop_eqjoin3 a conn)
+    , testProperty "eqjoin_nested_left" (\a -> prop_eqjoin_nested_left a conn)
+    , testProperty "eqjoin_nested_right" (\a -> prop_eqjoin_nested_right a conn)
+    , testProperty "eqjoin_nested_both" (\a -> prop_eqjoin_nested_both a conn)
+    , testProperty "nestjoin" (\a -> prop_nestjoin a conn)
+    , testProperty "nestjoin3" (\a -> prop_nestjoin3 a conn)
+    , testProperty "groupjoin_length" (\a -> prop_groupjoin_length a conn)
+    , testProperty "groupjoin_sum" (\a -> prop_groupjoin_sum a conn)
+    , testProperty "antijoin class12" (\a -> prop_aj_class12 a conn)
+    , testProperty "antijoin class15" (\a -> prop_aj_class15 a conn)
+    , testProperty "antijoin class16" (\a -> prop_aj_class16 a conn)
+    , testProperty "backdep1" (\a -> prop_backdep a conn)
+    , testProperty "backdep_filter" (\a -> prop_backdep_filter a conn)
+    , testProperty "backdep2" (\a -> prop_backdep2 a conn)
+    , testProperty "backdep3" (\a -> prop_backdep3 a conn)
+    , testProperty "backdep4" (\a -> prop_backdep4 a conn)
+    , testProperty "backdep5" (\a -> prop_backdep5 a conn)
+    , testProperty "deep" (\a -> prop_deep_iter a conn)
+    , testProperty "only tuple" (\a -> prop_only_tuple a conn)
+    ]
+
+tests_lifted_joins :: Backend c => c -> Test
+tests_lifted_joins conn = testGroup "Lifted Joins"
+    [ testProperty "lifted semijoin" (\a -> prop_liftsemijoin a conn)
+    , testProperty "lifted antijoin" (\a -> prop_liftantijoin a conn)
+    , testProperty "lifted thetajoin" (\a -> prop_liftthetajoin a conn)
+    ]
+
+tests_join_hunit :: Backend c => c -> Test
+tests_join_hunit conn = testGroup "HUnit joins"
+    [ testCase "heqjoin_nested1" (heqjoin_nested1 conn)
+    , testCase "hsemijoin" (hsemijoin conn)
+    , testCase "hsemijoin_range" (hsemijoin_range conn)
+    , testCase "hsemijoin_quant" (hsemijoin_quant conn)
+    , testCase "hsemijoin_not_null" (hsemijoin_not_null conn)
+    , testCase "hantijoin" (hantijoin conn)
+    , testCase "hantijoin_range" (hantijoin_range conn)
+    , testCase "hantijoin_null" (hantijoin_null conn)
+    , testCase "hantijoin_class12" (hantijoin_class12 conn)
+    , testCase "hantijoin_class15" (hantijoin_class15 conn)
+    , testCase "hantijoin_class16" (hantijoin_class16 conn)
+    , testCase "hfrontguard" (hfrontguard conn)
+    ]
+
+tests_nest_head_hunit :: Backend c => c -> Test
+tests_nest_head_hunit conn = testGroup "HUnit head nesting"
+    [ testCase "hnj1" (hnj1 conn)
+    , testCase "hnj2" (hnj2 conn)
+    , testCase "hnj3" (hnj3 conn)
+    , testCase "hnj4" (hnj4 conn)
+    , testCase "hnj5" (hnj5 conn)
+    , testCase "hnj6" (hnj6 conn)
+    , testCase "hnj7" (hnj7 conn)
+    , testCase "hnj8" (hnj8 conn)
+    , testCase "hnj9" (hnj9 conn)
+    , testCase "hnj10" (hnj10 conn)
+    , testCase "hnj11" (hnj11 conn)
+    , testCase "hnj12" (hnj12 conn)
+    , testCase "hnp1" (hnp1 conn)
+    , testCase "hnp2" (hnp2 conn)
+    , testCase "hnp3" (hnp3 conn)
+    , testCase "hnp4" (hnp4 conn)
+    ]
+
+tests_nest_guard_hunit :: Backend c => c -> Test
+tests_nest_guard_hunit conn = testGroup "HUnit guard nesting"
+    [ testCase "hnjg1" (hnjg1 conn)
+    , testCase "hnjg2" (hnjg2 conn)
+    , testCase "hnjg3" (hnjg3 conn)
+    , testCase "hnjg4" (hnjg4 conn)
+    , testCase "hnjg5" (hnjg5 conn)
+    ]
+
+---------------------------------------------------------------------------------
+-- QuickCheck properties for comprehensions
+
+prop_cartprod :: Backend c => ([Integer], [Integer]) -> c -> Property
+prop_cartprod = makePropEq C.cartprod cartprod_native
+  where
+    cartprod_native (xs, ys) = [ (x, y) | x <- xs, y <- ys]
+
+prop_eqjoin :: Backend c => ([Integer], [Integer]) -> c -> Property
+prop_eqjoin = makePropEq C.eqjoin eqjoin_native
+  where
+    eqjoin_native (xs, ys) = [ (x, y) | x <- xs , y <- ys , x == y ]
+
+prop_eqjoinproj :: Backend c => ([Integer], [Integer]) -> c -> Property
+prop_eqjoinproj = makePropEq C.eqjoinproj eqjoinproj_native
+  where
+    eqjoinproj_native (xs, ys) = [ (x, y) | x <- xs , y <- ys , (2 * x) == y ]
+
+prop_eqjoinpred :: Backend c => (Integer, [Integer], [Integer]) -> c -> Property
+prop_eqjoinpred = makePropEq C.eqjoinpred eqjoinpred_native
+  where
+    eqjoinpred_native (x', xs, ys) = [ (x, y) | x <- xs , y <- ys , x == y , x > x']
+
+prop_eqjointuples :: Backend c => ([(Integer, Integer)], [(Integer, Integer)]) -> c -> Property
+prop_eqjointuples = makePropEq C.eqjointuples eqjointuples_native
+  where
+    eqjointuples_native (xs, ys) = [ (x1 * x2, y1, y2)
+                                   | (x1, x2) <- xs
+                                   , (y1, y2) <- ys
+                                   , x1 == y2
+                                   ]
+
+prop_thetajoin_eq :: Backend c => ([(Integer, Integer)], [(Integer, Integer)]) -> c -> Property
+prop_thetajoin_eq = makePropEq C.thetajoin_eq thetajoin_eq_native
+  where
+    thetajoin_eq_native (xs, ys) = [ (x1 * x2, y1, y2)
+                                   | (x1, x2) <- xs
+                                   , (y1, y2) <- ys
+                                   , x1 == y2
+                                   , y1 == x2
+                                   ]
+
+prop_thetajoin_neq :: Backend c => ([(Integer, Integer)], [(Integer, Integer)]) -> c -> Property
+prop_thetajoin_neq = makePropEq C.thetajoin_neq thetajoin_neq_native
+  where
+    thetajoin_neq_native (xs, ys) = [ (x1 * x2, y1, y2)
+                                    | (x1, x2) <- xs
+                                    , (y1, y2) <- ys
+                                    , x1 == y2
+                                    , y1 /= x2
+                                    ]
+
+
+prop_eqjoin3 :: Backend c => ([Integer], [Integer], [Integer]) -> c -> Property
+prop_eqjoin3 = makePropEq C.eqjoin3 eqjoin3_native
+  where
+    eqjoin3_native (xs, ys, zs) = [ (x, y, z) | x <- xs , y <- ys , z <- zs , x == y , y == z]
+
+prop_eqjoin_nested_left :: Backend c => ([(Integer, [Integer])], [Integer]) -> c -> Property
+prop_eqjoin_nested_left = makePropEq C.eqjoin_nested_left eqjoin_nested_left_native
+  where
+    eqjoin_nested_left_native (xs, ys) = [ (x, y) | x <- xs , y <- ys , fst x == y]
+
+prop_eqjoin_nested_right :: Backend c => ([Integer], [(Integer, [Integer])]) -> c -> Property
+prop_eqjoin_nested_right = makePropEq C.eqjoin_nested_right eqjoin_nested_right_native
+  where
+    eqjoin_nested_right_native (xs, ys) = [ (x, y) | x <- xs , y <- ys , x == fst y]
+
+prop_eqjoin_nested_both :: Backend c => ([(Integer, [Integer])], [(Integer, [Integer])]) -> c -> Property
+prop_eqjoin_nested_both = makePropEq C.eqjoin_nested_both eqjoin_nested_both_native
+  where
+    eqjoin_nested_both_native (xs, ys) = [ (x, y) | x <- xs , y <- ys , fst x == fst y]
+
+prop_nestjoin :: Backend c => ([Integer], [Integer]) -> c -> Property
+prop_nestjoin = makePropEq C.nestjoin nestjoin_native
+  where
+    nestjoin_native (xs, ys) = [ (x, [ y | y <- ys, x == y ]) | x <- xs]
+
+prop_nestjoin3 :: Backend c => ([Integer], [Integer], [Integer]) -> c -> Property
+prop_nestjoin3 = makePropEq C.nestjoin3 nestjoin3_native
+  where
+    nestjoin3_native (njxs, njys, njzs) =
+        [ [ [ (x,y,z) | z <- njzs, y == z ]
+          | y <- njys
+          , x == y
+          ]
+        | x <- njxs
+        ]
+
+prop_groupjoin_length :: Backend c => ([Integer], [Integer]) -> c -> Property
+prop_groupjoin_length = makePropEq C.groupjoin_length groupjoin_length_native
+  where
+    groupjoin_length_native (njxs, njys) =
+        [ (x, fromIntegral $ length [ y | y <- njys, x == y ]) | x <- njxs ]
+
+prop_groupjoin_sum :: Backend c => ([Integer], [Integer]) -> c -> Property
+prop_groupjoin_sum = makePropEq C.groupjoin_sum groupjoin_sum_native
+  where
+    groupjoin_sum_native (njxs, njys) =
+        [ (x, fromIntegral $ sum [ 2 * y | y <- njys, x == y ]) | x <- njxs ]
+
+prop_aj_class12 :: Backend c => ([Integer], [Integer]) -> c -> Property
+prop_aj_class12 = makePropEq C.aj_class12 aj_class12_native
+  where
+    aj_class12_native (ajxs, ajys) = [ x
+                                     | x <- ajxs
+                                     , and [ x == y | y <- ajys, y > 10 ]
+                                     ]
+
+prop_aj_class15 :: Backend c => ([Integer], [Integer]) -> c -> Property
+prop_aj_class15 = makePropEq C.aj_class15 aj_class15_native
+  where
+    aj_class15_native (ajxs, ajys) = [ x
+                                     | x <- ajxs
+                                     , and [ y `rem` 4 == 0 | y <- ajys, x < y ]
+                                     ]
+
+prop_aj_class16 :: Backend c => ([Integer], [Integer]) -> c -> Property
+prop_aj_class16 = makePropEq C.aj_class16 aj_class16_native
+  where
+    aj_class16_native (ajxs, ajys) = [ x
+                                     | x <- ajxs
+                                     , and [ y <= 2 * x | y <- ajys, x < y ]
+                                     ]
+
+prop_backdep :: Backend c => [[Integer]] -> c -> Property
+prop_backdep = makePropEq C.backdep backdep_native
+  where
+    backdep_native xss = [x | xs <- xss, x <- xs]
+
+prop_backdep_filter :: Backend c => [[Integer]] -> c -> Property
+prop_backdep_filter = makePropEq C.backdep_filter backdep_filter_native
+  where
+    backdep_filter_native xss = [x | xs <- xss, x <- xs, fromIntegral (length xs) > x]
+
+prop_backdep2 :: Backend c => [[Integer]] -> c -> Property
+prop_backdep2 = makePropEq C.backdep2 backdep2
+  where
+    backdep2 xss = [ [ x * 42 | x <- xs ] | xs <- xss ]
+
+prop_backdep3 :: Backend c => [[Integer]] -> c -> Property
+prop_backdep3 = makePropEq C.backdep3 backdep3
+  where
+    backdep3 xss = [ [ x + fromIntegral (length xs) | x <- xs ] | xs <- xss ]
+
+prop_backdep4 :: Backend c => [[[Integer]]] -> c -> Property
+prop_backdep4 = makePropEq C.backdep4 backdep4
+  where
+    backdep4 xsss = [ [ [ x + fromIntegral (length xs) + fromIntegral (length xss)
+                        | x <- xs
+                        ]
+                      | xs <- xss
+                      ]
+                    | xss <- xsss
+                    ]
+
+prop_backdep5 :: Backend c => [[Integer]] -> c -> Property
+prop_backdep5 = makePropEq C.backdep5 backdep5
+  where
+    backdep5 xss = [ [ x + fromIntegral (length xs)
+                     | x <- take (length xs - 3) xs ]
+                   | xs <- xss ]
+
+--------------------------------------------------------------------------------
+-- Tests for lifted join operators
+
+prop_liftsemijoin :: Backend c => ([Positive Integer], [Integer]) -> c -> Property
+prop_liftsemijoin (xs, ys) = makePropEq C.liftsemijoin liftsemijoin (xs', ys)
+  where
+    xs' = map getPositive xs
+
+liftsemijoin :: ([Integer], [Integer]) -> [[Integer]]
+liftsemijoin (xs, ys) =
+    [ [ x | x <- g, x `elem` ys ]
+    | g <- groupWith (`rem` 10) xs
+    ]
+
+prop_liftantijoin :: Backend c => ([Positive Integer], [Integer]) -> c -> Property
+prop_liftantijoin (xs, ys) = makePropEq C.liftantijoin liftantijoin (xs', ys)
+  where
+    xs' = map getPositive xs
+
+liftantijoin :: ([Integer], [Integer]) -> [[Integer]]
+liftantijoin (xs, ys) =
+    [ [ x | x <- g, x `notElem` ys ]
+    | g <- groupWith (`rem` 10) xs
+    ]
+
+prop_liftthetajoin :: Backend c => ([Positive Integer], [Integer]) -> c -> Property
+prop_liftthetajoin (xs, ys) = makePropEq C.liftthetajoin liftthetajoin (xs', ys)
+  where
+    xs' = map getPositive xs
+
+liftthetajoin :: ([Integer], [Integer]) -> [[(Integer, Integer)]]
+liftthetajoin (xs, ys) =
+    [ [ (x, y) | x <- g, y <- ys, x < y ]
+    | g <- groupWith (`rem` 10) xs
+    ]
+
+-----------------------------------------------------------------------
+-- HUnit tests for comprehensions
+
+heqjoin_nested1 :: Backend c => c -> Assertion
+heqjoin_nested1 = makeEqAssertion "heqjoin_nested" C.eqjoin_nested1 res
+  where
+    res = [ ((20, ['b']), 20)
+          , ((30, ['c', 'd']), 30)
+          , ((30, ['c', 'd']), 30)
+          , ((40, []), 40)
+          ]
+
+hsemijoin :: Backend c => c -> Assertion
+hsemijoin = makeEqAssertion "hsemijoin" C.semijoin res
+  where
+    res = [2, 4, 6, 7]
+
+hsemijoin_range :: Backend c => c -> Assertion
+hsemijoin_range = makeEqAssertion "hsemijoin_range" C.semijoin_range res
+  where
+    res = [2, 4]
+
+hsemijoin_not_null :: Backend c => c -> Assertion
+hsemijoin_not_null = makeEqAssertion "hsemijoin_range" C.semijoin_not_null res
+  where
+    res = [2, 4, 6, 7]
+
+hsemijoin_quant :: Backend c => c -> Assertion
+hsemijoin_quant = makeEqAssertion "hsemijoin_quant" C.semijoin_quant res
+  where
+    res = [6,7]
+
+hantijoin :: Backend c => c -> Assertion
+hantijoin = makeEqAssertion "hantijoin" C.antijoin res
+  where
+    res = [1, 3, 5]
+
+hantijoin_range :: Backend c => c -> Assertion
+hantijoin_range = makeEqAssertion "hantijoin_range" C.antijoin_range res
+  where
+    res = [1, 3, 5, 6, 7]
+
+hantijoin_null :: Backend c => c -> Assertion
+hantijoin_null = makeEqAssertion "hantijoin_range" C.antijoin_null res
+  where
+    res = [1, 3, 5]
+
+hantijoin_class12 :: Backend c => c -> Assertion
+hantijoin_class12 = makeEqAssertion "hantijoin_class12" C.antijoin_class12 res
+  where
+    res = [6,7,8,9,10]
+
+hantijoin_class15 :: Backend c => c -> Assertion
+hantijoin_class15 = makeEqAssertion "hantijoin_class15" C.antijoin_class15 res
+  where
+    res = [5,6,7,8]
+
+hantijoin_class16 :: Backend c => c -> Assertion
+hantijoin_class16 = makeEqAssertion "hantijoin_class16" C.antijoin_class16 res
+  where
+    res = [4,5,6]
+
+hfrontguard :: Backend c => c -> Assertion
+hfrontguard = makeEqAssertion "hfrontguard" C.frontguard res
+  where
+    res = [[],[1,2],[1,2]]
+
+-----------------------------------------------------------------------
+-- HUnit tests for nestjoin/nestproduct
+
+njxs1 :: [Integer]
+njxs1 = [1,2,3,4,5,6]
+
+njys1 :: [Integer]
+njys1 = [3,4,5,6,3,6,4,1,1,1]
+
+hnj1 :: Backend c => c -> Assertion
+hnj1 = makeEqAssertion "hnj1" (C.nj1 njxs1 njys1) (nj1 njxs1 njys1)
+
+hnj2 :: Backend c => c -> Assertion
+hnj2 = makeEqAssertion "hnj2" (C.nj2 njxs1 njys1) (nj2 njxs1 njys1)
+
+hnj3 :: Backend c => c -> Assertion
+hnj3 = makeEqAssertion "hnj3" (C.nj3 njxs1 njys1) (nj3 njxs1 njys1)
+
+hnj4 :: Backend c => c -> Assertion
+hnj4 = makeEqAssertion "hnj4" (C.nj4 njxs1 njys1) (nj4 njxs1 njys1)
+
+hnj5 :: Backend c => c -> Assertion
+hnj5 = makeEqAssertion "hnj5" (C.nj5 njxs1 njys1) (nj5 njxs1 njys1)
+
+hnj6 :: Backend c => c -> Assertion
+hnj6 = makeEqAssertion "hnj6" (C.nj6 njxs1 njys1) (nj6 njxs1 njys1)
+
+hnj7 :: Backend c => c -> Assertion
+hnj7 = makeEqAssertion "hnj7" (C.nj7 njxs1 njys1) (nj7 njxs1 njys1)
+
+hnj8 :: Backend c => c -> Assertion
+hnj8 = makeEqAssertion "hnj8" (C.nj8 njxs1 njys1) (nj8 njxs1 njys1)
+
+hnj9 :: Backend c => c -> Assertion
+hnj9 = makeEqAssertion "hnj9" (C.nj9 njxs1 njys1) (nj9 njxs1 njys1)
+
+hnj10 :: Backend c => c -> Assertion
+hnj10 = makeEqAssertion "hnj10" (C.nj10 njxs1 njys1) (nj10 njxs1 njys1)
+
+hnj11 :: Backend c => c -> Assertion
+hnj11 = makeEqAssertion "hnj11" (C.nj11 njxs1 njys1) (nj11 njxs1 njys1)
+
+-- Test data for testcase hnj12
+njxs2, njys2, njzs2 :: [Integer]
+njxs2 = [1,2,3,4,5,5,2]
+njys2 = [2,1,0,5,4,4,4]
+njzs2 = [6,1,1,3,2,5]
+
+hnj12 :: Backend c => c -> Assertion
+hnj12 = makeEqAssertion "hnj12" (C.nj12 njxs2 njys2 njzs2) (nj12 njxs2 njys2 njzs2)
+
+hnp1 :: Backend c => c -> Assertion
+hnp1 = makeEqAssertion "hnp1" (C.np1 njxs1 njys1) (np1 njxs1 njys1)
+
+hnp2 :: Backend c => c -> Assertion
+hnp2 = makeEqAssertion "hnp2" (C.np2 njxs1 njys1) (np2 njxs1 njys1)
+
+hnp3 :: Backend c => c -> Assertion
+hnp3 = makeEqAssertion "hnp3" (C.np3 njxs1 njys1) (np3 njxs1 njys1)
+
+hnp4 :: Backend c => c -> Assertion
+hnp4 = makeEqAssertion "hnp4" (C.np4 njxs1 njys1) (np4 njxs1 njys1)
+
+hnjg1 :: Backend c => c -> Assertion
+hnjg1 = makeEqAssertion "hnjg1" (C.njg1 njgxs1 njgzs1) (njg1 njgxs1 njgzs1)
+
+hnjg2 :: Backend c => c -> Assertion
+hnjg2 = makeEqAssertion "hnjg2" (C.njg2 njgxs1 njgys1) (njg2 njgxs1 njgys1)
+
+hnjg3 :: Backend c => c -> Assertion
+hnjg3 = makeEqAssertion "hnjg3" (C.njg3 njgxs1 njgys1 njgzs1) (njg3 njgxs1 njgys1 njgzs1)
+
+hnjg4 :: Backend c => c -> Assertion
+hnjg4 = makeEqAssertion "hnjg4" (C.njg4 njgxs1 njgys1 njgzs1) (njg4 njgxs1 njgys1 njgzs1)
+
+hnjg5 :: Backend c => c -> Assertion
+hnjg5 = makeEqAssertion "hnjg5" (C.njg5 njgxs1 njgys1) (njg5 njgxs1 njgys1)
+
+pair :: a -> b -> (a, b)
+pair = (,)
+
+-- Head/NestJoin
+nj1 :: [Integer] -> [Integer] -> [[Integer]]
+nj1 njxs njys =
+    [ [ y | y <- njys, x == y ]
+    | x <- njxs
+    ]
+
+nj2 :: [Integer] -> [Integer] -> [(Integer, [Integer])]
+nj2 njxs njys =
+    [ pair x [ y | y <- njys, x == y ]
+    | x <- njxs
+    ]
+
+nj3 :: [Integer] -> [Integer] -> [(Integer, [Integer])]
+nj3 njxs njys =
+    [ pair x ([ y | y <- njys, x == y ] ++ ([100, 200, 300]))
+    | x <- njxs
+    ]
+
+nj4 :: [Integer] -> [Integer] -> [(Integer, [Integer])]
+nj4 njxs njys =
+      [ pair x ([ y | y <- njys, x == y ] ++ [ z | z <- njys, x == z ])
+      | x <- njxs
+      ]
+
+nj5 :: [Integer] -> [Integer] -> [(Integer, [Integer])]
+nj5 njxs njys =
+      [ pair x [ y | y <- njys, x + y > 15 ]
+      | x <- njxs
+      ]
+
+nj6 :: [Integer] -> [Integer] -> [(Integer, [Integer])]
+nj6 njxs njys =
+      [ pair x [ y | y <- njys, x + y > 10, y < 7 ]
+      | x <- njxs
+      ]
+
+nj7 :: [Integer] -> [Integer] -> [[Integer]]
+nj7 njxs njys =
+    [ [ x + y | y <- njys, x + 2 == y ] | x <- njxs ]
+
+nj8 :: [Integer] -> [Integer] -> [[Integer]]
+nj8 njxs njys = [ [ x + y | y <- njys, x == y, y < 5 ] | x <- njxs, x > 3 ]
+
+nj9 :: [Integer] -> [Integer] -> [[Integer]]
+nj9 njxs njys = [ [ x + y | y <- njys, x + 1 == y, y > 2, x < 6 ] | x <- njxs ]
+
+nj10 :: [Integer] -> [Integer] -> [Integer]
+nj10 njxs njys = [ x + sum [ x * y | y <- njys, x == y ] | x <- njxs ]
+
+nj11 :: [Integer] -> [Integer] -> [[Integer]]
+nj11 njxs njys = [ [ x + y | y <- njys, x > y, x < y * 2 ] | x <- njxs ]
+
+nj12 :: [Integer] -> [Integer] -> [Integer] -> [[[(Integer, Integer, Integer)]]]
+nj12 njxs njys njzs =
+    [ [ [ (x,y,z) | z <- njzs, y == z ]
+      | y <- njys
+      , x == y
+      ]
+    | x <- njxs
+    ]
+
+-- Head/NestProduct
+np1 :: [Integer] -> [Integer] -> [[Integer]]
+np1 njxs njys = [ [ x * y * 2 | y <- njys ] | x <- njxs ]
+
+np2 :: [Integer] -> [Integer] -> [(Integer, [Integer])]
+np2 njxs njys = [ pair x [ y * 2 | y <- njys ] | x <- njxs ]
+
+np3 :: [Integer] -> [Integer] -> [[Integer]]
+np3 njxs njys = [ [ x + y | y <- njys ] | x <- njxs ]
+
+np4 :: [Integer] -> [Integer] -> [[Integer]]
+np4 njxs njys = [ [ y | y <- njys, x > y ] | x <- njxs ]
+
+-- Guard/NestJoin
+
+njgxs1 :: [Integer]
+njgxs1 = [1,2,3,4,5,6,7,8,12]
+
+njgys1 :: [Integer]
+njgys1 = [2,3,2,4,5,5,9,12,2,2,13]
+
+njgzs1 :: [(Integer, Integer)]
+njgzs1 = [(2, 20), (5, 60), (3, 30), (3, 80), (4, 40), (5, 10), (5, 30), (12, 120)]
+
+njg1 :: [Integer] -> [(Integer, Integer)] -> [Integer]
+njg1 njgxs njgzs =
+  [ x
+  | x <- njgxs
+  , x < 8
+  , sum [ snd z | z <- njgzs, fst z == x ] > 100
+  ]
+
+njg2 :: [Integer] -> [Integer] -> [Integer]
+njg2 njgxs njgys =
+  [ x
+  | x <- njgxs
+  , and [ y > 1 | y <- njgys, x == y ]
+  , x < 8
+  ]
+
+njg3 :: [Integer] -> [Integer] -> [(Integer, Integer)] -> [(Integer, Integer)]
+njg3 njgxs njgys njgzs =
+  [ pair x y
+  | x <- njgxs
+  , y <- njgys
+  , length [ () | z <- njgzs, fst z == x ] > 2
+  ]
+
+njg4 :: [Integer] -> [Integer] -> [(Integer, Integer)] -> [Integer]
+njg4 njgxs njgys njgzs =
+  [ x
+  | x <- njgxs
+  , length [ () | y <- njgys, x == y ]
+    > length [ () | z <- njgzs, fst z == x ]
+  ]
+
+njg5 :: [Integer] -> [Integer] -> [Integer]
+njg5 njgxs njgys =
+  [ x
+  | x <- njgxs
+  , sum [ y | y <- njgys, x < y, y > 5 ] < 10
+  ]
+
+--------------------------------------------------------------------------------
+--
+
+prop_deep_iter :: Backend c => ([Integer], [Integer], [Integer], [Integer], [Integer]) -> c -> Property
+prop_deep_iter = makePropEq C.deep_iter deep_iter_native
+  where
+    deep_iter_native (ws1, ws2, xs, ys, zs) =
+      [ [ [ [ w1 * 23 - y | w1 <- ws1 ]
+            ++
+            [ w2 + 42 - y | w2 <- ws2 ]
+          | z <- zs
+          , z > x
+          ]
+        | y <- ys
+        ]
+      | x <- xs
+      ]
+
+-- | Test non-lifted tuple construction with a singleton extracted
+-- from a nested list.
+prop_only_tuple :: Backend c
+                => (Integer, NonEmptyList Integer, [Integer])
+                -> c
+                -> Property
+prop_only_tuple (x, ys, zs) c =
+    makePropEq C.only_tuple only_tuple (x, getNonEmpty ys, zs) c
+
+only_tuple :: (Integer, [Integer], [Integer]) -> (Integer, (Integer, [Integer]))
+only_tuple (x, ys, zs) =
+    pair x (head [ (y, [ z | z <- zs, x == y ])  | y <- ys ])
diff --git a/src/Database/DSH/Tests/DSHComprehensions.hs b/src/Database/DSH/Tests/DSHComprehensions.hs
new file mode 100644
--- /dev/null
+++ b/src/Database/DSH/Tests/DSHComprehensions.hs
@@ -0,0 +1,415 @@
+{-# LANGUAGE RebindableSyntax    #-}
+{-# LANGUAGE ViewPatterns        #-}
+{-# LANGUAGE MonadComprehensions #-}
+
+-- | This module contains testcases for monad comprehensions. We store them in a
+-- separate module because they rely on RebindableSyntax and hidden
+-- Prelude.
+module Database.DSH.Tests.DSHComprehensions where
+
+import Database.DSH
+
+---------------------------------------------------------------
+-- Comprehensions for quickcheck tests
+
+cartprod :: Q ([Integer], [Integer]) -> Q [(Integer, Integer)]
+cartprod (view -> (xs, ys)) =
+  [ tup2 x y
+  | x <- xs
+  , y <- ys
+  ]
+
+eqjoin :: Q ([Integer], [Integer]) -> Q [(Integer, Integer)]
+eqjoin (view -> (xs, ys)) =
+  [ tup2 x y
+  | x <- xs
+  , y <- ys
+  , x == y
+  ]
+
+
+eqjoinproj :: Q ([Integer], [Integer]) -> Q [(Integer, Integer)]
+eqjoinproj (view -> (xs, ys)) =
+  [ tup2 x y
+  | x <- xs
+  , y <- ys
+  , (2 * x) == y
+  ]
+
+eqjoinpred :: Q (Integer, [Integer], [Integer]) -> Q [(Integer, Integer)]
+eqjoinpred (view -> (x', xs, ys)) =
+  [ tup2 x y
+  | x <- xs
+  , y <- ys
+  , x == y
+  , x > x'
+  ]
+
+eqjointuples :: Q ([(Integer, Integer)], [(Integer, Integer)]) -> Q [(Integer, Integer, Integer)]
+eqjointuples (view -> (xs, ys)) =
+  [ tup3 (x1 * x2) y1 y2
+  | (view -> (x1, x2)) <- xs
+  , (view -> (y1, y2)) <- ys
+  , x1 == y2
+  ]
+
+thetajoin_eq :: Q ([(Integer, Integer)], [(Integer, Integer)]) -> Q [(Integer, Integer, Integer)]
+thetajoin_eq (view -> (xs, ys)) =
+  [ tup3 (x1 * x2) y1 y2
+  | (view -> (x1, x2)) <- xs
+  , (view -> (y1, y2)) <- ys
+  , x1 == y2
+  , y1 == x2
+  ]
+
+thetajoin_neq :: Q ([(Integer, Integer)], [(Integer, Integer)]) -> Q [(Integer, Integer, Integer)]
+thetajoin_neq (view -> (xs, ys)) =
+  [ tup3 (x1 * x2) y1 y2
+  | (view -> (x1, x2)) <- xs
+  , (view -> (y1, y2)) <- ys
+  , x1 == y2
+  , y1 /= x2
+  ]
+
+eqjoin3 :: Q ([Integer], [Integer], [Integer]) -> Q [(Integer, Integer, Integer)]
+eqjoin3 (view -> (xs, ys, zs)) =
+  [ tup3 x y z
+  | x <- xs
+  , y <- ys
+  , z <- zs
+  , x == y
+  , y == z
+  ]
+
+eqjoin_nested_left :: Q ([(Integer, [Integer])], [Integer]) -> Q [((Integer, [Integer]), Integer)]
+eqjoin_nested_left args =
+  [ pair x y
+  | x <- fst args
+  , y <- snd args
+  , fst x == y
+  ]
+
+eqjoin_nested_right :: Q ([Integer], [(Integer, [Integer])]) -> Q [(Integer, (Integer, [Integer]))]
+eqjoin_nested_right args =
+  [ pair x y
+  | x <- fst args
+  , y <- snd args
+  , x == fst y
+  ]
+
+eqjoin_nested_both :: Q ([(Integer, [Integer])], [(Integer, [Integer])])
+                   -> Q [((Integer, [Integer]), (Integer, [Integer]))]
+eqjoin_nested_both args =
+  [ pair x y
+  | x <- fst args
+  , y <- snd args
+  , fst x == fst y
+  ]
+
+nestjoin :: Q ([Integer], [Integer]) -> Q [(Integer, [Integer])]
+nestjoin (view -> (xs, ys)) =
+  [ tup2 x [ y | y <- ys, x == y]
+  | x <- xs
+  ]
+
+nestjoin3 :: Q ([Integer], [Integer], [Integer]) -> Q [[[(Integer, Integer, Integer)]]]
+nestjoin3 (view -> (xs, ys, zs)) =
+    [ [ [ tup3 x y z | z <- zs, y == z ]
+      | y <- ys
+      , x == y
+      ]
+    | x <- xs
+    ]
+
+groupjoin_length :: Q ([Integer], [Integer]) -> Q [(Integer, Integer)]
+groupjoin_length (view -> (xs, ys)) =
+    [ tup2 x (length [ y | y <- ys, x == y ]) | x <- xs ]
+
+groupjoin_sum :: Q ([Integer], [Integer]) -> Q [(Integer, Integer)]
+groupjoin_sum (view -> (xs, ys)) =
+    [ tup2 x (sum [ 2 * y | y <- ys, x == y ]) | x <- xs ]
+
+--------------------------------------------------------------------------------
+-- Comprehensions for lifted join tests
+
+liftsemijoin :: Q ([Integer], [Integer]) -> Q [[Integer]]
+liftsemijoin (view -> (xs, ys)) =
+    [ [ x | x <- g, x `elem` ys ]
+    | g <- groupWith (`rem` 10) xs
+    ]
+
+liftantijoin :: Q ([Integer], [Integer]) -> Q [[Integer]]
+liftantijoin (view -> (xs, ys)) =
+    [ [ x | x <- g, x `notElem` ys ]
+    | g <- groupWith (`rem` 10) xs
+    ]
+
+liftthetajoin :: Q ([Integer], [Integer]) -> Q [[(Integer, Integer)]]
+liftthetajoin (view -> (xs, ys)) =
+    [ [ pair x y | x <- g, y <- ys, x < y ]
+    | g <- groupWith (`rem` 10) xs
+    ]
+
+--------------------------------------------------------------
+-- Comprehensions for HUnit tests
+
+eqjoin_nested1 :: Q [((Integer, [Char]), Integer)]
+eqjoin_nested1 =
+    [ pair x y
+    | x <- (toQ ([(10, ['a']), (20, ['b']), (30, ['c', 'd']), (40, [])] :: [(Integer, [Char])]))
+    , y <- (toQ [20, 30, 30, 40, 50])
+    , fst x == y
+    ]
+
+semijoin :: Q [Integer]
+semijoin =
+    let xs = (toQ [1, 2, 3, 4, 5, 6, 7] :: Q [Integer])
+        ys = (toQ [2, 4, 6, 7] :: Q [Integer])
+    in [ x | x <- xs , x `elem` ys ]
+
+semijoin_range :: Q [Integer]
+semijoin_range =
+    let xs = (toQ [1, 2, 3, 4, 5, 6, 7] :: Q [Integer])
+        ys = (toQ [2, 4, 6] :: Q [Integer])
+    in [ x | x <- xs , x `elem` [ y | y <- ys, y < 6 ] ]
+
+semijoin_quant :: Q [Integer]
+semijoin_quant =
+    let xs = (toQ [1, 2, 3, 4, 5, 6, 7] :: Q [Integer])
+        ys = (toQ [2, 4, 6, 7] :: Q [Integer])
+    in [ x | x <- xs, or [ y > 5 | y <- ys, x == y ] ]
+
+semijoin_not_null :: Q [Integer]
+semijoin_not_null =
+    let xs = (toQ [1, 2, 3, 4, 5, 6, 7] :: Q [Integer])
+        ys = (toQ [2, 4, 6, 7] :: Q [Integer])
+    in [ x | x <- xs, not $ null [ y | y <- ys, x == y] ]
+
+
+antijoin :: Q [Integer]
+antijoin =
+    let xs = (toQ [1, 2, 3, 4, 5, 6, 7] :: Q [Integer])
+        ys = (toQ [2, 4, 6, 7] :: Q [Integer])
+    in [ x | x <- xs , not $ x `elem` ys ]
+
+antijoin_null :: Q [Integer]
+antijoin_null =
+    let xs = (toQ [1, 2, 3, 4, 5, 6, 7] :: Q [Integer])
+        ys = (toQ [2, 4, 6, 7] :: Q [Integer])
+    in [ x | x <- xs, null [ y | y <- ys, x == y] ]
+
+antijoin_range :: Q [Integer]
+antijoin_range =
+    let xs = (toQ [1, 2, 3, 4, 5, 6, 7] :: Q [Integer])
+        ys = (toQ [2, 4, 6, 7] :: Q [Integer])
+    in [ x | x <- xs , not $ x `elem` [ y | y <- ys, y < 5 ] ]
+
+antijoin_class12 :: Q [Integer]
+antijoin_class12 =
+    let xs = toQ ([6,7,8,9,10,12] :: [Integer])
+        ys = toQ ([8,9,12,13,15,16] :: [Integer])
+    in [ x | x <- xs, and [ x < y | y <- ys, y > 10 ]]
+
+antijoin_class15 :: Q [Integer]
+antijoin_class15 =
+    let xs = toQ ([3,4,5,6,7,8] :: [Integer])
+        ys = toQ ([4,5,8,16] :: [Integer])
+    in [ x | x <- xs, and [ y `rem` 4 == 0 | y <- ys, x < y ]]
+
+antijoin_class16 :: Q [Integer]
+antijoin_class16 =
+    let xs = toQ ([3,4,5,6] :: [Integer])
+        ys = toQ ([1,2,3,4,5,6,7,8] :: [Integer])
+    in [ x | x <- xs, and [ y <= 2 * x | y <- ys, x < y ]]
+
+frontguard :: Q [[Integer]]
+frontguard =
+    [ [ y | x > 13, y <- toQ ([1,2,3,4] :: [Integer]), y < 3 ]
+    | x <- toQ ([10, 20, 30] :: [Integer])
+    ]
+
+----------------------------------------------------------------------
+-- Comprehensions for HUnit NestJoin/NestProduct tests
+
+nj1 :: [Integer] -> [Integer] -> Q [[Integer]]
+nj1 njxs njys =
+    [ [ y | y <- toQ njys, x == y ]
+    | x <- toQ njxs
+    ]
+
+nj2 :: [Integer] -> [Integer] -> Q [(Integer, [Integer])]
+nj2 njxs njys =
+    [ pair x [ y | y <- toQ njys, x == y ]
+    | x <- toQ njxs
+    ]
+
+nj3 :: [Integer] -> [Integer] -> Q [(Integer, [Integer])]
+nj3 njxs njys =
+    [ pair x ([ y | y <- toQ njys, x == y ] ++ (toQ [100, 200, 300]))
+    | x <- toQ njxs
+    ]
+
+nj4 :: [Integer] -> [Integer] -> Q [(Integer, [Integer])]
+nj4 njxs njys =
+      [ pair x ([ y | y <- toQ njys, x == y ] ++ [ z | z <- toQ njys, x == z ])
+      | x <- toQ njxs
+      ]
+
+-- Code incurs DistSeg for the literal 15.
+nj5 :: [Integer] -> [Integer] -> Q [(Integer, [Integer])]
+nj5 njxs njys =
+      [ pair x [ y | y <- toQ njys, x + y > 15 ]
+      | x <- toQ njxs
+      ]
+
+nj6 :: [Integer] -> [Integer] -> Q [(Integer, [Integer])]
+nj6 njxs njys =
+      [ pair x [ y | y <- toQ njys, x + y > 10, y < 7 ]
+      | x <- toQ njxs
+      ]
+
+nj7 :: [Integer] -> [Integer] -> Q [[Integer]]
+nj7 njxs njys =
+    [ [ x + y | y <- toQ njys, x + 2 == y ] | x <- toQ njxs ]
+
+nj8 :: [Integer] -> [Integer] -> Q [[Integer]]
+nj8 njxs njys = [ [ x + y | y <- toQ njys, x == y, y < 5 ] | x <- toQ njxs, x > 3 ]
+
+nj9 :: [Integer] -> [Integer] -> Q [[Integer]]
+nj9 njxs njys = [ [ x + y | y <- toQ njys, x + 1 == y, y > 2, x < 6 ] | x <- toQ njxs ]
+
+nj10 :: [Integer] -> [Integer] -> Q [Integer]
+nj10 njxs njys = [ x + sum [ x * y | y <- toQ njys, x == y ] | x <- toQ njxs ]
+
+nj11 :: [Integer] -> [Integer] -> Q [[Integer]]
+nj11 njxs njys = [ [ x + y | y <- toQ njys, x > y, x < y * 2 ] | x <- toQ njxs ]
+
+nj12 :: [Integer] -> [Integer] -> [Integer] -> Q [[[(Integer, Integer, Integer)]]]
+nj12 njxs njys njzs =
+    [ [ [ tup3 x y z | z <- toQ njzs, y == z ]
+      | y <- toQ njys
+      , x == y
+      ]
+    | x <- toQ njxs
+    ]
+
+np1 :: [Integer] -> [Integer] -> Q [[Integer]]
+np1 njxs njys = [ [ x * y * 2 | y <- toQ njys ] | x <- toQ njxs ]
+
+np2 :: [Integer] -> [Integer] -> Q [(Integer, [Integer])]
+np2 njxs njys = [ pair x [ y * 2 | y <- toQ njys ] | x <- toQ njxs ]
+
+np3 :: [Integer] -> [Integer] -> Q [[Integer]]
+np3 njxs njys = [ [ x + y | y <- toQ njys ] | x <- toQ njxs ]
+
+np4 :: [Integer] -> [Integer] -> Q [[Integer]]
+np4 njxs njys = [ [ y | y <- toQ njys, x > y ] | x <- toQ njxs ]
+
+njg1 :: [Integer] -> [(Integer, Integer)] -> Q [Integer]
+njg1 njgxs njgzs =
+  [ x
+  | x <- toQ njgxs
+  , x < 8
+  , sum [ snd z | z <- toQ njgzs, fst z == x ] > 100
+  ]
+
+njg2 :: [Integer] -> [Integer] -> Q [Integer]
+njg2 njgxs njgys =
+  [ x
+  | x <- toQ njgxs
+  , and [ y > 1 | y <- toQ njgys, x == y ]
+  , x < 8
+  ]
+
+njg3 :: [Integer] -> [Integer] -> [(Integer, Integer)] -> Q [(Integer, Integer)]
+njg3 njgxs njgys njgzs =
+  [ pair x y
+  | x <- toQ njgxs
+  , y <- toQ njgys
+  , length [ toQ () | z <- toQ njgzs, fst z == x ] > 2
+  ]
+
+njg4 :: [Integer] -> [Integer] -> [(Integer, Integer)] -> Q [Integer]
+njg4 njgxs njgys njgzs =
+  [ x
+  | x <- toQ njgxs
+  , length [ toQ () | y <- toQ njgys, x == y ]
+    > length [ toQ () | z <- toQ njgzs, fst z == x ]
+  ]
+
+njg5 :: [Integer] -> [Integer] -> Q [Integer]
+njg5 njgxs njgys =
+  [ x
+  | x <- toQ njgxs
+  , sum [ y | y <- toQ njgys, x < y, y > 5 ] < 10
+  ]
+
+--------------------------------------------------------------------------------
+-- Comprehensions for QuickCheck antijoin/semijoin tests
+
+aj_class12 :: Q ([Integer], [Integer]) -> Q [Integer]
+aj_class12 (view -> (xs, ys)) =
+  [ x
+  | x <- xs
+  , and [ x == y | y <- ys, y > 10 ]
+  ]
+
+aj_class15 :: Q ([Integer], [Integer]) -> Q [Integer]
+aj_class15 (view -> (xs, ys)) =
+  [ x
+  | x <- xs
+  , and [ y `rem` 4 == 0 | y <- ys, x < y ]
+  ]
+
+aj_class16 :: Q ([Integer], [Integer]) -> Q [Integer]
+aj_class16 (view -> (xs, ys)) =
+  [ x
+  | x <- xs
+  , and [ y <= 2 * x | y <- ys, x < y ]
+  ]
+
+
+
+--------------------------------------------------------------------------------
+-- Comprehensions for
+
+backdep :: Q [[Integer]] -> Q [Integer]
+backdep xss = [ x | xs <- xss, x <- xs ]
+
+backdep_filter :: Q [[Integer]] -> Q [Integer]
+backdep_filter xss = [ x | xs <- xss, x <- xs, length xs > x ]
+
+backdep2 :: Q [[Integer]] -> Q [[Integer]]
+backdep2 xss = [ [ x * 42 | x <- xs ] | xs <- xss ]
+
+backdep3 :: Q [[Integer]] -> Q [[Integer]]
+backdep3 xss = [ [ x + length xs | x <- xs ] | xs <- xss ]
+
+backdep4 :: Q [[[Integer]]] -> Q [[[Integer]]]
+backdep4 xsss = [ [ [ x + length xs + length xss
+                    | x <- xs
+                    ]
+                  | xs <- xss
+                  ]
+                | xss <- xsss
+                ]
+
+backdep5 :: Q [[Integer]] -> Q [[Integer]]
+backdep5 xss = [ [ x + length xs | x <- take (length xs - 3) xs ] | xs <- xss ]
+
+deep_iter :: Q ([Integer], [Integer], [Integer], [Integer], [Integer]) -> Q [[[[Integer]]]]
+deep_iter (view -> (ws1, ws2, xs, ys, zs)) =
+  [ [ [ [ w1 * 23 - y | w1 <- ws1 ]
+        ++
+        [ w2 + 42 - y | w2 <- ws2 ]
+      | z <- zs
+      , z > x
+      ]
+    | y <- ys
+    ]
+  | x <- xs
+  ]
+
+only_tuple :: Q (Integer, [Integer], [Integer]) -> Q (Integer, (Integer, [Integer]))
+only_tuple (view -> (x, ys, zs)) =
+    pair x (head [ pair y [ z | z <- zs, x == y ]  | y <- ys ])
diff --git a/src/Database/DSH/Tests/LawTests.hs b/src/Database/DSH/Tests/LawTests.hs
new file mode 100644
--- /dev/null
+++ b/src/Database/DSH/Tests/LawTests.hs
@@ -0,0 +1,49 @@
+module Database.DSH.Tests.LawTests
+    ( tests_laws
+    ) where
+
+
+
+import           Test.Framework            (Test, testGroup)
+import           Test.QuickCheck
+import           Test.QuickCheck.Monadic
+
+import qualified Database.DSH              as Q
+import           Database.DSH.Backend
+import           Database.DSH.Compiler
+import           Database.DSH.Tests.Common
+
+tests_laws :: Backend c => c -> Test
+tests_laws conn = testGroup "List Laws"
+    [ testPropertyConn conn "takedrop" prop_takedrop
+    , testPropertyConn conn "reverse id" prop_reverse_identity
+    , testPropertyConn conn "reverse sort" prop_reverse_sort
+    , testPropertyConn conn "reverse sort tuple" prop_reverse_sort_tuple
+    ]
+
+--------------------------------------------------------------------------------
+-- Common list laws
+
+prop_takedrop :: Backend c => (Integer, [Integer]) -> c -> Property
+prop_takedrop (i, xs) conn = monadicIO $ do
+    let q = Q.take (Q.toQ i) (Q.toQ xs) Q.++ Q.drop (Q.toQ i) (Q.toQ xs)
+    res <- run $ runQ conn q
+    assert $ res == xs
+
+prop_reverse_identity :: Backend c => [Integer] -> c -> Property
+prop_reverse_identity xs conn = monadicIO $ do
+    let q = Q.reverse $ Q.reverse (Q.toQ xs)
+    res <- run $ runQ conn q
+    assert $ res == xs
+
+prop_reverse_sort :: Backend c => OrderedList Integer -> c -> Property
+prop_reverse_sort (Ordered xs) conn = monadicIO $ do
+    let q = Q.sortWith id $ Q.reverse (Q.toQ xs)
+    res <- run $ runQ conn q
+    assert $ res == xs
+
+prop_reverse_sort_tuple :: Backend c => OrderedList (Integer, Integer) -> c -> Property
+prop_reverse_sort_tuple (Ordered xs) conn = monadicIO $ do
+    let q = Q.sortWith id $ Q.reverse (Q.toQ xs)
+    res <- run $ runQ conn q
+    assert $ res == xs
diff --git a/src/Database/DSH/Tools/VLDotGen.hs b/src/Database/DSH/Tools/VLDotGen.hs
--- a/src/Database/DSH/Tools/VLDotGen.hs
+++ b/src/Database/DSH/Tools/VLDotGen.hs
@@ -1,30 +1,32 @@
 module Main where
 
-import System.IO
-import System.Exit
-import System.Environment
-import System.Console.GetOpt
+import           System.Console.GetOpt
+import           System.Environment
+import           System.Exit
+import           System.IO
 
-import Data.ByteString.Lazy.Char8 (pack)
-  
-import Data.Maybe
+import           Data.Aeson
+import           Data.ByteString.Lazy.Char8 (pack)
+import qualified Data.IntMap                as M
+import           Data.Maybe
 
-import Database.DSH.VL.Render.JSON
-import Database.DSH.VL.Render.Dot
-  
-data Options = Options { optInput          :: IO String
-                       , optReuse          :: Bool
-                       , optRootNodes      :: Maybe [Int]
-                       , optProperties      :: Bool
+import           Database.Algebra.Dag
+
+import           Database.DSH.VL.Render.Dot
+
+data Options = Options { optInput      :: IO String
+                       , optReuse      :: Bool
+                       , optRootNodes  :: Maybe [Int]
+                       , optProperties :: Bool
                        }
-               
+
 startOptions :: Options
 startOptions = Options { optInput            = getContents
                        , optReuse            = False
                        , optRootNodes        = Nothing
                        , optProperties       = False
                        }
-               
+
 options :: [OptDescr (Options -> IO Options)]
 options =
   [ Option "i" ["input"]
@@ -37,19 +39,19 @@
       "List of root nodes to use (must be in Haskell list syntax)"
   , Option "p" ["properties"]
       (NoArg (\opt -> return opt { optProperties = True }))
-      "Infer properties and display them" 
+      "Infer properties and display them"
   , Option "h" ["help"]
       (NoArg
-         (\_ -> do 
+         (\_ -> do
              prg <- getProgName
              hPutStrLn stderr (usageInfo prg options)
              exitWith ExitSuccess))
       "Show help"
   ]
-  
+
 {-
 propertyTags :: [AlgNode] -> NodeMap X100Algebra -> NodeMap [Tag] -> NodeMap [Tag]
-propertyTags rs nm tags = 
+propertyTags rs nm tags =
   let dag = normalizePlan $ mkDag nm rs
       topsorted = topsort dag
       bu = inferBottomUpProperties topsorted dag
@@ -60,24 +62,24 @@
       propsRendered = M.map render $ M.unionWith ($$) tagDocs $ M.unionWith ($$) buDocs tdDocs
       in M.map (\s -> [s]) propsRendered
 -}
-         
+
 main :: IO ()
 main = do
-    args <- getArgs 
+    args <- getArgs
     let (actions, _, _) = getOpt RequireOrder options args
     opts <- foldl (>>=) (return startOptions) actions
     let Options { optInput = input
                 , optRootNodes = mRootNodes } = opts
-    
+
     plan <- input
-    
-    let (tags, rs, m) = deserializePlan $ pack plan
-    
-    let rs' = fromMaybe rs mRootNodes
+
+    let dag = fromJust $ decode $ pack plan
+
+    let rs' = fromMaybe (rootNodes dag) mRootNodes
     {-
         tags' = if printProperties
                 then propertyTags rs' m tags
                 else tags
 -}
-    
-    putStr $ renderVLDot tags rs' m
+
+    putStr $ renderVLDot M.empty rs' (nodeMap dag)
diff --git a/src/Database/DSH/Translate/Algebra2Query.hs b/src/Database/DSH/Translate/Algebra2Query.hs
deleted file mode 100644
--- a/src/Database/DSH/Translate/Algebra2Query.hs
+++ /dev/null
@@ -1,42 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-
-module Database.DSH.Translate.Algebra2Query 
-    ( generateSqlQueries
-    ) where
-
-import           Database.DSH.Impossible
-
-import           Database.Algebra.Dag
-import           Database.Algebra.SQL.Compatibility
-import           Database.Algebra.SQL.Materialization.CTE
-import           Database.Algebra.SQL.Util
-import           Database.Algebra.Table.Lang
-
-import           Database.DSH.Common.QueryPlan
-import           Database.DSH.Execute.Sql
-import           Database.DSH.VL.Vector
-
--- | In a query shape, render each root node for the algebraic plan
--- into a separate SQL query.
-
--- FIXME use materialization "prelude"
-generateSqlQueries :: QueryPlan TableAlgebra NDVec -> Shape (BackendCode SqlBackend)
-generateSqlQueries taPlan = renderQueryCode $ queryShape taPlan
-  where
-    roots = rootNodes $ queryDag taPlan
-    (_sqlShared, sqlQueries) = renderOutputDSHWith PostgreSQL materialize (queryDag taPlan)
-    nodeToQuery  = zip roots sqlQueries
-    lookupNode n = maybe $impossible SqlCode $ lookup n nodeToQuery
-
-    renderQueryCode :: Shape NDVec -> Shape (BackendCode SqlBackend)
-    renderQueryCode shape =
-        case shape of
-            SShape (ADVec r _) lyt -> SShape (lookupNode r) (convertLayout lyt)
-            VShape (ADVec r _) lyt -> VShape (lookupNode r) (convertLayout lyt)
-
-    convertLayout :: Layout NDVec -> Layout (BackendCode SqlBackend)
-    convertLayout lyt =
-        case lyt of
-            LCol i                 -> LCol i
-            LNest (ADVec r _) clyt -> LNest (lookupNode r) (convertLayout clyt)
-            LTuple lyts            -> LTuple $ map convertLayout lyts
diff --git a/src/Database/DSH/Translate/CL2NKL.hs b/src/Database/DSH/Translate/CL2NKL.hs
--- a/src/Database/DSH/Translate/CL2NKL.hs
+++ b/src/Database/DSH/Translate/CL2NKL.hs
@@ -14,10 +14,9 @@
 import qualified Data.List.NonEmpty          as N
 import qualified Data.Foldable               as F
 import           Control.Monad.Reader
-import           Control.Applicative
-  
-import           Database.DSH.Impossible
-       
+
+import           Database.DSH.Common.Impossible
+
 import           Database.DSH.Common.Type
 import           Database.DSH.Common.Lang
 
@@ -29,60 +28,51 @@
 
 --------------------------------------------------------------------------------
 -- Conversion of primitive operators
-       
+
 prim1 :: Type -> CL.Prim1 -> CL.Expr -> NameEnv NKL.Expr
 prim1 t p e = mkApp t <$> expr e
-  where 
-    mkApp = 
+  where
+    mkApp =
         case p of
             CL.Singleton        -> mkPrim1 NKL.Singleton
-            CL.Length           -> mkPrim1 NKL.Length 
-            CL.Concat           -> mkPrim1 NKL.Concat 
+            CL.Only             -> mkPrim1 NKL.Only
+            CL.Length           -> mkPrim1 NKL.Length
+            CL.Concat           -> mkPrim1 NKL.Concat
             -- Null in explicit form is useful during CL optimization
             -- to easily recognize universal/existential patterns. In
             -- backend implementations however, there currently is no
             -- need to store it explicitly. Therefore, we implement it
             -- using length in NKL.
             CL.Null             -> nklNull
-            CL.Sum              -> mkPrim1 NKL.Sum 
-            CL.Avg              -> mkPrim1 NKL.Avg 
-            CL.The              -> mkPrim1 NKL.The 
-            CL.Head             -> mkPrim1 NKL.Head 
-            CL.Minimum          -> mkPrim1 NKL.Minimum 
-            CL.Maximum          -> mkPrim1 NKL.Maximum 
-            CL.Tail             -> mkPrim1 NKL.Tail 
-            CL.Reverse          -> mkPrim1 NKL.Reverse 
-            CL.And              -> mkPrim1 NKL.And 
-            CL.Or               -> mkPrim1 NKL.Or 
-            CL.Init             -> mkPrim1 NKL.Init 
-            CL.Last             -> mkPrim1 NKL.Last 
-            CL.Nub              -> mkPrim1 NKL.Nub 
-            CL.Number           -> mkPrim1 NKL.Number 
-            (CL.Reshape n)      -> mkPrim1 $ NKL.Reshape n
-            CL.Transpose        -> mkPrim1 NKL.Transpose
+            CL.Sum              -> mkPrim1 NKL.Sum
+            CL.Avg              -> mkPrim1 NKL.Avg
+            CL.Minimum          -> mkPrim1 NKL.Minimum
+            CL.Maximum          -> mkPrim1 NKL.Maximum
+            CL.Reverse          -> mkPrim1 NKL.Reverse
+            CL.And              -> mkPrim1 NKL.And
+            CL.Or               -> mkPrim1 NKL.Or
+            CL.Nub              -> mkPrim1 NKL.Nub
+            CL.Number           -> mkPrim1 NKL.Number
             CL.TupElem i        -> mkPrim1 $ NKL.TupElem i
+            CL.Sort             -> mkPrim1 NKL.Sort
+            CL.Group            -> mkPrim1 NKL.Group
             CL.Guard            -> $impossible
-    
-    nklNull _ ne = NKL.BinOp boolT 
+
+    nklNull _ ne = NKL.BinOp PBoolT
                              (SBRelOp Eq)
-                             (NKL.Const intT $ IntV 0)
-                             (NKL.AppE1 intT NKL.Length ne)
-                                       
+                             (NKL.Const PIntT $ ScalarV $ IntV 0)
+                             (NKL.AppE1 PIntT NKL.Length ne)
+
     mkPrim1 nop nt ne = NKL.AppE1 nt nop ne
-                                   
 
--- | Transform applications of binary primitives. Regular primitives
--- are mapped to their direct NKL equivalent. Higher-order primitives
--- (concatMap, map, filter, sortWith, groupWith) are mapped to their
--- first-order NKL equivalent combined with a single-generator
--- comprehension.
+
+-- | Transform applications of binary primitives.
 prim2 :: Type -> CL.Prim2 -> CL.Expr -> CL.Expr -> NameEnv NKL.Expr
 prim2 t o e1 e2 = mkApp2
   where
     mkApp2 =
         case o of
             CL.Append       -> mkPrim2 NKL.Append
-            CL.Index        -> mkPrim2 NKL.Index 
             CL.Zip          -> mkPrim2 NKL.Zip
             CL.CartProduct  -> mkPrim2 NKL.CartProduct
             CL.NestProduct  -> mkPrim2 NKL.NestProduct
@@ -90,8 +80,6 @@
             CL.NestJoin p   -> mkPrim2 $ NKL.NestJoin p
             CL.SemiJoin p   -> mkPrim2 $ NKL.SemiJoin p
             CL.AntiJoin p   -> mkPrim2 $ NKL.AntiJoin p
-            CL.Sort         -> mkPrim2 $ NKL.Sort
-            CL.Group        -> mkPrim2 $ NKL.Group
 
     mkPrim2 :: NKL.Prim2 -> NameEnv NKL.Expr
     mkPrim2 nop = NKL.AppE2 t nop <$> expr e1 <*> expr e2
@@ -109,7 +97,7 @@
 -- each variable, we store it's type and an expression that projects
 -- the variables' value out of the constructed tuple.
 type GenEnv = N.NonEmpty EnvEntry
-            
+
 -- | Construct an environment from one generator variable
 -- => (x, t, \n t -> Var t n)
 mkEnv :: (Ident, Type) -> GenEnv
@@ -134,24 +122,23 @@
 
 type NameEnv a = Reader [Ident] a
 
-freshName :: NameEnv Ident
-freshName = do
-    boundNames <- ask
-    return $ tryName 0 boundNames
-
+-- | Generate an identifier that does not occur in the list provided.
+freshIdent :: [Ident] -> NameEnv Ident
+freshIdent names = do
+    visibleNames <- ask
+    return $ checkCollision (0 :: Int) (names ++ visibleNames)
   where
-    tryName :: Int -> [Ident] -> Ident
-    tryName i ns = if mkName i `elem` ns
-                   then tryName (i + 1) ns
-                   else mkName i
+    checkCollision i ns = if mkName i `elem` ns
+                          then checkCollision (i + 1) ns
+                          else mkName i
 
-    mkName i = "f" ++ show i
+    mkName i = "v" ++ show i
 
 -- | Map a CL expression to its NKL equivalent by desugaring all
 -- comprehensions.
 expr :: CL.Expr -> NameEnv NKL.Expr
 expr (CL.MkTuple t es)           = NKL.MkTuple t <$> mapM expr es
-expr (CL.Table t s cs ks)        = return $ NKL.Table t s cs ks
+expr (CL.Table t s schema)       = return $ NKL.Table t s schema
 expr (CL.AppE1 t p e)            = prim1 t p e
 expr (CL.AppE2 t p e1 e2)        = prim2 t p e1 e2
 expr (CL.BinOp t o e1 e2)        = NKL.BinOp t o <$> expr e1 <*> expr e2
@@ -169,7 +156,7 @@
 -- but deal only with list comprehensions. The motivation for now is
 -- to avoid inefficient patterns (e.g. the handling of guards via
 -- 'if') already by construction.
--- 
+--
 -- In the current qualifier list, we consider the longest prefix of
 -- generators. The cartesian product of those generators is
 -- computed. We compute the cartesian product using nested
@@ -179,7 +166,7 @@
 -- cartesian product of all preceding generators.
 --
 -- Example:
--- 
+--
 -- [ e x y z | x <- xs, y <- ys, p1 x y, z <- zs, p2 y z ]
 -- =>
 -- map (\t -> e [x/fst (fst t)] [y/snd (fst t)] [z/snd t])
@@ -188,25 +175,14 @@
 --                        (filter (\t -> p1[x/fst t][y/snd t])
 --                                (concatMap (\t -> concatMap (\y -> pair t y) ys[x/t])
 --                                           xs
-     
+
 -- | Split a qualifier list into a prefix of generators and the
 -- remaining qualifiers.
 takeGens :: [CL.Qual] -> ([(Ident, CL.Expr)], [CL.Qual])
 takeGens (CL.BindQ x xs : qs) = let (binds, rest) = takeGens qs in ((x, xs) : binds, rest)
 takeGens qs                   = ([], qs)
 
--- | Generate an identifier that does not occur in the list provided.
-freshIdent :: [Ident] -> NameEnv Ident
-freshIdent names = do
-    visibleNames <- ask
-    return $ checkCollision (0 :: Int) (names ++ visibleNames)
-  where
-    checkCollision i ns = if mkName i `elem` ns
-                          then checkCollision (i + 1) ns
-                          else mkName i
 
-    mkName i = "v" ++ show i
-
 -- | Construct a left-deep tuple from a list of expressions
 mkTuple :: NonEmpty NKL.Expr -> NKL.Expr
 mkTuple xs = F.foldl1 P.pair xs
@@ -219,28 +195,28 @@
 -- concatMap (\x -> concatMap (\y -> concatMap (\z -> (((t, x), y), z)) zs) ys) xs
 -- where t is the binding variable for the base expression.
 nestQualifiers :: NKL.Expr -> [(Ident, NKL.Expr)] -> NKL.Expr
-nestQualifiers tupConst ((x, xs) : qs) = P.concat $ NKL.Iterator (listT bodyType) compHead x xs
+nestQualifiers tupConst ((x, xs) : qs) = P.concat $ NKL.Iterator (ListT bodyType) compHead x xs
   where
     compHead  = nestQualifiers tupConst qs
     bodyType = typeOf compHead
 nestQualifiers tupConst []             = tupConst
 
--- | Desugar a sequence of generators. 
+-- | Desugar a sequence of generators.
 desugarGens :: GenEnv -> NKL.Expr -> NonEmpty (Ident, NKL.Expr) -> NameEnv NKL.Expr
 desugarGens env baseExpr qs = do
     -- Avoid all names that are bound by enclosing binders and the
     -- ones bound in the current generator list.
     visibleNames <- (++) (map fst $ N.toList qs) <$> ask
-    
+
     -- Avoid all names that are bound in the generator expressions in
     -- which we will substitute.
     let boundNames = concatMap (boundVars . snd) $ N.toList qs
         avoidNames = boundNames ++ visibleNames
 
-    outerName    <- freshIdent $ visibleNames ++ boundNames 
+    outerName    <- freshIdent $ visibleNames ++ boundNames
 
     let baseElemType   = elemT $ typeOf baseExpr
-        
+
         -- Generator expressions might reference variables bound by
         -- preceding generators. These variables go out of scope during
         -- desugaring. To eliminate them, we have to replace references to
@@ -251,9 +227,9 @@
     let qs'            = fmap substGenExpr qs
 
         tupConst       = P.sng $ mkTuple $ fmap mkVar ((outerName, baseExpr) N.<| qs')
-        mkVar (x, xs)  = NKL.Var (elemT $ typeOf xs) x 
+        mkVar (x, xs)  = NKL.Var (elemT $ typeOf xs) x
         gensExpr       = nestQualifiers tupConst (N.toList qs')
-        compTy         = (listT $ typeOf tupConst)
+        compTy         = (ListT $ typeOf tupConst)
     return $ P.concat $ NKL.Iterator compTy gensExpr outerName baseExpr
 
 -- | Replace every occurence of a generator variable with the
@@ -279,7 +255,9 @@
     qs' <- local (n :) (genExprs $ q :| qs)
     return $ (n, e') N.<| qs'
 
--- | Desugar a list of qualifiers.
+-- | Desugar a list of qualifiers. The second parameter 'baseSrc' is
+-- the (filtered) cartesian product of all generators that have been
+-- desugared so far.
 desugarQualsRec :: GenEnv -> NKL.Expr -> [CL.Qual] -> NameEnv (GenEnv, NKL.Expr)
 -- If we encounter a generator, we produce the cartesian product of
 -- the generator prefix of the current qualifier list.
@@ -288,10 +266,10 @@
         genNames         = map fst gens
     nklGens  <- genExprs ((x, xs) :| gens)
     baseSrc' <- desugarGens env baseSrc nklGens
-    let env' = addGensToEnv nklGens env 
+    let env' = addGensToEnv nklGens env
 
     local (++ genNames) $ desugarQualsRec env' baseSrc' remQuals
-                       
+
 -- A guard is desugared by filtering the cartesian product of the
 -- generators that have been encountered so far.
 desugarQualsRec env baseSrc (CL.GuardQ p : qs)    = do
@@ -299,14 +277,19 @@
     visibleNames <- ask
 
     filterName   <- freshIdent $ visibleNames ++ boundVars p'
-    srcName      <- freshName
-    let srcVar = NKL.Var (typeOf baseSrc) srcName
 
-    let elemType   = elemT $ typeOf baseSrc
-        filterExpr = substTupleAccesses visibleNames (filterName, elemType) env p'
-        predComp   = NKL.Iterator (listT boolT) filterExpr filterName srcVar
-        filterSrc  = P.let_ srcName baseSrc (P.restrict srcVar predComp)
+    let elemTy        = elemT $ typeOf baseSrc
+        filterExpr    = substTupleAccesses visibleNames (filterName, elemTy) env p'
 
+        predTy        = ListT (PPairT elemTy PBoolT)
+        predPairConst = P.tuple [NKL.Var elemTy filterName, filterExpr]
+        -- Construct an iterator that pairs every input element with
+        -- the corresponding result of the predicate:
+        --
+        -- [ (x, p x) | x <- xs ]
+        predIter      = NKL.Iterator predTy predPairConst filterName baseSrc
+        filterSrc     = P.restrict predIter
+
     desugarQualsRec env filterSrc qs
 
 desugarQualsRec env baseSrc []                    = return (env, baseSrc)
@@ -359,13 +342,13 @@
         -- though, as the information is only used for alpha-conversion
         -- on lambdas during substitution.
         e''      = substTupleAccesses visibleNames (n, t) env e'
- 
-    return $ wrapHead $ NKL.Iterator (listT $ typeOf e') e'' n genExpr
-        
+
+    return $ wrapHead $ NKL.Iterator (ListT $ typeOf e') e'' n genExpr
+
 -- | Express comprehensions through NKL iteration constructs map and
 -- concatMap and filter.
 desugarComprehensions :: CL.Expr -> NKL.Expr
-desugarComprehensions e = 
+desugarComprehensions e =
 #ifdef DEBUGCOMP
     trace (debugPrint eo) eo
 
@@ -380,4 +363,3 @@
 #else
     runReader (expr e) []
 #endif
-
diff --git a/src/Database/DSH/Translate/FKL2VL.hs b/src/Database/DSH/Translate/FKL2VL.hs
--- a/src/Database/DSH/Translate/FKL2VL.hs
+++ b/src/Database/DSH/Translate/FKL2VL.hs
@@ -3,8 +3,6 @@
 
 module Database.DSH.Translate.FKL2VL (specializeVectorOps) where
 
-import           Control.Applicative              hiding (Const)
-
 import           Control.Monad.Reader
 
 import           Database.Algebra.Dag.Build
@@ -13,14 +11,12 @@
 import           Database.DSH.Common.Lang
 import           Database.DSH.Common.QueryPlan
 import           Database.DSH.Common.Type
+import           Database.DSH.Common.Vector
 import           Database.DSH.FKL.Lang
-import           Database.DSH.Impossible
-import           Database.DSH.VL.Render.JSON      ()
-import           Database.DSH.VL.Vector
+import           Database.DSH.Common.Impossible
 import qualified Database.DSH.VL.Lang          as VL
-import           Database.DSH.VL.Render.JSON   ()
-import qualified Database.DSH.VL.Vectorize     as V
 import           Database.DSH.VL.Primitives
+import qualified Database.DSH.VL.Vectorize     as V
 
 --------------------------------------------------------------------------------
 -- Extend the DAG builder monad with an environment for compiled VL
@@ -49,18 +45,17 @@
         Let _ n e1 e -> do
             e1' <- fkl2VL e1
             local (bind n e1') $ fkl2VL e
-        Table _ n cs hs -> lift $ V.dbTable n cs hs
+        Table _ n schema -> do
+            lift $ V.dbTable n schema
         Const t v -> lift $ V.mkLiteral t v
         BinOp _ o NotLifted e1 e2    -> do
-            SShape p1 lyt <- fkl2VL e1
-            SShape p2 _   <- fkl2VL e2
-            p              <- lift $ vlBinExpr o p1 p2
-            return $ SShape p lyt
+            s1 <- fkl2VL e1
+            s2 <- fkl2VL e2
+            lift $ V.binOp o s1 s2
         BinOp _ o Lifted e1 e2     -> do
-            VShape p1 lyt <- fkl2VL e1
-            VShape p2 _   <- fkl2VL e2
-            p                  <- lift $ vlBinExpr o p1 p2
-            return $ VShape p lyt
+            s1 <- fkl2VL e1
+            s2 <- fkl2VL e2
+            lift $ V.binOpL o s1 s2
         UnOp _ o NotLifted e1 -> do
             SShape p1 lyt <- fkl2VL e1
             p              <- lift $ vlUnExpr o p1
@@ -108,17 +103,15 @@
 papp1 t f Lifted =
     case f of
         Singleton       -> V.singletonL
+        Only            -> V.onlyL
         Length          -> V.lengthL
         Concat          -> V.concatL
-        The             -> V.theL
-        Tail            -> V.tailL
         Reverse         -> V.reverseL
-        Init            -> V.initL
-        Last            -> V.lastL
         Nub             -> V.nubL
         Number          -> V.numberL
-        Transpose       -> V.transposeL
-        Reshape n       -> V.reshapeL n
+        Sort            -> V.sortL
+        Group           -> V.groupL
+        Restrict        -> V.restrictL
         And             -> V.aggrL VL.AggrAll
         Or              -> V.aggrL VL.AggrAny
         Minimum         -> V.aggrL VL.AggrMin
@@ -130,17 +123,15 @@
 papp1 t f NotLifted =
     case f of
         Singleton        -> V.singleton
+        Only             -> V.only
         Length           -> V.length_
-        Reshape n        -> V.reshape n
-        Transpose        -> V.transpose
         Number           -> V.number
+        Sort             -> V.sort
+        Group            -> V.group
+        Restrict         -> V.restrict
         Nub              -> V.nub
-        Last             -> V.last
-        Init             -> V.init
         Reverse          -> V.reverse
-        Tail             -> V.tail
         Concat           -> V.concat
-        The              -> V.the
         Sum              -> V.aggr $ VL.AggrSum $ typeToScalarType t
         Avg              -> V.aggr VL.AggrAvg
         Or               -> V.aggr VL.AggrAny
@@ -153,11 +144,7 @@
 papp2 f Lifted =
     case f of
         Dist           -> V.distL
-        Group          -> V.groupL
-        Sort           -> V.sortL
-        Restrict       -> V.restrictL
         Append         -> V.appendL
-        Index          -> V.indexL
         Zip            -> V.zipL
         CartProduct    -> V.cartProductL
         NestProduct    -> V.nestProductL
@@ -169,11 +156,7 @@
 papp2 f NotLifted =
     case f of
         Dist            -> V.dist
-        Group           -> V.group
-        Sort            -> V.sort
-        Restrict        -> V.restrict
         Append          -> V.append
-        Index           -> V.index
         Zip             -> V.zip
         CartProduct     -> V.cartProduct
         NestProduct     -> V.nestProduct
@@ -191,29 +174,26 @@
   where
     traverseShape :: Shape VLDVec -> Build VL.VL (Shape VLDVec)
     traverseShape (VShape (VLDVec q) lyt) =
-        insertProj lyt q VL.Project VLDVec VShape
+        insertProj lyt q VShape
     traverseShape (SShape (VLDVec q) lyt)     =
-        insertProj lyt q VL.Project VLDVec SShape
+        insertProj lyt q SShape
 
     traverseLayout :: (Layout VLDVec) -> Build VL.VL (Layout VLDVec)
-    traverseLayout (LCol c)               = return $ LCol c
+    traverseLayout LCol                   = return LCol
     traverseLayout (LTuple lyts)          = LTuple <$> mapM traverseLayout lyts
     traverseLayout (LNest (VLDVec q) lyt) =
-      insertProj lyt q VL.Project VLDVec LNest
+      insertProj lyt q LNest
 
-    insertProj
-      :: Layout VLDVec               -- ^ The node's layout
-      -> Alg.AlgNode                    -- ^ The top node to consider
-      -> ([VL.Expr] -> VL.UnOp)         -- ^ Constructor for the projection op
-      -> (Alg.AlgNode -> v)             -- ^ Vector constructor
-      -> (v -> (Layout VLDVec) -> t) -- ^ Layout/Shape constructor
-      -> Build VL.VL t
-    insertProj lyt q project vector describe = do
+    insertProj :: Layout VLDVec                    -- ^ The node's layout
+               -> Alg.AlgNode                      -- ^ The top node to consider
+               -> (VLDVec -> (Layout VLDVec) -> t) -- ^ Layout/Shape constructor
+               -> Build VL.VL t
+    insertProj lyt q describe = do
         let width = columnsInLayout lyt
             cols  = [1 .. width]
-        qp   <- insert $ Alg.UnOp (project $ map VL.Column cols) q
+        qp   <- insert $ Alg.UnOp (VL.Project $ map VL.Column cols) q
         lyt' <- traverseLayout lyt
-        return $ describe (vector qp) lyt'
+        return $ describe (VLDVec qp) lyt'
 
 -- | Compile a FKL expression into a query plan of vector operators (VL)
 specializeVectorOps :: FExpr -> QueryPlan VL.VL VLDVec
diff --git a/src/Database/DSH/Translate/Frontend2CL.hs b/src/Database/DSH/Translate/Frontend2CL.hs
--- a/src/Database/DSH/Translate/Frontend2CL.hs
+++ b/src/Database/DSH/Translate/Frontend2CL.hs
@@ -5,91 +5,55 @@
 
 -- | Translate DSH frontend expressions (implicitly typed through
 -- GADT) into explicitly typed DSH backend expressions.
-module Database.DSH.Translate.Frontend2CL (toComprehensions) where
-
-import           Database.DSH.Impossible
-
-import qualified Database.DSH.CL.Lang            as CL
-import qualified Database.DSH.CL.Primitives      as CP
-import qualified Database.DSH.Common.Lang        as L
-import qualified Database.DSH.Common.Type        as T
-
-import           Data.Text                       (unpack)
-import           Database.DSH.Frontend.Funs
-import           Database.DSH.Frontend.TupleTypes
-import           Database.DSH.Frontend.Internals
-
-import qualified Data.Map                        as M
+module Database.DSH.Translate.Frontend2CL
+    ( toComprehensions
+    ) where
 
-import           Control.Applicative
-import           Control.Monad
 import           Control.Monad.State
-
+import           Data.List.NonEmpty               (NonEmpty((:|)))
+import qualified Data.List.NonEmpty               as N
+import qualified Data.Text                        as T
 import           Text.Printf
 
-import           GHC.Exts                        (sortWith)
-
--- | For each column, we need the name of the column, a string
--- description of the type for error messsages and a function to check
--- a DSH base type for compability with the column.
-type TableInfo = [(String, String, (T.Type -> Bool))]
-
-type TableInfoCache = M.Map String TableInfo
-
-type QueryTableInfo = String -> IO TableInfo
-
--- In the state, we store a counter for fresh variable names, the
--- cache for table information and the backend-specific IO function
--- that retrieves not-yet-cached table information.
-type CompileState = (Integer, TableInfoCache, QueryTableInfo)
+import qualified Database.DSH.CL.Lang             as CL
+import qualified Database.DSH.CL.Primitives       as CP
+import           Database.DSH.Common.Impossible
+import qualified Database.DSH.Common.Lang         as L
+import qualified Database.DSH.Common.Type         as Ty
+import           Database.DSH.Frontend.Builtins
+import           Database.DSH.Frontend.Internals
+import           Database.DSH.Frontend.TupleTypes
 
--- | The Compile monad provides fresh variable names, allows to
--- retrieve information about tables from the database backend and
--- caches table information.
-type Compile = StateT  CompileState IO
+-- In the state, we store a counter for fresh variable names.
+type CompileState = Integer
 
--- | Lookup information that describes a table. If the information is
--- not present in the state then the connection is used to retrieve
--- the table information from the Database.
-tableInfo :: String -> Compile TableInfo
-tableInfo tableName = do
-    (i, env, f) <- get
-    case M.lookup tableName env of
-        Nothing -> do
-            inf <- getTableInfoFun tableName
-            put (i, M.insert tableName inf env, f)
-            return inf
-        Just v -> return v
+-- | The Compile monad provides fresh variable names.
+type Compile = State CompileState
 
 -- | Provide a fresh identifier name during compilation
 freshVar :: Compile Integer
 freshVar = do
-    (i, m, f) <- get
-    put (i + 1, m, f)
+    i <- get
+    put $ i + 1
     return i
 
 prefixVar :: Integer -> String
 prefixVar i = "v" ++ show i
 
-getTableInfoFun :: String -> Compile TableInfo
-getTableInfoFun tableName = do
-    (_, _, queryTableInfo) <- get
-    lift $ queryTableInfo tableName
-
 -- | Translate a DSH frontend expression into the internal
--- comprehension-based language. 'queryTableInfo' abstracts asking a
--- database for information about tables, which might be performed
--- using one of the existing backends (X100, SQL).
-toComprehensions :: QueryTableInfo -> Exp a -> IO CL.Expr
-toComprehensions queryTableInfo e = runCompile queryTableInfo $ translate e
+-- comprehension-based language.
+toComprehensions :: Exp a -> CL.Expr
+toComprehensions q = runCompile (translate q)
 
 -- | Execute the transformation computation. During compilation table
 -- information can be retrieved from the database, therefore the result
 -- is wrapped in the IO Monad.
-runCompile :: QueryTableInfo -> Compile a -> IO a
-runCompile f = liftM fst . flip runStateT (1, M.empty, f)
+runCompile :: Compile a -> a
+runCompile ma = evalState ma 1
 
-lamBody :: forall a b.(Reify a, Reify b) => (Exp a -> Exp b) -> Compile (L.Ident, Exp b)
+lamBody :: forall a b.(Reify a, Reify b)
+        => (Exp a -> Exp b)
+        -> Compile (L.Ident, Exp b)
 lamBody f = do
     v <- freshVar
     return (prefixVar v, f (VarE v :: Exp a))
@@ -101,10 +65,12 @@
                              in translateTupleConst tc
 translate UnitE = return $ CP.unit
 translate (BoolE b) = return $ CP.bool b
-translate (CharE c) = return $ CP.string [c]
+translate (CharE c) = return $ CP.string $ T.singleton c
 translate (IntegerE i) = return $ CP.int (fromInteger i)
 translate (DoubleE d) = return $ CP.double d
-translate (TextE t) = return $ CP.string (unpack t)
+translate (TextE t) = return $ CP.string t
+translate (DecimalE d) = return $ CP.decimal d
+translate (DayE d) = return $ CP.day d
 translate (VarE i) = do
     let ty = reify (undefined :: a)
     return $ CP.var (translateType ty) (prefixVar i)
@@ -117,88 +83,84 @@
 -- have not been eliminated by inlining in the frontend, additional
 -- normalization rules or defunctionalization should be employed.
 translate (LamE _) = $impossible
-translate (TableE (TableDB tableName hints)) = do
+translate (TableE (TableDB tableName colNames hints)) = do
     -- Reify the type of the table expression
     let ty = reify (undefined :: a)
-
-    -- Extract the column types from the frontend type
-    let ts = T.tupleElemTypes $ T.elemT $ translateType ty
-
-    -- Fetch the actual type of the table from the database
-    -- backend. Since we can't refer to columns by name from the
-    -- Haskell side, we sort the columns by name to get a canonical
-    -- order.
-    tableDescr <- sortWith (\(n, _, _) -> n) <$> tableInfo tableName
-
-    let tableTypeError = printf "DSH type and type of table %s are incompatible:\nDSH: %s\nDatabase: %s"
-                                tableName
-                                (show ts)
-                                (show $ map (\(n, t, _) -> (n, t)) tableDescr)
+    let colNames' = fmap L.ColName colNames
+    let bty = translateType ty
 
-    -- The DSH record/tuple type must match the number of columns in
-    -- the database table
-    if length tableDescr == length ts
-        then return ()
-        else error tableTypeError
+    return $ CP.table bty tableName (schema tableName colNames' bty hints)
 
-    let matchTypes :: (String, String, T.Type -> Bool) -> T.Type -> (L.ColName, T.Type)
-        matchTypes (colName, _, typesCompatible) dshType =
-            if typesCompatible dshType
-            then (L.ColName colName, dshType)
-            else error tableTypeError
+translate (AppE f args) = translateApp f args
 
-    let cols = zipWith matchTypes tableDescr ts
+schema :: String -> N.NonEmpty L.ColName -> Ty.Type -> TableHints -> L.BaseTableSchema
+schema tableName cols ty hints =
+    L.BaseTableSchema { L.tableCols     = colTys
+                      , L.tableKeys     = keys (keysHint hints)
+                      , L.tableNonEmpty = ne $ nonEmptyHint hints
+                      }
+  where
+    colTys :: NonEmpty L.Column
+    colTys = case Ty.elemT ty of
+        Ty.TupleT ts@(_:_) | length ts == N.length cols ->
+            case mapM Ty.scalarType ts of
+                Just (st : sts) -> N.zip cols (st :| sts)
+                _               -> error errMsgScalar
+        (Ty.ScalarT st)      | N.length cols == 1       ->
+            N.zip cols (st :| [])
+        _                                              ->
+            error errMsgLen
 
-    return $ CP.table (translateType ty) tableName cols (compileHints hints)
+    errMsgLen = printf "Type for table %s does not match column specification"
+                       tableName
 
-translate (AppE f args) = translateApp f args
+    errMsgScalar = printf "Non-scalar types in table %s" tableName
 
-compileHints :: TableHints -> L.TableHints
-compileHints hints = L.TableHints { L.keysHint = keys $ keysHint hints
-                                  , L.nonEmptyHint = ne $ nonEmptyHint hints
-                                  }
-  where
-    keys :: [Key] -> [L.Key]
-    keys ks = [ L.Key [ L.ColName c | c <- k ] | Key k <- ks ]
+    keys :: N.NonEmpty Key -> N.NonEmpty L.Key
+    keys = fmap (\(Key k) -> L.Key $ fmap L.ColName k)
 
     ne :: Emptiness -> L.Emptiness
     ne NonEmpty      = L.NonEmpty
     ne PossiblyEmpty = L.PossiblyEmpty
 
 
-translateApp3 :: (CL.Expr -> CL.Expr -> CL.Expr -> CL.Expr) -> Exp (a, b, c) -> Compile CL.Expr
-translateApp3 f (TupleConstE (Tuple3E e1 e2 e3)) = f <$> translate e1 <*> translate e2 <*> translate e3
+translateApp3 :: (CL.Expr -> CL.Expr -> CL.Expr -> CL.Expr)
+              -> Exp (a, b, c)
+              -> Compile CL.Expr
+translateApp3 f (TupleConstE (Tuple3E e1 e2 e3)) =
+    f <$> translate e1 <*> translate e2 <*> translate e3
 translateApp3 _ _ = $impossible
 
-translateApp2 :: (CL.Expr -> CL.Expr -> CL.Expr) -> Exp (a, b) -> Compile CL.Expr
-translateApp2 f (TupleConstE (Tuple2E e1 e2)) = f <$> translate e1 <*> translate e2
+translateApp2 :: (CL.Expr -> CL.Expr -> CL.Expr)
+              -> Exp (a, b)
+              -> Compile CL.Expr
+translateApp2 f (TupleConstE (Tuple2E e1 e2)) =
+    f <$> translate e1 <*> translate e2
 translateApp2 _ _ = $impossible
 
 translateApp1 :: (CL.Expr -> CL.Expr) -> Exp a -> Compile CL.Expr
 translateApp1 f e = f <$> translate e
 
 -- | Translate DSH frontend types into backend types.
-translateType :: Type a -> T.Type
-translateType UnitT          = T.unitT
-translateType BoolT          = T.boolT
-translateType CharT          = T.stringT
-translateType IntegerT       = T.intT
-translateType DoubleT        = T.doubleT
-translateType TextT          = T.stringT
-translateType (ListT t)      = T.listT (translateType t)
+translateType :: Type a -> Ty.Type
+translateType UnitT          = Ty.PUnitT
+translateType BoolT          = Ty.PBoolT
+translateType CharT          = Ty.PStringT
+translateType IntegerT       = Ty.PIntT
+translateType DoubleT        = Ty.PDoubleT
+translateType DecimalT       = Ty.PDecimalT
+translateType TextT          = Ty.PStringT
+translateType DayT           = Ty.PDateT
+translateType (ListT t)      = Ty.ListT (translateType t)
 translateType (TupleT tupTy) = let translateTupleType = $(mkTranslateType 16)
                                in translateTupleType tupTy
-translateType (ArrowT t1 t2) = $impossible
-
--- | From the type of a table (a list of base records represented as
--- right-deep nested tuples) extract the types of the individual
--- fields.
+translateType (ArrowT _ _)   = $impossible
 
 translateApp :: Fun a b -> Exp a -> Compile CL.Expr
 translateApp f args =
     case f of
        -- Builtin functions with arity three
-       Cond -> translateApp3 CP.cond args
+       Cond         -> translateApp3 CP.cond args
 
        -- Builtin functions with arity two
        Add          -> translateApp2 CP.add args
@@ -206,11 +168,10 @@
        Sub          -> translateApp2 CP.sub args
        Div          -> translateApp2 CP.div args
        Mod          -> translateApp2 CP.mod args
-       Index        -> translateApp2 CP.index args
        Cons         -> translateApp2 CP.cons args
 
        -- Map to a comprehension
-       Map          -> 
+       Map          ->
            case args of
                TupleConstE (Tuple2E (LamE lam) xs) -> do
                    xs'                 <- translate xs
@@ -220,7 +181,7 @@
                _ -> $impossible
 
        -- Map to a comprehension and concat
-       ConcatMap    -> 
+       ConcatMap    ->
            case args of
                TupleConstE (Tuple2E (LamE lam) xs) -> do
                    xs'                 <- translate xs
@@ -228,45 +189,47 @@
                    bodyExp'            <- translate bodyExp
                    return $ CP.concat $ CP.singleGenComp bodyExp' boundVar xs'
                _ -> $impossible
-               
+
        -- Map to a first-order combinator 'sort'
-       SortWith     -> 
+       -- sortWith (\x -> f x) xs => sort [ (x, f x) | x <- xs ]
+       SortWith     ->
            case args of
                TupleConstE (Tuple2E (LamE lam) xs) -> do
-                   xs'                 <- translate xs
-                   (boundVar, bodyExp) <- lamBody lam
-                   bodyExp'            <- translate bodyExp
-                   genName             <- prefixVar <$> freshVar
+                   xs'                  <- translate xs
+                   -- Get a FOAS representation of the lambda
+                   (boundName, sortExp) <- lamBody lam
+                   sortExp'             <- translate sortExp
 
-                   let genVar = CL.Var (T.typeOf xs') genName
-                       ss     = CP.singleGenComp bodyExp' boundVar genVar 
-                   return $ CP.let_ genName xs' (CP.sort genVar ss)
+                   let boundVar = CL.Var (Ty.elemT $ Ty.typeOf xs') boundName
+
+                   return $ CP.sort $ CP.singleGenComp (CP.pair boundVar sortExp') boundName xs'
                _ -> $impossible
 
        -- Map to a comprehension with a guard
-       Filter       -> 
+       Filter       ->
            case args of
                TupleConstE (Tuple2E (LamE lam) xs) -> do
                    xs'                 <- translate xs
                    (boundVar, bodyExp) <- lamBody lam
                    bodyExp'            <- translate bodyExp
-                   let xt    = T.typeOf xs'
+                   let xt    = Ty.typeOf xs'
                        quals = CL.BindQ boundVar xs' CL.:* (CL.S $ CL.GuardQ bodyExp')
                    return $ CL.Comp xt (CL.Var xt boundVar) quals
                _ -> $impossible
 
        -- Map to a first-order combinator 'group'
+       -- groupWithKey (\x -> f x) xs => group [ (x, f x) | x <- xs ]
        GroupWithKey ->
            case args of
                TupleConstE (Tuple2E (LamE lam) xs) -> do
-                   xs'                 <- translate xs
-                   (boundVar, bodyExp) <- lamBody lam
-                   bodyExp'            <- translate bodyExp
-                   genName             <- prefixVar <$> freshVar
+                   xs'                   <- translate xs
+                   (boundName, groupExp) <- lamBody lam
+                   groupExp'             <- translate groupExp
 
-                   let genVar = CL.Var (T.typeOf xs') genName
-                       ss     = CP.singleGenComp bodyExp' boundVar genVar 
-                   return $ CP.let_ genName xs' (CP.group genVar ss)
+                   let boundVar = CL.Var (Ty.elemT $ Ty.typeOf xs') boundName
+
+                   return $ CP.group $ CP.singleGenComp (CP.pair boundVar groupExp') boundName xs'
+
                _ -> $impossible
 
        Append       -> translateApp2 CP.append args
@@ -280,40 +243,44 @@
        Gte          -> translateApp2 CP.gte args
        Gt           -> translateApp2 CP.gt args
        Like         -> translateApp2 CP.like args
+       AddDays      -> translateApp2 CP.addDays args
+       SubDays      -> translateApp2 CP.subDays args
+       DiffDays     -> translateApp2 CP.diffDays args
 
        -- Builtin functions with arity one
-       SubString f t   -> translateApp1 (CP.substring f t) args
-       IntegerToDouble -> translateApp1 CP.castDouble args
-       Not             -> translateApp1 CP.not args
-       Sin             -> translateApp1 CP.sin args
-       Cos             -> translateApp1 CP.cos args
-       Tan             -> translateApp1 CP.tan args
-       ASin            -> translateApp1 CP.asin args
-       ACos            -> translateApp1 CP.acos args
-       ATan            -> translateApp1 CP.atan args
-       Sqrt            -> translateApp1 CP.sqrt args
-       Log             -> translateApp1 CP.log args
-       Exp             -> translateApp1 CP.exp args
-       Fst             -> translateApp1 CP.fst args
-       Snd             -> translateApp1 CP.snd args
-       Head            -> translateApp1 CP.head args
-       Tail            -> translateApp1 CP.tail args
-       Minimum         -> translateApp1 CP.minimum args
-       Maximum         -> translateApp1 CP.maximum args
-       Concat          -> translateApp1 CP.concat args
-       Sum             -> translateApp1 CP.sum args
-       Avg             -> translateApp1 CP.avg args
-       And             -> translateApp1 CP.and args
-       Or              -> translateApp1 CP.or args
-       Reverse         -> translateApp1 CP.reverse args
-       Number          -> translateApp1 CP.number args
-       Length          -> translateApp1 CP.length args
-       Null            -> translateApp1 CP.null args
-       Init            -> translateApp1 CP.init args
-       Last            -> translateApp1 CP.last args
-       Nub             -> translateApp1 CP.nub args
-       Guard           -> translateApp1 CP.guard args
-       Transpose       -> translateApp1 CP.transpose args
-       Reshape n       -> translateApp1 (CP.reshape n) args
-       TupElem te      -> let compileTupElem = $(mkTupElemCompile 16)
-                          in compileTupElem te args
+       Only             -> translateApp1 CP.only args
+       SubString s e    -> translateApp1 (CP.substring s e) args
+       IntegerToDouble  -> translateApp1 CP.castDouble args
+       IntegerToDecimal -> translateApp1 CP.castDecimal args
+       Not              -> translateApp1 CP.not args
+       Sin              -> translateApp1 CP.sin args
+       Cos              -> translateApp1 CP.cos args
+       Tan              -> translateApp1 CP.tan args
+       ASin             -> translateApp1 CP.asin args
+       ACos             -> translateApp1 CP.acos args
+       ATan             -> translateApp1 CP.atan args
+       Sqrt             -> translateApp1 CP.sqrt args
+       Log              -> translateApp1 CP.log args
+       Exp              -> translateApp1 CP.exp args
+       DayDay           -> translateApp1 CP.dateDay args
+       DayMonth         -> translateApp1 CP.dateMonth args
+       DayYear          -> translateApp1 CP.dateYear args
+       Fst              -> translateApp1 CP.fst args
+       Snd              -> translateApp1 CP.snd args
+       Minimum          -> translateApp1 CP.minimum args
+       Maximum          -> translateApp1 CP.maximum args
+       Concat           -> translateApp1 CP.concat args
+       Sum              -> translateApp1 CP.sum args
+       Avg              -> translateApp1 CP.avg args
+       And              -> translateApp1 CP.and args
+       Or               -> translateApp1 CP.or args
+       Reverse          -> translateApp1 CP.reverse args
+       Number           -> translateApp1 CP.number args
+       Length           -> translateApp1 CP.length args
+       Null             -> translateApp1 CP.null args
+       Nub              -> translateApp1 CP.nub args
+       Guard            -> translateApp1 CP.guard args
+       TupElem te       -> do
+           e' <- translate args
+           let tupAcc = $(mkTupElemCompile 16) te
+           return $ tupAcc e'
diff --git a/src/Database/DSH/Translate/NKL2FKL.hs b/src/Database/DSH/Translate/NKL2FKL.hs
--- a/src/Database/DSH/Translate/NKL2FKL.hs
+++ b/src/Database/DSH/Translate/NKL2FKL.hs
@@ -1,15 +1,18 @@
 {-# LANGUAGE TemplateHaskell #-}
 -- | The Flattening Transformation
-module Database.DSH.Translate.NKL2FKL (flatTransform) where
+module Database.DSH.Translate.NKL2FKL
+    ( flatTransform
+    , normalizeLifted
+    , liftOperators
+    ) where
 
 -- FIXME use more let bindings to avoid term replication, e.g. in if conditionals
 -- FIXME make sure that no wrong shadowing occurs while lifting or restricting the environment.
 
 import           Control.Monad.State
 import           Control.Monad.Reader
-import           Control.Applicative
 
-import           Database.DSH.Impossible
+import           Database.DSH.Common.Impossible
 import           Database.DSH.Common.Lang
 import           Database.DSH.Common.Nat
 import           Database.DSH.Common.Type
@@ -20,16 +23,21 @@
 
 -- | Transform an expression in the Nested Kernel Language into its
 -- equivalent Flat Kernel Language expression by means of the
--- flattening transformation.
+-- flattening transformation. Apply standard optimization rewrites.
 flatTransform :: N.Expr -> F.FExpr
-flatTransform expr = optimizeFKL "FKL" 
-                     $ normalize 
-                     $ optimizeFKL "FKL Intermediate" 
+flatTransform expr = optimizeNormFKL
+                     $ normalizeLifted
+                     $ optimizeFKL
                      $ runFlat initEnv (flatten expr)
 
 --------------------------------------------------------------------------------
 -- The Flattening Transformation
 
+-- | The first stage of the flattening transformation: replace
+-- iterators by lifted operators.
+liftOperators :: N.Expr -> F.LExpr
+liftOperators expr = runFlat initEnv (flatten expr)
+
 --------------------------------------------------------------------------------
 -- Translation of built-in combinators. Combinators are lifted
 -- according to the iteration depth at which they are encountered.
@@ -38,34 +46,27 @@
 prim1 p =
     case p of
         N.Singleton -> P.sng
+        N.Only      -> P.only
         N.Length    -> P.length
         N.Concat    -> P.concat
         N.Sum       -> P.sum
         N.Avg       -> P.avg
-        N.The       -> P.the
         N.TupElem n -> P.tupElem n
-        N.Head      -> P.head
-        N.Tail      -> P.tail
         N.Minimum   -> P.minimum
         N.Maximum   -> P.maximum
         N.Reverse   -> P.reverse
         N.And       -> P.and
         N.Or        -> P.or
-        N.Init      -> P.init
-        N.Last      -> P.last
         N.Nub       -> P.nub
         N.Number    -> P.number
-        N.Reshape n -> P.reshape n
-        N.Transpose -> P.transpose
+        N.Sort      -> P.sort
+        N.Group     -> P.group
+        N.Restrict  -> P.restrict
 
 prim2 :: N.Prim2 -> F.LExpr -> F.LExpr -> Nat -> F.LExpr
 prim2 p =
     case p of
-        N.Group        -> P.group
-        N.Sort         -> P.sort
-        N.Restrict     -> P.restrict
         N.Append       -> P.append
-        N.Index        -> P.index
         N.Zip          -> P.zip
         N.CartProduct  -> P.cartProduct
         N.NestProduct  -> P.nestProduct
@@ -105,7 +106,7 @@
 -- comprehension that binds the name 'x'. This involves binding 'x' in
 -- the current environment frame and increasing the frame depth.
 descendEnv :: (Ident, Type) -> Env -> Env
-descendEnv x env = env { inScope    = x : inScope env 
+descendEnv x env = env { inScope    = x : inScope env
                        , frameDepth = Succ $ frameDepth env
                        }
 
@@ -121,11 +122,11 @@
     mkRestrictLet [] = $impossible
     mkRestrictLet (e : []) =
         P.let_ (fst e)
-               (P.restrict (envVar e) bs d1)
+               (P.restrict (P.tuple [envVar e, bs] (Succ d1)) d1)
                branchExpr
-    mkRestrictLet (e : (e2 : es)) = 
+    mkRestrictLet (e : (e2 : es)) =
         P.let_ (fst e)
-               (P.restrict (envVar e) bs d1)
+               (P.restrict (P.tuple [envVar e, bs] (Succ d1)) d1)
                (mkRestrictLet (e2 : es))
 
 -- | Lift all names bound in the environment: the value is replicated
@@ -151,7 +152,7 @@
 -- | Transform top-level expressions which are not nested in an
 -- iterator.
 flatten :: N.Expr -> Flatten F.LExpr
-flatten (N.Table t n cs hs)  = return $ F.Table t n cs hs
+flatten (N.Table t n schema) = return $ F.Table t n schema
 flatten (N.UnOp t op e1)     = P.un t op <$> flatten e1 <*> pure Zero
 flatten (N.BinOp t op e1 e2) = P.bin t op <$> flatten e1 <*> flatten e2 <*> pure Zero
 flatten (N.Const t v)        = return $ F.Const t v
@@ -165,7 +166,7 @@
     -- Prepare an environment in which the current generator is the
     -- context
     let initCtx    = (x, typeOf xs)
-    
+
     -- In this environment, transform the iterator head
     flatHead <- local (descendEnv initCtx) (deepFlatten initCtx h)
 
@@ -176,7 +177,7 @@
 -- | Compile expressions nested in an iterator.
 deepFlatten :: (Ident, Type) -> N.Expr -> Flatten F.LExpr
 deepFlatten _   (N.Var t v)          = frameDepthM >>= \d -> return $ F.Var (liftTypeN d t) v
-deepFlatten ctx (N.Table t n cs hs)  = P.broadcast (F.Table t n cs hs) (envVar ctx) <$> frameDepthM
+deepFlatten ctx (N.Table t n schema) = P.broadcast (F.Table t n schema) (envVar ctx) <$> frameDepthM
 deepFlatten ctx (N.Const t v)        = P.broadcast (F.Const t v) (envVar ctx) <$> frameDepthM
 deepFlatten ctx (N.UnOp t op e1)     = P.un t op <$> deepFlatten ctx e1 <*> frameDepthM
 deepFlatten ctx (N.BinOp t op e1 e2) = P.bin t op <$> deepFlatten ctx e1 <*> deepFlatten ctx e2 <*> frameDepthM
@@ -184,15 +185,15 @@
 deepFlatten ctx (N.AppE1 _ p e)      = prim1 p <$> deepFlatten ctx e <*> frameDepthM
 deepFlatten ctx (N.AppE2 _ p e1 e2)  = prim2 p <$> deepFlatten ctx e1 <*> deepFlatten ctx e2 <*> frameDepthM
 
-deepFlatten ctx (N.Let _ x xs e)     = P.let_ x <$> deepFlatten ctx xs 
+deepFlatten ctx (N.Let _ x xs e)     = P.let_ x <$> deepFlatten ctx xs
                                                 <*> local (bindEnv x (typeOf xs)) (deepFlatten ctx e)
 
 deepFlatten ctx (N.If _ ce te ee)    = do
     Succ d1      <- frameDepthM
-    
+
     -- Lift the condition
     bs           <- deepFlatten ctx ce
-    
+
     -- Lift the THEN branch. Note that although the environment record
     -- does not change, all environment variables are re-bound to a
     -- restricted environment by 'restrictEnv'.
@@ -205,8 +206,8 @@
 
     -- Construct the restricted environments in which the THEN and
     -- ELSE branches are evaluated.
-    let notL xs = P.un boolT (SUBoolOp Not) xs (Succ d1) 
-    
+    let notL xs = P.un PBoolT (SUBoolOp Not) xs (Succ d1)
+
         thenRes = restrictEnv env d1 bs thenExpr
 
         elseRes = restrictEnv env d1 (notL bs) elseExpr
@@ -218,7 +219,7 @@
     d           <- frameDepthM
     env         <- asks inScope
     let ctx' = (x, liftTypeN (Succ d) (typeOf xs))
-    headExpr    <- local (descendEnv ctx') $ deepFlatten ctx' h 
+    headExpr    <- local (descendEnv ctx') $ deepFlatten ctx' h
 
     xs'         <- deepFlatten ctx xs
 
@@ -240,8 +241,8 @@
     put $ i + 1
     return $ "nf" ++ show i
 
-normalize :: F.LExpr -> F.FExpr
-normalize e = evalState (normLifting e) 0
+normalizeLifted :: F.LExpr -> F.FExpr
+normalizeLifted e = evalState (normLifting e) 0
 
 implementBroadcast :: F.BroadcastExt -> NormFlat F.FExpr
 implementBroadcast (F.Broadcast d _ e1 e2) = do
@@ -257,7 +258,7 @@
 -- operators to singly lifted variants by flattening the arguments and
 -- restoring the original list shape on the result.
 normLifting :: F.LExpr -> NormFlat F.FExpr
-normLifting (F.Table t n cs hs)    = return $ F.Table t n cs hs
+normLifting (F.Table t n schema)   = return $ F.Table t n schema
 normLifting (F.If t ce te ee)      = F.If t <$> normLifting ce <*> normLifting te <*> normLifting ee
 normLifting (F.Const t v)          = return $ F.Const t v
 normLifting (F.Var t n)            = return $ F.Var t n
@@ -274,7 +275,7 @@
                 app = F.MkTuple (unliftTypeN d t) F.Lifted (P.forget d v : map (P.forget d) es')
             return $ P.let_ n e1' $ P.imprint d v app
 
-normLifting (F.UnOp t op l e)      = 
+normLifting (F.UnOp t op l e)      =
     case l of
         F.LiftedN Zero         -> F.UnOp t op F.NotLifted <$> normLifting e
         F.LiftedN (Succ Zero)  -> F.UnOp t op F.Lifted <$> normLifting e
@@ -285,7 +286,7 @@
                 app = F.UnOp (unliftTypeN d t) op F.Lifted (P.forget d v)
             return $ P.let_ n e' $ P.imprint d v app
 
-normLifting (F.BinOp t op l e1 e2)  = 
+normLifting (F.BinOp t op l e1 e2)  =
     case l of
         F.LiftedN Zero         -> F.BinOp t op F.NotLifted
                                             <$> normLifting e1
@@ -301,7 +302,7 @@
                 app = F.BinOp (unliftTypeN d t) op F.Lifted (P.forget d v) (P.forget d e2')
             return $ P.let_ n e1' $ P.imprint d v app
 
-normLifting (F.PApp1 t p l e)    = 
+normLifting (F.PApp1 t p l e)    =
     case l of
         F.LiftedN Zero         -> F.PApp1 t p F.NotLifted <$> normLifting e
         F.LiftedN (Succ Zero)  -> F.PApp1 t p F.Lifted <$> normLifting e
@@ -312,7 +313,7 @@
                 app = F.PApp1 (unliftTypeN d t) p F.Lifted (P.forget d v)
             return $ P.let_ n e' (P.imprint d v app)
 
-normLifting (F.PApp2 t p l e1 e2)   = 
+normLifting (F.PApp2 t p l e1 e2)   =
     case l of
         F.LiftedN Zero         -> F.PApp2 t p F.NotLifted
                                               <$> normLifting e1
@@ -328,7 +329,7 @@
                 app = F.PApp2 (unliftTypeN d t) p F.Lifted (P.forget d v) (P.forget d e2')
             return $ P.let_ n e1' $ P.imprint d v app
 
-normLifting (F.PApp3 t p l e1 e2 e3)    = 
+normLifting (F.PApp3 t p l e1 e2 e3)    =
     case l of
         F.LiftedN Zero        -> F.PApp3 t p F.NotLifted
                                              <$> normLifting e1
@@ -344,7 +345,7 @@
             e3' <- normLifting e3
             n   <- freshNameN
             let v   = F.Var (typeOf e1') n
-                app = F.PApp3 (unliftTypeN d t) p F.Lifted (P.forget d v) 
-                                                           (P.forget d e2') 
+                app = F.PApp3 (unliftTypeN d t) p F.Lifted (P.forget d v)
+                                                           (P.forget d e2')
                                                            (P.forget d e3')
             return $ P.let_ n e1' $ P.imprint d v app
diff --git a/src/Database/DSH/Translate/VL2Algebra.hs b/src/Database/DSH/Translate/VL2Algebra.hs
--- a/src/Database/DSH/Translate/VL2Algebra.hs
+++ b/src/Database/DSH/Translate/VL2Algebra.hs
@@ -2,98 +2,114 @@
 {-# LANGUAGE FlexibleContexts #-}
 
 module Database.DSH.Translate.VL2Algebra
-    ( implementVectorOpsPF
+    ( VecBuild
+    , runVecBuild
+    , vl2Algebra
     ) where
 
 import qualified Data.IntMap                          as IM
 import           Data.List
 import qualified Data.Map                             as M
-import           Data.Maybe
+import qualified Data.Traversable                     as T
 
-import           Control.Applicative
 import           Control.Monad.State
 
 import qualified Database.Algebra.Dag                 as D
 import qualified Database.Algebra.Dag.Build           as B
 import           Database.Algebra.Dag.Common
-import qualified Database.Algebra.Table.Lang          as TA
 
-import           Database.DSH.Impossible
+import           Database.DSH.Common.Impossible
 import           Database.DSH.Common.QueryPlan
 import           Database.DSH.Translate.FKL2VL        ()
-import           Database.DSH.VL.Vector
+import           Database.DSH.Common.Vector
 import qualified Database.DSH.VL.Lang                 as V
 import           Database.DSH.VL.VectorAlgebra
-import           Database.DSH.VL.VectorAlgebra.TA     ()
 
+-- FIXME the vector types d r k f s are determined by the algebra a.
+-- The only type variable necessary should be a.
+type Cache d r k f s = M.Map AlgNode (Res d r k f s)
+
 -- | A layer on top of the DAG builder monad that caches the
 -- translation result of VL nodes.
-type VecBuild a v = StateT (M.Map AlgNode (Res v)) (B.Build a)
+type VecBuild a d r k f s = StateT (Cache d r k f s) (B.Build a)
 
-runVecBuild :: VectorAlgebra v a => VecBuild a v r -> (D.AlgebraDag a, r, NodeMap [Tag])
+runVecBuild :: VectorAlgebra a
+            => VecBuild a (DVec a) (RVec a) (KVec a) (FVec a) (SVec a) r
+            -> (D.AlgebraDag a, r, NodeMap [Tag])
 runVecBuild c = B.runBuild $ fst <$> runStateT c M.empty
 
-data Res v = Prop    AlgNode
-           | Rename  AlgNode
-           | RDVec   v
-           | RLPair   (Res v) (Res v)
-           | RTriple (Res v) (Res v) (Res v)
-         deriving Show
+data Res d r k f s
+    = RRVec r
+    | RKVec k
+    | RFVec f
+    | RSVec s
+    | RDVec d
+    | RLPair (Res d r k f s) (Res d r k f s)
+    | RTriple (Res d r k f s) (Res d r k f s) (Res d r k f s)
+    deriving Show
 
-fromDict :: VectorAlgebra v a => AlgNode -> VecBuild a v (Maybe (Res v))
+fromDict :: VectorAlgebra a => AlgNode -> VecBuild a d r k f s (Maybe (Res d r k f s))
 fromDict n = do
     dict <- get
     return $ M.lookup n dict
 
-insertTranslation :: VectorAlgebra v a => AlgNode -> Res v -> VecBuild a v ()
+insertTranslation :: VectorAlgebra a => AlgNode -> Res d r k f s -> VecBuild a d r k f s ()
 insertTranslation n res = modify (M.insert n res)
 
-fromPVec :: PVec -> Res v
-fromPVec (PVec p) = Prop p
-
-toPVec :: Res v -> PVec
-toPVec (Prop p) = PVec p
-toPVec _       = error "toPVec: Not a prop vector"
+--------------------------------------------------------------------------------
+-- Wrappers and unwrappers for vector references
 
-fromRVec :: RVec -> Res v
-fromRVec (RVec r) = Rename r
+fromRVec :: r -> Res d r k f s
+fromRVec p = RRVec p
 
-toRVec :: Res v -> RVec
-toRVec (Rename r) = RVec r
-toRVec _          = error "toRVec: Not a rename vector"
+fromKVec :: k -> Res d r k f s
+fromKVec r = RKVec r
 
-fromDVec :: v -> Res v
+fromDVec :: d -> Res d r k f s
 fromDVec v = RDVec v
 
-toDVec :: Res v -> v
+fromFVec :: f -> Res d r k f s
+fromFVec v = RFVec v
+
+fromSVec :: s -> Res d r k f s
+fromSVec v = RSVec v
+
+toDVec :: Res d r k f s -> d
 toDVec (RDVec v) = v
 toDVec _         = error "toDVec: Not a NDVec"
 
-refreshLyt :: VectorAlgebra v a => Layout VLDVec -> VecBuild a v (Layout v)
-refreshLyt (LCol c) = return $ LCol c
-refreshLyt (LNest (VLDVec n) lyt) = do
-    Just n' <- fromDict n
-    lyt'    <- refreshLyt lyt
-    return $ LNest (toDVec n') lyt'
-refreshLyt (LTuple lyts) = LTuple <$> mapM refreshLyt lyts
+toRVec :: Res d r k f s -> r
+toRVec (RRVec p) = p
+toRVec _         = error "toRVec: Not a replication vector"
 
-refreshShape :: VectorAlgebra v a => Shape VLDVec -> VecBuild a v (Shape v)
-refreshShape (VShape (VLDVec n) lyt) = do
-    mv <- fromDict n
-    case mv of
-        Just v -> do
-            lyt' <- refreshLyt lyt
-            return $ VShape (toDVec v) lyt'
-        _ -> $impossible
-refreshShape (SShape (VLDVec n) lyt) = do
-    mv <- fromDict n
-    case mv of
-        Just (RDVec v) -> do
-            lyt'              <- refreshLyt lyt
-            return $ SShape v lyt'
-        _ -> $impossible
+toKVec :: Res d r k f s -> k
+toKVec (RKVec r) = r
+toKVec _         = error "toKVec: Not a rekeying vector"
 
-translate :: VectorAlgebra v a => NodeMap V.VL -> AlgNode -> VecBuild a v (Res v)
+toFVec :: Res d r k f s -> f
+toFVec (RFVec r) = r
+toFVec _         = error "toFVec: Not a filtering vector"
+
+toSVec :: Res d r k f s -> s
+toSVec (RSVec r) = r
+toSVec _         = error "toSVec: Not a filtering vector"
+
+--------------------------------------------------------------------------------
+
+-- | Refresh vectors in a shape from the cache.
+refreshShape :: VectorAlgebra a => Shape VLDVec -> VecBuild a d r k f s (Shape d)
+refreshShape shape = T.mapM refreshVec shape
+  where
+    refreshVec (VLDVec n) = do
+        mv <- fromDict n
+        case mv of
+            Just v -> return $ toDVec v
+            Nothing -> $impossible
+
+translate :: VectorAlgebra a
+          => NodeMap V.VL
+          -> AlgNode
+          -> VecBuild a (DVec a) (RVec a) (KVec a) (FVec a) (SVec a) (Res (DVec a) (RVec a) (KVec a) (FVec a) (SVec a))
 translate vlNodes n = do
     r <- fromDict n
 
@@ -130,7 +146,10 @@
 pp :: NodeMap V.VL -> String
 pp m = intercalate ",\n" $ map show $ IM.toList m
 
-vl2Algebra :: VectorAlgebra v a => NodeMap V.VL -> Shape VLDVec -> VecBuild a v (Shape v)
+vl2Algebra :: VectorAlgebra a
+           => NodeMap V.VL
+           -> Shape VLDVec
+           -> VecBuild a (DVec a) (RVec a) (KVec a) (FVec a) (SVec a) (Shape (DVec a))
 vl2Algebra vlNodes plan = do
     mapM_ (translate vlNodes) roots
 
@@ -139,158 +158,165 @@
     roots :: [AlgNode]
     roots = shapeNodes plan
 
-translateTerOp :: VectorAlgebra v a => V.TerOp -> Res v -> Res v -> Res v -> B.Build a (Res v)
+translateTerOp :: VectorAlgebra a
+               => V.TerOp
+               -> Res (DVec a) (RVec a) (KVec a) (FVec a) (SVec a)
+               -> Res (DVec a) (RVec a) (KVec a) (FVec a) (SVec a)
+               -> Res (DVec a) (RVec a) (KVec a) (FVec a) (SVec a)
+               -> B.Build a (Res (DVec a) (RVec a) (KVec a) (FVec a) (SVec a))
 translateTerOp t c1 c2 c3 =
     case t of
         V.Combine -> do
             (d, r1, r2) <- vecCombine (toDVec c1) (toDVec c2) (toDVec c3)
-            return $ RTriple (fromDVec d) (fromRVec r1) (fromRVec r2)
+            return $ RTriple (fromDVec d) (fromKVec r1) (fromKVec r2)
 
-translateBinOp :: VectorAlgebra v a => V.BinOp -> Res v -> Res v -> B.Build a (Res v)
+translateBinOp :: VectorAlgebra a
+               => V.BinOp
+               -> Res (DVec a) (RVec a) (KVec a) (FVec a) (SVec a)
+               -> Res (DVec a) (RVec a) (KVec a) (FVec a) (SVec a)
+               -> B.Build a (Res (DVec a) (RVec a) (KVec a) (FVec a) (SVec a))
 translateBinOp b c1 c2 = case b of
     V.DistLift -> do
         (v, p) <- vecDistLift (toDVec c1) (toDVec c2)
-        return $ RLPair (fromDVec v) (fromPVec p)
-
-    V.PropRename -> fromDVec <$> vecPropRename (toRVec c1) (toDVec c2)
+        return $ RLPair (fromDVec v) (fromRVec p)
+    V.DistSng -> do
+        (v, p) <- vecDistSng (toDVec c1) (toDVec c2)
+        return $ RLPair (fromDVec v) (fromRVec p)
 
-    V.PropFilter -> do
-        (v, r) <- vecPropFilter (toRVec c1) (toDVec c2)
-        return $ RLPair (fromDVec v) (fromRVec r)
+    V.AppKey -> do
+        (v, k) <- vecAppKey (toKVec c1) (toDVec c2)
+        return $ RLPair (fromDVec v) (fromKVec k)
 
-    V.PropReorder -> do
-        (v, p) <- vecPropReorder (toPVec c1) (toDVec c2)
-        return $ RLPair (fromDVec v) (fromPVec p)
+    V.AppSort -> do
+        (v, s) <- vecAppSort (toSVec c1) (toDVec c2)
+        return $ RLPair (fromDVec v) (fromSVec s)
 
-    V.UnboxNested -> do
-        (v, r) <- vecUnboxNested (toRVec c1) (toDVec c2)
+    V.AppRep -> do
+        (v, r) <- vecAppRep (toRVec c1) (toDVec c2)
         return $ RLPair (fromDVec v) (fromRVec r)
 
-    V.UnboxScalar -> RDVec <$> vecUnboxScalar (toDVec c1) (toDVec c2)
+    V.AppFilter -> do
+        (v, f) <- vecAppFilter (toFVec c1) (toDVec c2)
+        return $ RLPair (fromDVec v) (fromFVec f)
 
+    V.UnboxSng -> do
+        (v, k) <- vecUnboxSng (toDVec c1) (toDVec c2)
+        return $ RLPair (fromDVec v) (fromKVec k)
+
     V.Append -> do
         (v, r1, r2) <- vecAppend (toDVec c1) (toDVec c2)
-        return $ RTriple (fromDVec v) (fromRVec r1) (fromRVec r2)
+        return $ RTriple (fromDVec v) (fromKVec r1) (fromKVec r2)
 
     V.AppendS -> do
         (v, r1, r2) <- vecAppendS (toDVec c1) (toDVec c2)
-        return $ RTriple (fromDVec v) (fromRVec r1) (fromRVec r2)
+        return $ RTriple (fromDVec v) (fromKVec r1) (fromKVec r2)
 
     V.AggrS a -> fromDVec <$> vecAggrS a (toDVec c1) (toDVec c2)
 
 
-    V.SelectPos o -> do
-        (v, r, ru) <- vecSelectPos (toDVec c1) o (toDVec c2)
-        return $ RTriple (fromDVec v) (fromRVec r) (fromRVec ru)
-
-    V.SelectPosS o -> do
-        (v, rp, ru) <- vecSelectPosS (toDVec c1) o (toDVec c2)
-        return $ RTriple (fromDVec v) (fromRVec rp) (fromRVec ru)
+    V.Zip -> do
+        (v, f1, f2) <- vecZip (toDVec c1) (toDVec c2)
+        return $ RTriple (fromDVec v) (fromKVec f1) (fromKVec f2)
 
-    V.Zip -> fromDVec <$> vecZip (toDVec c1) (toDVec c2)
-    V.Align -> fromDVec <$> vecZip (toDVec c1) (toDVec c2)
+    V.Align -> fromDVec <$> vecAlign (toDVec c1) (toDVec c2)
 
     V.ZipS -> do
         (v, r1 ,r2) <- vecZipS (toDVec c1) (toDVec c2)
-        return $ RTriple (fromDVec v) (fromRVec r1) (fromRVec r2)
+        return $ RTriple (fromDVec v) (fromKVec r1) (fromKVec r2)
 
     V.CartProduct -> do
         (v, p1, p2) <- vecCartProduct (toDVec c1) (toDVec c2)
-        return $ RTriple (fromDVec v) (fromPVec p1) (fromPVec p2)
+        return $ RTriple (fromDVec v) (fromRVec p1) (fromRVec p2)
 
     V.CartProductS -> do
         (v, p1, p2) <- vecCartProductS (toDVec c1) (toDVec c2)
-        return $ RTriple (fromDVec v) (fromPVec p1) (fromPVec p2)
+        return $ RTriple (fromDVec v) (fromRVec p1) (fromRVec p2)
 
     V.NestProductS -> do
-        (v, p2) <- vecNestProductS (toDVec c1) (toDVec c2)
-        return $ RLPair (fromDVec v) (fromPVec p2)
+        (v, p1, p2) <- vecNestProductS (toDVec c1) (toDVec c2)
+        return $ RTriple (fromDVec v) (fromRVec p1) (fromRVec p2)
 
     V.ThetaJoin p -> do
         (v, p1, p2) <- vecThetaJoin p (toDVec c1) (toDVec c2)
-        return $ RTriple (fromDVec v) (fromPVec p1) (fromPVec p2)
+        return $ RTriple (fromDVec v) (fromRVec p1) (fromRVec p2)
 
     V.NestProduct -> do
         (v, p1, p2) <- vecNestProduct (toDVec c1) (toDVec c2)
-        return $ RTriple (fromDVec v) (fromPVec p1) (fromPVec p2)
+        return $ RTriple (fromDVec v) (fromRVec p1) (fromRVec p2)
 
     V.NestJoin p -> do
         (v, p1, p2) <- vecNestJoin p (toDVec c1) (toDVec c2)
-        return $ RTriple (fromDVec v) (fromPVec p1) (fromPVec p2)
+        return $ RTriple (fromDVec v) (fromRVec p1) (fromRVec p2)
 
     V.ThetaJoinS p -> do
         (v, p1, p2) <- vecThetaJoinS p (toDVec c1) (toDVec c2)
-        return $ RTriple (fromDVec v) (fromPVec p1) (fromPVec p2)
+        return $ RTriple (fromDVec v) (fromRVec p1) (fromRVec p2)
 
     V.NestJoinS p -> do
-        (v, p2) <- vecNestJoinS p (toDVec c1) (toDVec c2)
-        return $ RLPair (fromDVec v) (fromPVec p2)
+        (v, p1, p2) <- vecNestJoinS p (toDVec c1) (toDVec c2)
+        return $ RTriple (fromDVec v) (fromRVec p1) (fromRVec p2)
 
+    V.GroupJoin (p, a) -> fromDVec <$> vecGroupJoin p a (toDVec c1) (toDVec c2)
+
     V.SemiJoin p -> do
         (v, r) <- vecSemiJoin p (toDVec c1) (toDVec c2)
-        return $ RLPair (fromDVec v) (fromRVec r)
+        return $ RLPair (fromDVec v) (fromFVec r)
 
     V.SemiJoinS p -> do
         (v, r) <- vecSemiJoinS p (toDVec c1) (toDVec c2)
-        return $ RLPair (fromDVec v) (fromRVec r)
+        return $ RLPair (fromDVec v) (fromFVec r)
 
     V.AntiJoin p -> do
         (v, r) <- vecAntiJoin p (toDVec c1) (toDVec c2)
-        return $ RLPair (fromDVec v) (fromRVec r)
+        return $ RLPair (fromDVec v) (fromFVec r)
 
     V.AntiJoinS p -> do
         (v, r) <- vecAntiJoinS p (toDVec c1) (toDVec c2)
-        return $ RLPair (fromDVec v) (fromRVec r)
-
-    V.TransposeS -> do
-        (qo, qi) <- vecTransposeS (toDVec c1) (toDVec c2)
-        return $ RLPair (fromDVec qo) (fromDVec qi)
+        return $ RLPair (fromDVec v) (fromFVec r)
 
-translateUnOp :: VectorAlgebra v a => V.UnOp -> Res v -> B.Build a (Res v)
+translateUnOp :: VectorAlgebra a
+              => V.UnOp
+              -> Res (DVec a) (RVec a) (KVec a) (FVec a) (SVec a)
+              -> B.Build a (Res (DVec a) (RVec a) (KVec a) (FVec a) (SVec a))
 translateUnOp unop c = case unop of
-    V.AggrNonEmptyS a  -> fromDVec <$> vecAggrNonEmptyS a (toDVec c)
+    V.Unique           -> fromDVec <$> vecUnique (toDVec c)
     V.UniqueS          -> fromDVec <$> vecUniqueS (toDVec c)
     V.Number           -> fromDVec <$> vecNumber (toDVec c)
     V.NumberS          -> fromDVec <$> vecNumberS (toDVec c)
-    V.UnboxRename      -> fromRVec <$> descToRename (toDVec c)
-    V.Segment          -> fromDVec <$> vecSegment (toDVec c)
-    V.Unsegment        -> fromDVec <$> vecUnsegment (toDVec c)
+    V.UnboxKey         -> fromKVec <$> vecUnboxKey (toDVec c)
     V.Aggr a           -> fromDVec <$> vecAggr a (toDVec c)
     V.WinFun  (a, w)   -> fromDVec <$> vecWinFun a w (toDVec c)
-    V.AggrNonEmpty as  -> fromDVec <$> vecAggrNonEmpty as (toDVec c)
+    V.Segment          -> do
+        (d1, d2) <- vecSegment (toDVec c)
+        return $ RLPair (fromDVec d1) (fromDVec d2)
     V.Select e         -> do
         (d, r) <- vecSelect e (toDVec c)
-        return $ RLPair (fromDVec d) (fromRVec r)
+        return $ RLPair (fromDVec d) (fromFVec r)
+    V.Sort es         -> do
+        (d, p) <- vecSort es (toDVec c)
+        return $ RLPair (fromDVec d) (fromSVec p)
     V.SortS es         -> do
         (d, p) <- vecSortS es (toDVec c)
-        return $ RLPair (fromDVec d) (fromPVec p)
+        return $ RLPair (fromDVec d) (fromSVec p)
+    V.Group es -> do
+        (qo, qi, p) <- vecGroup es (toDVec c)
+        return $ RTriple (fromDVec qo) (fromDVec qi) (fromSVec p)
     V.GroupS es -> do
         (qo, qi, p) <- vecGroupS es (toDVec c)
-        return $ RTriple (fromDVec qo) (fromDVec qi) (fromPVec p)
+        return $ RTriple (fromDVec qo) (fromDVec qi) (fromSVec p)
     V.Project cols -> fromDVec <$> vecProject cols (toDVec c)
     V.Reverse      -> do
         (d, p) <- vecReverse (toDVec c)
-        return $ RLPair (fromDVec d) (fromPVec p)
+        return $ RLPair (fromDVec d) (fromSVec p)
     V.ReverseS      -> do
         (d, p) <- vecReverseS (toDVec c)
-        return $ RLPair (fromDVec d) (fromPVec p)
-    V.SelectPos1 (op, pos) -> do
-        (d, p, u) <- vecSelectPos1 (toDVec c) op pos
-        return $ RTriple (fromDVec d) (fromRVec p) (fromRVec u)
-    V.SelectPos1S (op, pos) -> do
-        (d, p, u) <- vecSelectPos1S (toDVec c) op pos
-        return $ RTriple (fromDVec d) (fromRVec p) (fromRVec u)
+        return $ RLPair (fromDVec d) (fromSVec p)
     V.GroupAggr (g, as) -> fromDVec <$> vecGroupAggr g as (toDVec c)
 
-    V.Reshape n -> do
-        (qo, qi) <- vecReshape n (toDVec c)
-        return $ RLPair (fromDVec qo) (fromDVec qi)
-    V.ReshapeS n -> do
-        (qo, qi) <- vecReshapeS n (toDVec c)
-        return $ RLPair (fromDVec qo) (fromDVec qi)
-    V.Transpose -> do
-        (qo, qi) <- vecTranspose (toDVec c)
+    V.Nest -> do
+        (qo, qi) <- vecNest (toDVec c)
         return $ RLPair (fromDVec qo) (fromDVec qi)
+
     V.R1            -> case c of
         (RLPair c1 _)     -> return c1
         (RTriple c1 _ _) -> return c1
@@ -303,78 +329,8 @@
         (RTriple _ _ c3) -> return c3
         _                -> error "R3: Not a tuple"
 
-translateNullary :: VectorAlgebra v a => V.NullOp -> B.Build a (Res v)
-translateNullary V.SingletonDescr          = fromDVec <$> singletonDescr
+translateNullary :: VectorAlgebra a
+                 => V.NullOp
+                 -> B.Build a (Res (DVec a) (RVec a) (KVec a) (FVec a) (SVec a))
 translateNullary (V.Lit (_, tys, vals))    = fromDVec <$> vecLit tys vals
-translateNullary (V.TableRef (n, tys, hs)) = fromDVec <$> vecTableRef n tys hs
-
--- | Insert SerializeRel operators in TA.TableAlgebra plans to define
--- descr and order columns as well as the required payload columns.
--- FIXME: once we are a bit more flexible wrt surrogates, determine the
--- surrogate (i.e. descr) columns from information in NDVec.
-insertSerialize :: VecBuild TA.TableAlgebra NDVec (Shape NDVec) 
-                -> VecBuild TA.TableAlgebra NDVec (Shape NDVec)
-insertSerialize g = g >>= traverseShape
-
-  where
-    traverseShape :: Shape NDVec -> VecBuild TA.TableAlgebra NDVec (Shape NDVec)
-    traverseShape (VShape dvec lyt) = do
-        mLyt' <- traverseLayout lyt
-        case mLyt' of
-            Just lyt' -> do
-                dvec' <- insertOp dvec noDescr needAbsPos
-                return $ VShape dvec' lyt'
-            Nothing   -> do
-                dvec' <- insertOp dvec noDescr needRelPos
-                return $ VShape dvec' lyt
-
-    traverseShape (SShape dvec lyt)     = do
-        mLyt' <- traverseLayout lyt
-        case mLyt' of
-            Just lyt' -> do
-                dvec' <- insertOp dvec noDescr needAbsPos
-                return $ SShape dvec' lyt'
-            Nothing   -> do
-                dvec' <- insertOp dvec noDescr noPos
-                return $ SShape dvec' lyt
-
-    traverseLayout :: (Layout NDVec) -> VecBuild TA.TableAlgebra NDVec (Maybe (Layout NDVec))
-    traverseLayout (LCol _) = return Nothing
-    traverseLayout (LTuple lyts) = do
-        mLyts <- mapM traverseLayout lyts
-        if all isNothing mLyts
-            then return Nothing
-            else return $ Just $ LTuple $ zipWith (\l ml -> maybe l id ml) lyts mLyts
-    traverseLayout (LNest dvec lyt) = do
-        mLyt' <- traverseLayout lyt
-        case mLyt' of
-            Just lyt' -> do
-                dvec' <- insertOp dvec needDescr needAbsPos
-                return $ Just $ LNest dvec' lyt'
-            Nothing   -> do
-                dvec' <- insertOp dvec needDescr needRelPos
-                return $ Just $ LNest dvec' lyt
-
-
-    -- | Insert a Serialize node for the given vector
-    insertOp :: NDVec -> Maybe TA.DescrCol -> TA.SerializeOrder -> VecBuild TA.TableAlgebra NDVec NDVec
-    insertOp (ADVec q cols) descr pos = do
-        let cs = map (TA.PayloadCol . ("item" ++) . show) cols
-            op = TA.Serialize (descr, pos, cs)
-
-        qp   <- lift $ B.insert $ UnOp op q
-        return $ ADVec qp cols
-
-    needDescr = Just (TA.DescrCol "descr")
-    noDescr   = Nothing
-
-    needAbsPos = TA.AbsPos "pos"
-    needRelPos = TA.RelPos ["pos"]
-    noPos      = TA.NoPos
-
-implementVectorOpsPF :: QueryPlan V.VL VLDVec -> QueryPlan TA.TableAlgebra NDVec
-implementVectorOpsPF vlPlan = mkQueryPlan dag shape tagMap
-  where
-    taPlan               = vl2Algebra (D.nodeMap $ queryDag vlPlan) (queryShape vlPlan)
-    serializedPlan       = insertSerialize taPlan
-    (dag, shape, tagMap) = runVecBuild serializedPlan
+translateNullary (V.TableRef (n, schema))  = fromDVec <$> vecTableRef n schema
diff --git a/src/Database/DSH/VL.hs b/src/Database/DSH/VL.hs
new file mode 100644
--- /dev/null
+++ b/src/Database/DSH/VL.hs
@@ -0,0 +1,11 @@
+module Database.DSH.VL
+    ( module Database.DSH.VL.Lang
+    , module Database.DSH.VL.VectorAlgebra
+    , module Database.DSH.Translate.VL2Algebra
+    ) where
+
+import           Database.DSH.Translate.VL2Algebra (VecBuild, runVecBuild, vl2Algebra)
+import           Database.DSH.VL.Lang              (VL, AggrFun (..), DBCol,
+                                                    Expr (..), FrameSpec (..),
+                                                    WinFun (..), shiftExprCols)
+import           Database.DSH.VL.VectorAlgebra
diff --git a/src/Database/DSH/VL/Lang.hs b/src/Database/DSH/VL/Lang.hs
--- a/src/Database/DSH/VL/Lang.hs
+++ b/src/Database/DSH/VL/Lang.hs
@@ -1,44 +1,28 @@
-{-# LANGUAGE TemplateHaskell      #-}
 {-# LANGUAGE FlexibleInstances    #-}
 {-# LANGUAGE GADTs                #-}
 {-# LANGUAGE RankNTypes           #-}
+{-# LANGUAGE TemplateHaskell      #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 
 module Database.DSH.VL.Lang where
 
-import qualified Data.List.NonEmpty as N
 import           Data.Aeson.TH
+import qualified Data.List.NonEmpty          as N
 
-import           Database.Algebra.Dag        (Operator, opChildren, replaceOpChild)
+import           Database.Algebra.Dag        (Operator, opChildren,
+                                              replaceOpChild)
 import           Database.Algebra.Dag.Common
 
-import qualified Database.DSH.Common.Lang as L
+import qualified Database.DSH.Common.Lang    as L
+import           Database.DSH.Common.Type
 
-data ScalarType = Int 
-                | Bool 
-                | Double
-                | String 
-                | Unit
-             deriving (Eq, Ord, Show)
 
-$(deriveJSON defaultOptions ''ScalarType)
-
-type VLColumn = (L.ColName, ScalarType)
 type DBCol = Int
 
-data VLVal = VLInt Int
-           | VLBool Bool
-           | VLString String
-           | VLDouble Double
-           | VLUnit
-           deriving (Eq, Ord, Show, Read)
-
-$(deriveJSON defaultOptions ''VLVal)
-
 data Expr = BinApp L.ScalarBinOp Expr Expr
           | UnApp L.ScalarUnOp Expr
           | Column DBCol
-          | Constant VLVal
+          | Constant L.ScalarVal
           | If Expr Expr Expr
           deriving (Eq, Ord, Show)
 
@@ -46,13 +30,12 @@
 
 -- | Helper function: Shift all column indexes in an expression by a certain offset.
 shiftExprCols :: Int -> Expr -> Expr
-shiftExprCols o (BinApp op e1 e2) = BinApp op (shiftExprCols o e1) 
-                                              (shiftExprCols o e2)
+shiftExprCols o (BinApp op e1 e2) = BinApp op (shiftExprCols o e1) (shiftExprCols o e2)
 shiftExprCols o (UnApp op e)      = UnApp op (shiftExprCols o e)
 shiftExprCols o (Column c)        = Column $ c + o
 shiftExprCols _ (Constant v)      = Constant v
-shiftExprCols o (If c t e)        = If (shiftExprCols o c) 
-                                       (shiftExprCols o t) 
+shiftExprCols o (If c t e)        = If (shiftExprCols o c)
+                                       (shiftExprCols o t)
                                        (shiftExprCols o e)
 
 data AggrFun = AggrSum ScalarType Expr
@@ -94,16 +77,15 @@
 -- Vector Language operators. Documentation can be found in module
 -- VectorPrimitives.
 
-data NullOp = SingletonDescr
-            | Lit (L.Emptiness, [ScalarType], [[VLVal]])
-            | TableRef (String, [VLColumn], L.TableHints)
+data NullOp = Lit (L.Emptiness, [ScalarType], [[L.ScalarVal]])
+            | TableRef (String, L.BaseTableSchema)
             deriving (Eq, Ord, Show)
 
 $(deriveJSON defaultOptions ''NullOp)
 
-data UnOp = UnboxRename
+data UnOp = UnboxKey
           | Segment
-          | Unsegment
+          | Nest
 
           | R1
           | R2
@@ -114,42 +96,35 @@
 
           | GroupAggr ([Expr], N.NonEmpty AggrFun)
           | Aggr AggrFun
-          | AggrNonEmpty (N.NonEmpty AggrFun)
-          | AggrNonEmptyS (N.NonEmpty AggrFun)
-
           | Number
           | NumberS
+          | Unique
           | UniqueS
           | Reverse
           | ReverseS
-          | SelectPos1 (L.ScalarBinOp, Int)
-          | SelectPos1S (L.ScalarBinOp, Int)
+          | Sort [Expr]
           | SortS [Expr]
+          | Group [Expr]
           | GroupS [Expr]
           | WinFun (WinFun, FrameSpec)
-
-          | Reshape Integer
-          | ReshapeS Integer
-          | Transpose
     deriving (Eq, Ord, Show)
 
 $(deriveJSON defaultOptions ''UnOp)
 
 data BinOp = DistLift
+           | DistSng
 
-           | PropRename
-           | PropFilter
-           | PropReorder
-           
-           | UnboxNested
-           | UnboxScalar
+           | AppKey
+           | AppSort
+           | AppFilter
+           | AppRep
+
+           | UnboxSng
            | Align
 
            | AggrS AggrFun
            | Append
            | AppendS
-           | SelectPos L.ScalarBinOp
-           | SelectPosS L.ScalarBinOp
            | Zip
            | ZipS
            | CartProduct
@@ -162,9 +137,9 @@
            | AntiJoinS (L.JoinPredicate Expr)
            | NestJoin (L.JoinPredicate Expr)
            | NestJoinS (L.JoinPredicate Expr)
+           | GroupJoin (L.JoinPredicate Expr, AggrFun)
            | NestProduct
            | NestProductS
-           | TransposeS
     deriving (Eq, Ord, Show)
 
 $(deriveJSON defaultOptions ''BinOp)
@@ -186,9 +161,9 @@
     opChildren (NullaryOp _) = []
 
     replaceOpChild oper old new = replaceChild old new oper
-     where
-         replaceChild :: forall t b u n c. Eq c => c -> c -> Algebra t b u n c -> Algebra t b u n c
-         replaceChild o n (TerOp op c1 c2 c3) = TerOp op (checkRep o n c1) (checkRep o n c2) (checkRep o n c3)
-         replaceChild o n (BinOp op c1 c2) = BinOp op (checkRep o n c1) (checkRep o n c2)
-         replaceChild o n (UnOp op c) = UnOp op (checkRep o n c)
-         replaceChild _ _ (NullaryOp op) = NullaryOp op
+      where
+        replaceChild :: forall t b u n c. Eq c => c -> c -> Algebra t b u n c -> Algebra t b u n c
+        replaceChild o n (TerOp op c1 c2 c3) = TerOp op (checkRep o n c1) (checkRep o n c2) (checkRep o n c3)
+        replaceChild o n (BinOp op c1 c2) = BinOp op (checkRep o n c1) (checkRep o n c2)
+        replaceChild o n (UnOp op c) = UnOp op (checkRep o n c)
+        replaceChild _ _ (NullaryOp op) = NullaryOp op
diff --git a/src/Database/DSH/VL/Opt/OptimizeVL.hs b/src/Database/DSH/VL/Opt/OptimizeVL.hs
new file mode 100644
--- /dev/null
+++ b/src/Database/DSH/VL/Opt/OptimizeVL.hs
@@ -0,0 +1,56 @@
+module Database.DSH.VL.Opt.OptimizeVL where
+
+import qualified Data.IntMap                                                      as M
+
+import qualified Database.Algebra.Dag                                             as Dag
+
+import           Database.DSH.Common.QueryPlan
+
+import           Database.DSH.VL.Lang
+import           Database.DSH.Common.Vector
+
+import           Database.DSH.Common.Opt
+import           Database.DSH.VL.Opt.Rewrite.Expressions
+import           Database.DSH.VL.Opt.Rewrite.PruneEmpty
+import           Database.DSH.VL.Opt.Rewrite.Redundant
+
+type RewriteClass = Rewrite VL (Shape VLDVec) Bool
+
+rewriteClasses :: [(Char, RewriteClass)]
+rewriteClasses = [ ('E', pruneEmpty)
+                 , ('R', removeRedundancy)
+                 , ('C', optExpressions)
+                 ]
+
+defaultPipeline :: [RewriteClass]
+defaultPipeline = case assemblePipeline "ER" of
+  Just p -> p
+  Nothing -> error "invalid default pipeline"
+
+runPipeline
+  :: Dag.AlgebraDag VL
+  -> (Shape VLDVec)
+  -> [RewriteClass]
+  -> Bool -> (Dag.AlgebraDag VL, Log, Shape VLDVec)
+runPipeline d sh pipeline debug = (d', rewriteLog, sh')
+  where (d', sh', _, rewriteLog) = runRewrite (sequence_ pipeline) d sh debug
+
+assemblePipeline :: String -> Maybe [RewriteClass]
+assemblePipeline s = mapM (flip lookup rewriteClasses) s
+
+optimizeVL :: [RewriteClass] -> QueryPlan VL VLDVec -> QueryPlan VL VLDVec
+optimizeVL pipeline plan =
+#ifdef DEBUGGRAPH
+  let (d, _, shape) = runPipeline (queryDag plan) (queryShape plan) pipeline True
+#else
+  let (d, _, shape) = runPipeline (queryDag plan) (queryShape plan) pipeline False
+#endif
+  in QueryPlan { queryDag = d, queryShape = shape, queryTags = M.empty }
+
+optimizeVL' :: [RewriteClass] -> QueryPlan VL VLDVec -> (QueryPlan VL VLDVec, Log)
+optimizeVL' pipeline plan =
+  let (d, l, shape) = runPipeline (queryDag plan) (queryShape plan) pipeline False
+  in (QueryPlan { queryDag = d, queryShape = shape, queryTags = M.empty }, l)
+
+optimizeVLDefault :: QueryPlan VL VLDVec -> QueryPlan VL VLDVec
+optimizeVLDefault = optimizeVL defaultPipeline
diff --git a/src/Database/DSH/VL/Opt/Properties/BottomUp.hs b/src/Database/DSH/VL/Opt/Properties/BottomUp.hs
new file mode 100644
--- /dev/null
+++ b/src/Database/DSH/VL/Opt/Properties/BottomUp.hs
@@ -0,0 +1,91 @@
+module Database.DSH.VL.Opt.Properties.BottomUp where
+
+import Text.Printf
+
+import Database.Algebra.Dag
+import Database.Algebra.Dag.Common
+
+import Database.DSH.VL.Lang
+import Database.DSH.Common.Opt
+
+import Database.DSH.VL.Opt.Properties.Card
+import Database.DSH.VL.Opt.Properties.Const
+import Database.DSH.VL.Opt.Properties.Empty
+import Database.DSH.VL.Opt.Properties.Types
+import Database.DSH.VL.Opt.Properties.VectorType
+
+-- FIXME this is (almost) identical to its X100 counterpart -> merge
+inferWorker :: NodeMap VL -> VL -> AlgNode -> NodeMap BottomUpProps -> BottomUpProps
+inferWorker d op node pm =
+    case op of
+         TerOp vl c1 c2 c3 ->
+           let c1Props = lookupUnsafe pm "no children properties" c1
+               c2Props = lookupUnsafe pm "no children properties" c2
+               c3Props = lookupUnsafe pm "no children properties" c3
+           in checkError d node [c1Props, c2Props, c3Props] pm $ inferTerOp vl c1Props c2Props c3Props
+         BinOp vl c1 c2 ->
+           let c1Props = lookupUnsafe pm "no children properties" c1
+               c2Props = lookupUnsafe pm "no children properties" c2
+           in checkError d node [c1Props, c2Props] pm $ inferBinOp vl c1Props c2Props
+         UnOp vl c ->
+           let cProps = lookupUnsafe pm "no children properties" c
+           in checkError d node [cProps] pm $ inferUnOp vl cProps
+         NullaryOp vl -> checkError d node [] pm $ inferNullOp vl
+
+checkError :: NodeMap VL -> AlgNode -> [BottomUpProps] -> NodeMap BottomUpProps -> Either String BottomUpProps -> BottomUpProps
+checkError d n childProps propMap (Left msg) =
+    let childPropsMsg = concatMap ((++) "\n" . show) childProps
+        completeMsg   = printf "Inference failed at node %d\n%s\n%s\n%s\n%s" n msg childPropsMsg (show propMap) (show d)
+    in error completeMsg
+checkError _ _ _ _ (Right props) = props
+
+inferNullOp :: NullOp -> Either String BottomUpProps
+inferNullOp op = do
+  opEmpty    <- inferEmptyNullOp op
+  opConst    <- inferConstVecNullOp op
+  opType     <- inferVectorTypeNullOp op
+  opCard     <- inferCardOneNullOp op
+  return $ BUProps { emptyProp = opEmpty
+                   , constProp = opConst
+                   , card1Prop = opCard
+                   , vectorTypeProp = opType }
+
+inferUnOp :: UnOp -> BottomUpProps -> Either String BottomUpProps
+inferUnOp op cProps = do
+  opEmpty    <- inferEmptyUnOp (emptyProp cProps) op
+  opType     <- inferVectorTypeUnOp (vectorTypeProp cProps) op
+  opConst    <- inferConstVecUnOp (constProp cProps) op
+  opCard     <- inferCardOneUnOp (card1Prop cProps) op
+  return $ BUProps { emptyProp = opEmpty
+                   , constProp = opConst
+                   , card1Prop = opCard
+                   , vectorTypeProp = opType }
+
+inferBinOp :: BinOp -> BottomUpProps -> BottomUpProps -> Either String BottomUpProps
+inferBinOp op c1Props c2Props = do
+  opEmpty    <- inferEmptyBinOp (emptyProp c1Props) (emptyProp c2Props) op
+  opType     <- inferVectorTypeBinOp (vectorTypeProp c1Props) (vectorTypeProp c2Props) op
+  opConst    <- inferConstVecBinOp (constProp c1Props) (constProp c2Props) op
+  opCard     <- inferCardOneBinOp (card1Prop c1Props) (card1Prop c2Props) op
+  return $ BUProps { emptyProp = opEmpty
+                   , constProp = opConst
+                   , card1Prop = opCard
+                   , vectorTypeProp = opType }
+
+inferTerOp :: TerOp
+           -> BottomUpProps
+           -> BottomUpProps
+           -> BottomUpProps
+           -> Either String BottomUpProps
+inferTerOp op c1Props c2Props c3Props = do
+  opEmpty    <- inferEmptyTerOp (emptyProp c1Props) (emptyProp c2Props) (emptyProp c3Props) op
+  opType     <- inferVectorTypeTerOp (vectorTypeProp c1Props) (vectorTypeProp c2Props) (vectorTypeProp c3Props) op
+  opConst    <- inferConstVecTerOp (constProp c1Props) (constProp c2Props) (constProp c3Props) op
+  opCard     <- inferCardOneTerOp (card1Prop c1Props) (card1Prop c2Props) (card1Prop c3Props) op
+  return $ BUProps { emptyProp = opEmpty
+                   , constProp = opConst
+                   , card1Prop = opCard
+                   , vectorTypeProp = opType }
+
+inferBottomUpProperties :: AlgebraDag VL -> NodeMap BottomUpProps
+inferBottomUpProperties dag = inferBottomUpGeneral inferWorker dag
diff --git a/src/Database/DSH/VL/Opt/Properties/Card.hs b/src/Database/DSH/VL/Opt/Properties/Card.hs
new file mode 100644
--- /dev/null
+++ b/src/Database/DSH/VL/Opt/Properties/Card.hs
@@ -0,0 +1,93 @@
+-- FIXME complete rules
+{-# LANGUAGE TemplateHaskell #-}
+
+module Database.DSH.VL.Opt.Properties.Card where
+
+import Database.DSH.VL.Lang
+
+import Database.DSH.VL.Opt.Properties.Types
+import Database.DSH.VL.Opt.Properties.Common
+
+unp :: Show a => VectorProp a -> Either String a
+unp = unpack "Properties.Card"
+
+inferCardOneNullOp :: NullOp -> Either String (VectorProp Bool)
+inferCardOneNullOp op =
+  case op of
+    Lit (_, _, rows) -> Right $ VProp $ length rows == 1
+    TableRef _       -> Right $ VProp False
+
+inferCardOneUnOp :: VectorProp Bool -> UnOp -> Either String (VectorProp Bool)
+inferCardOneUnOp c op =
+  case op of
+    Unique -> Right c
+    UniqueS -> Right c
+    Aggr _ -> Right $ VProp True
+    WinFun _ -> Right c
+    UnboxKey -> Right c
+    Segment -> unp c >>= (\uc -> return $ VPropPair uc uc)
+    Nest -> unp c >>= (\uc -> return $ VPropPair True uc)
+    Project _  -> Right c
+    Reverse -> unp c >>= (\uc -> return $ VPropPair uc uc)
+    ReverseS -> unp c >>= (\uc -> return $ VPropPair uc uc)
+    Select _ -> Right $ VPropPair False False
+    Sort _ -> unp c >>= (\uc -> return $ VPropPair uc uc)
+    SortS _ -> unp c >>= (\uc -> return $ VPropPair uc uc)
+    Group _ -> unp c >>= (\uc -> return $ VPropTriple uc uc uc)
+    GroupS _ -> unp c >>= (\uc -> return $ VPropTriple uc uc uc)
+    R1 ->
+      case c of
+        VProp _           -> Left "Properties.Card: not a pair/triple"
+        VPropPair b _     -> Right $ VProp b
+        VPropTriple b _ _ -> Right $ VProp b
+    R2 ->
+      case c of
+        VProp _           -> Left "Properties.Card: not a pair/triple"
+        VPropPair _ b     -> Right $ VProp b
+        VPropTriple _ b _ -> Right $ VProp b
+    R3 ->
+      case c of
+        VPropTriple _ _ b -> Right $ VProp b
+        _                 -> Left "Properties.Card: not a triple"
+    GroupAggr ([], _) -> Right $ VProp True
+    GroupAggr (_, _)  -> Right c
+    Number -> Right c
+    NumberS -> Right c
+
+inferCardOneBinOp :: VectorProp Bool -> VectorProp Bool -> BinOp -> Either String (VectorProp Bool)
+inferCardOneBinOp c1 c2 op =
+  case op of
+    AggrS _ -> return $ VProp False
+    NestProduct -> return $ VPropTriple False False False
+    DistLift -> return $ VPropPair False False
+    DistSng -> unp c2 >>= (\uc -> return $ VPropPair uc uc)
+    AppKey -> return $ VPropPair False False
+    AppSort -> return $ VPropPair False False
+    AppFilter -> return $ VPropPair False False
+    AppRep -> return $ VPropPair False False
+    UnboxSng -> return $ VPropPair False False
+    -- FIXME more precisely: empty(left) and card1(right) or card1(left) and empty(right)
+    Append -> Right $ VPropTriple False False False
+    AppendS -> Right $ VPropTriple False False False
+    Zip ->  (||) <$> unp c1 <*> unp c2 >>= \p -> return $ VPropTriple p p p
+    Align -> VProp <$> ((||) <$> unp c1 <*> unp c2)
+    CartProduct -> return $ VPropTriple False False False
+    CartProductS -> return $ VPropTriple False False False
+    NestProductS -> return $ VPropTriple False False False
+    ThetaJoin _ -> return $ VPropTriple False False False
+    NestJoin _ -> return $ VPropTriple False False False
+    ThetaJoinS _ -> return $ VPropTriple False False False
+    NestJoinS _ -> return $ VPropTriple False False False
+    GroupJoin _ -> return $ VProp False
+    SemiJoin _ -> return $ VPropPair False False
+    SemiJoinS _ -> return $ VPropPair False False
+    AntiJoin _ -> return $ VPropPair False False
+    AntiJoinS _ -> return $ VPropPair False False
+    ZipS -> do
+      c <- (||) <$> unp c1 <*> unp c2
+      return $ VPropTriple c c c
+
+inferCardOneTerOp :: VectorProp Bool -> VectorProp Bool -> VectorProp Bool -> TerOp -> Either String (VectorProp Bool)
+inferCardOneTerOp _ _ _ op =
+  case op of
+    Combine -> return $ VPropTriple False False False
diff --git a/src/Database/DSH/VL/Opt/Properties/Common.hs b/src/Database/DSH/VL/Opt/Properties/Common.hs
new file mode 100644
--- /dev/null
+++ b/src/Database/DSH/VL/Opt/Properties/Common.hs
@@ -0,0 +1,19 @@
+module Database.DSH.VL.Opt.Properties.Common where
+
+import Control.Monad
+
+import Database.DSH.VL.Opt.Properties.Types
+
+unpack :: Show a => String -> VectorProp a -> Either String a
+unpack _ (VProp b)  = Right b
+unpack moduleName p = Left $ "no single vector in " ++ moduleName ++ " " ++ (show p)
+
+mapUnpack :: Show a => String
+             -> VectorProp a
+             -> VectorProp a
+             -> (a -> a -> VectorProp a)
+             -> Either String (VectorProp a)
+mapUnpack moduleName e1 e2 f = let ue1 = unpack moduleName e1
+                                   ue2 = unpack moduleName e2
+                               in liftM2 f ue1 ue2
+
diff --git a/src/Database/DSH/VL/Opt/Properties/Const.hs b/src/Database/DSH/VL/Opt/Properties/Const.hs
new file mode 100644
--- /dev/null
+++ b/src/Database/DSH/VL/Opt/Properties/Const.hs
@@ -0,0 +1,375 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module Database.DSH.VL.Opt.Properties.Const
+    ( inferConstVecNullOp
+    , inferConstVecUnOp
+    , inferConstVecBinOp
+    , inferConstVecTerOp
+    ) where
+
+import           Control.Monad
+import           Data.List
+import qualified Data.List.NonEmpty                          as N
+import           Data.Maybe
+
+import Database.DSH.Common.Impossible
+import           Database.DSH.VL.Opt.Properties.Common
+import           Database.DSH.VL.Opt.Properties.Types
+import           Database.DSH.VL.Lang
+import           Database.DSH.Common.Lang
+
+unp :: Show a => VectorProp a -> Either String a
+unp = unpack "Properties.Const"
+
+fromDBV :: ConstVec -> Either String [ConstPayload]
+fromDBV (ConstVec pl) = Right pl
+fromDBV CNA           = Left $ "Properties.Const.fromDBV"
+
+--------------------------------------------------------------------------------
+-- Evaluation of constant expressions
+
+-- FIXME finish remaining cases, only integer numeric operations so
+-- far.
+
+mkEnv :: [ConstPayload] -> [(DBCol, ScalarVal)]
+mkEnv constCols = mapMaybe envEntry $ zip [1..] constCols
+  where
+    envEntry :: (DBCol, ConstPayload) -> Maybe (DBCol, ScalarVal)
+    envEntry (_, NonConstPL) = mzero
+    envEntry (c, ConstPL v)  = return (c, v)
+
+evalNumOp :: BinNumOp -> Int -> Int -> Int
+evalNumOp op v1 v2 =
+    case op of
+        Add -> v1 + v2
+        Sub -> v1 - v2
+        Div -> v1 `div` v2
+        Mul -> v1 * v2
+        Mod -> v1 `mod` v2
+
+evalBinOp :: ScalarBinOp -> ScalarVal -> ScalarVal -> Maybe ScalarVal
+evalBinOp (SBNumOp nop)  (IntV i1)    (IntV i2)    = return $ IntV $ evalNumOp nop i1 i2
+evalBinOp (SBNumOp _)    (DoubleV _)  (DoubleV _)  = mzero
+evalBinOp (SBNumOp _)    (DecimalV _) (DecimalV _) = mzero
+
+evalBinOp (SBRelOp _)    (IntV _)     (IntV _)     = mzero
+evalBinOp (SBRelOp _)    (DoubleV _)  (DoubleV _)  = mzero
+evalBinOp (SBRelOp _)    (DecimalV _) (DecimalV _) = mzero
+evalBinOp (SBRelOp _)    (StringV _)  (StringV _)  = mzero
+evalBinOp (SBRelOp _)    (DateV _)    (DateV _)    = mzero
+
+evalBinOp (SBBoolOp _)   (BoolV _)    (BoolV _)    = mzero
+evalBinOp (SBStringOp _) (StringV _)  (StringV _)  = mzero
+evalBinOp (SBDateOp _)   (IntV _)     (DateV _)    = mzero
+evalBinOp (SBDateOp _)   (DateV _)    (DateV _)    = mzero
+evalBinOp _              _            _            = $impossible
+
+evalUnOp :: ScalarUnOp -> ScalarVal -> Maybe ScalarVal
+evalUnOp _ _ = mzero
+
+constExpr :: [ConstPayload] -> Expr -> Either String ConstPayload
+constExpr constCols expr =
+    case eval expr of
+        Just v  -> return $ ConstPL v
+        Nothing -> return NonConstPL
+
+  where
+    env :: [(DBCol, ScalarVal)]
+    env = mkEnv constCols
+
+    eval :: Expr -> Maybe ScalarVal
+    eval (Constant v)      = return v
+    eval (Column i)        = lookup i env
+    eval (BinApp op e1 e2) = do
+        v1 <- eval e1
+        v2 <- eval e2
+        evalBinOp op v1 v2
+    eval (UnApp op e1)     = do
+        v <- eval e1
+        evalUnOp op v
+    eval (If c t e)        = do
+        cv <- eval c
+        case cv of
+            BoolV True  -> eval t
+            BoolV False -> eval e
+            _           -> mzero
+
+--------------------------------------------------------------------------------
+-- Stuff
+
+inferConstVecNullOp :: NullOp -> Either String (VectorProp ConstVec)
+inferConstVecNullOp op =
+  case op of
+    -- do not include the first two columns in the payload columns because they represent descr and pos.
+    Lit (_, colTypes, rows)      ->
+      if null rows
+      then return $ VProp $ ConstVec $ map (const NonConstPL) colTypes
+      else return $ VProp $ ConstVec constCols
+        where constCols       = map toConstPayload $ drop 2 $ transpose rows
+
+              toConstPayload col@(c : _) = if all (c ==) col
+                                           then ConstPL c
+                                           else NonConstPL
+              toConstPayload []          = NonConstPL
+
+    TableRef (_, schema)    -> return $ VProp
+                                      $ ConstVec
+                                      $ map (const NonConstPL)
+                                      $ N.toList
+                                      $ tableCols schema
+
+inferConstVecUnOp :: (VectorProp ConstVec) -> UnOp -> Either String (VectorProp ConstVec)
+inferConstVecUnOp c op =
+  case op of
+    Nest -> do
+      cols <- unp c >>= fromDBV
+      return $ VPropPair (ConstVec []) (ConstVec cols)
+
+    WinFun _ -> do
+      cols <- unp c >>= fromDBV
+      return $ VProp $ ConstVec (cols ++ [NonConstPL])
+
+    UniqueS -> return c
+    Unique -> return c
+
+    Aggr _ -> do
+      return $ VProp $ ConstVec [NonConstPL]
+
+    UnboxKey -> return $ VProp CNA
+
+    Segment -> do
+      constCols <- unp c >>= fromDBV
+      return $ VPropPair (ConstVec []) (ConstVec constCols)
+
+    Reverse -> do
+      cs <- unp c >>= fromDBV
+      return $ VPropPair (ConstVec cs) CNA
+
+    ReverseS -> do
+      cs <- unp c >>= fromDBV
+      return $ VPropPair (ConstVec cs) CNA
+
+    Project projExprs   -> do
+      constCols  <- unp c >>= fromDBV
+      constCols' <- mapM (constExpr constCols) projExprs
+      return $ VProp $ ConstVec constCols'
+
+    Select _       -> do
+      cols <- unp c >>= fromDBV
+      return $ VPropPair (ConstVec cols) CNA
+
+    GroupAggr (g, as) -> do
+      let pl = [ NonConstPL | _ <- [1 .. (length g) + (N.length as)] ]
+      return $ VProp $ ConstVec pl
+
+    Number -> do
+      cols <- unp c >>= fromDBV
+      return $ VProp $ ConstVec (cols ++ [NonConstPL])
+
+    NumberS -> do
+      cols <- unp c >>= fromDBV
+      return $ VProp $ ConstVec (cols ++ [NonConstPL])
+
+    Sort _ -> do
+      cs <- unp c >>= fromDBV
+      return $ VPropPair (ConstVec cs) CNA
+
+    SortS _ -> do
+      cs <- unp c >>= fromDBV
+      return $ VPropPair (ConstVec cs) CNA
+
+    Group es -> do
+      cs <- unp c >>= fromDBV
+      return $ VPropTriple (ConstVec (map (const NonConstPL) es))
+                           (ConstVec (map (const NonConstPL) cs))
+                           CNA
+
+    GroupS es -> do
+      cs <- unp c >>= fromDBV
+      return $ VPropTriple (ConstVec (map (const NonConstPL) es))
+                           (ConstVec (map (const NonConstPL) cs))
+                           CNA
+
+    R1 ->
+      case c of
+        VProp _           -> Left "Properties.Const: not a pair/triple"
+        VPropPair b _     -> Right $ VProp b
+        VPropTriple b _ _ -> Right $ VProp b
+    R2 ->
+      case c of
+        VProp _           -> Left "Properties.Const: not a pair/triple"
+        VPropPair _ b     -> Right $ VProp b
+        VPropTriple _ b _ -> Right $ VProp b
+    R3 ->
+      case c of
+        VPropTriple _ _ b -> Right $ VProp b
+        _                 -> Left "Properties.Const: not a triple"
+
+inferConstVecBinOp :: (VectorProp ConstVec) -> (VectorProp ConstVec) -> BinOp -> Either String (VectorProp ConstVec)
+inferConstVecBinOp c1 c2 op =
+  case op of
+    -- FIXME use cardinality property to infer the length if possible
+    -- FIXME handle special cases: empty input, cardinality 1 and const input, ...
+    AggrS _ -> do
+      return $ VProp $ ConstVec [NonConstPL]
+
+    DistLift -> do
+      cols1 <- unp c1 >>= fromDBV
+      cols2 <- unp c2 >>= fromDBV
+      return $ VPropPair (ConstVec (cols1 ++ cols2)) CNA
+
+    DistSng -> do
+      cols1 <- unp c1 >>= fromDBV
+      cols2 <- unp c2 >>= fromDBV
+      return $ VPropPair (ConstVec (cols1 ++ cols2)) CNA
+
+    AppKey -> do
+      cols <- unp c2 >>= fromDBV
+      return $ VPropPair (ConstVec cols) CNA
+
+    AppSort -> do
+      cols <- unp c2 >>= fromDBV
+      return $ VPropPair (ConstVec cols) CNA
+
+    AppFilter -> do
+      cols <- unp c2 >>= fromDBV
+      return $ VPropPair (ConstVec cols) CNA
+
+    AppRep -> do
+      cols <- unp c2 >>= fromDBV
+      return $ VPropPair (ConstVec cols) CNA
+
+    UnboxSng -> do
+      cols1 <- unp c1 >>= fromDBV
+      cols2 <- unp c2 >>= fromDBV
+      return $ VPropPair (ConstVec (cols1 ++ cols2)) CNA
+
+    Append -> do
+      cols1 <- unp c1 >>= fromDBV
+      cols2 <- unp c2 >>= fromDBV
+
+      let constCols = map sameConst $ zip cols1 cols2
+
+          sameConst ((ConstPL v1), (ConstPL v2)) | v1 == v2 = ConstPL v1
+          sameConst (_, _)                                  = NonConstPL
+
+      return $ VPropTriple (ConstVec constCols) CNA CNA
+
+    AppendS -> do
+      cols1 <- unp c1 >>= fromDBV
+      cols2 <- unp c2 >>= fromDBV
+
+      let constCols = map sameConst $ zip cols1 cols2
+
+          sameConst ((ConstPL v1), (ConstPL v2)) | v1 == v2 = ConstPL v1
+          sameConst (_, _)                                  = NonConstPL
+
+      return $ VPropTriple (ConstVec constCols) CNA CNA
+
+    Align -> do
+      cols1 <- unp c1 >>= fromDBV
+      cols2  <- unp c2 >>= fromDBV
+      let cols = cols1 ++ cols2
+      return $ VProp $ ConstVec cols
+
+    Zip -> do
+      cols1 <- unp c1 >>= fromDBV
+      cols2  <- unp c2 >>= fromDBV
+      let cols = cols1 ++ cols2
+      return $ VPropTriple (ConstVec cols) CNA CNA
+
+    ZipS -> do
+      cols1 <- unp c1 >>= fromDBV
+      cols2  <- unp c2 >>= fromDBV
+      let cols = cols1 ++ cols2
+      return $ VPropTriple (ConstVec cols) CNA CNA
+
+    CartProduct -> do
+      cols1 <- unp c1 >>= fromDBV
+      cols2 <- unp c2 >>= fromDBV
+      let constCols = cols1 ++ cols2
+      return $ VPropTriple (ConstVec constCols) CNA CNA
+
+    CartProductS -> do
+      cols1 <- unp c1 >>= fromDBV
+      cols2 <- unp c2 >>= fromDBV
+      let constCols = cols1 ++ cols2
+      return $ VPropTriple (ConstVec constCols) CNA CNA
+
+    NestProductS -> do
+      cols1 <- unp c1 >>= fromDBV
+      cols2 <- unp c2 >>= fromDBV
+      let constCols = cols1 ++ cols2
+      return $ VPropTriple (ConstVec constCols) CNA CNA
+
+    NestJoin _ -> do
+      cols1 <- unp c1 >>= fromDBV
+      cols2 <- unp c2 >>= fromDBV
+      let constCols = cols1 ++ cols2
+      return $ VPropTriple (ConstVec constCols) CNA CNA
+
+    GroupJoin _ -> do
+      cols1 <- unp c1 >>= fromDBV
+      let constCols = cols1 ++ [NonConstPL]
+      return $ VProp (ConstVec constCols)
+
+    NestProduct -> do
+      cols1 <- unp c1 >>= fromDBV
+      cols2 <- unp c2 >>= fromDBV
+      let constCols = cols1 ++ cols2
+      return $ VPropTriple (ConstVec constCols) CNA CNA
+
+    ThetaJoin _ -> do
+      cols1 <- unp c1 >>= fromDBV
+      cols2 <- unp c2 >>= fromDBV
+
+      let constCols = cols1 ++ cols2
+
+      return $ VPropTriple (ConstVec constCols) CNA CNA
+
+    ThetaJoinS _ -> do
+      cols1 <- unp c1 >>= fromDBV
+      cols2 <- unp c2 >>= fromDBV
+      let constCols = cols1 ++ cols2
+      return $ VPropTriple (ConstVec constCols) CNA CNA
+
+    NestJoinS _ -> do
+      cols1 <- unp c1 >>= fromDBV
+      cols2 <- unp c2 >>= fromDBV
+      let constCols = cols1 ++ cols2
+      return $ VPropTriple (ConstVec constCols) CNA CNA
+
+    SemiJoin _ -> do
+      cols1 <- unp c1 >>= fromDBV
+      return $ VPropPair (ConstVec cols1) CNA
+
+    SemiJoinS _ -> do
+      cols1 <- unp c1 >>= fromDBV
+      return $ VPropPair (ConstVec cols1) CNA
+
+    AntiJoin _ -> do
+      cols1 <- unp c1 >>= fromDBV
+      return $ VPropPair (ConstVec cols1) CNA
+
+    AntiJoinS _ -> do
+      cols1 <- unp c1 >>= fromDBV
+      return $ VPropPair (ConstVec cols1) CNA
+
+inferConstVecTerOp :: VectorProp ConstVec
+                   -> VectorProp ConstVec
+                   -> VectorProp ConstVec
+                   -> TerOp
+                   -> Either String (VectorProp ConstVec)
+inferConstVecTerOp _c1 c2 c3 op =
+  case op of
+    Combine -> do
+      cols2  <- unp c2 >>= fromDBV
+      cols3  <- unp c3 >>= fromDBV
+
+      let constCols = map sameConst $ zip cols2 cols3
+
+          sameConst ((ConstPL v1), (ConstPL v2)) | v1 == v2 = ConstPL v1
+          sameConst (_, _)                                  = NonConstPL
+
+      return $ VPropTriple (ConstVec constCols) CNA CNA
+
diff --git a/src/Database/DSH/VL/Opt/Properties/Empty.hs b/src/Database/DSH/VL/Opt/Properties/Empty.hs
new file mode 100644
--- /dev/null
+++ b/src/Database/DSH/VL/Opt/Properties/Empty.hs
@@ -0,0 +1,104 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module Database.DSH.VL.Opt.Properties.Empty where
+
+import Control.Monad
+
+import Database.DSH.VL.Lang
+
+import Database.DSH.VL.Opt.Properties.Types
+import Database.DSH.VL.Opt.Properties.Common
+
+unp :: Show a => VectorProp a -> Either String a
+unp = unpack "Properties.Empty"
+
+mapUnp :: Show a => VectorProp a
+          -> VectorProp a
+          -> (a -> a -> VectorProp a)
+          -> Either String (VectorProp a)
+mapUnp = mapUnpack "Properties.Empty"
+
+inferEmptyNullOp :: NullOp -> Either String (VectorProp Bool)
+inferEmptyNullOp op =
+  case op of
+    Lit (_, _, []) -> Right $ VProp True
+    Lit{}          -> Right $ VProp False
+    TableRef{}     -> Right $ VProp False
+
+inferEmptyUnOp :: VectorProp Bool -> UnOp -> Either String (VectorProp Bool)
+inferEmptyUnOp e op =
+  case op of
+    Nest             -> VPropPair False <$> unp e
+    WinFun _         -> Right e
+    Unique           -> Right e
+    UniqueS          -> Right e
+    Aggr _           -> Right $ VProp False
+    UnboxKey         -> Right e
+    Segment          -> let ue = unp e in liftM2 VPropPair ue ue
+    Reverse          -> let ue = unp e in liftM2 VPropPair ue ue
+    ReverseS         -> let ue = unp e in liftM2 VPropPair ue ue
+    Project _        -> Right e
+    Select _         -> let ue = unp e in liftM2 VPropPair ue ue
+    Sort _           -> let ue = unp e in liftM2 VPropPair ue ue
+    SortS _          -> let ue = unp e in liftM2 VPropPair ue ue
+    Group _          -> let ue = unp e in liftM3 VPropTriple ue ue ue
+    GroupS _         -> let ue = unp e in liftM3 VPropTriple ue ue ue
+
+    -- FIXME think about it: what happens if we feed an empty vector into the aggr operator?
+    GroupAggr (_, _) -> Right $ VProp False
+    Number           -> Right e
+    NumberS          -> Right e
+
+    R1 ->
+      case e of
+        VProp _           -> Left "Properties.Empty: not a pair/triple"
+        VPropPair b _     -> Right $ VProp b
+        VPropTriple b _ _ -> Right $ VProp b
+    R2 ->
+      case e of
+        VProp _           -> Left "Properties.Empty: not a pair/triple"
+        VPropPair _ b     -> Right $ VProp b
+        VPropTriple _ b _ -> Right $ VProp b
+    R3 ->
+      case e of
+        VPropTriple _ _ b -> Right $ VProp b
+        p                 -> Left ("Properties.Empty: not a triple" ++ show p)
+
+
+inferEmptyBinOp :: VectorProp Bool -> VectorProp Bool -> BinOp -> Either String (VectorProp Bool)
+inferEmptyBinOp e1 e2 op =
+  case op of
+    DistLift -> mapUnp e1 e2 (\ue1 ue2 -> VPropPair (ue1 || ue2) (ue1 || ue2))
+    DistSng -> mapUnp e1 e2 (\_ ue2 -> VPropPair ue2 ue2)
+    UnboxSng -> mapUnp e1 e2 (\ue1 ue2 -> VPropPair (ue1 || ue2) (ue1 || ue2))
+    Append -> mapUnp e1 e2 (\ue1 ue2 -> VPropTriple (ue1 && ue2) ue1 ue2)
+    AppendS -> mapUnp e1 e2 (\ue1 ue2 -> VPropTriple (ue1 && ue2) ue1 ue2)
+    AggrS _ -> return $ VProp False
+    Zip -> mapUnp e1 e2 (\ue1 ue2 -> let p = ue1 || ue2 in VPropTriple p p p)
+    Align -> mapUnp e1 e2 (\ue1 ue2 -> VProp (ue1 || ue2))
+    ZipS -> mapUnp e1 e2 (\ue1 ue2 -> (\p -> VPropTriple p p p) (ue1 || ue2))
+    CartProduct -> mapUnp e1 e2 (\ue1 ue2 -> (\p -> VPropTriple p p p) (ue1 || ue2))
+    CartProductS -> mapUnp e1 e2 (\ue1 ue2 -> (\p -> VPropTriple p p p) (ue1 || ue2))
+    NestProductS -> mapUnp e1 e2 (\ue1 ue2 -> (\p -> VPropTriple p p p) (ue1 || ue2))
+    ThetaJoin _ -> mapUnp e1 e2 (\ue1 ue2 -> (\p -> VPropTriple p p p) (ue1 || ue2))
+    NestJoin _ -> mapUnp e1 e2 (\ue1 ue2 -> (\p -> VPropTriple p p p) (ue1 || ue2))
+    GroupJoin _ -> mapUnp e1 e2 (\ue1 ue2 -> VProp (ue1 || ue2))
+    NestProduct -> mapUnp e1 e2 (\ue1 ue2 -> (\p -> VPropTriple p p p) (ue1 || ue2))
+    ThetaJoinS _ -> mapUnp e1 e2 (\ue1 ue2 -> (\p -> VPropTriple p p p) (ue1 || ue2))
+    NestJoinS _ -> mapUnp e1 e2 (\ue1 ue2 -> (\p -> VPropTriple p p p) (ue1 || ue2))
+    SemiJoin _ -> mapUnp e1 e2 (\ue1 ue2 -> (\p -> VPropPair p p) (ue1 || ue2))
+    SemiJoinS _ -> mapUnp e1 e2 (\ue1 ue2 -> (\p -> VPropPair p p) (ue1 || ue2))
+    AntiJoin _ -> mapUnp e1 e2 (\ue1 _ -> (\p -> VPropPair p p) ue1)
+    AntiJoinS _ -> mapUnp e1 e2 (\ue1 _ -> (\p -> VPropPair p p) ue1)
+    AppKey -> mapUnp e1 e2 (\ue1 ue2 -> (\p -> VPropPair p p) (ue1 || ue2))
+    AppFilter -> mapUnp e1 e2 (\ue1 ue2 -> (\p -> VPropPair p p) (ue1 || ue2))
+    AppSort -> mapUnp e1 e2 (\ue1 ue2 -> (\p -> VPropPair p p) (ue1 || ue2))
+    AppRep -> mapUnp e1 e2 (\ue1 ue2 -> (\p -> VPropPair p p) (ue1 || ue2))
+
+inferEmptyTerOp :: VectorProp Bool -> VectorProp Bool -> VectorProp Bool -> TerOp -> Either String (VectorProp Bool)
+inferEmptyTerOp _ e2 e3 op =
+  case op of
+    Combine -> let ue2 = unp e2
+                   ue3 = unp e3
+               in liftM3 VPropTriple (liftM2 (&&) ue2 ue3) ue2 ue3
+
diff --git a/src/Database/DSH/VL/Opt/Properties/ReqColumns.hs b/src/Database/DSH/VL/Opt/Properties/ReqColumns.hs
new file mode 100644
--- /dev/null
+++ b/src/Database/DSH/VL/Opt/Properties/ReqColumns.hs
@@ -0,0 +1,416 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module Database.DSH.VL.Opt.Properties.ReqColumns where
+
+import qualified Data.List                                  as L
+import qualified Data.List.NonEmpty                         as N
+
+import           Database.DSH.Common.Lang
+import           Database.DSH.VL.Opt.Properties.Types
+import           Database.DSH.VL.Lang
+
+
+(∪) :: VectorProp ReqCols -> VectorProp ReqCols -> Either String (VectorProp ReqCols)
+(∪) (VProp (Just cols1)) (VProp (Just cols2)) = return $ VProp $ Just $ cols1 `L.union` cols2
+(∪) (VProp (Just cols1)) (VProp Nothing)      = return $ VProp $ Just $ cols1
+(∪) (VProp Nothing)      (VProp (Just cols2)) = return $ VProp $ Just $ cols2
+(∪) (VProp Nothing)      (VProp Nothing)      = return $ VProp $ Nothing
+(∪) p1                   p2                   = Left $ "ReqColumns.union"
+                                                       ++ " "
+                                                       ++ (show p1)
+                                                       ++ " "
+                                                       ++ (show p2)
+
+none :: VectorProp ReqCols
+none = VProp $ Just []
+
+one :: VectorProp ReqCols
+one = VProp $ Just [1]
+
+na :: VectorProp ReqCols
+na = VProp Nothing
+
+reqExprCols :: Expr -> [DBCol]
+reqExprCols (BinApp _ e1 e2) = reqExprCols e1 `L.union` reqExprCols e2
+reqExprCols (UnApp _ e)      = reqExprCols e
+reqExprCols (Column col)     = [col]
+reqExprCols (Constant _)     = []
+reqExprCols (If c t e)       = reqExprCols c `L.union` reqExprCols t `L.union` reqExprCols e
+
+reqLeftPredCols :: JoinPredicate Expr -> [DBCol]
+reqLeftPredCols (JoinPred cs) = L.nub
+                                $ concatMap (\(JoinConjunct le _ _) -> reqExprCols le)
+                                $ N.toList cs
+
+reqRightPredCols :: JoinPredicate Expr -> [DBCol]
+reqRightPredCols (JoinPred cs) = L.nub
+                                $ concatMap (\(JoinConjunct _ _ re) -> reqExprCols re)
+                                $ N.toList cs
+
+aggrReqCols :: AggrFun -> [DBCol]
+aggrReqCols (AggrSum _ e) = reqExprCols e
+aggrReqCols (AggrMin e)   = reqExprCols e
+aggrReqCols (AggrMax e)   = reqExprCols e
+aggrReqCols (AggrAvg e)   = reqExprCols e
+aggrReqCols (AggrAll e)   = reqExprCols e
+aggrReqCols (AggrAny e)   = reqExprCols e
+aggrReqCols AggrCount     = []
+
+winReqCols :: WinFun -> [DBCol]
+winReqCols (WinSum e)        = reqExprCols e
+winReqCols (WinMin e)        = reqExprCols e
+winReqCols (WinMax e)        = reqExprCols e
+winReqCols (WinAvg e)        = reqExprCols e
+winReqCols (WinAll e)        = reqExprCols e
+winReqCols (WinAny e)        = reqExprCols e
+winReqCols (WinFirstValue e) = reqExprCols e
+winReqCols WinCount          = []
+
+fromProp :: Show a => VectorProp a -> Either String a
+fromProp (VProp p) = return p
+fromProp x         = fail $ "ReqColumns.fromProp " ++ (show x)
+
+fromPropPair :: VectorProp a -> Either String (a, a)
+fromPropPair (VPropPair x y) = return (x, y)
+fromPropPair _               = fail "not a property pair"
+
+fromPropTriple :: VectorProp a -> Either String (a, a, a)
+fromPropTriple (VPropTriple x y z) = return (x, y, z)
+fromPropTriple _                   = fail "not a property triple"
+
+allCols :: BottomUpProps -> Either String (VectorProp ReqCols)
+allCols props = do
+    VProp (VTDataVec w) <- return $ vectorTypeProp props
+    return $ VProp $ Just [1 .. w]
+
+-- | For operators that combine two value vectors in a product-like
+-- manner (products, joins, zips, ...), map the columns that are
+-- required from above to the respective input columns.
+partitionCols :: BottomUpProps   -- ^ Available columns in the left input
+              -> BottomUpProps   -- ^ Available columns in the right input
+              -> ReqCols         -- ^ Columns required from above
+              -> Either String (VectorProp ReqCols, VectorProp ReqCols)
+partitionCols childBUProps1 childBUProps2 ownReqCols = do
+    VTDataVec w1 <- fromProp $ vectorTypeProp childBUProps1
+    VTDataVec w2 <- fromProp $ vectorTypeProp childBUProps2
+
+    let cols = maybe [] id ownReqCols
+
+    -- If both inputs are VTDataVecs, map the required columns to
+    -- the respective inputs
+    let leftReqCols  = cols `L.intersect` [1 .. w1]
+        rightReqCols = map (\c -> c - w1) $ cols `L.intersect` [(w1 + 1) .. (w1 + w2)]
+    return (VProp $ Just leftReqCols, VProp $ Just rightReqCols)
+
+-- | Infer required columns for unary operators
+inferReqColumnsUnOp :: BottomUpProps          -- ^ Input properties
+                    -> VectorProp ReqCols     -- ^ Columns required from the current node
+                    -> VectorProp ReqCols     -- ^ Columns required from the input node
+                    -> UnOp                   -- ^ Current operator
+                    -> Either String (VectorProp ReqCols)
+inferReqColumnsUnOp childBUProps ownReqColumns childReqColumns op =
+    case op of
+
+        Nest -> do
+            cols <- snd <$> fromPropPair ownReqColumns
+            childReqColumns ∪ VProp cols
+
+        WinFun (wfun, _) -> do
+            cs <- (VProp $ Just $ winReqCols wfun)
+                  ∪
+                  childReqColumns
+            cs ∪ ownReqColumns
+        UniqueS    -> ownReqColumns ∪ childReqColumns
+        Unique    -> ownReqColumns ∪ childReqColumns
+
+        Aggr aggrFun -> (VProp $ Just $ aggrReqCols aggrFun)
+                        ∪
+                        childReqColumns
+
+        UnboxKey -> none ∪ childReqColumns
+
+        Segment    -> do
+            cols <- snd <$> fromPropPair ownReqColumns
+            VProp cols ∪ childReqColumns
+
+        -- Numbering operators add one column at the end. We have to
+        -- determine the column index of the new column and remove it
+        -- from the set of required columns
+        Number     -> do
+            VTDataVec w <- fromProp $ vectorTypeProp childBUProps
+            Just cols     <- fromProp ownReqColumns
+            let cols'     = filter (/= w) cols
+            VProp (Just cols') ∪ childReqColumns
+        NumberS    -> do
+            VTDataVec w <- fromProp $ vectorTypeProp childBUProps
+            (Just cols)   <- fromProp ownReqColumns
+            let cols'     = filter (/= w) cols
+            VProp (Just cols') ∪ childReqColumns
+
+        Reverse    -> do
+            cols <- fst <$> fromPropPair ownReqColumns
+            VProp cols ∪ childReqColumns
+        ReverseS   -> do
+            cols <- fst <$> fromPropPair ownReqColumns
+            VProp cols ∪ childReqColumns
+
+        Project ps -> childReqColumns ∪ (VProp $ Just $ L.nub $ concatMap reqExprCols ps)
+
+        Select e   -> do
+            cols           <- fst <$> fromPropPair ownReqColumns
+            ownReqColumns' <- (VProp cols) ∪ (VProp $ Just $ reqExprCols e)
+            ownReqColumns' ∪ childReqColumns
+
+        -- We don't need to look at the columns required from above,
+        -- because they can only be a subset of (gs ++ as).
+        GroupAggr (gs, as) -> childReqColumns
+                           ∪
+                           (VProp $ Just $ L.nub $ concatMap reqExprCols gs
+                                                   ++
+                                                   concatMap aggrReqCols (N.toList as))
+
+        Sort exprs -> do
+            cols <- fst <$> fromPropPair ownReqColumns
+            ownReqColumns' <- VProp cols
+                              ∪
+                              (VProp $ Just $ L.nub $ concatMap reqExprCols exprs)
+            childReqColumns ∪ ownReqColumns'
+        SortS exprs -> do
+            cols <- fst <$> fromPropPair ownReqColumns
+            ownReqColumns' <- VProp cols
+                              ∪
+                              (VProp $ Just $ L.nub $ concatMap reqExprCols exprs)
+            childReqColumns ∪ ownReqColumns'
+
+        Group exprs -> do
+            (_, colsi, _) <- fromPropTriple ownReqColumns
+            ownReqColumns' <- VProp colsi
+                              ∪
+                              (VProp $ Just $ L.nub $ concatMap reqExprCols exprs)
+            childReqColumns ∪ ownReqColumns'
+        GroupS exprs -> do
+            (_, colsi, _) <- fromPropTriple ownReqColumns
+            ownReqColumns' <- VProp colsi
+                              ∪
+                              (VProp $ Just $ L.nub $ concatMap reqExprCols exprs)
+            childReqColumns ∪ ownReqColumns'
+
+        R1               ->
+            case childReqColumns of
+                VProp _                       -> Left $ "ReqColumns.R1 " ++ (show childReqColumns)
+                VPropPair cols1 cols2         -> do
+                    cols1' <- fromProp =<< VProp cols1 ∪ ownReqColumns
+                    return $ VPropPair cols1' cols2
+                VPropTriple cols1 cols2 cols3 -> do
+                    cols1' <- fromProp =<< VProp cols1 ∪ ownReqColumns
+                    return $ VPropTriple cols1' cols2 cols3
+
+        R2               ->
+            case childReqColumns of
+                VProp _                       -> fail "ReqColumns.R2"
+                VPropPair cols1 cols2         -> do
+                    cols2' <- fromProp =<< VProp cols2 ∪ ownReqColumns
+                    return $ VPropPair cols1 cols2'
+                VPropTriple cols1 cols2 cols3 -> do
+                    cols2' <- fromProp =<< VProp cols2 ∪ ownReqColumns
+                    return $ VPropTriple cols1 cols2' cols3
+
+        R3               ->
+            case childReqColumns of
+                VProp _                       -> fail "ReqColumns.R3/1"
+                VPropPair _ _                 -> fail "ReqColumns.R3/2"
+                VPropTriple cols1 cols2 cols3 -> do
+                    cols3' <- fromProp =<< VProp cols3 ∪ ownReqColumns
+                    return $ VPropTriple cols1 cols2 cols3'
+
+
+-- | Infer required columns for binary operators
+inferReqColumnsBinOp :: BottomUpProps
+                     -> BottomUpProps
+                     -> VectorProp ReqCols
+                     -> VectorProp ReqCols
+                     -> VectorProp ReqCols
+                     -> BinOp
+                     -> Either String (VectorProp ReqCols, VectorProp ReqCols)
+inferReqColumnsBinOp childBUProps1 childBUProps2 ownReqColumns childReqColumns1 childReqColumns2 op =
+  case op of
+      AggrS aggrFun   -> do
+          fromLeft  <- childReqColumns1 ∪ none
+          fromRight <- (VProp $ Just $ aggrReqCols aggrFun)
+                       ∪
+                       childReqColumns2
+          return (fromLeft, fromRight)
+
+      DistLift -> do
+          cols <- fst <$> fromPropPair ownReqColumns
+          (ownLeft, ownRight) <- partitionCols childBUProps1 childBUProps2 cols
+          (,) <$> (childReqColumns1 ∪ ownLeft) <*> (childReqColumns2 ∪ ownRight)
+
+      DistSng -> do
+          cols <- fst <$> fromPropPair ownReqColumns
+          (ownLeft, ownRight) <- partitionCols childBUProps1 childBUProps2 cols
+          (,) <$> (childReqColumns1 ∪ ownLeft) <*> (childReqColumns2 ∪ ownRight)
+
+      AppRep      -> do
+          cols      <- fst <$> fromPropPair ownReqColumns
+          fromRight <- childReqColumns2 ∪ VProp cols
+          return (na, fromRight)
+
+      AppFilter      -> do
+          cols      <- fst <$> fromPropPair ownReqColumns
+          fromRight <- childReqColumns2 ∪ VProp cols
+          return (na, fromRight)
+
+      AppSort      -> do
+          cols      <- fst <$> fromPropPair ownReqColumns
+          fromRight <- childReqColumns2 ∪ VProp cols
+          return (na, fromRight)
+
+      AppKey      -> do
+          cols      <- fst <$> fromPropPair ownReqColumns
+          fromRight <- childReqColumns2 ∪ VProp cols
+          return (na, fromRight)
+
+      Append -> do
+          (cols, _, _) <- fromPropTriple ownReqColumns
+          fromLeft     <- (VProp cols) ∪ childReqColumns1
+          fromRight    <- (VProp cols) ∪ childReqColumns2
+          return (fromLeft, fromRight)
+
+      AppendS -> do
+          (cols, _, _) <- fromPropTriple ownReqColumns
+          fromLeft     <- (VProp cols) ∪ childReqColumns1
+          fromRight    <- (VProp cols) ∪ childReqColumns2
+          return (fromLeft, fromRight)
+
+      Align -> do
+          cols <- fromProp ownReqColumns
+          (ownLeft, ownRight) <- partitionCols childBUProps1 childBUProps2 cols
+          (,) <$> (childReqColumns1 ∪ ownLeft) <*> (childReqColumns2 ∪ ownRight)
+
+      Zip -> do
+          cols <- fromProp ownReqColumns
+          (ownLeft, ownRight) <- partitionCols childBUProps1 childBUProps2 cols
+          (,) <$> (childReqColumns1 ∪ ownLeft) <*> (childReqColumns2 ∪ ownRight)
+
+      CartProduct -> do
+          (cols1, _, _)       <- fromPropTriple ownReqColumns
+          (ownLeft, ownRight) <- partitionCols childBUProps1 childBUProps2 cols1
+          (,) <$> (childReqColumns1 ∪ ownLeft) <*> (childReqColumns2 ∪ ownRight)
+
+      CartProductS -> do
+          (cols1, _, _)       <- fromPropTriple ownReqColumns
+          (ownLeft, ownRight) <- partitionCols childBUProps1 childBUProps2 cols1
+          (,) <$> (childReqColumns1 ∪ ownLeft) <*> (childReqColumns2 ∪ ownRight)
+
+      NestProductS -> do
+          (cols1, _, _)       <- fromPropTriple ownReqColumns
+          (ownLeft, ownRight) <- partitionCols childBUProps1 childBUProps2 cols1
+          (,) <$> (childReqColumns1 ∪ ownLeft) <*> (childReqColumns2 ∪ ownRight)
+
+      ThetaJoin p -> do
+          (cols1, _, _)               <- fromPropTriple ownReqColumns
+          (leftReqCols, rightReqCols) <- partitionCols childBUProps1 childBUProps2 cols1
+          leftReqCols'                <- (VProp $ Just $ reqLeftPredCols p) ∪ leftReqCols
+          rightReqCols'               <- (VProp $ Just $ reqRightPredCols p) ∪ rightReqCols
+          (,) <$> (childReqColumns1 ∪ leftReqCols') <*> (childReqColumns2 ∪ rightReqCols')
+
+      UnboxSng -> do
+          cols1                       <- fst <$> fromPropPair ownReqColumns
+          (leftReqCols, rightReqCols) <- partitionCols childBUProps1 childBUProps2 cols1
+          (,) <$> (childReqColumns1 ∪ leftReqCols) <*> (childReqColumns2 ∪ rightReqCols)
+
+      NestJoin p -> do
+          (cols1, _, _)               <- fromPropTriple ownReqColumns
+          (leftReqCols, rightReqCols) <- partitionCols childBUProps1 childBUProps2 cols1
+          leftReqCols'                <- (VProp $ Just $ reqLeftPredCols p) ∪ leftReqCols
+          rightReqCols'               <- (VProp $ Just $ reqRightPredCols p) ∪ rightReqCols
+          (,) <$> (childReqColumns1 ∪ leftReqCols') <*> (childReqColumns2 ∪ rightReqCols')
+      NestProduct -> do
+          (cols1, _, _)               <- fromPropTriple ownReqColumns
+          (leftReqCols, rightReqCols) <- partitionCols childBUProps1 childBUProps2 cols1
+          (,) <$> (childReqColumns1 ∪ leftReqCols) <*> (childReqColumns2 ∪ rightReqCols)
+
+      ThetaJoinS p -> do
+          (cols1, _, _)               <- fromPropTriple ownReqColumns
+          (leftReqCols, rightReqCols) <- partitionCols childBUProps1 childBUProps2 cols1
+          leftReqCols'                <- (VProp $ Just $ reqLeftPredCols p) ∪ leftReqCols
+          rightReqCols'               <- (VProp $ Just $ reqRightPredCols p) ∪ rightReqCols
+          (,) <$> (childReqColumns1 ∪ leftReqCols') <*> (childReqColumns2 ∪ rightReqCols')
+
+      NestJoinS p -> do
+          (cols1, _, _)               <- fromPropTriple ownReqColumns
+          (leftReqCols, rightReqCols) <- partitionCols childBUProps1 childBUProps2 cols1
+          leftReqCols'                <- (VProp $ Just $ reqLeftPredCols p) ∪ leftReqCols
+          rightReqCols'               <- (VProp $ Just $ reqRightPredCols p) ∪ rightReqCols
+          (,) <$> (childReqColumns1 ∪ leftReqCols') <*> (childReqColumns2 ∪ rightReqCols')
+
+      GroupJoin (p, a) -> do
+          cols <- fromProp ownReqColumns
+          let acols = Just $ aggrReqCols a
+          -- columns from the left required by the predicate
+          let plcols = VProp $ Just $ reqLeftPredCols p
+          -- columns from the right required by the predicate
+          let prcols = VProp $ Just $ reqRightPredCols p
+          -- Columns from left and right sides that are required for
+          -- the aggregate.
+          (alcols, arcols) <- partitionCols childBUProps1 childBUProps2 acols
+          -- columns from the left side that are required downstream
+          lcols            <- fst <$> partitionCols childBUProps1 childBUProps2 cols
+          -- left: plcols, alcols, lcols
+          -- right: prcols, arcols
+          leftReqCols  <- plcols ∪ alcols
+          leftReqCols' <- leftReqCols ∪ lcols
+          rightReqCols <- prcols ∪ arcols
+          return (leftReqCols', rightReqCols)
+
+      ZipS -> do
+          (cols, _, _) <- fromPropTriple ownReqColumns
+          (ownLeft, ownRight) <- partitionCols childBUProps1 childBUProps2 cols
+          (,) <$> (childReqColumns1 ∪ ownLeft) <*> (childReqColumns2 ∪ ownRight)
+
+      -- For a semijoin, we only require the columns used in the join argument
+      -- from the right input.
+      SemiJoin p -> do
+          cols1     <- fst <$> fromPropPair ownReqColumns
+          fromLeft  <- ((VProp $ Just $ reqLeftPredCols p) ∪ VProp cols1) >>= (∪ childReqColumns1)
+          fromRight <- (VProp $ Just $ reqRightPredCols p) ∪ childReqColumns2
+          return (fromLeft, fromRight)
+
+      -- For a semijoin, we only require the columns used in the join argument
+      -- from the right input.
+      SemiJoinS p -> do
+          cols1     <- fst <$> fromPropPair ownReqColumns
+          fromLeft  <- ((VProp $ Just $ reqLeftPredCols p) ∪ VProp cols1) >>= (∪ childReqColumns1)
+          fromRight <- (VProp $ Just $ reqRightPredCols p) ∪ childReqColumns2
+          return (fromLeft, fromRight)
+
+      -- For a antijoin, we only require the columns used in the join argument
+      -- from the right input.
+      AntiJoin p -> do
+          cols1     <- fst <$> fromPropPair ownReqColumns
+          fromLeft  <- ((VProp $ Just $ reqLeftPredCols p) ∪ VProp cols1) >>= (∪ childReqColumns1)
+          fromRight <- (VProp $ Just $ reqRightPredCols p) ∪ childReqColumns2
+          return (fromLeft, fromRight)
+
+      -- For a antijoin, we only require the columns used in the join argument
+      -- from the right input.
+      AntiJoinS p -> do
+          cols1     <- fst <$> fromPropPair ownReqColumns
+          fromLeft  <- ((VProp $ Just $ reqLeftPredCols p) ∪ VProp cols1) >>= (∪ childReqColumns1)
+          fromRight <- (VProp $ Just $ reqRightPredCols p) ∪ childReqColumns2
+          return (fromLeft, fromRight)
+
+inferReqColumnsTerOp :: VectorProp ReqCols
+                     -> VectorProp ReqCols
+                     -> VectorProp ReqCols
+                     -> VectorProp ReqCols
+                     -> TerOp
+                     -> Either String (VectorProp ReqCols, VectorProp ReqCols, VectorProp ReqCols)
+inferReqColumnsTerOp ownReqColumns _ childReqColumns2 childReqColumns3 op =
+    case op of
+        Combine -> do
+            (cols, _, _) <- fromPropTriple ownReqColumns
+            fromLeft     <- VProp cols ∪ childReqColumns2
+            fromRight    <- VProp cols ∪ childReqColumns3
+            return (one, fromLeft, fromRight)
diff --git a/src/Database/DSH/VL/Opt/Properties/TopDown.hs b/src/Database/DSH/VL/Opt/Properties/TopDown.hs
new file mode 100644
--- /dev/null
+++ b/src/Database/DSH/VL/Opt/Properties/TopDown.hs
@@ -0,0 +1,196 @@
+module Database.DSH.VL.Opt.Properties.TopDown
+    ( inferTopDownProperties
+    ) where
+
+import           Control.Monad.State
+import           Text.Printf
+
+import qualified Data.IntMap                               as M
+
+import qualified Database.Algebra.Dag                      as D
+import           Database.Algebra.Dag.Common
+
+import           Database.DSH.Common.Opt
+import           Database.DSH.VL.Lang
+import           Database.DSH.VL.Opt.Properties.ReqColumns
+import           Database.DSH.VL.Opt.Properties.Types
+
+reqColumnsSeed :: ReqCols
+reqColumnsSeed = Nothing
+
+vPropSeed :: TopDownProps
+vPropSeed = TDProps { reqColumnsProp = VProp reqColumnsSeed }
+
+vPropPairSeed :: TopDownProps
+vPropPairSeed = TDProps { reqColumnsProp = VPropPair reqColumnsSeed reqColumnsSeed }
+
+vPropTripleSeed :: TopDownProps
+vPropTripleSeed = TDProps { reqColumnsProp = VPropTriple reqColumnsSeed
+                                                         reqColumnsSeed
+                                                         reqColumnsSeed }
+
+seed :: VL -> TopDownProps
+seed (NullaryOp _) = vPropSeed
+seed (UnOp op _)   =
+    case op of
+        Nest               -> vPropPairSeed
+        WinFun _           -> vPropSeed
+        Reverse            -> vPropPairSeed
+        ReverseS           -> vPropPairSeed
+        UniqueS            -> vPropSeed
+        UnboxKey           -> vPropSeed
+        Unique             -> vPropSeed
+        Segment            -> vPropPairSeed
+        Select     _       -> vPropPairSeed
+        Sort _             -> vPropPairSeed
+        SortS _            -> vPropPairSeed
+        Group _            -> vPropTripleSeed
+        GroupS _           -> vPropTripleSeed
+        Project      _     -> vPropSeed
+        Aggr _             -> vPropSeed
+        GroupAggr (_, _)   -> vPropSeed
+        R1                 -> vPropSeed
+        R2                 -> vPropSeed
+        R3                 -> vPropSeed
+        Number             -> vPropSeed
+        NumberS            -> vPropSeed
+
+seed (BinOp op _ _) =
+    case op of
+        Append       -> vPropTripleSeed
+        AppendS      -> vPropTripleSeed
+        ZipS         -> vPropTripleSeed
+        DistLift     -> vPropPairSeed
+        DistSng      -> vPropPairSeed
+        AppKey       -> vPropPairSeed
+        AppSort      -> vPropPairSeed
+        AppFilter    -> vPropPairSeed
+        AppRep       -> vPropPairSeed
+        UnboxSng  -> vPropPairSeed
+        AggrS _      -> vPropSeed
+        Zip          -> vPropSeed
+        Align        -> vPropSeed
+        CartProduct  -> vPropTripleSeed
+        CartProductS -> vPropTripleSeed
+        ThetaJoin _  -> vPropTripleSeed
+        NestJoin _   -> vPropTripleSeed
+        NestProduct  -> vPropTripleSeed
+        ThetaJoinS _ -> vPropTripleSeed
+        SemiJoin _   -> vPropPairSeed
+        SemiJoinS _  -> vPropPairSeed
+        AntiJoin _   -> vPropPairSeed
+        AntiJoinS _  -> vPropPairSeed
+        NestJoinS _  -> vPropTripleSeed
+        GroupJoin _  -> vPropSeed
+        NestProductS -> vPropTripleSeed
+
+seed (TerOp op _ _ _) =
+    case op of
+        Combine -> vPropTripleSeed
+
+
+type InferenceState = NodeMap TopDownProps
+
+lookupProps :: AlgNode -> State InferenceState TopDownProps
+lookupProps n = do
+    m <- get
+    case M.lookup n m of
+        Just props -> return props
+        Nothing -> error "TopDown.lookupProps"
+
+replaceProps :: AlgNode -> TopDownProps -> State InferenceState ()
+replaceProps n p = modify (M.insert n p)
+
+inferUnOp :: BottomUpProps
+          -> TopDownProps
+          -> TopDownProps
+          -> UnOp
+          -> Either String TopDownProps
+inferUnOp childBUProps ownProps cp op = do
+    cols <- inferReqColumnsUnOp childBUProps
+                                (reqColumnsProp ownProps)
+                                (reqColumnsProp cp)
+                                op
+    return $ TDProps { reqColumnsProp = cols }
+
+inferBinOp :: BottomUpProps
+           -> BottomUpProps
+           -> TopDownProps
+           -> TopDownProps
+           -> TopDownProps
+           -> BinOp
+           -> Either String (TopDownProps, TopDownProps)
+inferBinOp childBUProps1 childBUProps2 ownProps cp1 cp2 op = do
+    (crc1', crc2') <- inferReqColumnsBinOp childBUProps1
+                                           childBUProps2
+                                           (reqColumnsProp ownProps)
+                                           (reqColumnsProp cp1)
+                                           (reqColumnsProp cp2) op
+    let cp1' = TDProps { reqColumnsProp = crc1' }
+        cp2' = TDProps { reqColumnsProp = crc2' }
+    return (cp1', cp2')
+
+inferTerOp :: TopDownProps
+           -> TopDownProps
+           -> TopDownProps
+           -> TopDownProps
+           -> TerOp
+           -> Either String (TopDownProps, TopDownProps, TopDownProps)
+inferTerOp ownProps cp1 cp2 cp3 op = do
+    (crc1', crc2', crc3') <- inferReqColumnsTerOp (reqColumnsProp ownProps)
+                                                  (reqColumnsProp cp1)
+                                                  (reqColumnsProp cp2)
+                                                  (reqColumnsProp cp3) op
+    let cp1' = TDProps { reqColumnsProp = crc1' }
+        cp2' = TDProps { reqColumnsProp = crc2' }
+        cp3' = TDProps { reqColumnsProp = crc3' }
+    return (cp1', cp2', cp3')
+
+inferChildProperties :: NodeMap BottomUpProps
+                     -> D.AlgebraDag VL
+                     -> AlgNode
+                     -> State InferenceState ()
+inferChildProperties buPropMap d n = do
+    ownProps <- lookupProps n
+    case D.operator n d of
+        NullaryOp _ -> return ()
+        UnOp op c -> do
+            cp <- lookupProps c
+            let buProps = lookupUnsafe buPropMap "TopDown.infer" c
+            let cp' = checkError n [cp] d $ inferUnOp buProps ownProps cp op
+            replaceProps c cp'
+        BinOp op c1 c2 -> do
+            cp1 <- lookupProps c1
+            cp2 <- lookupProps c2
+            let buProps1 = lookupUnsafe buPropMap "TopDown.inferChildProperties" c1
+                buProps2 = lookupUnsafe buPropMap "TopDown.inferChildProperties" c2
+            let (cp1', cp2') = checkError n [cp1, cp2] d
+                               $ inferBinOp buProps1 buProps2 ownProps cp1 cp2 op
+            replaceProps c1 cp1'
+            replaceProps c2 cp2'
+        TerOp op c1 c2 c3 -> do
+          cp1 <- lookupProps c1
+          cp2 <- lookupProps c2
+          cp3 <- lookupProps c3
+          let (cp1', cp2', cp3') = checkError n [cp1, cp2, cp3] d
+                                   $ inferTerOp ownProps cp1 cp2 cp3 op
+          replaceProps c1 cp1'
+          replaceProps c2 cp2'
+          replaceProps c3 cp3'
+
+checkError :: AlgNode -> [TopDownProps] -> D.AlgebraDag VL -> Either String p -> p
+checkError n childProps d (Left msg) =
+    let completeMsg   = printf "Inference failed at node %d\n%s\n%s\n%s"
+                                n msg (show childProps) (show $ D.nodeMap d)
+    in error completeMsg
+checkError _ _ _ (Right props) = props
+
+-- | Infer properties during a top-down traversal.
+inferTopDownProperties :: NodeMap BottomUpProps
+                       -> [AlgNode]
+                       -> D.AlgebraDag VL
+                       -> NodeMap TopDownProps
+inferTopDownProperties buPropMap topOrderedNodes d = execState action initialMap
+  where
+    action = mapM_ (inferChildProperties buPropMap d) topOrderedNodes
+    initialMap = M.map seed $ D.nodeMap d
diff --git a/src/Database/DSH/VL/Opt/Properties/Types.hs b/src/Database/DSH/VL/Opt/Properties/Types.hs
new file mode 100644
--- /dev/null
+++ b/src/Database/DSH/VL/Opt/Properties/Types.hs
@@ -0,0 +1,94 @@
+module Database.DSH.VL.Opt.Properties.Types where
+
+import           Prelude hiding ((<$>))
+import           Text.PrettyPrint.ANSI.Leijen
+
+import           Database.DSH.Common.Lang
+import           Database.DSH.Common.Pretty
+import           Database.DSH.VL.Lang
+
+data VectorProp a = VProp a
+                  | VPropPair a a
+                  | VPropTriple a a a
+
+instance Show a => Show (VectorProp a) where
+  show (VProp a) = show a
+  show (VPropPair a1 a2) = show (a1, a2)
+  show (VPropTriple a1 a2 a3) = show (a1, a2, a3)
+
+data VectorType = VTDataVec Int
+                | VTNA
+                deriving Show
+
+data Const = Const ScalarVal
+           | NoConst
+            deriving Show
+
+data ConstPayload = ConstPL ScalarVal
+                  | NonConstPL
+                  deriving Show
+
+data ConstVec = ConstVec [ConstPayload]
+              | CNA
+              deriving (Show)
+
+data BottomUpProps = BUProps { emptyProp      :: VectorProp Bool
+                             , constProp      :: VectorProp ConstVec
+                             , card1Prop      :: VectorProp Bool
+                             , vectorTypeProp :: VectorProp VectorType
+                             } deriving (Show)
+
+
+type ReqCols = Maybe [DBCol]
+
+data TopDownProps = TDProps { reqColumnsProp :: VectorProp ReqCols } deriving (Show)
+
+data Properties = Properties { bu :: BottomUpProps
+                             , td :: TopDownProps
+                             }
+
+insertComma :: Doc -> Doc -> Doc
+insertComma d1 d2 = d1 <> comma <+> d2
+
+instance Pretty a => Pretty (VectorProp a) where
+  pretty (VProp p)              = pretty p
+  pretty (VPropPair p1 p2)      = parens $ (pretty p1) `insertComma` (pretty p2)
+  pretty (VPropTriple p1 p2 p3) = parens $ (pretty p1) `insertComma` (pretty p2) `insertComma` (pretty p3)
+
+bracketList :: (a -> Doc) -> [a] -> Doc
+bracketList f = brackets . hsep . punctuate comma . map f
+
+isConst :: (Int, ConstPayload) -> [(Int, ScalarVal)] -> [(Int, ScalarVal)]
+isConst (_, NonConstPL) vals   = vals
+isConst (i, (ConstPL v)) vals  = (i, v) : vals
+
+renderPL :: Pretty a => (Int, a) -> Doc
+renderPL (i, v)  = int i <> colon <> pretty v
+
+instance Pretty ConstVec where
+  pretty (ConstVec ps) = bracketList id
+                         $ map renderPL
+                         $ foldr isConst []
+                         $ zip [1..] ps
+  pretty CNA           = text "NA"
+
+instance Pretty VectorType where
+  pretty = text . show
+
+instance Pretty BottomUpProps where
+  pretty p = text "empty:" <+> (pretty $ emptyProp p)
+                 <$> text "const:" <+> (pretty $ constProp p)
+                 <$> text "schema:" <+> (pretty $ vectorTypeProp p)
+
+instance Pretty TopDownProps where
+  pretty p = text "reqCols:" <+> (text $ show $ reqColumnsProp p)
+
+-- | Rendering function for the bottom-up properties container.
+renderBottomUpProps :: BottomUpProps -> [String]
+renderBottomUpProps ps = [pp $ pretty ps]
+
+renderTopDownProps :: TopDownProps -> [String]
+renderTopDownProps ps = [pp $ pretty ps]
+
+prettyerties  :: Properties -> [String]
+prettyerties ps = (renderBottomUpProps $ bu ps) ++ (renderTopDownProps $ td ps)
diff --git a/src/Database/DSH/VL/Opt/Properties/VectorType.hs b/src/Database/DSH/VL/Opt/Properties/VectorType.hs
new file mode 100644
--- /dev/null
+++ b/src/Database/DSH/VL/Opt/Properties/VectorType.hs
@@ -0,0 +1,170 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+-- FIXME introduce consistency checks for schema inference
+module Database.DSH.VL.Opt.Properties.VectorType where
+
+import           Control.Monad
+import qualified Data.List.NonEmpty as N
+
+import           Database.DSH.VL.Opt.Properties.Types
+import           Database.DSH.Common.Lang
+
+import           Database.DSH.VL.Lang
+
+{- Implement more checks: check the input types for correctness -}
+
+vectorWidth :: VectorProp VectorType -> Int
+vectorWidth (VProp (VTDataVec w))  = w
+vectorWidth _                      = error "vectorWidth: non-VTDataVec input"
+
+inferVectorTypeNullOp :: NullOp -> Either String (VectorProp VectorType)
+inferVectorTypeNullOp op =
+  case op of
+    Lit (_, t, _)        -> Right $ VProp $ VTDataVec $ length t
+    TableRef (_, schema) -> Right $ VProp $ VTDataVec $ N.length (tableCols schema)
+
+unpack :: VectorProp VectorType -> Either String VectorType
+unpack (VProp s) = Right s
+unpack _         = Left "Input is not a single vector property"
+
+inferVectorTypeUnOp :: VectorProp VectorType -> UnOp -> Either String (VectorProp VectorType)
+inferVectorTypeUnOp s op =
+  case op of
+    Nest -> do
+        VTDataVec w <- unpack s
+        return $ VPropPair (VTDataVec 0) (VTDataVec w)
+    WinFun _ -> do
+        VTDataVec w <- unpack s
+        return $ VProp $ VTDataVec $ w + 1
+    Unique -> VProp <$> unpack s
+    UniqueS -> VProp <$> unpack s
+    Aggr _ -> Right $ VProp $ VTDataVec 1
+    UnboxKey -> Right $ VProp $ VTNA
+    Segment -> VPropPair <$> pure (VTDataVec 0) <*> unpack s
+    Reverse -> liftM2 VPropPair (unpack s) (Right VTNA)
+    ReverseS -> liftM2 VPropPair (unpack s) (Right VTNA)
+    R1 ->
+      case s of
+        VPropPair s1 _ -> Right $ VProp s1
+        VPropTriple s1 _ _ -> Right $ VProp s1
+        _ -> Left "Input of R1 is not a tuple"
+    R2 ->
+      case s of
+        VPropPair _ s2 -> Right $ VProp s2
+        VPropTriple _ s2 _ -> Right $ VProp s2
+        _ -> Left "Input of R2 is not a tuple"
+    R3 ->
+      case s of
+        VPropTriple s3 _ _ -> Right $ VProp s3
+        _ -> Left "Input of R3 is not a tuple"
+
+    Project valProjs -> Right $ VProp $ VTDataVec $ length valProjs
+
+    Select _ -> VPropPair <$> unpack s <*> (Right VTNA)
+    Sort _   -> liftM2 VPropPair (unpack s) (Right VTNA)
+    SortS _  -> liftM2 VPropPair (unpack s) (Right VTNA)
+
+    Group es ->
+      case s of
+        VProp t@(VTDataVec _) ->
+          Right $ VPropTriple (VTDataVec $ length es) t VTNA
+        _                                                    ->
+          Left "Input of Group is not a value vector"
+    GroupS es ->
+      case s of
+        VProp t@(VTDataVec _) ->
+          Right $ VPropTriple (VTDataVec $ length es) t VTNA
+        _                                                    ->
+          Left "Input of GroupS is not a value vector"
+    GroupAggr (g, as) -> Right $ VProp $ VTDataVec (length g + N.length as)
+    Number -> do
+        VTDataVec w <- unpack s
+        return $ VProp $ VTDataVec (w + 1)
+    NumberS -> do
+        VTDataVec w <- unpack s
+        return $ VProp $ VTDataVec (w + 1)
+
+reqValVectors :: VectorProp VectorType
+                 -> VectorProp VectorType
+                 -> (Int -> Int -> VectorProp VectorType)
+                 -> String
+                 -> Either String (VectorProp VectorType)
+reqValVectors (VProp (VTDataVec w1)) (VProp (VTDataVec w2)) f _ =
+  Right $ f w1 w2
+reqValVectors _ _ _ e =
+  Left $ "Inputs of " ++ e ++ " are not VTDataVecs"
+
+inferVectorTypeBinOp :: VectorProp VectorType -> VectorProp VectorType -> BinOp -> Either String (VectorProp VectorType)
+inferVectorTypeBinOp s1 s2 op =
+  case op of
+    AggrS _ -> return $ VProp $ VTDataVec 1
+
+    DistLift -> do
+        VTDataVec w1 <- unpack s1
+        VTDataVec w2 <- unpack s2
+        return $ VPropPair (VTDataVec $ w1 + w2) VTNA
+    DistSng -> do
+        VTDataVec w1 <- unpack s1
+        VTDataVec w2 <- unpack s2
+        return $ VPropPair (VTDataVec $ w1 + w2) VTNA
+
+    AppRep -> liftM2 VPropPair (unpack s2) (Right VTNA)
+    AppSort -> liftM2 VPropPair (unpack s2) (Right VTNA)
+    AppFilter -> liftM2 VPropPair (unpack s2) (Right VTNA)
+    AppKey -> liftM2 VPropPair (unpack s2) (Right VTNA)
+    Append ->
+      case (s1, s2) of
+        (VProp (VTDataVec w1), VProp (VTDataVec w2)) | w1 == w2 ->
+          Right $ VPropTriple (VTDataVec w1) VTNA VTNA
+        (VProp (VTDataVec w1), VProp (VTDataVec w2)) ->
+          Left $ "Inputs of Append do not have the same width " ++ (show w1) ++ " " ++ (show w2)
+        v ->
+          Left $ "Input of Append is not a VTDataVec " ++ (show v)
+    AppendS ->
+      case (s1, s2) of
+        (VProp (VTDataVec w1), VProp (VTDataVec w2)) | w1 == w2 ->
+          Right $ VPropTriple (VTDataVec w1) VTNA VTNA
+        (VProp (VTDataVec w1), VProp (VTDataVec w2)) ->
+          Left $ "Inputs of Append do not have the same width " ++ (show w1) ++ " " ++ (show w2)
+        v ->
+          Left $ "Input of Append is not a VTDataVec " ++ (show v)
+
+    Align ->
+      case (s1, s2) of
+        (VProp (VTDataVec w1), VProp (VTDataVec w2)) -> Right $ VProp $ VTDataVec $ w1 + w2
+        _                                                -> Left "Inputs of Align are not VTDataVecs"
+    Zip ->
+        case (s1, s2) of
+            (VProp (VTDataVec w1), VProp (VTDataVec w2)) ->
+                Right $ VPropTriple (VTDataVec $ w1 + w2) VTNA VTNA
+            _                                            ->
+                Left "Inputs of PairL are not VTDataVecs"
+    ZipS -> reqValVectors s1 s2 (\w1 w2 -> VPropTriple (VTDataVec $ w1 + w2) VTNA VTNA) "ZipL"
+    CartProduct -> reqValVectors s1 s2 (\w1 w2 -> VPropTriple (VTDataVec $ w1 + w2) VTNA VTNA) "CartProduct"
+    CartProductS -> reqValVectors s1 s2 (\w1 w2 -> VPropTriple (VTDataVec $ w1 + w2) VTNA VTNA) "CartProductS"
+    NestProductS -> reqValVectors s1 s2 (\w1 w2 -> VPropTriple (VTDataVec $ w1 + w2) VTNA VTNA) "NestProductS"
+    ThetaJoin _ -> reqValVectors s1 s2 (\w1 w2 -> VPropTriple (VTDataVec $ w1 + w2) VTNA VTNA) "ThetaJoin"
+    UnboxSng -> reqValVectors s1 s2 (\w1 w2 -> VPropPair (VTDataVec $ w1 + w2) VTNA) "UnboxSng"
+    NestJoin _ -> reqValVectors s1 s2 (\w1 w2 -> VPropTriple (VTDataVec $ w1 + w2) VTNA VTNA) "NestJoin"
+    NestProduct -> reqValVectors s1 s2 (\w1 w2 -> VPropTriple (VTDataVec $ w1 + w2) VTNA VTNA) "NestProduct"
+    ThetaJoinS _ -> reqValVectors s1 s2 (\w1 w2 -> VPropTriple (VTDataVec $ w1 + w2) VTNA VTNA) "ThetaJoinS"
+    NestJoinS _ -> reqValVectors s1 s2 (\w1 w2 -> VPropTriple (VTDataVec $ w1 + w2) VTNA VTNA) "NestJoinS"
+    GroupJoin _ -> do
+        VTDataVec w <- unpack s1
+        return $ VProp $ VTDataVec $ w + 1
+    SemiJoin _ -> liftM2 VPropPair (unpack s1) (Right VTNA)
+    SemiJoinS _ -> liftM2 VPropPair (unpack s1) (Right VTNA)
+    AntiJoin _ -> liftM2 VPropPair (unpack s1) (Right VTNA)
+    AntiJoinS _ -> liftM2 VPropPair (unpack s1) (Right VTNA)
+
+inferVectorTypeTerOp :: VectorProp VectorType -> VectorProp VectorType -> VectorProp VectorType -> TerOp -> Either String (VectorProp VectorType)
+inferVectorTypeTerOp _ s2 s3 op =
+  case op of
+    Combine ->
+      case (s2, s3) of
+        (VProp (VTDataVec w1), VProp (VTDataVec w2)) | w1 == w2 ->
+          Right $ VPropTriple (VTDataVec w1) VTNA VTNA
+        (VProp (VTDataVec _), VProp (VTDataVec _))              ->
+          Left $ "Inputs of CombineVec do not have the same width"
+        _                                                           ->
+          Left $ "Inputs of CombineVec are not VTDataVecs/DescrVectors " ++ (show (s2, s3))
diff --git a/src/Database/DSH/VL/Opt/Rewrite/Aggregation.hs b/src/Database/DSH/VL/Opt/Rewrite/Aggregation.hs
new file mode 100644
--- /dev/null
+++ b/src/Database/DSH/VL/Opt/Rewrite/Aggregation.hs
@@ -0,0 +1,231 @@
+{-# LANGUAGE TemplateHaskell #-}
+module Database.DSH.VL.Opt.Rewrite.Aggregation
+    ( groupingToAggregation
+    ) where
+
+import           Control.Monad
+import qualified Data.List.NonEmpty                         as N
+import           Data.Semigroup
+
+import           Database.Algebra.Dag.Common
+
+import           Database.DSH.Common.Opt
+import           Database.DSH.VL.Opt.Properties.Types
+import           Database.DSH.VL.Opt.Rewrite.Common
+import           Database.DSH.VL.Lang
+
+aggregationRules :: VLRuleSet ()
+aggregationRules = [ inlineAggrSProject
+                   , inlineAggrProject
+                   , flatGrouping
+                   -- , mergeNonEmptyAggrs
+                   , mergeGroupAggr
+                   , mergeGroupWithGroupAggrLeft
+                   , mergeGroupWithGroupAggrRight
+                   , groupJoin
+                   ]
+
+aggregationRulesBottomUp :: VLRuleSet BottomUpProps
+aggregationRulesBottomUp = [ {- nonEmptyAggr
+                           , nonEmptyAggrS -}
+                           ]
+
+groupingToAggregation :: VLRewrite Bool
+groupingToAggregation =
+    iteratively
+    $ sequenceRewrites [ applyToAll inferBottomUp aggregationRulesBottomUp
+                       , applyToAll noProps aggregationRules
+                       ]
+
+-- -- FIXME this rewrite will no longer work: take the UnboxSngS
+-- -- operator into account.
+-- mergeNonEmptyAggrs :: VLRule ()
+-- mergeNonEmptyAggrs q =
+--   $(dagPatMatch 'q "(AggrNonEmptyS afuns1 (qi1)) Zip (AggrNonEmptyS afuns2 (qi2))"
+--     [| do
+--         predicate $ $(v "qi1") == $(v "qi2")
+
+--         return $ do
+--             logRewrite "Aggregation.NonEmpty.Merge" q
+--             let afuns  = $(v "afuns1") <> $(v "afuns2")
+--             let aggrOp = UnOp (AggrNonEmptyS afuns) $(v "qi1")
+--             void $ replaceWithNew q aggrOp |])
+
+-- -- | If we can infer that the vector is not empty, we can employ a
+-- -- simplified version of the aggregate operator that does not add a
+-- -- default value for an empty input.
+-- nonEmptyAggr :: VLRule BottomUpProps
+-- nonEmptyAggr q =
+--   $(dagPatMatch 'q "Aggr aggrFun (q1)"
+--     [| do
+--         VProp True <- nonEmptyProp <$> properties $(v "q1")
+
+--         return $ do
+--             logRewrite "Aggregation.NonEmpty.Aggr" q
+--             let aggrOp = UnOp (AggrNonEmpty ($(v "aggrFun") N.:| [])) $(v "q1")
+--             void $ replaceWithNew q aggrOp |])
+
+-- -- | If we can infer that all segments (if there are any) are not
+-- -- empty, we can employ a simplified version of the aggregate operator
+-- -- that does not add default values for empty segments.
+-- nonEmptyAggrS :: VLRule BottomUpProps
+-- nonEmptyAggrS q =
+--   $(dagPatMatch 'q "(_) AggrS aggrFun (q2)"
+--     [| do
+--         VProp True <- nonEmptyProp <$> properties $(v "q2")
+
+--         return $ do
+--             logRewrite "Aggregation.NonEmpty.AggrS" q
+--             let aggrOp = UnOp (AggrNonEmptyS ($(v "aggrFun") N.:| [])) $(v "q2")
+--             void $ replaceWithNew q aggrOp |])
+
+-- | Merge a projection into a segmented aggregate operator.
+inlineAggrProject :: VLRule ()
+inlineAggrProject q =
+  $(dagPatMatch 'q "Aggr afun (Project proj (qi))"
+    [| do
+        let env = zip [1..] $(v "proj")
+        let afun' = mapAggrFun (mergeExpr env) $(v "afun")
+
+        return $ do
+            logRewrite "Aggregation.Normalize.Aggr.Project" q
+            void $ replaceWithNew q $ UnOp (Aggr afun') $(v "qi") |])
+
+-- | Merge a projection into a segmented aggregate operator.
+inlineAggrSProject :: VLRule ()
+inlineAggrSProject q =
+  $(dagPatMatch 'q "(qo) AggrS afun (Project proj (qi))"
+    [| do
+        let env = zip [1..] $(v "proj")
+        let afun' = mapAggrFun (mergeExpr env) $(v "afun")
+
+        return $ do
+            logRewrite "Aggregation.Normalize.AggrS.Project" q
+            void $ replaceWithNew q $ BinOp (AggrS afun') $(v "qo") $(v "qi") |])
+
+-- We rewrite a combination of Group and aggregation operators into a single
+-- GroupAggr operator if the following conditions hold:
+--
+-- 1. The R2 output of Group is only consumed by an AggrS operator
+-- 2. The grouping criteria is a simple column projection from the input vector
+flatGrouping :: VLRule ()
+flatGrouping q =
+  $(dagPatMatch 'q "R1 ((R1 (qg)) UnboxSng ((_) AggrS afun (R2 (qg1=Group groupExprs (q1)))))"
+    [| do
+
+        -- Ensure that the aggregate results are unboxed using the
+        -- outer vector of the grouping operator.
+        predicate $ $(v "qg") == $(v "qg1")
+
+        return $ do
+          logRewrite "Aggregation.Grouping.Aggr" q
+          let afuns = $(v "afun") N.:| []
+          void $ replaceWithNew q $ UnOp (GroupAggr ($(v "groupExprs"), afuns)) $(v "q1") |])
+
+mergeGroupAggr :: VLRule ()
+mergeGroupAggr q =
+  $(dagPatMatch 'q "(GroupAggr args1 (q1)) Align (GroupAggr args2 (q2))"
+    [| do
+        let (ges1, afuns1) = $(v "args1")
+        let (ges2, afuns2) = $(v "args2")
+
+        -- The rewrite can be applied if the same input is grouped
+        -- according to the same grouping expressions.
+        predicate $ ges1 == ges2
+        predicate $ $(v "q1") == $(v "q2")
+
+        return $ do
+          logRewrite "Aggregation.Normalize.MergeGroupAggr" q
+          groupNode <- insert $ UnOp (GroupAggr ($(v "ges1"), ($(v "afuns1") <> $(v "afuns2")))) $(v "q1")
+
+          -- Reconstruct the schema produced by Zip. Note that this
+          -- duplicates the grouping columns.
+          let groupWidth = length $(v "ges1")
+              aggrWidth1 = N.length afuns1
+              aggrWidth2 = N.length afuns2
+              groupCols  = [ Column c | c <- [1 .. groupWidth]]
+
+          let proj = groupCols
+                     ++
+                     [ Column $ c + groupWidth | c <- [1 .. aggrWidth1] ]
+                     ++
+                     groupCols
+                     ++
+                     [ Column $ c + groupWidth + aggrWidth1 | c <- [1 .. aggrWidth2] ]
+
+          void $ replaceWithNew q $ UnOp (Project proj) groupNode |])
+
+-- | This is a cleanup rewrite: It applies in a situation when
+-- aggregates have already been merged with Group into GroupAggr. If
+-- the GroupAggr output is combined with the R1 output of Group on the
+-- same input and grouping expressions via Align, the effect is that
+-- only the grouping expressions are duplicated.
+mergeGroupWithGroupAggrLeft :: VLRule ()
+mergeGroupWithGroupAggrLeft q =
+  $(dagPatMatch 'q "(R1 (Group ges (q1))) Align (GroupAggr args (q2))"
+    [| do
+        let (ges', afuns) = $(v "args")
+
+        -- Input vectors and grouping expressions have to be the same.
+        predicate $ $(v "q1") == $(v "q2")
+        predicate $ $(v "ges") == ges'
+
+        return $ do
+            logRewrite "Aggregation.Normalize.MergeGroup.Left" q
+
+            -- To keep the schema, we have to duplicate the grouping
+            -- columns.
+            let groupWidth = length ges'
+                aggrWidth  = N.length afuns
+                groupCols  = [ Column c | c <- [1..groupWidth] ]
+                proj       = groupCols
+                             ++
+                             groupCols
+                             ++
+                             [ Column $ c + groupWidth | c <- [1..aggrWidth] ]
+
+            groupNode <- insert $ UnOp (GroupAggr (ges', afuns)) $(v "q1")
+            void $ replaceWithNew q $ UnOp (Project proj) groupNode |])
+
+-- | The mirrored dual of rewrite
+-- 'Aggregation.Normalize.MergeGroup.Left'.
+mergeGroupWithGroupAggrRight :: VLRule ()
+mergeGroupWithGroupAggrRight q =
+  $(dagPatMatch 'q "(GroupAggr args (q1)) Align (R1 (Group ges (q2)))"
+    [| do
+        let (ges', afuns) = $(v "args")
+
+        -- Input vectors and grouping expressions have to be the same.
+        predicate $ $(v "q1") == $(v "q2")
+        predicate $ $(v "ges") == ges'
+
+        return $ do
+            logRewrite "Aggregation.Normalize.MergeGroup.Right" q
+
+            -- To keep the schema, we have to duplicate the grouping
+            -- columns.
+            let groupWidth = length ges'
+                aggrWidth  = N.length afuns
+                groupCols  = [ Column c | c <- [1..groupWidth] ]
+                proj       = groupCols
+                             ++
+                             [ Column $ c + groupWidth | c <- [1..aggrWidth] ]
+                             ++
+                             groupCols
+
+            groupNode <- insert $ UnOp (GroupAggr (ges', afuns)) $(v "q1")
+            void $ replaceWithNew q $ UnOp (Project proj) groupNode |])
+
+-- | Merge nestjoin-based binary grouping and subsequent aggregation
+-- into one groupjoin operator.
+groupJoin :: VLRule ()
+groupJoin q =
+  $(dagPatMatch 'q "R1 ((qo) UnboxSng ((qo1) AggrS a (R1 ((qo2) NestJoin p (qi)))))"
+    [| do
+        predicate $ $(v "qo1") == $(v "qo")
+        predicate $ $(v "qo2") == $(v "qo")
+
+        return $ do
+            logRewrite "GroupJoin" q
+            void $ replaceWithNew q $ BinOp (GroupJoin ($(v "p"), $(v "a"))) $(v "qo") $(v "qi")
+        |])
diff --git a/src/Database/DSH/VL/Opt/Rewrite/Common.hs b/src/Database/DSH/VL/Opt/Rewrite/Common.hs
new file mode 100644
--- /dev/null
+++ b/src/Database/DSH/VL/Opt/Rewrite/Common.hs
@@ -0,0 +1,114 @@
+{-# LANGUAGE TemplateHaskell #-}
+module Database.DSH.VL.Opt.Rewrite.Common where
+
+import qualified Data.IntMap                             as M
+
+import           Control.Monad
+
+import           Database.Algebra.Dag.Common
+
+import           Database.DSH.Common.QueryPlan
+
+import           Database.DSH.Common.Lang
+import           Database.DSH.Common.Opt
+import           Database.DSH.Common.Vector
+import           Database.DSH.VL.Lang
+
+import           Database.DSH.VL.Opt.Properties.BottomUp
+import           Database.DSH.VL.Opt.Properties.TopDown
+import           Database.DSH.VL.Opt.Properties.Types
+
+  -- Type abbreviations for convenience
+type VLRewrite p = Rewrite VL (Shape VLDVec) p
+type VLRule p = Rule VL p (Shape VLDVec)
+type VLRuleSet p = RuleSet VL p (Shape VLDVec)
+type VLMatch p = Match VL p (Shape VLDVec)
+
+inferBottomUp :: VLRewrite (NodeMap BottomUpProps)
+inferBottomUp = do
+  props <- infer inferBottomUpProperties
+  return props
+
+inferTopDown :: VLRewrite (NodeMap TopDownProps)
+inferTopDown = do
+  to <- topsort
+  buPropMap <- infer inferBottomUpProperties
+  props <- infer (inferTopDownProperties buPropMap to)
+  return props
+
+inferProperties :: VLRewrite (NodeMap Properties)
+inferProperties = do
+  buMap <- inferBottomUp
+  tdMap <- inferTopDown
+  return $ M.intersectionWith Properties buMap tdMap
+
+noProps :: Monad m => m (M.IntMap a)
+noProps = return M.empty
+
+---------------------------------------------------------------------------------
+-- Rewrite helper functions
+
+lookupR1Parents :: AlgNode -> VLRewrite [AlgNode]
+lookupR1Parents q = parents q >>= \ps -> filterM isR1 ps
+  where
+    isR1 :: AlgNode -> VLRewrite Bool
+    isR1 q' = do
+        o <- operator q'
+        case o of
+            UnOp R1 _ -> return True
+            _         -> return False
+
+
+lookupR2Parents :: AlgNode -> VLRewrite [AlgNode]
+lookupR2Parents q = parents q >>= \ps -> filterM isR2 ps
+  where
+    isR2 :: AlgNode -> VLRewrite Bool
+    isR2 q' = do
+        o <- operator q'
+        case o of
+            UnOp R2 _ -> return True
+            _         -> return False
+
+mergeExpr :: [(DBCol, Expr)] -> Expr -> Expr
+mergeExpr env expr =
+    case expr of
+        BinApp o e1 e2 -> BinApp o (mergeExpr env e1) (mergeExpr env e2)
+        UnApp o e1     -> UnApp o (mergeExpr env e1)
+        Column c       -> case lookup c env of
+                               Just expr' -> expr'
+                               Nothing    -> error $ show c ++ " " ++ show env
+        If c t e       -> If (mergeExpr env c) (mergeExpr env t) (mergeExpr env e)
+        Constant _     -> expr
+
+-- | Unwrap a constant value
+constVal :: Monad m => (ScalarVal -> a) -> ConstPayload -> m a
+constVal wrap (ConstPL val) = return $ wrap val
+constVal _             _    = fail "no match"
+
+mapAggrFun :: (Expr -> Expr) -> AggrFun -> AggrFun
+mapAggrFun f (AggrMax e) = AggrMax $ f e
+mapAggrFun f (AggrSum t e) = AggrSum t $ f e
+mapAggrFun f (AggrMin e) = AggrMin $ f e
+mapAggrFun f (AggrAvg e) = AggrAvg $ f e
+mapAggrFun f (AggrAny e) = AggrAny $ f e
+mapAggrFun f (AggrAll e) = AggrAll $ f e
+mapAggrFun _ AggrCount   = AggrCount
+
+mapWinFun :: (Expr -> Expr) -> WinFun -> WinFun
+mapWinFun f (WinMax e)        = WinMax $ f e
+mapWinFun f (WinSum e)        = WinSum $ f e
+mapWinFun f (WinMin e)        = WinMin $ f e
+mapWinFun f (WinAvg e)        = WinAvg $ f e
+mapWinFun f (WinAny e)        = WinAny $ f e
+mapWinFun f (WinAll e)        = WinAll $ f e
+mapWinFun f (WinFirstValue e) = WinFirstValue $ f e
+mapWinFun _ WinCount          = WinCount
+
+mapExprCols :: (DBCol -> DBCol) -> Expr -> Expr
+mapExprCols f (BinApp op e1 e2) = BinApp op (mapExprCols f e1) (mapExprCols f e2)
+mapExprCols f (UnApp op e)      = UnApp op (mapExprCols f e)
+mapExprCols f (Column c)        = Column $ f c
+mapExprCols _ (Constant val)    = Constant val
+mapExprCols f (If c t e)        = If (mapExprCols f c)
+                                     (mapExprCols f t)
+                                     (mapExprCols f e)
diff --git a/src/Database/DSH/VL/Opt/Rewrite/Expressions.hs b/src/Database/DSH/VL/Opt/Rewrite/Expressions.hs
new file mode 100644
--- /dev/null
+++ b/src/Database/DSH/VL/Opt/Rewrite/Expressions.hs
@@ -0,0 +1,119 @@
+{-# LANGUAGE ParallelListComp #-}
+{-# LANGUAGE TemplateHaskell  #-}
+
+module Database.DSH.VL.Opt.Rewrite.Expressions where
+
+-- This module contains rewrites which aim to simplify and merge complex expressions
+-- which are expressed through multiple operators.
+
+import           Control.Monad
+import           Data.Maybe
+
+import           Database.Algebra.Dag.Common
+
+import           Database.DSH.Common.Lang
+import           Database.DSH.Common.Opt
+import           Database.DSH.VL.Lang
+import           Database.DSH.VL.Opt.Properties.Types
+import           Database.DSH.VL.Opt.Rewrite.Common
+
+optExpressions :: VLRewrite Bool
+optExpressions = iteratively $ applyToAll inferBottomUp expressionRules
+
+expressionRules :: VLRuleSet BottomUpProps
+expressionRules = [ mergeExpr1
+                  , identityProject
+                  , mergeSelectProject
+                  ]
+
+mergeExpr1 :: VLRule BottomUpProps
+mergeExpr1 q =
+  $(dagPatMatch 'q "Project es1 (Project es2 (q1))"
+    [| do
+
+        return $ do
+          logRewrite "Expr.Merge.11" q
+          let env  = zip [1..] $(v "es2")
+              es1' = map (mergeExpr env) $(v "es1")
+          void $ replaceWithNew q $ UnOp (Project es1') $(v "q1") |])
+
+mergeSelectProject :: VLRule BottomUpProps
+mergeSelectProject q =
+  $(dagPatMatch 'q "R1 (qs=Select p (Project projs (q1)))"
+     [| do
+        return $ do
+          logRewrite "Expr.Merge.Select" q
+          let env = zip [1..] $(v "projs")
+          let p'  = mergeExpr env $(v "p")
+          selectNode <- insert $ UnOp (Select p') $(v "q1")
+          r1Node     <- insert $ UnOp R1 selectNode
+          void $ replaceWithNew q $ UnOp (Project $(v "projs")) r1Node
+
+          r2Parents <- lookupR2Parents $(v "qs")
+
+          -- If there are any R2 nodes linking to the original
+          -- Restrict operator (i.e. there are inner vectors to which
+          -- changes must be propagated), they have to be rewired to
+          -- the new Select operator.
+          when (not $ null r2Parents) $ do
+            qr2' <- insert $ UnOp R2 selectNode
+            mapM_ (\qr2 -> replace qr2 qr2') r2Parents |])
+
+identityProject :: VLRule BottomUpProps
+identityProject q =
+  $(dagPatMatch 'q "Project ps (q1)"
+    [| do
+        VProp (VTDataVec w) <- vectorTypeProp <$> properties $(v "q1")
+        predicate $ length $(v "ps") == w
+
+        let sameCol :: (Int, Expr) -> Bool
+            sameCol (i, Column i') = i == i'
+            sameCol _               = False
+
+        predicate $ all sameCol (zip [1..] $(v "ps"))
+
+        rs <- getRootNodes
+        predicate $ not $ q `elem` rs
+
+        return $ do
+          logRewrite "Project.Identity" q
+          replace q $(v "q1") |])
+
+------------------------------------------------------------------------------
+-- Constant expression inputs
+
+liftPairRight :: Monad m => (a, m b) -> m (a, b)
+liftPairRight (a, mb) = mb >>= \b -> return (a, b)
+
+mapPair :: (a -> c) -> (b -> d) -> (a, b) -> (c, d)
+mapPair f g (a, b) = (f a, g b)
+
+insertConstants :: [(DBCol, ScalarVal)] -> Expr -> Expr
+insertConstants env expr =
+    case expr of
+        BinApp o e1 e2 -> BinApp o (insertConstants env e1) (insertConstants env e2)
+        UnApp o e1     -> UnApp o (insertConstants env e1)
+        Column c       -> case lookup c env of
+                               Just val -> Constant val
+                               Nothing  -> Column c
+        If c t e       -> If (insertConstants env c) (insertConstants env t) (insertConstants env e)
+        Constant _     -> expr
+
+constProject :: VLRule BottomUpProps
+constProject q =
+  $(dagPatMatch 'q "Project projs (q1)"
+    [| do
+        VProp (ConstVec constCols) <- constProp <$> properties $(v "q1")
+        let envEntry = liftPairRight . mapPair id (constVal id)
+        let constEnv = mapMaybe envEntry $ zip [1..] constCols
+
+        predicate $ not $ null constEnv
+
+        let projs' = map (insertConstants constEnv) $(v "projs")
+
+        -- To avoid rewriting loops, ensure that a change occured.
+        predicate $ projs' /= $(v "projs")
+
+        return $ do
+          logRewrite "Expr.Project.Const" q
+          void $ replaceWithNew q $ UnOp (Project projs') $(v "q1") |])
diff --git a/src/Database/DSH/VL/Opt/Rewrite/PruneEmpty.hs b/src/Database/DSH/VL/Opt/Rewrite/PruneEmpty.hs
new file mode 100644
--- /dev/null
+++ b/src/Database/DSH/VL/Opt/Rewrite/PruneEmpty.hs
@@ -0,0 +1,112 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module Database.DSH.VL.Opt.Rewrite.PruneEmpty(pruneEmpty) where
+
+import           Control.Monad
+
+import           Database.DSH.Common.Opt
+import           Database.DSH.VL.Opt.Properties.Types
+import           Database.DSH.VL.Opt.Rewrite.Common
+
+import           Database.Algebra.Dag.Common
+-- import           Database.DSH.VL.Lang
+
+pruneEmpty :: VLRewrite Bool
+pruneEmpty = applyToAll inferBottomUp emptyRules
+
+emptyRules :: VLRuleSet BottomUpProps
+emptyRules = [ -- emptyAppendLeftR1
+             -- , emptyAppendLeftR2
+             -- , emptyAppendLeftR3
+             -- , emptyAppendRightR1
+             -- , emptyAppendRightR2
+             -- , emptyAppendRightR3
+             ]
+
+-- FIXME pruning data vectors (R1) alone is not sufficient when
+-- dealing with natural keys. We need to treat R2 and R3 outputs as
+-- well, because otherwise inner vectors will be re-keyed and no
+-- longer be aligned with the outer vector.
+
+isEmpty :: AlgNode -> VLMatch BottomUpProps Bool
+isEmpty q = do
+  ps <- liftM emptyProp $ properties q
+  case ps of
+    VProp b -> return b
+    x       -> error $ "PruneEmpty.isEmpty: non-vector input " ++ show x
+
+-- {- If the left input is empty and the other is not, the resulting value vector
+-- is simply the right input. -}
+-- emptyAppendLeftR1 :: VLRule BottomUpProps
+-- emptyAppendLeftR1 q =
+--   $(dagPatMatch 'q "R1 ((q1) [Append | AppendS] (q2))"
+--     [| do
+--         predicate =<< ((&&) <$> (isEmpty $(v "q1")) <*> (not <$> isEmpty $(v "q2")))
+
+--         return $ do
+--           logRewrite "Empty.Append.Left.R1" q
+--           replace q $(v "q2") |])
+
+-- FIXME re-add rules when
+{-
+-- If the left input is empty, renaming will make the inner vector
+-- empty as well.
+emptyAppendLeftR2 :: VLRule BottomUpProps
+emptyAppendLeftR2 q =
+  $(dagPatMatch 'q "(R2 ((q1) Append (q2))) PropRename (qv)"
+    [| do
+        predicate =<< ((&&) <$> (isEmpty $(v "q1")) <*> (not <$> isEmpty $(v "q2")))
+
+        VProp (ValueVector w) <- vectorTypeProp <$> properties $(v "qv")
+
+        return $ do
+          logRewrite "Empty.Append.Left.R2" q
+          void $ replaceWithNew q (NullaryOp $ Empty w) |])
+
+-- If the left input is empty, the rename vector for the right inner
+-- vectors is simply identity
+emptyAppendLeftR3 :: VLRule BottomUpProps
+emptyAppendLeftR3 q =
+  $(dagPatMatch 'q "(R3 ((q1) Append (q2))) PropRename (qv)"
+    [| do
+        predicate =<< ((&&) <$> (isEmpty $(v "q1")) <*> (not <$> isEmpty $(v "q2")))
+
+        return $ do
+          logRewrite "Empty.Append.Left.R3" q
+          replace q $(v "qv") |])
+-}
+
+-- emptyAppendRightR1 :: VLRule BottomUpProps
+-- emptyAppendRightR1 q =
+--   $(dagPatMatch 'q "R1 ((q1) [Append | AppendS] (q2))"
+--     [| do
+--         predicate =<< ((&&) <$> (isEmpty $(v "q2")) <*> (not <$> isEmpty $(v "q1")))
+--         return $ do
+--           logRewrite "Empty.Append.Right.R1" q
+--           replace q $(v "q1") |])
+
+{-
+-- If the right input is empty, renaming will make the inner vector
+-- empty as well.
+emptyAppendRightR3 :: VLRule BottomUpProps
+emptyAppendRightR3 q =
+  $(dagPatMatch 'q "(R3 ((q1) Append (q2))) PropRename (qv)"
+    [| do
+        predicate =<< ((&&) <$> (not <$> isEmpty $(v "q1")) <*> (isEmpty $(v "q2")))
+        VProp (ValueVector w) <- vectorTypeProp <$> properties $(v "qv")
+
+        return $ do
+          logRewrite "Empty.Append.Right.R3" q
+          void $ replaceWithNew q $ NullaryOp $ Empty w |])
+
+-- If the right input is empty, the rename vector for the left inner
+-- vectors is simply identity
+emptyAppendRightR2 :: VLRule BottomUpProps
+emptyAppendRightR2 q =
+  $(dagPatMatch 'q "(R2 ((q1) Append (q2))) PropRename (qv)"
+    [| do
+        predicate =<< ((&&) <$> (isEmpty $(v "q2")) <*> (not <$> isEmpty $(v "q1")))
+        return $ do
+          logRewrite "Empty.Append.Right.R2" q
+          void $ replace q $(v "qv") |])
+-}
diff --git a/src/Database/DSH/VL/Opt/Rewrite/Redundant.hs b/src/Database/DSH/VL/Opt/Rewrite/Redundant.hs
new file mode 100644
--- /dev/null
+++ b/src/Database/DSH/VL/Opt/Rewrite/Redundant.hs
@@ -0,0 +1,1050 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module Database.DSH.VL.Opt.Rewrite.Redundant (removeRedundancy) where
+
+import           Control.Monad
+
+import           Database.Algebra.Dag.Common
+
+import           Database.DSH.Common.Lang
+
+import           Database.DSH.Common.Opt
+import           Database.DSH.VL.Opt.Properties.Types
+import           Database.DSH.VL.Opt.Properties.VectorType
+import           Database.DSH.VL.Opt.Rewrite.Common
+import           Database.DSH.VL.Opt.Rewrite.Expressions
+import           Database.DSH.VL.Opt.Rewrite.Aggregation
+import           Database.DSH.VL.Opt.Rewrite.Window
+import           Database.DSH.VL.Lang
+
+removeRedundancy :: VLRewrite Bool
+removeRedundancy =
+    iteratively $ sequenceRewrites [ cleanup
+                                   , applyToAll noProps redundantRules
+                                   , applyToAll inferBottomUp redundantRulesBottomUp
+                                   , applyToAll inferProperties redundantRulesAllProps
+                                   , groupingToAggregation
+                                   ]
+
+cleanup :: VLRewrite Bool
+cleanup = iteratively $ sequenceRewrites [ optExpressions ]
+
+redundantRules :: VLRuleSet ()
+redundantRules = [ pullProjectAppKey
+                 , pullProjectAppRep
+                 , pullProjectAppFilter
+                 , pullProjectAppSort
+                 , pullProjectUnboxKey
+                 , pullProjectAggrS
+                 , scalarConditional
+                 ]
+
+redundantRulesBottomUp :: VLRuleSet BottomUpProps
+redundantRulesBottomUp = [ sameInputAlign
+                         , sameInputZip
+                         -- , sameInputZipProject
+                         -- , sameInputZipProjectLeft
+                         -- , sameInputZipProjectRight
+                         , zipProjectLeft
+                         , alignProjectLeft
+                         , zipProjectRight
+                         , alignProjectRight
+                         , distLiftProjectLeft
+                         , distLiftProjectRight
+                         , distLiftNestProduct
+                         , distLiftNestJoin
+                         , distLiftStacked
+                         , distLiftSelect
+                         , alignedDistLeft
+                         , alignedDistRight
+                         , zipConstLeft
+                         , zipConstRight
+                         , alignConstLeft
+                         , alignConstRight
+                         , zipZipLeft
+                         , alignWinLeft
+                         , alignWinRight
+                         , alignWinRightPush
+                         , alignUnboxSngRight
+                         , alignUnboxSngLeft
+                         , alignCartProdRight
+                         , alignGroupJoinLeft
+                         , alignGroupJoinRight
+                         -- , runningAggWin
+                         , inlineWinAggrProject
+                         , pullProjectNumber
+                         , constDist
+                         , nestJoinChain
+                         , pullProjectUnboxSngLeft
+                         , pullProjectUnboxSngRight
+                         , pullProjectNestJoinLeft
+                         , pullProjectNestJoinRight
+                         , pullProjectGroupJoinLeft
+                         , selectCartProd
+                         ]
+
+redundantRulesAllProps :: VLRuleSet Properties
+redundantRulesAllProps = [ unreferencedDistLift
+                         , notReqNumber
+                         , unboxNumber
+                         ]
+
+--------------------------------------------------------------------------------
+--
+
+unwrapConstVal :: ConstPayload -> VLMatch p ScalarVal
+unwrapConstVal (ConstPL val) = return val
+unwrapConstVal  NonConstPL   = fail "not a constant"
+
+-- | If the left input of a dist operator is constant, a normal projection
+-- can be used because the Dist* operators keeps the shape of the
+-- right input.
+constDist :: VLRule BottomUpProps
+constDist q =
+  $(dagPatMatch 'q "R1 ((q1) [DistLift | DistSng] (q2))"
+    [| do
+         VProp (ConstVec constCols) <- constProp <$> properties $(v "q1")
+         VProp (VTDataVec w)        <- vectorTypeProp <$> properties $(v "q2")
+         constVals                  <- mapM unwrapConstVal constCols
+
+         return $ do
+              logRewrite "Redundant.Const.DistLift" q
+              let proj = map Constant constVals ++ map Column [1..w]
+              void $ replaceWithNew q $ UnOp (Project proj) $(v "q2") |])
+
+-- | If a vector is distributed over an inner vector in a segmented
+-- way, check if the vector's columns are actually referenced/required
+-- downstream. If not, we can remove the DistLift altogether, as the
+-- shape of the inner vector is not changed by DistLift.
+unreferencedDistLift :: VLRule Properties
+unreferencedDistLift q =
+  $(dagPatMatch 'q  "R1 ((q1) DistLift (q2))"
+    [| do
+        VProp (Just reqCols) <- reqColumnsProp <$> td <$> properties q
+        VProp (VTDataVec w1) <- vectorTypeProp <$> bu <$> properties $(v "q1")
+        VProp (VTDataVec w2) <- vectorTypeProp <$> bu <$> properties $(v "q2")
+
+        -- Check that only columns from the right input are required
+        predicate $ all (> w1) reqCols
+
+        return $ do
+          logRewrite "Redundant.Unreferenced.DistLift" q
+
+          -- FIXME HACKHACKHACK
+          let padProj = [ Constant $ IntV 0xdeadbeef | _ <- [1..w1] ]
+                        ++
+                        [ Column i | i <- [1..w2] ]
+
+          void $ replaceWithNew q $ UnOp (Project padProj) $(v "q2") |])
+
+-- | Remove a DistLift if the outer vector is aligned with a
+-- NestProduct that uses the same outer vector.
+distLiftNestProduct :: VLRule BottomUpProps
+distLiftNestProduct q =
+  $(dagPatMatch 'q "R1 ((qo) DistLift (R1 ((qo1) NestProduct (qi))))"
+    [| do
+        predicate $ $(v "qo") == $(v "qo1")
+
+        w1 <- liftM (vectorWidth . vectorTypeProp) $ properties $(v "qo")
+        w2 <- liftM (vectorWidth . vectorTypeProp) $ properties $(v "qi")
+
+        return $ do
+            logRewrite "Redundant.DistLift.NestProduct" q
+            -- Preserve the original schema
+            let proj = map Column $ [1..w1] ++ [1..w1] ++ [w1+1..w1+w2]
+            prodNode <- insert $ BinOp NestProduct $(v "qo") $(v "qi")
+            r1Node   <- insert $ UnOp R1 prodNode
+            void $ replaceWithNew q $ UnOp (Project proj) r1Node |])
+
+-- | Remove a DistLift if the outer vector is aligned with a
+-- NestJoin that uses the same outer vector.
+distLiftNestJoin :: VLRule BottomUpProps
+distLiftNestJoin q =
+  $(dagPatMatch 'q "R1 ((qo) DistLift (R1 ((qo1) NestJoin p (qi))))"
+    [| do
+        predicate $ $(v "qo") == $(v "qo1")
+
+        w1 <- liftM (vectorWidth . vectorTypeProp) $ properties $(v "qo")
+        w2 <- liftM (vectorWidth . vectorTypeProp) $ properties $(v "qi")
+
+        return $ do
+            logRewrite "Redundant.DistLift.NestJoin" q
+            -- Preserve the original schema
+            let proj = map Column $ [1..w1] ++ [1..w1] ++ [w1+1..w1+w2]
+            prodNode <- insert $ BinOp (NestJoin $(v "p")) $(v "qo") $(v "qi")
+            r1Node   <- insert $ UnOp R1 prodNode
+            void $ replaceWithNew q $ UnOp (Project proj) r1Node |])
+
+distLiftProjectLeft :: VLRule BottomUpProps
+distLiftProjectLeft q =
+  $(dagPatMatch 'q "R1 ((Project ps1 (q1)) DistLift (q2))"
+    [| do
+        w1 <- liftM (vectorWidth . vectorTypeProp) $ properties $(v "q1")
+        w2 <- liftM (vectorWidth . vectorTypeProp) $ properties $(v "q2")
+
+        return $ do
+          logRewrite "Redundant.DistLift.Project.Left" q
+          -- Take the projection expressions from the left and the
+          -- shifted columns from the right.
+          let proj = $(v "ps1") ++ [ Column $ c + w1 | c <- [1 .. w2]]
+          distNode <- insert $ BinOp DistLift $(v "q1") $(v "q2")
+          r1Node   <- insert $ UnOp R1 distNode
+          void $ replaceWithNew q $ UnOp (Project proj) r1Node |])
+
+distLiftProjectRight :: VLRule BottomUpProps
+distLiftProjectRight q =
+  $(dagPatMatch 'q "R1 ((q1) DistLift (Project p2 (q2)))"
+    [| do
+        w1 <- liftM (vectorWidth . vectorTypeProp) $ properties $(v "q1")
+
+        return $ do
+          logRewrite "Redundant.DistLift.Project.Right" q
+          -- Take the columns from the left and the expressions from
+          -- the right projection. Since expressions are applied after
+          -- the zip, their column references have to be shifted.
+          let proj = [Column c | c <- [1..w1]] ++ [ mapExprCols (+ w1) e | e <- $(v "p2") ]
+          distNode <- insert $ BinOp DistLift $(v "q1") $(v "q2")
+          r1Node   <- insert $ UnOp R1 distNode
+          void $ replaceWithNew q $ UnOp (Project proj) r1Node |])
+
+-- If the same outer vector is propagated twice to an inner vector,
+-- one DistLift can be removed. Reasoning: DistLift does not change
+-- the shape of the inner vector.
+distLiftStacked :: VLRule BottomUpProps
+distLiftStacked q =
+  $(dagPatMatch 'q "R1 ((q1) DistLift (r1=R1 ((q11) DistLift (q2))))"
+     [| do
+         predicate $ $(v "q1") == $(v "q11")
+         w1 <- liftM (vectorWidth . vectorTypeProp) $ properties $(v "q1")
+         w2 <- liftM (vectorWidth . vectorTypeProp) $ properties $(v "q2")
+
+         return $ do
+             logRewrite "Redundant.DistLift.Stacked" q
+             let proj = map Column $ [1..w1] ++ [1..w1] ++ [w1+1..w1+w2]
+             void $ replaceWithNew q $ UnOp (Project proj) $(v "r1") |])
+
+-- | Pull a selection through a DistLift. The reasoning for
+-- correctness is simple: It does not matter wether an element of an
+-- inner segment is removed before or after DistLift (on relational
+-- level, DistLift maps to join which commutes with selection). The
+-- "use case" for this rewrite is not well thought-through yet: We
+-- want to push down DistLift to eliminate it or merge it with other
+-- operators (e.g. DistLift.Stacked). The usual wisdom would suggest
+-- to push selections down, though.
+distLiftSelect :: VLRule BottomUpProps
+distLiftSelect q =
+  $(dagPatMatch 'q "R1 ((q1) DistLift (R1 (Select p (q2))))"
+     [| do
+         w1 <- liftM (vectorWidth . vectorTypeProp) $ properties $(v "q1")
+         return $ do
+             logRewrite "Redundant.DistLift.Select" q
+             let p' = shiftExprCols w1 $(v "p")
+             distNode <- insert $ BinOp DistLift $(v "q1") $(v "q2")
+             distR1   <- insert $ UnOp R1 distNode
+             selNode  <- insert $ UnOp (Select p') distR1
+             void $ replaceWithNew q $ UnOp R1 selNode |])
+
+-- | When a DistLift result is aligned with the right (inner) DistLift
+-- input, we can eliminate the Align. Reasoning: DistLift does not
+-- change the shape of the vector, only adds columns from its right
+-- input.
+alignedDistRight :: VLRule BottomUpProps
+alignedDistRight q =
+  $(dagPatMatch 'q "(q21) Align (qr1=R1 ((q1) [DistLift | DistSng] (q22)))"
+    [| do
+        predicate $ $(v "q21") == $(v "q22")
+        w1 <- liftM (vectorWidth . vectorTypeProp) $ properties $(v "q1")
+        w2 <- liftM (vectorWidth . vectorTypeProp) $ properties $(v "q21")
+
+        return $ do
+            logRewrite "Redundant.Dist.Align.Right" q
+            let proj = map Column $
+                       [w1+1..w1+w2]
+                       ++
+                       [1..w1]
+                       ++
+                       [w1+1..w1+w2]
+            void $ replaceWithNew q $ UnOp (Project proj) $(v "qr1") |])
+
+-- | When a DistLift result is aligned with the right (inner) DistLift
+-- input, we can eliminate the Align. Reasoning: DistLift does not
+-- change the shape of the vector, only adds columns from its right
+-- input.
+alignedDistLeft :: VLRule BottomUpProps
+alignedDistLeft q =
+  $(dagPatMatch 'q "(qr1=R1 ((q1) [DistLift | DistSng] (q21))) Align (q22)"
+    [| do
+        predicate $ $(v "q21") == $(v "q22")
+        w1 <- liftM (vectorWidth . vectorTypeProp) $ properties $(v "q1")
+        w2 <- liftM (vectorWidth . vectorTypeProp) $ properties $(v "q21")
+
+        return $ do
+            logRewrite "Redundant.Dist.Align.Left" q
+            let proj = map Column $
+                       [1..w1]
+                       ++
+                       [w1+1..w1+w2]
+                       ++
+                       [w1+1..w1+w2]
+            void $ replaceWithNew q $ UnOp (Project proj) $(v "qr1") |])
+
+--------------------------------------------------------------------------------
+-- Zip and Align rewrites.
+
+-- Note that the rewrites valid for Zip are a subset of the rewrites
+-- valid for Align. In the case of Align, we statically know that both
+-- inputs have the same length and can be positionally aligned without
+-- discarding elements.
+
+-- | Replace an Align operator with a projection if both inputs are the
+-- same.
+sameInputAlign :: VLRule BottomUpProps
+sameInputAlign q =
+  $(dagPatMatch 'q "(q1) Align (q2)"
+    [| do
+        predicate $ $(v "q1") == $(v "q2")
+        w <- liftM (vectorWidth . vectorTypeProp) $ properties $(v "q1")
+
+        return $ do
+          logRewrite "Redundant.Align.Self" q
+          let ps = map Column [1 .. w]
+          void $ replaceWithNew q $ UnOp (Project (ps ++ ps)) $(v "q1") |])
+
+-- | Replace an Align operator with a projection if both inputs are the
+-- same.
+sameInputZip :: VLRule BottomUpProps
+sameInputZip q =
+  $(dagPatMatch 'q "R1 ((q1) Zip (q2))"
+    [| do
+        predicate $ $(v "q1") == $(v "q2")
+        w <- liftM (vectorWidth . vectorTypeProp) $ properties $(v "q1")
+
+        return $ do
+          logRewrite "Redundant.Zip.Self" q
+          let ps = map Column [1 .. w]
+          void $ replaceWithNew q $ UnOp (Project (ps ++ ps)) $(v "q1") |])
+
+-- sameInputZipProject :: VLRule BottomUpProps
+-- sameInputZipProject q =
+--   $(dagPatMatch 'q "(Project ps1 (q1)) [Zip | Align] (Project ps2 (q2))"
+--     [| do
+--         predicate $ $(v "q1") == $(v "q2")
+
+--         return $ do
+--           logRewrite "Redundant.Zip/Align.Self.Project" q
+--           void $ replaceWithNew q $ UnOp (Project ($(v "ps1") ++ $(v "ps2"))) $(v "q1") |])
+
+-- sameInputZipProjectLeft :: VLRule BottomUpProps
+-- sameInputZipProjectLeft q =
+--   $(dagPatMatch 'q "(Project ps1 (q1)) [Zip | Align] (q2)"
+--     [| do
+--         predicate $ $(v "q1") == $(v "q2")
+--         w1 <- liftM (vectorWidth . vectorTypeProp) $ properties $(v "q1")
+
+--         return $ do
+--           logRewrite "Redundant.Zip/Align.Self.Project.Left" q
+--           let proj = $(v "ps1") ++ (map Column [1..w1])
+--           void $ replaceWithNew q $ UnOp (Project proj) $(v "q1") |])
+
+-- sameInputZipProjectRight :: VLRule BottomUpProps
+-- sameInputZipProjectRight q =
+--   $(dagPatMatch 'q "(q1) [Zip | Align] (Project ps2 (q2))"
+--     [| do
+--         predicate $ $(v "q1") == $(v "q2")
+--         w <- liftM (vectorWidth . vectorTypeProp) $ properties $(v "q1")
+
+--         return $ do
+--           logRewrite "Redundant.Zip/Align.Self.Project.Right" q
+--           let proj = (map Column [1 .. w]) ++ $(v "ps2")
+--           void $ replaceWithNew q $ UnOp (Project proj) $(v "q1") |])
+
+alignProjectLeft :: VLRule BottomUpProps
+alignProjectLeft q =
+  $(dagPatMatch 'q "(Project ps1 (q1)) Align (q2)"
+    [| do
+        w1 <- liftM (vectorWidth . vectorTypeProp) $ properties $(v "q1")
+        w2 <- liftM (vectorWidth . vectorTypeProp) $ properties $(v "q2")
+
+        return $ do
+          logRewrite "Redundant.Align.Project.Left" q
+          -- Take the projection expressions from the left and the
+          -- shifted columns from the right.
+          let proj = $(v "ps1") ++ [ Column $ c + w1 | c <- [1 .. w2]]
+          alignNode <- insert $ BinOp Align $(v "q1") $(v "q2")
+          void $ replaceWithNew q $ UnOp (Project proj) alignNode |])
+
+zipProjectLeft :: VLRule BottomUpProps
+zipProjectLeft q =
+  $(dagPatMatch 'q "R1 ((Project ps1 (q1)) Zip (q2))"
+    [| do
+        w1 <- liftM (vectorWidth . vectorTypeProp) $ properties $(v "q1")
+        w2 <- liftM (vectorWidth . vectorTypeProp) $ properties $(v "q2")
+
+        return $ do
+          logRewrite "Redundant.Zip.Project.Left" q
+          -- Take the projection expressions from the left and the
+          -- shifted columns from the right.
+          let proj = $(v "ps1") ++ [ Column $ c + w1 | c <- [1 .. w2]]
+          zipNode <- insert $ BinOp Zip $(v "q1") $(v "q2")
+          r1Node  <- insert $ UnOp R1 zipNode
+          void $ replaceWithNew q $ UnOp (Project proj) r1Node |])
+
+alignProjectRight :: VLRule BottomUpProps
+alignProjectRight q =
+  $(dagPatMatch 'q "(q1) Align (Project p2 (q2))"
+    [| do
+        w1 <- liftM (vectorWidth . vectorTypeProp) $ properties $(v "q1")
+
+        return $ do
+          logRewrite "Redundant.Align.Project.Right" q
+          -- Take the columns from the left and the expressions from
+          -- the right projection. Since expressions are applied after
+          -- the zip, their column references have to be shifted.
+          let proj = [Column c | c <- [1..w1]] ++ [ mapExprCols (+ w1) e | e <- $(v "p2") ]
+          zipNode <- insert $ BinOp Align $(v "q1") $(v "q2")
+          void $ replaceWithNew q $ UnOp (Project proj) zipNode |])
+
+zipProjectRight :: VLRule BottomUpProps
+zipProjectRight q =
+  $(dagPatMatch 'q "R1 ((q1) Zip (Project p2 (q2)))"
+    [| do
+        w1 <- liftM (vectorWidth . vectorTypeProp) $ properties $(v "q1")
+
+        return $ do
+          logRewrite "Redundant.Zip.Project.Right" q
+          -- Take the columns from the left and the expressions from
+          -- the right projection. Since expressions are applied after
+          -- the zip, their column references have to be shifted.
+          let proj = [Column c | c <- [1..w1]] ++ [ mapExprCols (+ w1) e | e <- $(v "p2") ]
+          zipNode <- insert $ BinOp Zip $(v "q1") $(v "q2")
+          r1Node  <- insert $ UnOp R1 zipNode
+          void $ replaceWithNew q $ UnOp (Project proj) r1Node |])
+
+fromConst :: Monad m => ConstPayload -> m ScalarVal
+fromConst (ConstPL val) = return val
+fromConst NonConstPL    = fail "not a constant"
+
+-- | This rewrite is valid because we statically know that both
+-- vectors have the same length.
+alignConstLeft :: VLRule BottomUpProps
+alignConstLeft q =
+  $(dagPatMatch 'q "(q1) Align (q2)"
+    [| do
+        VProp (ConstVec ps) <- constProp <$> properties $(v "q1")
+        w2                  <- vectorWidth <$> vectorTypeProp <$> properties $(v "q2")
+        vals                <- mapM fromConst ps
+
+        return $ do
+            logRewrite "Redundant.Align.Constant.Left" q
+            let proj = map Constant vals ++ map Column [1..w2]
+            void $ replaceWithNew q $ UnOp (Project proj) $(v "q2") |])
+
+alignConstRight :: VLRule BottomUpProps
+alignConstRight q =
+  $(dagPatMatch 'q "(q1) Align (q2)"
+    [| do
+        w1                  <- vectorWidth <$> vectorTypeProp <$> properties $(v "q1")
+        VProp (ConstVec ps) <- constProp <$> properties $(v "q2")
+        vals                <- mapM fromConst ps
+
+        return $ do
+            logRewrite "Redundant.Align.Constant.Right" q
+            let proj = map Column [1..w1] ++ map Constant vals
+            void $ replaceWithNew q $ UnOp (Project proj) $(v "q1") |])
+
+-- | In contrast to the 'Align' version ('alignConstLeft') this
+-- rewrite is only valid if we can statically determine that both
+-- input vectors have the same length. If the constant vector was
+-- shorter, overhanging elements from the non-constant vector would
+-- need to be discarded. In general, we can only determine equal
+-- length for the special case of length one.
+zipConstLeft :: VLRule BottomUpProps
+zipConstLeft q =
+  $(dagPatMatch 'q "R1 ((q1) Zip (q2))"
+    [| do
+        prop1               <- properties $(v "q1")
+        VProp card1         <- return $ card1Prop prop1
+        VProp (ConstVec ps) <- return $ constProp prop1
+
+        prop2               <- properties $(v "q2")
+        VProp card2         <- return $ card1Prop prop2
+        w2                  <- vectorWidth <$> vectorTypeProp <$> properties $(v "q2")
+
+        vals                <- mapM fromConst ps
+        predicate $ card1 && card2
+
+        return $ do
+            logRewrite "Redundant.Zip.Constant.Left" q
+            let proj = map Constant vals ++ map Column [1..w2]
+            void $ replaceWithNew q $ UnOp (Project proj) $(v "q2") |])
+
+zipConstRight :: VLRule BottomUpProps
+zipConstRight q =
+  $(dagPatMatch 'q "R1 ((q1) Zip (q2))"
+    [| do
+        prop1               <- properties $(v "q1")
+        VProp card1         <- return $ card1Prop prop1
+        w1                  <- vectorWidth <$> vectorTypeProp <$> properties $(v "q1")
+
+        prop2               <- properties $(v "q2")
+        VProp card2         <- return $ card1Prop prop2
+        VProp (ConstVec ps) <- return $ constProp prop2
+
+
+        vals                  <- mapM fromConst ps
+        predicate $ card1 && card2
+
+        return $ do
+            logRewrite "Redundant.Zip.Constant.Right" q
+            let proj = map Column [1..w1] ++ map Constant vals
+            void $ replaceWithNew q $ UnOp (Project proj) $(v "q1") |])
+
+zipZipLeft :: VLRule BottomUpProps
+zipZipLeft q =
+  $(dagPatMatch 'q "(q1) Zip (qz=(q11) [Zip | Align] (_))"
+     [| do
+         predicate $ $(v "q1") == $(v "q11")
+
+         w1 <- vectorWidth <$> vectorTypeProp <$> properties $(v "q1")
+         wz <- vectorWidth <$> vectorTypeProp <$> properties $(v "qz")
+
+         return $ do
+             logRewrite "Redundant.Zip/Align.Zip.Left" q
+             let proj = map Column $ [1..w1] ++ [1..wz]
+             void $ replaceWithNew q $ UnOp (Project proj) $(v "qz") |])
+
+alignWinRight :: VLRule BottomUpProps
+alignWinRight q =
+  $(dagPatMatch 'q "(q1) Align (qw=WinFun _ (q2))"
+     [| do
+         predicate $ $(v "q1") == $(v "q2")
+
+         w <- vectorWidth <$> vectorTypeProp <$> properties $(v "q1")
+
+         return $ do
+             logRewrite "Redundant.Align.Self.Win.Right" q
+             -- We get all columns from the left input. The WinAggr
+             -- operator produces the input column followed the window
+             -- function result.
+             let proj = map Column $ [1 .. w] ++ [1 .. w] ++ [w+1]
+             -- logGeneral ("zipWinRight " ++ show proj)
+             void $ replaceWithNew q $ UnOp (Project proj) $(v "qw") |])
+
+alignWinLeft :: VLRule BottomUpProps
+alignWinLeft q =
+  $(dagPatMatch 'q "(qw=WinFun _ (q1)) Align (q2)"
+     [| do
+         predicate $ $(v "q1") == $(v "q2")
+
+         w <- vectorWidth <$> vectorTypeProp <$> properties $(v "q1")
+
+         return $ do
+             logRewrite "Redundant.Align.Self.Win.Left" q
+             -- We get all input columns plus the window function
+             -- output from the left. From the right we get all input
+             -- columns.
+             let proj = map Column $ [1 .. w] ++ [w+1] ++ [1 .. w]
+             void $ replaceWithNew q $ UnOp (Project proj) $(v "qw") |])
+
+isPrecedingFrameSpec :: FrameSpec -> Bool
+isPrecedingFrameSpec fs =
+    case fs of
+        FAllPreceding -> True
+        FNPreceding _ -> True
+
+alignWinRightPush :: VLRule BottomUpProps
+alignWinRightPush q =
+  $(dagPatMatch 'q "(q1) Align (WinFun args (q2))"
+    [| do
+        let (winFun, frameSpec) = $(v "args")
+        predicate $ isPrecedingFrameSpec frameSpec
+        w1 <- vectorWidth <$> vectorTypeProp <$> properties $(v "q1")
+
+        return $ do
+            logRewrite "Redundant.Align.Win.Right" q
+            zipNode <- insert $ BinOp Align $(v "q1") $(v "q2")
+            let winFun' = mapWinFun (mapExprCols (\c -> c + w1)) winFun
+                args'   = (winFun', frameSpec)
+            void $ replaceWithNew q $ UnOp (WinFun args') zipNode |])
+
+alignGroupJoinRight :: VLRule BottomUpProps
+alignGroupJoinRight q =
+  $(dagPatMatch 'q "(qo) Align (gj=(qo1) GroupJoin _ (_))"
+    [| do
+        predicate $ $(v "qo") == $(v "qo1")
+        w <- vectorWidth <$> vectorTypeProp <$> properties $(v "qo")
+
+        return $ do
+            logRewrite "Redundant.Align.GroupJoin.Right" q
+            -- In the result, replicate the columns from the outer
+            -- vector to keep the schema intact.
+            let proj = map Column $ [1..w] ++ [1..w+1]
+            void $ replaceWithNew q $ UnOp (Project proj) $(v "gj") |])
+
+alignGroupJoinLeft :: VLRule BottomUpProps
+alignGroupJoinLeft q =
+  $(dagPatMatch 'q "(gj=(qo1) GroupJoin _ (_)) Align (qo)"
+    [| do
+        predicate $ $(v "qo") == $(v "qo1")
+        w <- vectorWidth <$> vectorTypeProp <$> properties $(v "qo")
+
+        return $ do
+            logRewrite "Redundant.Align.GroupJoin.Left" q
+            -- In the result, replicate the columns from the outer
+            -- vector to keep the schema intact.
+            let proj = map Column $ [1..w+1] ++ [1..w]
+            void $ replaceWithNew q $ UnOp (Project proj) $(v "gj") |])
+
+-- | If the right (outer) input of Unbox is a number operator and the
+-- number output is not required, eliminate it from the outer
+-- input. This is correct because Number does not change the vertical
+-- shape of the vector.
+--
+-- The motivation is to eliminate zip operators that align with the
+-- unboxed block. By removing Number from the Unbox input, we hope to
+-- achieve that the outer input is the same one as the zip input so
+-- that we can remove the zip.
+--
+-- For an example, see the bestProfit query (AQuery examples).
+--
+-- FIXME This could be extended to all operators that do not modify
+-- the vertical shape.
+unboxNumber :: VLRule Properties
+unboxNumber q =
+  $(dagPatMatch 'q "R1 ((Number (qo)) UnboxSng (qi))"
+    [| do
+        VProp (Just reqCols) <- reqColumnsProp <$> td <$> properties q
+        VProp (VTDataVec wo) <- vectorTypeProp <$> bu <$> properties $(v "qo")
+        VProp (VTDataVec wi) <- vectorTypeProp <$> bu <$> properties $(v "qi")
+        predicate $ (wo+1) `notElem` reqCols
+
+        return $ do
+            logRewrite "Redundant.Unbox.Number" q
+            -- FIXME HACKHACKHACK We have to insert a dummy column in
+            -- place of the number column to avoid destroying column
+            -- indexes.
+            let proj = map Column [1..wo]
+                     ++ [Constant $ IntV 0xdeadbeef]
+                     ++ map Column [wo+1..wi+wo]
+            unboxNode <- insert $ BinOp UnboxSng $(v "qo") $(v "qi")
+            r1Node    <- insert $ UnOp R1 unboxNode
+            void $ replaceWithNew q $ UnOp (Project proj) r1Node |])
+
+-- | If singleton scalar elements in an inner vector (with singleton
+-- segments) are unboxed using an outer vector and then aligned with
+-- the same outer vector, we can eliminate the align, because the
+-- positional alignment is implicitly performed by the UnboxSng
+-- operator. We exploit the fact that UnboxSng is only a
+-- specialized join which nevertheless produces payload columns from
+-- both inputs.
+alignUnboxSngRight :: VLRule BottomUpProps
+alignUnboxSngRight q =
+  $(dagPatMatch 'q "(q11) Align (qu=R1 ((q12) UnboxSng (q2)))"
+     [| do
+         predicate $ $(v "q11") == $(v "q12")
+
+         leftWidth  <- vectorWidth <$> vectorTypeProp <$> properties $(v "q11")
+         rightWidth <- vectorWidth <$> vectorTypeProp <$> properties $(v "q2")
+
+         return $ do
+             logRewrite "Redundant.Align.UnboxSng.Right" q
+
+
+             -- Keep the original schema intact by duplicating columns
+             -- from the left input (UnboxSng produces columns from
+             -- its left and right inputs).
+             let outputCols = -- Two times the left input columns
+                              [1..leftWidth] ++ [1..leftWidth]
+                              -- Followed by the right input columns
+                              ++ [ leftWidth+1..rightWidth+leftWidth ]
+                 proj       = map Column outputCols
+
+             -- Keep only the unboxing operator, together with a
+             -- projection that keeps the original output schema
+             -- intact.
+             void $ replaceWithNew q $ UnOp (Project proj) $(v "qu") |])
+
+-- | See Align.UnboxSng.Right
+alignUnboxSngLeft :: VLRule BottomUpProps
+alignUnboxSngLeft q =
+  $(dagPatMatch 'q "(qu=R1 ((q11) UnboxSng (q2))) Align (q12)"
+     [| do
+         predicate $ $(v "q11") == $(v "q12")
+
+         leftWidth  <- vectorWidth <$> vectorTypeProp <$> properties $(v "q11")
+         rightWidth <- vectorWidth <$> vectorTypeProp <$> properties $(v "q2")
+
+         return $ do
+             logRewrite "Redundant.Align.UnboxSng.Left" q
+
+
+             -- Keep the original schema intact by duplicating columns
+             -- from the left input (UnboxSng produces columns from
+             -- its left and right inputs).
+             let outputCols = -- The left (outer) columns
+                              [1..leftWidth]
+                              -- Followed by the right (inner) input columns
+                              ++ [ leftWidth+1..rightWidth+leftWidth ]
+                              -- Followed by the left (outer columns) again
+                              -- (originally produced by Align)
+                              ++ [1..leftWidth]
+                 proj       = map Column outputCols
+
+             -- Keep only the unboxing operator, together with a
+             -- projection that keeps the original output schema
+             -- intact.
+             void $ replaceWithNew q $ UnOp (Project proj) $(v "qu") |])
+
+-- | A CartProduct output is aligned with some other vector. If one of
+-- the CartProduct inputs has cardinality one, the other CartProduct
+-- input determines the length of the result vector. From the original
+-- structure we can derive that 'q11' and the CartProduct result are
+-- aligned. Consequentially, 'q11 and 'q12' (the left CartProduct
+-- input) must be aligned as well.
+alignCartProdRight :: VLRule BottomUpProps
+alignCartProdRight q =
+  $(dagPatMatch 'q "(q11) Align (R1 ((q12) CartProduct (q2)))"
+    [| do
+        VProp True <- card1Prop <$> properties $(v "q2")
+        return $ do
+            logRewrite "Redundant.Align.CartProduct.Card1.Right" q
+            alignNode <- insert $ BinOp Align $(v "q11") $(v "q12")
+            prodNode  <- insert $ BinOp CartProduct alignNode $(v "q2")
+            void $ replaceWithNew q $ UnOp R1 prodNode |])
+
+--------------------------------------------------------------------------------
+-- Scalar conditionals
+
+-- | Under a number of conditions, a combination of Combine and Select
+-- (Restrict) operators implements a scalar conditional that can be
+-- simply mapped to an 'if' expression evaluated on the input vector.
+scalarConditional :: VLRule ()
+scalarConditional q =
+  $(dagPatMatch 'q "R1 (Combine (Project predProj (q1)) (Project thenProj (R1 (Select pred2 (q2)))) (Project elseProj (R1 (Select negPred (q3)))))"
+    [| do
+        -- All branches must work on the same input vector
+        predicate $ $(v "q1") == $(v "q2") && $(v "q1") == $(v "q3")
+
+        -- The condition projection as well as the projections for
+        -- then and else branches must produce single columns.
+        [predExpr] <- return $(v "predProj")
+        [thenExpr] <- return $(v "thenProj")
+        [elseExpr] <- return $(v "elseProj")
+
+        -- The condition for the boolean vector must be the same as
+        -- the selection condition for the then-branch.
+        predicate $ predExpr == $(v "pred2")
+
+        -- The selection condition must be the negated form of the
+        -- then-condition.
+        predicate $ (UnApp (SUBoolOp Not) predExpr) == $(v "negPred")
+
+        return $ do
+          logRewrite "Redundant.ScalarConditional" q
+          void $ replaceWithNew q $ UnOp (Project [If predExpr thenExpr elseExpr]) $(v "q1") |])
+
+------------------------------------------------------------------------------
+-- Projection pullup
+
+inlineJoinPredLeft :: [(DBCol, Expr)] -> JoinPredicate Expr -> JoinPredicate Expr
+inlineJoinPredLeft env (JoinPred conjs) = JoinPred $ fmap inlineLeft conjs
+  where
+    inlineLeft :: JoinConjunct Expr -> JoinConjunct Expr
+    inlineLeft (JoinConjunct le op re) = JoinConjunct (mergeExpr env le) op re
+
+inlineJoinPredRight :: [(DBCol, Expr)] -> JoinPredicate Expr -> JoinPredicate Expr
+inlineJoinPredRight env (JoinPred conjs) = JoinPred $ fmap inlineRight conjs
+  where
+    inlineRight :: JoinConjunct Expr -> JoinConjunct Expr
+    inlineRight (JoinConjunct le op re) = JoinConjunct le op (mergeExpr env re)
+
+pullProjectGroupJoinLeft :: VLRule BottomUpProps
+pullProjectGroupJoinLeft q =
+  $(dagPatMatch 'q "(Project proj (q1)) GroupJoin args (q2)"
+    [| do
+        let (p, a) = $(v "args")
+        leftWidth  <- vectorWidth <$> vectorTypeProp <$> properties $(v "q1")
+        rightWidth <- vectorWidth <$> vectorTypeProp <$> properties $(v "q2")
+
+        return $ do
+            logRewrite "Redundant.Project.GroupJoin.Left" q
+            let proj'     = $(v "proj") ++ [Column $ leftWidth + 1]
+                p'        = inlineJoinPredLeft (zip [1..] $(v "proj")) p
+                rightCols = [leftWidth+1 .. leftWidth + rightWidth]
+                env       = zip [1..] ($(v "proj") ++ map Column rightCols)
+                a'        = mapAggrFun (mergeExpr env) a
+
+            joinNode <- insert $ BinOp (GroupJoin (p', a')) $(v "q1") $(v "q2")
+            void $ replaceWithNew q $ UnOp (Project proj') joinNode |])
+
+pullProjectNestJoinLeft :: VLRule BottomUpProps
+pullProjectNestJoinLeft q =
+  $(dagPatMatch 'q "R1 ((Project proj (q1)) NestJoin p (q2))"
+    [| do
+        leftWidth  <- vectorWidth <$> vectorTypeProp <$> properties $(v "q1")
+        rightWidth <- vectorWidth <$> vectorTypeProp <$> properties $(v "q2")
+
+        return $ do
+            logRewrite "Redundant.Project.NestJoin.Left" q
+            let proj' = $(v "proj") ++ map Column [leftWidth + 1 .. leftWidth + rightWidth]
+                p'    = inlineJoinPredLeft (zip [1..] $(v "proj")) $(v "p")
+
+            joinNode <- insert $ BinOp (NestJoin p') $(v "q1") $(v "q2")
+            r1Node   <- insert $ UnOp R1 joinNode
+            void $ replaceWithNew q $ UnOp (Project proj') r1Node
+
+            -- FIXME relink R2 and R3 parents
+            |])
+
+pullProjectNestJoinRight :: VLRule BottomUpProps
+pullProjectNestJoinRight q =
+  $(dagPatMatch 'q "R1 ((q1) NestJoin p (Project proj (q2)))"
+    [| do
+        leftWidth  <- vectorWidth <$> vectorTypeProp <$> properties $(v "q1")
+
+        return $ do
+            logRewrite "Redundant.Project.NestJoin.Right" q
+            let proj' = map Column [1..leftWidth] ++ map (shiftExprCols leftWidth) $(v "proj")
+                p'    = inlineJoinPredRight (zip [1..] $(v "proj")) $(v "p")
+
+            joinNode <- insert $ BinOp (NestJoin p') $(v "q1") $(v "q2")
+            r1Node   <- insert $ UnOp R1 joinNode
+            void $ replaceWithNew q $ UnOp (Project proj') r1Node
+
+            -- FIXME relink R2 and R3 parents
+            |])
+
+
+pullProjectNumber :: VLRule BottomUpProps
+pullProjectNumber q =
+  $(dagPatMatch 'q "Number (Project proj (q1))"
+    [| do
+         w <- vectorWidth <$> vectorTypeProp <$> properties $(v "q1")
+
+         return $ do
+             logRewrite "Redundant.Project.Number" q
+
+             -- We have to preserve the numbering column in the
+             -- pulled-up projection.
+             let proj' = $(v "proj") ++ [Column $ w + 1]
+             numberNode <- insert $ UnOp Number $(v "q1")
+             void $ replaceWithNew q $ UnOp (Project proj') numberNode |])
+
+-- Motivation: In order to eliminate or pull up sorting operations in
+-- VL rewrites or subsequent stages, payload columns which might
+-- induce sort order should be available as long as possible. We
+-- assume that the cost of having unrequired columns around is
+-- negligible (best case: column store).
+
+pullProjectAppKey :: VLRule ()
+pullProjectAppKey q =
+  $(dagPatMatch 'q "R1 ((qp) AppKey (Project proj (qv)))"
+    [| do
+         return $ do
+           logRewrite "Redundant.Project.AppKey" q
+           rekeyNode <- insert $ BinOp AppKey $(v "qp") $(v "qv")
+           r1Node    <- insert $ UnOp R1 rekeyNode
+           void $ replaceWithNew q $ UnOp (Project $(v "proj")) r1Node |])
+
+pullProjectUnboxSngLeft :: VLRule BottomUpProps
+pullProjectUnboxSngLeft q =
+  $(dagPatMatch 'q "R1 ((Project proj (q1)) UnboxSng (q2))"
+    [| do
+         leftWidth  <- vectorWidth <$> vectorTypeProp <$> properties $(v "q1")
+         rightWidth <- vectorWidth <$> vectorTypeProp <$> properties $(v "q2")
+
+         return $ do
+           logRewrite "Redundant.Project.UnboxSng" q
+
+           -- Employ projection expressions on top of the unboxing
+           -- operator, add right input columns.
+           let proj' = $(v "proj") ++ map Column [ leftWidth + 1 .. leftWidth + rightWidth ]
+           unboxNode <- insert $ BinOp UnboxSng $(v "q1") $(v "q2")
+           r1Node    <- insert $ UnOp R1 unboxNode
+
+           void $ replaceWithNew q $ UnOp (Project proj') r1Node |])
+
+pullProjectUnboxSngRight :: VLRule BottomUpProps
+pullProjectUnboxSngRight q =
+  $(dagPatMatch 'q "R1 ((q1) UnboxSng (Project proj (q2)))"
+    [| do
+         leftWidth  <- vectorWidth <$> vectorTypeProp <$> properties $(v "q1")
+
+         return $ do
+           logRewrite "Redundant.Project.UnboxSng" q
+
+           -- Preserve left input columns on top of the unboxing
+           -- operator and add right input expressions with shifted
+           -- columns.
+           let proj' = map Column [1..leftWidth]
+                       ++
+                       [ mapExprCols (+ leftWidth) e | e <- $(v "proj") ]
+
+           unboxNode <- insert $ BinOp UnboxSng $(v "q1") $(v "q2")
+           r1Node    <- insert $ UnOp R1 unboxNode
+
+           void $ replaceWithNew q $ UnOp (Project proj') r1Node |])
+
+pullProjectAppRep :: VLRule ()
+pullProjectAppRep q =
+  $(dagPatMatch 'q "R1 ((qp) AppRep (Project proj (qv)))"
+    [| do
+         return $ do
+           logRewrite "Redundant.Project.AppRep" q
+           repNode <- insert $ BinOp AppRep $(v "qp") $(v "qv")
+           r1Node  <- insert $ UnOp R1 repNode
+           void $ replaceWithNew q $ UnOp (Project $(v "proj")) r1Node |])
+
+pullProjectAppFilter :: VLRule ()
+pullProjectAppFilter q =
+  $(dagPatMatch 'q "R1 ((q1) AppFilter (Project proj (q2)))"
+    [| do
+         return $ do
+           logRewrite "Redundant.Project.AppFilter" q
+           filterNode <- insert $ BinOp AppFilter $(v "q1") $(v "q2")
+           r1Node     <- insert $ UnOp R1 filterNode
+           void $ replaceWithNew q $ UnOp (Project $(v "proj")) r1Node |])
+
+pullProjectAppSort :: VLRule ()
+pullProjectAppSort q =
+  $(dagPatMatch 'q "R1 ((q1) AppSort (Project proj (q2)))"
+    [| do
+         return $ do
+           logRewrite "Redundant.Project.AppSort" q
+           sortNode <- insert $ BinOp AppSort $(v "q1") $(v "q2")
+           r1Node   <- insert $ UnOp R1 sortNode
+           void $ replaceWithNew q $ UnOp (Project $(v "proj")) r1Node |])
+
+pullProjectUnboxKey :: VLRule ()
+pullProjectUnboxKey q =
+  $(dagPatMatch 'q "UnboxKey (Project _ (q1))"
+    [| do
+         return $ do
+           logRewrite "Redundant.Project.UnboxKey" q
+           void $ replaceWithNew q $ UnOp UnboxKey $(v "q1") |])
+
+-- | Any projections on the left input of AggrS are irrelevant, as
+-- only the segment information are required from the vector.
+pullProjectAggrS :: VLRule ()
+pullProjectAggrS q =
+  $(dagPatMatch 'q "(Project _ (q1)) AggrS args (q2)"
+    [| do
+        return $ do
+            logRewrite "Redundant.Project.AggrS" q
+            void $ replaceWithNew q $ BinOp (AggrS $(v "args")) $(v "q1") $(v "q2") |])
+
+--------------------------------------------------------------------------------
+-- Rewrites that deal with nested structures and propagation vectors.
+
+-- | Turn a right-deep nestjoin tree into a left-deep one.
+--
+-- A comprehension of the form
+-- @
+-- [ [ [ e x y z | z <- zs, p2 y z ]
+--   | y <- ys
+--   , p1 x y
+--   ]
+-- | x <- xs
+-- ]
+-- @
+--
+-- is first rewritten into a right-deep chain of nestjoins: 'xs △ (ys △ zs)'.
+-- Bottom-up compilation of this expression to VL (vectorization) results in
+-- a rather awkward plan, though: The inner nestjoin is computed independent
+-- of values of 'x'. The join result is then re-shaped using the propagation
+-- vector from the nestjoin of the outer relations 'xs' and 'ys'. This pattern
+-- is problematic for multiple reasons: PropReorder is an expensive operation as
+-- it involves re-ordering semantically, leading to a hard-to-eliminate rownum.
+-- On the plan level, we do not get a left- or right-deep join tree of thetajoins,
+-- but two independent joins between the two pairs of input relations whose results
+-- are connected using an additional join (PropReorder). This means that the two
+-- base joins will be executed on the full base tables, without being able to profit
+-- from a reduced cardinality in one of the join results.
+--
+-- NestJoin does not exhibit useful algebraic properties, most notably it is neither
+-- associate nor commutative. It turns out however that we can turn the pattern
+-- described above into a proper left-deep sequence of nestjoins if we consider
+-- the flat (vectorized) representation. The output of 'xs △ ys' is nestjoined
+-- with the innermost input 'zs'. This gives us exactly the representation of
+-- the nested output that we need. Semantically, 'zs' is not joined with all
+-- tuples in 'ys', but only with those that survive the (outer) join with 'xs'.
+-- As usual, a proper join tree should give the engine the freedom to re-arrange
+-- the joins and drive them in a pipelined manner.
+nestJoinChain :: VLRule BottomUpProps
+nestJoinChain q =
+  $(dagPatMatch 'q "R1 ((R3 (lj=(xs) NestJoin _ (ys))) AppRep (R1 ((ys1) NestJoin p (zs))))"
+   [| do
+       xsWidth <- vectorWidth <$> vectorTypeProp <$> properties $(v "xs")
+       ysWidth <- vectorWidth <$> vectorTypeProp <$> properties $(v "ys")
+       zsWidth <- vectorWidth <$> vectorTypeProp <$> properties $(v "zs")
+
+       predicate $ $(v "ys") == $(v "ys1")
+       return $ do
+         logRewrite "Redundant.Prop.NestJoinChain" q
+
+
+         let innermostCols = map Column [ xsWidth + 1 .. xsWidth + ysWidth + zsWidth ]
+
+             -- As the left input of the top nestjoin now includes the
+             -- columns from xs, we have to shift column references in
+             -- the left predicate side.
+             JoinPred conjs = $(v "p")
+             p' = JoinPred $ fmap (shiftJoinPredCols xsWidth 0) conjs
+
+         -- The R1 node on the left nest join might already exist, but
+         -- we simply rely on hash consing.
+         leftJoinR1  <- insert $ UnOp R1 $(v "lj")
+         rightJoin   <- insert $ BinOp (NestJoin p') leftJoinR1 $(v "zs")
+         rightJoinR1 <- insert $ UnOp R1 rightJoin
+
+         -- Because the original produced only the columns of ys and
+         -- zs in the PropReorder output, we have to remove the xs
+         -- columns from the top NestJoin.
+         void $ replaceWithNew q $ UnOp (Project innermostCols) rightJoinR1 |])
+
+shiftJoinPredCols :: Int -> Int -> JoinConjunct Expr -> JoinConjunct Expr
+shiftJoinPredCols leftOffset rightOffset (JoinConjunct leftExpr op rightExpr) =
+    JoinConjunct (shiftExprCols leftOffset leftExpr) op (shiftExprCols rightOffset rightExpr)
+
+--------------------------------------------------------------------------------
+-- Eliminating operators whose output is not required
+
+notReqNumber :: VLRule Properties
+notReqNumber q =
+  $(dagPatMatch 'q "Number (q1)"
+    [| do
+        w <- vectorWidth <$> vectorTypeProp <$> bu <$> properties $(v "q1")
+        VProp (Just reqCols) <- reqColumnsProp <$> td <$> properties $(v "q")
+
+        -- The number output in column w + 1 must not be required
+        predicate $ all (<= w) reqCols
+
+        return $ do
+          logRewrite "Redundant.Req.Number" q
+          -- Add a dummy column instead of the number output to keep
+          -- column references intact.
+          let proj = map Column [1..w] ++ [Constant $ IntV 0xdeadbeef]
+          void $ replaceWithNew q $ UnOp (Project proj) $(v "q1") |])
+
+--------------------------------------------------------------------------------
+-- Classical relational algebra rewrites
+
+-- | Merge a selection that refers to both sides of a cartesian
+-- product operators' inputs into a join.
+selectCartProd :: VLRule BottomUpProps
+selectCartProd q =
+  $(dagPatMatch 'q "R1 (Select p (R1 ((q1) CartProduct (q2))))"
+    [| do
+        wl <- vectorWidth <$> vectorTypeProp <$> properties $(v "q1")
+        BinApp (SBRelOp op) (Column lc) (Column rc)  <- return $(v "p")
+
+        -- The left operand column has to be from the left input, the
+        -- right operand from the right input.
+        predicate $ lc <= wl
+        predicate $ rc > wl
+
+        return $ do
+            logRewrite "Redundant.Relational.Join" q
+            let joinPred = singlePred $ JoinConjunct (Column lc) op (Column $ rc - wl)
+            joinNode <- insert $ BinOp (ThetaJoin joinPred) $(v "q1") $(v "q2")
+            void $ replaceWithNew q $ UnOp R1 joinNode |])
diff --git a/src/Database/DSH/VL/Opt/Rewrite/Unused.hs b/src/Database/DSH/VL/Opt/Rewrite/Unused.hs
new file mode 100644
--- /dev/null
+++ b/src/Database/DSH/VL/Opt/Rewrite/Unused.hs
@@ -0,0 +1,48 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+{- Based on the ReqColumns property, remove columns or entire operators which
+produce value vectors but whose payload output is not needed downstream. This
+is of course only sound if the operator in question does not change the vertical
+layout.  -}
+
+module Database.DSH.VL.Opt.Rewrite.Unused where
+
+{-
+import           Control.Applicative
+
+import           Database.Algebra.Dag.Common
+import           Database.Algebra.VL.Data
+
+import           Database.DSH.Common.Opt
+import           Database.DSH.VL.Opt.Properties.Types
+import           Database.DSH.VL.Opt.Rewrite.Common
+
+pruneUnused :: VLRewrite Bool
+pruneUnused = applyToAll inferTopDown [ {- unusedProject -} ]
+
+-}
+
+{-
+
+FIXME seems a bit fishy
+
+unusedProject :: VLRule TopDownProps
+unusedProject q =
+  $(pattern 'q "[ProjectL | Project] _ (q1)"
+    [| do
+      -- Don't remove top-level projections. They ensure that all required
+      -- columns required for the result type are actually there.
+      predicate =<< not <$> elem q <$> getRootNodes
+
+      reqColumns <- reqColumnsProp <$> properties q
+
+      case reqColumns of
+        VProp (Just []) -> return ()
+        VProp (Just _)  -> fail "no match"
+        p               -> error ("Unused.Project: " ++ show p)
+
+
+      return $ do
+        logRewrite "Unused.Project" q
+        replace q $(v "q1") |])
+-}
diff --git a/src/Database/DSH/VL/Opt/Rewrite/Window.hs b/src/Database/DSH/VL/Opt/Rewrite/Window.hs
new file mode 100644
--- /dev/null
+++ b/src/Database/DSH/VL/Opt/Rewrite/Window.hs
@@ -0,0 +1,158 @@
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE TemplateHaskell #-}
+module Database.DSH.VL.Opt.Rewrite.Window where
+
+import           Control.Monad
+import           Data.List.NonEmpty                              (NonEmpty (..))
+
+import           Database.Algebra.Dag.Common
+
+import           Database.DSH.Common.Lang
+import           Database.DSH.Common.Opt
+import           Database.DSH.VL.Opt.Properties.ReqColumns
+import           Database.DSH.VL.Opt.Properties.Types
+import           Database.DSH.VL.Opt.Properties.VectorType
+import           Database.DSH.VL.Opt.Rewrite.Common
+import           Database.DSH.VL.Lang
+
+pattern SingleJoinPred e1 op e2 = JoinPred ((JoinConjunct e1 op e2) :| [])
+pattern DoubleJoinPred e11 op1 e12 e21 op2 e22 = JoinPred ((JoinConjunct e11 op1 e12)
+                                                           :|
+                                                           [JoinConjunct e21 op2 e22])
+pattern AddExpr e1 e2 = BinApp (SBNumOp Add) e1 e2
+pattern SubExpr e1 e2 = BinApp (SBNumOp Sub) e1 e2
+
+aggrToWinFun :: AggrFun -> WinFun
+aggrToWinFun (AggrSum _ e) = WinSum e
+aggrToWinFun (AggrMin e)   = WinMin e
+aggrToWinFun (AggrMax e)   = WinMax e
+aggrToWinFun (AggrAvg e)   = WinAvg e
+aggrToWinFun (AggrAll e)   = WinAll e
+aggrToWinFun (AggrAny e)   = WinAny e
+aggrToWinFun AggrCount     = WinCount
+
+-- Turn a running aggregate based on a self-join into a window operator.
+runningAggWin :: VLRule BottomUpProps
+runningAggWin q =
+  $(dagPatMatch 'q "(qo) UnboxSng ((_) AggrS afun (R1 ((qn=Number (q1)) NestJoin p (Number (q2)))))"
+    [| do
+        predicate $ $(v "q1") == $(v "q2")
+        predicate $ $(v "qo") == $(v "qn")
+
+        w <- vectorWidth <$> vectorTypeProp <$> properties $(v "q1")
+
+        -- We require a range predicate on the positions generated by
+        -- Number.
+        -- FIXME allow other forms of window specifications
+        SingleJoinPred (Column nrCol) GtE (Column nrCol') <- return $(v "p")
+        predicate $ nrCol == w + 1 && nrCol' == w + 1
+
+        -- The aggregate should only reference columns from the right
+        -- ThetaJoin input, i.e. columns from the partition generated
+        -- for a input tuple.
+        let isWindowColumn c = c >= w + 2 && c <= 2 * w + 1
+        predicate $ all isWindowColumn (aggrReqCols $(v "afun"))
+
+        return $ do
+            logRewrite "Window.RunningAggr" q
+            -- Shift column references in aggregate functions so that
+            -- they are applied to partition columns.
+            let afun' = aggrToWinFun $ mapAggrFun (mapExprCols (\c -> c - (w + 1))) $(v "afun")
+
+            void $ replaceWithNew q $ UnOp (WinFun (afun', FAllPreceding)) $(v "qn") |])
+
+-- -- | Employ a window function that maps to SQL's first_value when the
+-- -- 'head' combinator is employed on a nestjoin-generated window.
+-- --
+-- -- FIXME this rewrite is currently extremely ugly and fragile: We map
+-- -- directly to first_value which produces only one value, but start
+-- -- with head one potentially broader inputs. To bring them into sync,
+-- -- we demand that only one column is required downstream and produce
+-- -- that column. This involves too much fiddling with column
+-- -- offsets. It would be less dramatic if we had name-based columns
+-- -- (which we should really do).
+-- firstValueWin :: VLRule Properties
+-- firstValueWin q =
+--   $(dagPatMatch 'q "(UnboxKey (Number (q1))) AppKey (R1 (SelectPos1S selectArgs (R1 ((Number (q2)) NestJoin joinPred (Number (q3))))))"
+--     [| do
+--         predicate $ $(v "q1") == $(v "q2") && $(v "q1") == $(v "q3")
+
+--         inputWidth <- vectorWidth <$> vectorTypeProp <$> bu <$> properties $(v "q1")
+--         resWidth   <- vectorWidth <$> vectorTypeProp <$> bu <$> properties $(v "q1")
+
+--         VProp (Just [resCol]) <- reqColumnsProp <$> td <$> properties $(v "q")
+
+--         -- Perform a sanity check (because this rewrite is rather
+--         -- insane): the required column must originate from the inner
+--         -- window created by the nestjoin and must not be the
+--         -- numbering column.
+--         predicate $ resCol > inputWidth + 1
+--         predicate $ resCol < 2 * inputWidth + 2
+
+--         -- The evaluation of first_value produces only a single value
+--         -- for each input column. To employ first_value, the input has
+--         -- to consist of a single column.
+
+--         -- We expect the VL representation of 'head'
+--         (SBRelOp Eq, 1) <- return $(v "selectArgs")
+
+--         -- We expect a window specification that for each element
+--         -- includes its predecessor (if there is one) and the element
+--         -- itself.
+--         DoubleJoinPred e11 op1 e12 e21 op2 e22                   <- return $(v "joinPred")
+--         (SubExpr (Column nrCol) frameOffset, LtE, Column nrCol') <- return (e11, op1, e12)
+--         (Column nrCol'', GtE, Column nrCol''')                   <- return (e21, op2, e22)
+--         Constant (IntV offset)                                   <- return frameOffset
+
+--         -- Check that all (assumed) numbering columns are actually the
+--         -- column added by the Number operator.
+--         predicate $ all (== (inputWidth + 1)) [nrCol, nrCol', nrCol'', nrCol''']
+
+--         return $ do
+--             logRewrite "Window.FirstValue" q
+--             let -- The input column for FirstValue is the column in
+--                 -- the inner window mapped to the input vector's
+--                 -- layout.
+--                 inputCol     = resCol - (inputWidth + 1)
+--                 winArgs      = (WinFirstValue $ Column inputCol, (FNPreceding offset))
+--                 placeHolders = repeat $ Constant $ IntV 0xdeadbeef
+
+--                 -- Now comes the ugly stuff: to keep the schema intact
+--                 -- (since columns are referred to by offset), we have
+--                 -- to keep columns that are not required in place and
+--                 -- replace them with placeholders.
+--                 proj         = -- Unreferenced columns in front of the
+--                                -- required column
+--                                take (resCol - 1) placeHolders
+--                                -- The required column (which is added
+--                                -- by WinFun to the input columns
+--                                ++ [Column (inputWidth + 1)]
+--                                -- Unrefeferenced columns after the
+--                                -- required column
+--                                ++ take (resWidth - resCol) placeHolders
+--             winNode <- insert $ UnOp (WinFun winArgs) $(v "q1")
+--             void $ replaceWithNew q $ UnOp (Project proj) winNode |])
+
+inlineWinAggrProject :: VLRule BottomUpProps
+inlineWinAggrProject q =
+  $(dagPatMatch 'q "WinFun args (Project proj (q1))"
+    [| do
+        w <- vectorWidth <$> vectorTypeProp <$> properties $(v "q1")
+
+        return $ do
+            logRewrite "Window.RunningAggr.Project" q
+
+            let (afun, frameSpec) = $(v "args")
+                env               = zip [1..] $(v "proj")
+                -- Inline column expressions from the projection into
+                -- the window function.
+                afun'             = mapWinFun (mergeExpr env) afun
+
+                -- WinAggr /adds/ the window function output to the
+                -- input columns. We have to provide the schema of the
+                -- input projection to which the window function
+                -- output is added.
+                proj' = $(v "proj") ++ [Column $ w + 1]
+
+            winNode <- insert $ UnOp (WinFun (afun', frameSpec)) $(v "q1")
+            void $ replaceWithNew q $ UnOp (Project proj') winNode |])
diff --git a/src/Database/DSH/VL/Primitives.hs b/src/Database/DSH/VL/Primitives.hs
--- a/src/Database/DSH/VL/Primitives.hs
+++ b/src/Database/DSH/VL/Primitives.hs
@@ -7,14 +7,13 @@
 import           Database.DSH.Common.Nat
 import qualified Database.DSH.Common.Lang      as L
 import qualified Database.DSH.Common.Type      as Ty
-import           Database.DSH.VL.Vector
+import           Database.DSH.Common.Vector
 
-import           Database.DSH.Impossible
+import           Database.DSH.Common.Impossible
 
 import           Database.Algebra.Dag.Build
 import           Database.Algebra.Dag.Common
 import           Database.DSH.VL.Lang          hiding (DBCol)
-import qualified Database.DSH.VL.Lang          as D
 
 --------------------------------------------------------------------------------
 -- Construct different types of vectors from algebraic nodes
@@ -24,12 +23,18 @@
 dvec :: VecConst r VLDVec
 dvec = fmap VLDVec
 
-pvec :: Build a AlgNode -> Build a PVec
-pvec = fmap PVec
+rvec :: Build a AlgNode -> Build a VLRVec
+rvec = fmap VLRVec
 
-rvec :: Build a AlgNode -> Build a RVec
-rvec = fmap RVec
-     
+kvec :: Build a AlgNode -> Build a VLKVec
+kvec = fmap VLKVec
+
+svec :: Build a AlgNode -> Build a VLSVec
+svec = fmap VLSVec
+
+fvec :: Build a AlgNode -> Build a VLFVec
+fvec = fmap VLFVec
+
 --------------------------------------------------------------------------------
 -- Insert VL operators and appropriate R1/R2/R3 nodes
 
@@ -43,10 +48,10 @@
     r2 <- mkVec2 $ insert $ UnOp R2 r
     return (r1, r2)
 
-tripleVec :: VL 
-          -> VecConst r a 
-          -> VecConst r b 
-          -> VecConst r c 
+tripleVec :: VL
+          -> VecConst r a
+          -> VecConst r b
+          -> VecConst r c
           -> Build VL (a, b ,c)
 tripleVec op mkVec1 mkVec2 mkVec3 = do
     r <- insert op
@@ -60,23 +65,15 @@
 mapSnd :: (b -> c) -> (a, b) -> (a, c)
 mapSnd f (a, b) = (a, f b)
 
-pVal :: L.Val -> VLVal
-pVal (L.IntV i)    = VLInt i
-pVal (L.BoolV b)   = VLBool b
-pVal (L.StringV s) = VLString s
-pVal (L.DoubleV d) = VLDouble d
-pVal L.UnitV       = VLUnit
-pVal _             = error "pVal: Not a supported value"
+pVal :: L.Val -> L.ScalarVal
+pVal (L.ScalarV v) = v
+pVal L.ListV{}     = $impossible
+pVal L.TupleV{}    = $impossible
 
-typeToScalarType :: Ty.Type -> ScalarType
-typeToScalarType t = case t of
-  Ty.IntT      -> D.Int
-  Ty.BoolT     -> D.Bool
-  Ty.StringT   -> D.String
-  Ty.UnitT     -> D.Unit
-  Ty.DoubleT   -> D.Double
-  Ty.ListT _   -> $impossible
-  Ty.TupleT _  -> $impossible
+typeToScalarType :: Ty.Type -> Ty.ScalarType
+typeToScalarType Ty.ListT{}     = $impossible
+typeToScalarType Ty.TupleT{}    = $impossible
+typeToScalarType (Ty.ScalarT t) = t
 
 ----------------------------------------------------------------------------------
 -- Convert join expressions into regular VL expressions
@@ -85,11 +82,7 @@
 recordWidth :: Ty.Type -> Int
 recordWidth t =
     case t of
-        Ty.IntT        -> 1
-        Ty.BoolT       -> 1
-        Ty.DoubleT     -> 1
-        Ty.StringT     -> 1
-        Ty.UnitT       -> 1
+        Ty.ScalarT _   -> 1
         Ty.TupleT ts   -> sum $ map recordWidth ts
         Ty.ListT _     -> 0
 
@@ -115,7 +108,7 @@
 toGeneralUnOp (L.JUTextOp o) = L.SUTextOp o
 
 toVLjoinConjunct :: L.JoinConjunct L.JoinExpr -> L.JoinConjunct Expr
-toVLjoinConjunct (L.JoinConjunct e1 o e2) = 
+toVLjoinConjunct (L.JoinConjunct e1 o e2) =
     L.JoinConjunct (joinExpr e1) o (joinExpr e2)
 
 toVLJoinPred :: L.JoinPredicate L.JoinExpr -> L.JoinPredicate Expr
@@ -149,6 +142,9 @@
 ----------------------------------------------------------------------------------
 -- DAG constructor functions for VL operators
 
+vlUnique :: VLDVec -> Build VL VLDVec
+vlUnique (VLDVec c) = vec (UnOp Unique c) dvec
+
 vlUniqueS :: VLDVec -> Build VL VLDVec
 vlUniqueS (VLDVec c) = vec (UnOp UniqueS c) dvec
 
@@ -158,66 +154,72 @@
 vlNumberS :: VLDVec -> Build VL VLDVec
 vlNumberS (VLDVec c) = vec (UnOp NumberS c) dvec
 
-vlGroupS :: [Expr] -> VLDVec -> Build VL (VLDVec, VLDVec, PVec)
-vlGroupS groupExprs (VLDVec c) = tripleVec (UnOp (GroupS groupExprs) c) dvec dvec pvec
+vlGroup :: [Expr] -> VLDVec -> Build VL (VLDVec, VLDVec, VLSVec)
+vlGroup groupExprs (VLDVec c) = tripleVec (UnOp (Group groupExprs) c) dvec dvec svec
 
-vlSortS :: [Expr] -> VLDVec -> Build VL (VLDVec, PVec)
-vlSortS sortExprs (VLDVec c1) = pairVec (UnOp (SortS sortExprs) c1) dvec pvec
+vlGroupS :: [Expr] -> VLDVec -> Build VL (VLDVec, VLDVec, VLSVec)
+vlGroupS groupExprs (VLDVec c) = tripleVec (UnOp (GroupS groupExprs) c) dvec dvec svec
 
+vlSort :: [Expr] -> VLDVec -> Build VL (VLDVec, VLSVec)
+vlSort sortExprs (VLDVec c1) = pairVec (UnOp (Sort sortExprs) c1) dvec svec
+
+vlSortS :: [Expr] -> VLDVec -> Build VL (VLDVec, VLSVec)
+vlSortS sortExprs (VLDVec c1) = pairVec (UnOp (SortS sortExprs) c1) dvec svec
+
 vlAggr :: AggrFun -> VLDVec -> Build VL VLDVec
 vlAggr aFun (VLDVec c) = vec (UnOp (Aggr aFun) c) dvec
 
 vlAggrS :: AggrFun -> VLDVec -> VLDVec -> Build VL VLDVec
 vlAggrS aFun (VLDVec c1) (VLDVec c2) = vec (BinOp (AggrS aFun) c1 c2) dvec
 
-vlUnboxRename :: VLDVec -> Build VL RVec
-vlUnboxRename (VLDVec c) = vec (UnOp UnboxRename c) rvec
+vlUnboxKey :: VLDVec -> Build VL VLKVec
+vlUnboxKey (VLDVec c) = vec (UnOp UnboxKey c) kvec
 
-vlNestProduct :: VLDVec -> VLDVec -> Build VL (VLDVec, PVec, PVec)
-vlNestProduct (VLDVec c1) (VLDVec c2) = tripleVec (BinOp NestProduct c1 c2) dvec pvec pvec
+vlNestProduct :: VLDVec -> VLDVec -> Build VL (VLDVec, VLRVec, VLRVec)
+vlNestProduct (VLDVec c1) (VLDVec c2) = tripleVec (BinOp NestProduct c1 c2) dvec rvec rvec
 
-vlDistLift :: VLDVec -> VLDVec -> Build VL (VLDVec, PVec)
-vlDistLift (VLDVec c1) (VLDVec c2) = pairVec (BinOp DistLift c1 c2) dvec pvec
+vlDistLift :: VLDVec -> VLDVec -> Build VL (VLDVec, VLRVec)
+vlDistLift (VLDVec c1) (VLDVec c2) = pairVec (BinOp DistLift c1 c2) dvec rvec
 
-vlPropRename :: RVec -> VLDVec -> Build VL VLDVec
-vlPropRename (RVec c1) (VLDVec c2) = vec (BinOp PropRename c1 c2) dvec
+vlDistSng :: VLDVec -> VLDVec -> Build VL (VLDVec, VLRVec)
+vlDistSng (VLDVec c1) (VLDVec c2) = pairVec (BinOp DistSng c1 c2) dvec rvec
 
-vlUnboxNested :: RVec -> VLDVec -> Build VL (VLDVec, RVec)
-vlUnboxNested (RVec c1) (VLDVec c2) = pairVec (BinOp UnboxNested c1 c2) dvec rvec
+vlUnboxSng :: VLDVec -> VLDVec -> Build VL (VLDVec, VLKVec)
+vlUnboxSng (VLDVec c1) (VLDVec c2) = pairVec (BinOp UnboxSng c1 c2) dvec kvec
 
-vlUnboxScalar :: VLDVec -> VLDVec -> Build VL VLDVec
-vlUnboxScalar (VLDVec c1) (VLDVec c2) = vec (BinOp UnboxScalar c1 c2) dvec
+vlAppSort :: VLSVec -> VLDVec -> Build VL (VLDVec, VLSVec)
+vlAppSort (VLSVec c1) (VLDVec c2) = pairVec (BinOp AppSort c1 c2) dvec svec
 
-vlPropFilter :: RVec -> VLDVec -> Build VL (VLDVec, RVec)
-vlPropFilter (RVec c1) (VLDVec c2) = pairVec (BinOp PropFilter c1 c2) dvec rvec
+vlAppFilter :: VLFVec -> VLDVec -> Build VL (VLDVec, VLFVec)
+vlAppFilter (VLFVec c1) (VLDVec c2) = pairVec (BinOp AppFilter c1 c2) dvec fvec
 
-vlPropReorder :: PVec -> VLDVec -> Build VL (VLDVec, PVec)
-vlPropReorder (PVec c1) (VLDVec c2) = pairVec (BinOp PropReorder c1 c2) dvec pvec
+vlAppKey :: VLKVec -> VLDVec -> Build VL (VLDVec, VLKVec)
+vlAppKey (VLKVec c1) (VLDVec c2) = pairVec (BinOp AppKey c1 c2) dvec kvec
 
-vlSingletonDescr :: Build VL VLDVec
-vlSingletonDescr = vec (NullaryOp SingletonDescr) dvec
+vlAppRep :: VLRVec -> VLDVec -> Build VL (VLDVec, VLRVec)
+vlAppRep (VLRVec c1) (VLDVec c2) = pairVec (BinOp AppRep c1 c2) dvec rvec
 
-vlAppend :: VLDVec -> VLDVec -> Build VL (VLDVec, RVec, RVec)
-vlAppend (VLDVec c1) (VLDVec c2) = tripleVec (BinOp Append c1 c2) dvec rvec rvec
+vlNest :: VLDVec -> Build VL (VLDVec, VLDVec)
+vlNest (VLDVec c)= pairVec (UnOp Nest c) dvec dvec
 
-vlAppendS :: VLDVec -> VLDVec -> Build VL (VLDVec, RVec, RVec)
-vlAppendS (VLDVec c1) (VLDVec c2) = tripleVec (BinOp AppendS c1 c2) dvec rvec rvec
+vlAppend :: VLDVec -> VLDVec -> Build VL (VLDVec, VLKVec, VLKVec)
+vlAppend (VLDVec c1) (VLDVec c2) = tripleVec (BinOp Append c1 c2) dvec kvec kvec
 
-vlSegment :: VLDVec -> Build VL VLDVec
-vlSegment (VLDVec c) = vec (UnOp Segment c) dvec
+vlAppendS :: VLDVec -> VLDVec -> Build VL (VLDVec, VLKVec, VLKVec)
+vlAppendS (VLDVec c1) (VLDVec c2) = tripleVec (BinOp AppendS c1 c2) dvec kvec kvec
 
-vlUnsegment :: VLDVec -> Build VL VLDVec
-vlUnsegment (VLDVec c) = vec (UnOp Unsegment c) dvec
+vlSegment :: VLDVec -> Build VL (VLDVec, VLDVec)
+vlSegment (VLDVec c) = pairVec (UnOp Segment c) dvec dvec
 
-vlCombine :: VLDVec -> VLDVec -> VLDVec -> Build VL (VLDVec, RVec, RVec)
-vlCombine (VLDVec c1) (VLDVec c2) (VLDVec c3) = 
-    tripleVec (TerOp Combine c1 c2 c3) dvec rvec rvec
+vlCombine :: VLDVec -> VLDVec -> VLDVec -> Build VL (VLDVec, VLKVec, VLKVec)
+vlCombine (VLDVec c1) (VLDVec c2) (VLDVec c3) =
+    tripleVec (TerOp Combine c1 c2 c3) dvec kvec kvec
 
-vlLit :: L.Emptiness -> [Ty.Type] -> [[VLVal]] -> Build VL VLDVec
+vlLit :: L.Emptiness -> [Ty.Type] -> [[L.ScalarVal]] -> Build VL VLDVec
 vlLit em tys vals = vec (NullaryOp $ Lit (em, map typeToScalarType tys, vals)) dvec
 
-vlTableRef :: String -> [VLColumn] -> L.TableHints -> Build VL VLDVec
-vlTableRef n tys hs = vec (NullaryOp $ TableRef (n, tys, hs)) dvec
+vlTableRef :: String -> L.BaseTableSchema -> Build VL VLDVec
+vlTableRef n schema = vec (NullaryOp $ TableRef (n, schema)) dvec
 
 vlUnExpr :: L.ScalarUnOp -> VLDVec -> Build VL VLDVec
 vlUnExpr o (VLDVec c) = vec (UnOp (Project [UnApp o (Column 1)]) c) dvec
@@ -228,114 +230,84 @@
     r <- dvec $ insert $ UnOp (Project [BinApp o (Column 1) (Column 2)]) z
     return r
 
-vlSelect :: Expr -> VLDVec -> Build VL (VLDVec, RVec)
-vlSelect p (VLDVec c) = pairVec (UnOp (Select p) c) dvec rvec
-
-vlSelectPos :: VLDVec -> L.ScalarBinOp -> VLDVec -> Build VL (VLDVec, RVec, RVec)
-vlSelectPos (VLDVec c1) op (VLDVec c2) = tripleVec (BinOp (SelectPos op) c1 c2) dvec rvec rvec
-
-vlSelectPos1 :: VLDVec -> L.ScalarBinOp -> Int -> Build VL (VLDVec, RVec, RVec)
-vlSelectPos1 (VLDVec c1) op posConst = 
-    tripleVec (UnOp (SelectPos1 (op, posConst)) c1) dvec rvec rvec
-
-vlSelectPosS :: VLDVec -> L.ScalarBinOp -> VLDVec -> Build VL (VLDVec, RVec, RVec)
-vlSelectPosS (VLDVec c1) op (VLDVec c2) = do
-    tripleVec (BinOp (SelectPosS op) c1 c2) dvec rvec rvec
-
-vlSelectPos1S :: VLDVec -> L.ScalarBinOp -> Int -> Build VL (VLDVec, RVec, RVec)
-vlSelectPos1S (VLDVec c1) op posConst = 
-    tripleVec (UnOp (SelectPos1S (op, posConst)) c1) dvec rvec rvec
+vlSelect :: Expr -> VLDVec -> Build VL (VLDVec, VLFVec)
+vlSelect p (VLDVec c) = pairVec (UnOp (Select p) c) dvec fvec
 
 vlProject :: [Expr] -> VLDVec -> Build VL VLDVec
 vlProject projs (VLDVec c) = dvec $ insert $ UnOp (Project projs) c
 
-vlZip :: VLDVec -> VLDVec -> Build VL VLDVec
-vlZip (VLDVec c1) (VLDVec c2) = vec (BinOp Zip c1 c2) dvec
+vlZip :: VLDVec -> VLDVec -> Build VL (VLDVec, VLKVec, VLKVec)
+vlZip (VLDVec c1) (VLDVec c2) = tripleVec (BinOp Zip c1 c2) dvec kvec kvec
 
 vlAlign :: VLDVec -> VLDVec -> Build VL VLDVec
 vlAlign (VLDVec c1) (VLDVec c2) = vec (BinOp Align c1 c2) dvec
 
-vlZipS :: VLDVec -> VLDVec -> Build VL (VLDVec, RVec, RVec)
+vlZipS :: VLDVec -> VLDVec -> Build VL (VLDVec, VLKVec, VLKVec)
 vlZipS (VLDVec c1) (VLDVec c2) =
-    tripleVec (BinOp ZipS c1 c2) dvec rvec rvec
+    tripleVec (BinOp ZipS c1 c2) dvec kvec kvec
 
-vlCartProduct :: VLDVec -> VLDVec -> Build VL (VLDVec, PVec, PVec)
+vlCartProduct :: VLDVec -> VLDVec -> Build VL (VLDVec, VLRVec, VLRVec)
 vlCartProduct (VLDVec c1) (VLDVec c2) =
-    tripleVec (BinOp CartProduct c1 c2) dvec pvec pvec
+    tripleVec (BinOp CartProduct c1 c2) dvec rvec rvec
 
-vlCartProductS :: VLDVec -> VLDVec -> Build VL (VLDVec, PVec, PVec)
+vlCartProductS :: VLDVec -> VLDVec -> Build VL (VLDVec, VLRVec, VLRVec)
 vlCartProductS (VLDVec c1) (VLDVec c2) =
-    tripleVec (BinOp CartProductS c1 c2) dvec pvec pvec
+    tripleVec (BinOp CartProductS c1 c2) dvec rvec rvec
 
-vlThetaJoin :: L.JoinPredicate L.JoinExpr -> VLDVec -> VLDVec -> Build VL (VLDVec, PVec, PVec)
+vlThetaJoin :: L.JoinPredicate L.JoinExpr -> VLDVec -> VLDVec -> Build VL (VLDVec, VLRVec, VLRVec)
 vlThetaJoin joinPred (VLDVec c1) (VLDVec c2) =
-    tripleVec (BinOp (ThetaJoin joinPred') c1 c2) dvec pvec pvec
+    tripleVec (BinOp (ThetaJoin joinPred') c1 c2) dvec rvec rvec
   where
     joinPred' = toVLJoinPred joinPred
 
-vlNestJoin :: L.JoinPredicate L.JoinExpr -> VLDVec -> VLDVec -> Build VL (VLDVec, PVec, PVec)
+vlNestJoin :: L.JoinPredicate L.JoinExpr -> VLDVec -> VLDVec -> Build VL (VLDVec, VLRVec, VLRVec)
 vlNestJoin joinPred (VLDVec c1) (VLDVec c2) =
-    tripleVec (BinOp (NestJoin joinPred') c1 c2) dvec pvec pvec
+    tripleVec (BinOp (NestJoin joinPred') c1 c2) dvec rvec rvec
   where
     joinPred' = toVLJoinPred joinPred
 
-vlThetaJoinS :: L.JoinPredicate L.JoinExpr -> VLDVec -> VLDVec -> Build VL (VLDVec, PVec, PVec)
+vlThetaJoinS :: L.JoinPredicate L.JoinExpr -> VLDVec -> VLDVec -> Build VL (VLDVec, VLRVec, VLRVec)
 vlThetaJoinS joinPred (VLDVec c1) (VLDVec c2) =
-    tripleVec (BinOp (ThetaJoinS joinPred') c1 c2) dvec pvec pvec
+    tripleVec (BinOp (ThetaJoinS joinPred') c1 c2) dvec rvec rvec
   where
     joinPred' = toVLJoinPred joinPred
 
-vlNestJoinS :: L.JoinPredicate L.JoinExpr -> VLDVec -> VLDVec -> Build VL (VLDVec, PVec)
+vlNestJoinS :: L.JoinPredicate L.JoinExpr -> VLDVec -> VLDVec -> Build VL (VLDVec, VLRVec, VLRVec)
 vlNestJoinS joinPred (VLDVec c1) (VLDVec c2) =
-    pairVec (BinOp (NestJoinS joinPred') c1 c2) dvec pvec
+    tripleVec (BinOp (NestJoinS joinPred') c1 c2) dvec rvec rvec
   where
     joinPred' = toVLJoinPred joinPred
 
-vlNestProductS :: VLDVec -> VLDVec -> Build VL (VLDVec, PVec)
+vlNestProductS :: VLDVec -> VLDVec -> Build VL (VLDVec, VLRVec, VLRVec)
 vlNestProductS (VLDVec c1) (VLDVec c2) = do
-    pairVec (BinOp NestProductS c1 c2) dvec pvec
+    tripleVec (BinOp NestProductS c1 c2) dvec rvec rvec
 
-vlSemiJoin :: L.JoinPredicate L.JoinExpr -> VLDVec -> VLDVec -> Build VL (VLDVec, RVec)
+vlSemiJoin :: L.JoinPredicate L.JoinExpr -> VLDVec -> VLDVec -> Build VL (VLDVec, VLFVec)
 vlSemiJoin joinPred (VLDVec c1) (VLDVec c2) = do
-    pairVec (BinOp (SemiJoin joinPred') c1 c2) dvec rvec
+    pairVec (BinOp (SemiJoin joinPred') c1 c2) dvec fvec
   where
     joinPred' = toVLJoinPred joinPred
 
-vlSemiJoinS :: L.JoinPredicate L.JoinExpr -> VLDVec -> VLDVec -> Build VL (VLDVec, RVec)
+vlSemiJoinS :: L.JoinPredicate L.JoinExpr -> VLDVec -> VLDVec -> Build VL (VLDVec, VLFVec)
 vlSemiJoinS joinPred (VLDVec c1) (VLDVec c2) = do
-    pairVec (BinOp (SemiJoinS joinPred') c1 c2) dvec rvec
+    pairVec (BinOp (SemiJoinS joinPred') c1 c2) dvec fvec
   where
     joinPred' = toVLJoinPred joinPred
 
-vlAntiJoin :: L.JoinPredicate L.JoinExpr -> VLDVec -> VLDVec -> Build VL (VLDVec, RVec)
+vlAntiJoin :: L.JoinPredicate L.JoinExpr -> VLDVec -> VLDVec -> Build VL (VLDVec, VLFVec)
 vlAntiJoin joinPred (VLDVec c1) (VLDVec c2) = do
-    pairVec (BinOp (AntiJoin joinPred') c1 c2) dvec rvec
+    pairVec (BinOp (AntiJoin joinPred') c1 c2) dvec fvec
   where
     joinPred' = toVLJoinPred joinPred
 
-vlAntiJoinS :: L.JoinPredicate L.JoinExpr -> VLDVec -> VLDVec -> Build VL (VLDVec, RVec)
+vlAntiJoinS :: L.JoinPredicate L.JoinExpr -> VLDVec -> VLDVec -> Build VL (VLDVec, VLFVec)
 vlAntiJoinS joinPred (VLDVec c1) (VLDVec c2) = do
-    pairVec (BinOp (AntiJoinS joinPred') c1 c2) dvec rvec
+    pairVec (BinOp (AntiJoinS joinPred') c1 c2) dvec fvec
   where
     joinPred' = toVLJoinPred joinPred
 
-vlReverse :: VLDVec -> Build VL (VLDVec, PVec)
-vlReverse (VLDVec c) = pairVec (UnOp Reverse c) dvec pvec
-
-vlReverseS :: VLDVec -> Build VL (VLDVec, PVec)
-vlReverseS (VLDVec c) = pairVec (UnOp ReverseS c) dvec pvec
-
-vlTranspose :: VLDVec -> Build VL (VLDVec, VLDVec)
-vlTranspose (VLDVec c) = pairVec (UnOp Transpose c) dvec dvec
-
-vlTransposeS :: VLDVec -> VLDVec -> Build VL (VLDVec, VLDVec)
-vlTransposeS (VLDVec c1) (VLDVec c2) = do
-    pairVec (BinOp TransposeS c1 c2) dvec dvec
-
-vlReshape :: Integer -> VLDVec -> Build VL (VLDVec, VLDVec)
-vlReshape n (VLDVec c) = do
-    pairVec (UnOp (Reshape n) c) dvec dvec
+vlReverse :: VLDVec -> Build VL (VLDVec, VLSVec)
+vlReverse (VLDVec c) = pairVec (UnOp Reverse c) dvec svec
 
-vlReshapeS :: Integer -> VLDVec -> Build VL (VLDVec, VLDVec)
-vlReshapeS n (VLDVec c) = do
-    pairVec (UnOp (ReshapeS n) c) dvec dvec
+vlReverseS :: VLDVec -> Build VL (VLDVec, VLSVec)
+vlReverseS (VLDVec c) = pairVec (UnOp ReverseS c) dvec svec
diff --git a/src/Database/DSH/VL/Render/Dot.hs b/src/Database/DSH/VL/Render/Dot.hs
--- a/src/Database/DSH/VL/Render/Dot.hs
+++ b/src/Database/DSH/VL/Render/Dot.hs
@@ -1,18 +1,20 @@
 {-# LANGUAGE TemplateHaskell #-}
 
-module Database.DSH.VL.Render.Dot(renderVLDot, renderTblVal) where
+module Database.DSH.VL.Render.Dot(renderVLDot) where
 
+import Prelude hiding ((<$>))
 import qualified Data.IntMap                 as Map
 import qualified Data.List.NonEmpty          as N
 import           Data.List
 
-import           Text.PrettyPrint
+import           Text.PrettyPrint.ANSI.Leijen
 
 import qualified Database.Algebra.Dag        as Dag
 import           Database.Algebra.Dag.Common as C
 
 import           Database.DSH.Common.Pretty
 import           Database.DSH.Common.Lang
+import           Database.DSH.Common.Type
 import           Database.DSH.VL.Lang
 
 nodeToDoc :: AlgNode -> Doc
@@ -22,7 +24,7 @@
 tagsToDoc ts = vcat $ map text ts
 
 labelToDoc :: AlgNode -> String -> Doc -> [Tag] -> Doc
-labelToDoc n s as ts = (nodeToDoc n) $$ ((text s) <> (parens as)) $$ (tagsToDoc $ nub ts)
+labelToDoc n s as ts = (nodeToDoc n) <$> ((text s) <> (parens as)) <$> (tagsToDoc $ nub ts)
 
 lookupTags :: AlgNode -> NodeMap [Tag] -> [Tag]
 lookupTags n m = Map.findWithDefault [] n m
@@ -35,7 +37,7 @@
 renderFrameSpec (FNPreceding n) = int n <+> text "prec"
 
 renderAggrFun :: AggrFun -> Doc
-renderAggrFun (AggrSum t c) = renderFun (text "sum" <> char '_' <> renderColumnType t) 
+renderAggrFun (AggrSum t c) = renderFun (text "sum" <> char '_' <> renderColumnType t)
                                         [renderExpr c]
 renderAggrFun (AggrMin c)   = renderFun (text "min") [renderExpr c]
 renderAggrFun (AggrMax c)   = renderFun (text "max") [renderExpr c]
@@ -57,26 +59,12 @@
 renderColumnType :: ScalarType -> Doc
 renderColumnType = text . show
 
-renderData :: [[VLVal]] -> Doc
+renderData :: [[ScalarVal]] -> Doc
 renderData [] = brackets empty
 renderData xs = (flip (<>) semi . sep . punctuate semi . map renderRow) xs
 
-renderRow :: [VLVal] -> Doc
-renderRow = hcat . punctuate comma . map renderTblVal
-
-renderTblVal :: VLVal -> Doc
-renderTblVal (VLInt i) = integer $ fromIntegral i
-renderTblVal (VLBool b) = text $ show b
-renderTblVal (VLString s) = doubleQuotes $ text $ escape s
-renderTblVal (VLDouble d) = double d
-renderTblVal VLUnit = text "()"
-
-escape :: String -> String
-escape (x@'\\':xs) = '\\':'\\':'\\':x:escape xs
-escape (x@'\'':xs) = '\\':x:escape xs
-escape (x@'"':xs) = '\\':'\\':x:escape xs
-escape (x:xs) = x:escape xs
-escape [] = []
+renderRow :: [ScalarVal] -> Doc
+renderRow = hcat . punctuate comma . map pretty
 
 bracketList :: (a -> Doc) -> [a] -> Doc
 bracketList f = brackets . hsep . punctuate comma . map f
@@ -84,48 +72,32 @@
 renderColName :: ColName -> Doc
 renderColName (ColName c) = text c
 
-renderTableType :: VLColumn -> Doc
-renderTableType (c, t) = renderColName c <> text "::" <> renderColumnType t
-
-renderTableHints :: TableHints -> Doc
-renderTableHints hs = renderTableKeys (keysHint hs) <> renderEmptiness (nonEmptyHint hs)
-
-renderEmptiness :: Emptiness -> Doc
-renderEmptiness NonEmpty      = text " NONEMPTY"
-renderEmptiness PossiblyEmpty = empty
-
-renderTableKeys :: [Key] -> Doc
-renderTableKeys [x]    = renderTableKey x
-renderTableKeys (x:xs) = renderTableKey x $$ renderTableKeys xs
-renderTableKeys []     = empty
-
-
-renderTableKey :: Key -> Doc
-renderTableKey (Key ks) = hsep $ punctuate comma $ map renderColName ks
+renderCol :: (ColName, ScalarType) -> Doc
+renderCol (c, t) = renderColName c <> text "::" <> renderColumnType t
 
 renderProj :: Doc -> Expr -> Doc
 renderProj d e = d <> colon <> renderExpr e
 
 renderJoinConjunct :: JoinConjunct Expr -> Doc
-renderJoinConjunct (JoinConjunct e1 o e2) = 
-    parenthize1 e1 <+> (text $ show o) <+> (parenthize1 e2)
+renderJoinConjunct (JoinConjunct e1 o e2) =
+    parenthize1 e1 <+> text (pp o) <+> (parenthize1 e2)
 
 renderJoinPred :: JoinPredicate Expr -> Doc
 renderJoinPred (JoinPred conjs) = brackets
-                                  $ hsep 
+                                  $ hsep
                                   $ punctuate (text "&&")
                                   $ map renderJoinConjunct $ N.toList conjs
 
 renderExpr :: Expr -> Doc
 renderExpr (BinApp op e1 e2) = (parenthize1 e1) <+> (text $ pp op) <+> (parenthize1 e2)
 renderExpr (UnApp op e)      = (text $ pp op) <+> (parens $ renderExpr e)
-renderExpr (Constant val)    = renderTblVal val
+renderExpr (Constant val)    = pretty val
 renderExpr (Column c)        = text "col" <> int c
-renderExpr (If c t e)        = text "if" 
-                                 <+> renderExpr c 
-                                 <+> text "then" 
-                                 <+> renderExpr t 
-                                 <+> text "else" 
+renderExpr (If c t e)        = text "if"
+                                 <+> renderExpr c
+                                 <+> text "then"
+                                 <+> renderExpr t
+                                 <+> text "else"
                                  <+> renderExpr e
 
 parenthize1 :: Expr -> Doc
@@ -140,19 +112,22 @@
 opDotLabel tm i (UnOp (WinFun (wfun, wspec)) _) = labelToDoc i "WinAggr"
     (renderWinFun wfun <> comma <+> renderFrameSpec wspec)
     (lookupTags i tm)
-opDotLabel tm i (NullaryOp (SingletonDescr)) = labelToDoc i "SingletonDescr" empty (lookupTags i tm)
-opDotLabel tm i (NullaryOp (Lit (em, tys, vals))) = labelToDoc i "LIT"
-        (renderEmptiness em <+> bracketList renderColumnType tys <> comma
-        $$ renderData vals) (lookupTags i tm)
-opDotLabel tm i (NullaryOp (TableRef (n, tys, hs))) = labelToDoc i "TableRef"
-        (quotes (text n) <> comma <+> bracketList (\t -> renderTableType t <> text "\n") tys <> comma $$ renderTableHints hs)
-        (lookupTags i tm)
+opDotLabel tm i (NullaryOp (Lit (_, tys, vals))) = labelToDoc i "LIT"
+        (bracketList renderColumnType tys <> comma
+        <$> renderData vals) (lookupTags i tm)
+opDotLabel tm i (NullaryOp (TableRef (n, schema))) =
+    labelToDoc i "TableScan"
+                 (text n <> text "\n"
+                  <> align (bracketList (\c -> renderCol c <> text "\n")
+                                        (N.toList $ tableCols schema)))
+                 (lookupTags i tm)
+opDotLabel tm i (UnOp Unique _) = labelToDoc i "Unique" empty (lookupTags i tm)
 opDotLabel tm i (UnOp UniqueS _) = labelToDoc i "UniqueS" empty (lookupTags i tm)
 opDotLabel tm i (UnOp Number _) = labelToDoc i "Number" empty (lookupTags i tm)
 opDotLabel tm i (UnOp NumberS _) = labelToDoc i "NumberS" empty (lookupTags i tm)
-opDotLabel tm i (UnOp UnboxRename _) = labelToDoc i "UnboxRename" empty (lookupTags i tm)
+opDotLabel tm i (UnOp UnboxKey _) = labelToDoc i "UnboxKey" empty (lookupTags i tm)
 opDotLabel tm i (UnOp Segment _) = labelToDoc i "Segment" empty (lookupTags i tm)
-opDotLabel tm i (UnOp Unsegment _) = labelToDoc i "Unsegment" empty (lookupTags i tm)
+opDotLabel tm i (UnOp Nest _) = labelToDoc i "Nest" empty (lookupTags i tm)
 opDotLabel tm i (UnOp Reverse _) = labelToDoc i "Reverse" empty (lookupTags i tm)
 opDotLabel tm i (UnOp ReverseS _) = labelToDoc i "ReverseS" empty (lookupTags i tm)
 opDotLabel tm i (UnOp R1 _) = labelToDoc i "R1" empty (lookupTags i tm)
@@ -164,28 +139,23 @@
         valCols = bracketList (\(j, p) -> renderProj (itemLabel j) p) $ zip ([1..] :: [Int]) pCols
         itemLabel j = (text "i") <> (int j)
 opDotLabel tm i (UnOp (Select e) _) = labelToDoc i "Select" (renderExpr e) (lookupTags i tm)
-opDotLabel tm i (UnOp (SelectPos1 (o, p)) _)  = labelToDoc i "SelectPos1" ((text $ show o) <+> int p) (lookupTags i tm)
-opDotLabel tm i (UnOp (SelectPos1S (o, p)) _) = labelToDoc i "SelectPos1S" ((text $ show o) <+> int p) (lookupTags i tm)
 opDotLabel tm i (UnOp (GroupAggr (g, as)) _) = labelToDoc i "GroupAggr" (bracketList renderExpr g <+> bracketList renderAggrFun (N.toList as)) (lookupTags i tm)
 opDotLabel tm i (UnOp (Aggr a) _) = labelToDoc i "Aggr" (renderAggrFun a) (lookupTags i tm)
-opDotLabel tm i (UnOp (Reshape n) _) = 
-  labelToDoc i "Reshape" (integer n) (lookupTags i tm)
 opDotLabel tm i (BinOp (AggrS a) _ _) = labelToDoc i "AggrS" (renderAggrFun a) (lookupTags i tm)
-opDotLabel tm i (UnOp (AggrNonEmpty as) _) = labelToDoc i "AggrNonEmpty" (bracketList renderAggrFun (N.toList as)) (lookupTags i tm)
-opDotLabel tm i (UnOp (AggrNonEmptyS as) _) = labelToDoc i "AggrNonEmptyS" (bracketList renderAggrFun (N.toList as)) (lookupTags i tm)
-opDotLabel tm i (UnOp (SortS cols) _) = labelToDoc i "Sort" (bracketList renderExpr cols) (lookupTags i tm)
+opDotLabel tm i (UnOp (Sort cols) _) = labelToDoc i "Sort" (bracketList renderExpr cols) (lookupTags i tm)
+opDotLabel tm i (UnOp (SortS cols) _) = labelToDoc i "SortS" (bracketList renderExpr cols) (lookupTags i tm)
+opDotLabel tm i (UnOp (Group cols) _) = labelToDoc i "Group" (bracketList renderExpr cols) (lookupTags i tm)
 opDotLabel tm i (UnOp (GroupS cols) _) = labelToDoc i "GroupS" (bracketList renderExpr cols) (lookupTags i tm)
 opDotLabel tm i (BinOp NestProduct _ _) = labelToDoc i "NestProduct" empty (lookupTags i tm)
 opDotLabel tm i (BinOp DistLift _ _) = labelToDoc i "DistLift" empty (lookupTags i tm)
-opDotLabel tm i (BinOp PropRename _ _) = labelToDoc i "PropRename" empty (lookupTags i tm)
-opDotLabel tm i (BinOp UnboxNested _ _) = labelToDoc i "UnboxNested" empty (lookupTags i tm)
-opDotLabel tm i (BinOp UnboxScalar _ _) = labelToDoc i "UnboxScalar" empty (lookupTags i tm)
-opDotLabel tm i (BinOp PropFilter _ _) = labelToDoc i "PropFilter" empty (lookupTags i tm)
-opDotLabel tm i (BinOp PropReorder _ _) = labelToDoc i "PropReorder" empty (lookupTags i tm)
+opDotLabel tm i (BinOp DistSng _ _) = labelToDoc i "DistSng" empty (lookupTags i tm)
+opDotLabel tm i (BinOp UnboxSng _ _) = labelToDoc i "UnboxSng" empty (lookupTags i tm)
+opDotLabel tm i (BinOp AppSort _ _) = labelToDoc i "AppSort" empty (lookupTags i tm)
+opDotLabel tm i (BinOp AppKey _ _) = labelToDoc i "AppKey" empty (lookupTags i tm)
+opDotLabel tm i (BinOp AppFilter _ _) = labelToDoc i "AppFilter" empty (lookupTags i tm)
+opDotLabel tm i (BinOp AppRep _ _) = labelToDoc i "AppRep" empty (lookupTags i tm)
 opDotLabel tm i (BinOp Append _ _) = labelToDoc i "Append" empty (lookupTags i tm)
 opDotLabel tm i (BinOp AppendS _ _) = labelToDoc i "AppendS" empty (lookupTags i tm)
-opDotLabel tm i (BinOp (SelectPos o) _ _) = labelToDoc i "SelectPos" (text $ show o) (lookupTags i tm)
-opDotLabel tm i (BinOp (SelectPosS o) _ _) = labelToDoc i "SelectPosS" (text $ show o) (lookupTags i tm)
 opDotLabel tm i (BinOp Zip _ _) = labelToDoc i "Zip" empty (lookupTags i tm)
 opDotLabel tm i (BinOp Align _ _) = labelToDoc i "Align" empty (lookupTags i tm)
 opDotLabel tm i (BinOp ZipS _ _) = labelToDoc i "ZipS" empty (lookupTags i tm)
@@ -208,48 +178,45 @@
   labelToDoc i "AntiJoin" (renderJoinPred p) (lookupTags i tm)
 opDotLabel tm i (BinOp (AntiJoinS p) _ _) =
   labelToDoc i "AntiJoinS" (renderJoinPred p) (lookupTags i tm)
-opDotLabel tm i (UnOp (ReshapeS n) _) = 
-  labelToDoc i "ReshapeS" (integer n) (lookupTags i tm)
-opDotLabel tm i (UnOp Transpose _) = labelToDoc i "Transpose" empty (lookupTags i tm)
+opDotLabel tm i (BinOp (GroupJoin (p, a)) _ _) =
+  labelToDoc i "GroupJoin" (renderJoinPred p <+> renderAggrFun a) (lookupTags i tm)
 opDotLabel tm i (TerOp Combine _ _ _) = labelToDoc i "Combine" empty (lookupTags i tm)
-opDotLabel tm i (BinOp TransposeS _ _) = labelToDoc i "TransposeS" empty (lookupTags i tm)
 
 opDotColor :: VL -> DotColor
-opDotColor (BinOp NestProduct _ _)       = DCRed
-opDotColor (BinOp CartProduct _ _)       = DCRed
-opDotColor (BinOp CartProductS _ _)      = DCRed
-opDotColor (BinOp NestProductS _ _)      = DCRed
-opDotColor (BinOp (ThetaJoin _) _ _)     = DCGreen
-opDotColor (BinOp (NestJoin _) _ _)      = DCGreen
-opDotColor (BinOp (ThetaJoinS _) _ _)    = DCGreen
-opDotColor (BinOp (NestJoinS _) _ _)     = DCGreen
-opDotColor (BinOp (SemiJoin _) _ _)      = DCGreen
-opDotColor (BinOp (SemiJoinS _) _ _)     = DCGreen
-opDotColor (BinOp (AntiJoin _) _ _)      = DCGreen
-opDotColor (BinOp (AntiJoinS _) _ _)     = DCGreen
-opDotColor (BinOp Zip _ _)               = DCYelloGreen
-opDotColor (UnOp (SortS _) _)            = DCTomato
-opDotColor (UnOp (GroupS _) _)           = DCTomato
-opDotColor (BinOp PropRename _ _)        = DCTan
-opDotColor (BinOp UnboxNested _ _)       = DCTan
-opDotColor (BinOp UnboxScalar _ _)       = DCTan
-opDotColor (BinOp PropReorder _ _)       = DCTan
-opDotColor (BinOp DistLift _ _)          = DCTan
-opDotColor (BinOp Align _ _)             = DCTan
-opDotColor (TerOp Combine _ _ _)         = DCDodgerBlue
-opDotColor (UnOp (Select _) _)           = DCLightSkyBlue
-opDotColor (UnOp (Aggr _) _)             = DCCrimson
-opDotColor (BinOp (AggrS _) _ _)         = DCCrimson
-opDotColor (UnOp (WinFun _) _)           = DCTomato
-opDotColor (UnOp (AggrNonEmpty _) _)     = DCCrimson
-opDotColor (UnOp (AggrNonEmptyS _) _)    = DCCrimson
-opDotColor (UnOp (GroupAggr (_, _)) _)   = DCTomato
-opDotColor (UnOp (Project _) _)          = DCLightSkyBlue
-opDotColor (UnOp Transpose _)            = DCHotPink
-opDotColor (BinOp TransposeS _ _)        = DCHotPink
-opDotColor (UnOp (ReshapeS _) _)         = DCHotPink
-opDotColor (UnOp (Reshape _) _)          = DCHotPink
-opDotColor _                             = DCGray
+opDotColor (BinOp NestProduct _ _)     = DCRed
+opDotColor (BinOp CartProduct _ _)     = DCRed
+opDotColor (BinOp CartProductS _ _)    = DCRed
+opDotColor (BinOp NestProductS _ _)    = DCRed
+opDotColor (BinOp (ThetaJoin _) _ _)   = DCGreen
+opDotColor (BinOp (NestJoin _) _ _)    = DCGreen
+opDotColor (BinOp (ThetaJoinS _) _ _)  = DCGreen
+opDotColor (BinOp (NestJoinS _) _ _)   = DCGreen
+opDotColor (BinOp (SemiJoin _) _ _)    = DCGreen
+opDotColor (BinOp (SemiJoinS _) _ _)   = DCGreen
+opDotColor (BinOp (AntiJoin _) _ _)    = DCGreen
+opDotColor (BinOp (AntiJoinS _) _ _)   = DCGreen
+opDotColor (BinOp (GroupJoin _) _ _)   = DCGreen
+opDotColor (BinOp Zip _ _)             = DCYelloGreen
+opDotColor (UnOp (Sort _) _)           = DCTomato
+opDotColor (UnOp (SortS _) _)          = DCTomato
+opDotColor (UnOp (Group _) _)          = DCTomato
+opDotColor (UnOp (GroupS _) _)         = DCTomato
+opDotColor (BinOp UnboxSng _ _)     = DCTan
+opDotColor (BinOp AppSort _ _)         = DCTan
+opDotColor (BinOp AppKey _ _)          = DCTan
+opDotColor (BinOp AppFilter _ _)       = DCTan
+opDotColor (BinOp AppRep _ _)          = DCTan
+opDotColor (BinOp DistLift _ _)        = DCTan
+opDotColor (BinOp DistSng _ _)         = DCTan
+opDotColor (BinOp Align _ _)           = DCTan
+opDotColor (TerOp Combine _ _ _)       = DCDodgerBlue
+opDotColor (UnOp (Select _) _)         = DCLightSkyBlue
+opDotColor (UnOp (Aggr _) _)           = DCCrimson
+opDotColor (BinOp (AggrS _) _ _)       = DCCrimson
+opDotColor (UnOp (WinFun _) _)         = DCTomato
+opDotColor (UnOp (GroupAggr (_, _)) _) = DCTomato
+opDotColor (UnOp (Project _) _)        = DCLightSkyBlue
+opDotColor _                           = DCGray
 
 -- Dot colors
 data DotColor = DCTomato
@@ -270,20 +237,20 @@
               | DCHotPink
 
 renderColor :: DotColor -> Doc
-renderColor DCTomato = text "tomato"
-renderColor DCSalmon = text "salmon"
-renderColor DCGray = text "gray"
-renderColor DimDCGray = text "dimgray"
-renderColor DCGold = text "gold"
-renderColor DCTan = text "tan"
-renderColor DCRed = text "red"
-renderColor DCCrimson = text "crimson"
-renderColor DCGreen = text "green"
-renderColor DCSeaGreen = text "seagreen"
-renderColor DCYelloGreen = text "yellowgreen"
-renderColor DCSienna = text "sienna"
-renderColor DCBeige = text "beige"
-renderColor DCDodgerBlue = text "dodgerblue"
+renderColor DCTomato       = text "tomato"
+renderColor DCSalmon       = text "salmon"
+renderColor DCGray         = text "gray"
+renderColor DimDCGray      = text "dimgray"
+renderColor DCGold         = text "gold"
+renderColor DCTan          = text "tan"
+renderColor DCRed          = text "red"
+renderColor DCCrimson      = text "crimson"
+renderColor DCGreen        = text "green"
+renderColor DCSeaGreen     = text "seagreen"
+renderColor DCYelloGreen   = text "yellowgreen"
+renderColor DCSienna       = text "sienna"
+renderColor DCBeige        = text "beige"
+renderColor DCDodgerBlue   = text "dodgerblue"
 renderColor DCLightSkyBlue = text "lightskyblue"
 renderColor DCHotPink      = text "hotpink"
 
@@ -313,20 +280,20 @@
 
 -- Generate the preamble of a Dot file
 preamble :: Doc
-preamble = graphAttributes $$ nodeAttributes
+preamble = graphAttributes <$> nodeAttributes
     where nodeAttributes = text "node" <+> (brackets $ text "style=filled" <> comma <+> text "shape=box") <> semi
           graphAttributes = text "ordering=out;"
 
 renderDotNode :: DotNode -> Doc
 renderDotNode (DotNode n l c s) =
     int n
-    <+> (brackets $ (((text "label=") <> (doubleQuotes $ text l))
+    <+> (brackets $ (((text "label=") <> (dquotes $ text l))
                      <> comma
                      <+> (text "color=") <> (renderColor c)
                      <> styleDoc))
     <> semi
-    where styleDoc =
-              case s of
+  where
+    styleDoc = case s of
                   Just Dashed -> comma <+> text "style=dashed"
                   Nothing     -> empty
 
@@ -335,9 +302,10 @@
 
 -- | Render a Dot document from the preamble, nodes and edges
 renderDot :: [DotNode] -> [DotEdge] -> Doc
-renderDot ns es = text "digraph" <> (braces $ preamble $$ nodeSection $$ edgeSection)
-    where nodeSection = vcat $ map renderDotNode ns
-          edgeSection = vcat $ map renderDotEdge es
+renderDot ns es = text "digraph" <> (braces $ preamble <$> nodeSection <$> edgeSection)
+  where
+    nodeSection = vcat $ map renderDotNode ns
+    edgeSection = vcat $ map renderDotEdge es
 
 -- | Create an abstract Dot node from an X100 operator description
 constructDotNode :: [AlgNode] -> NodeMap [Tag] -> (AlgNode, VL) -> DotNode
@@ -346,8 +314,9 @@
         DotNode n l c (Just Dashed)
     else
         DotNode n l c Nothing
-    where l = escapeLabel $ render $ opDotLabel ts n op
-          c = opDotColor op
+  where
+    l = escapeLabel $ pp $ opDotLabel ts n op
+    c = opDotColor op
 
 -- | Create an abstract Dot edge
 constructDotEdge :: (AlgNode, AlgNode) -> DotEdge
@@ -358,14 +327,16 @@
 extractGraphStructure :: Dag.AlgebraDag VL
                      -> ([(AlgNode, VL)], [(AlgNode, AlgNode)])
 extractGraphStructure d = (operators, childs)
-    where nodes = Dag.topsort d
-          operators = zip nodes $ map (flip Dag.operator d) nodes
-          childs = concat $ map (\(n, op) -> zip (repeat n) (Dag.opChildren op)) operators
+  where
+    nodes = Dag.topsort d
+    operators = zip nodes $ map (flip Dag.operator d) nodes
+    childs = concat $ map (\(n, op) -> zip (repeat n) (Dag.opChildren op)) operators
 
 -- | Render an VL plan into a dot file (GraphViz).
 renderVLDot :: NodeMap [Tag] -> [AlgNode] -> NodeMap VL -> String
-renderVLDot ts roots m = render $ renderDot dotNodes dotEdges
-    where (opLabels, edges) = extractGraphStructure d
-          d = Dag.mkDag m roots
-          dotNodes = map (constructDotNode roots ts) opLabels
-          dotEdges = map constructDotEdge edges
+renderVLDot ts roots m = pp $ renderDot dotNodes dotEdges
+  where
+    (opLabels, edges) = extractGraphStructure d
+    d = Dag.mkDag m roots
+    dotNodes = map (constructDotNode roots ts) opLabels
+    dotEdges = map constructDotEdge edges
diff --git a/src/Database/DSH/VL/Render/JSON.hs b/src/Database/DSH/VL/Render/JSON.hs
deleted file mode 100644
--- a/src/Database/DSH/VL/Render/JSON.hs
+++ /dev/null
@@ -1,41 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-
-module Database.DSH.VL.Render.JSON
-    ( serializePlan
-    , deserializePlan
-    , planToFile
-    , planFromFile
-    ) where
-
-import           Control.Monad
-import qualified Data.IntMap                 as M
-
-import           Data.Aeson                  (decode, encode)
-import           Data.Aeson.TH
-import qualified Data.ByteString.Lazy.Char8  as BL
-
-import           Database.Algebra.Dag.Common
-
-import           Database.DSH.VL.Lang
-
-data Plan = Plan { tags :: [(AlgNode, [Tag])]
-                 , roots :: [AlgNode]
-                 , graph :: [(AlgNode, VL)]
-                 }
-
-$(deriveJSON defaultOptions ''Plan)
-
-serializePlan :: (NodeMap [Tag], [AlgNode], NodeMap VL) -> BL.ByteString
-serializePlan (ts, rs, g) = let tags' = M.toList ts
-                                graph' = M.toList g
-                             in encode $ Plan {tags = tags', roots = rs, graph = graph'}
-
-deserializePlan :: BL.ByteString -> (NodeMap [Tag], [AlgNode], NodeMap VL)
-deserializePlan s = let Just (Plan ts rs g) = decode s
-                    in (M.fromList ts, rs, M.fromList g)
-
-planToFile :: FilePath -> (NodeMap [Tag], [AlgNode], NodeMap VL) -> IO ()
-planToFile f t = BL.writeFile f $ serializePlan t
-
-planFromFile :: FilePath -> IO (NodeMap [Tag], [AlgNode], NodeMap VL)
-planFromFile f = liftM deserializePlan $ BL.readFile f
diff --git a/src/Database/DSH/VL/Vector.hs b/src/Database/DSH/VL/Vector.hs
deleted file mode 100644
--- a/src/Database/DSH/VL/Vector.hs
+++ /dev/null
@@ -1,72 +0,0 @@
-{-# LANGUAGE TemplateHaskell      #-}
-{-# LANGUAGE TypeSynonymInstances #-}
-{-# LANGUAGE FlexibleInstances    #-}
-
--- | This module defines the kinds of vectors that occur in VL
--- programs.
-module Database.DSH.VL.Vector
-    ( DBCol
-    , DagVector
-    , vectorNodes
-    , updateVector
-    , ADVec(..)
-    , VLDVec(..)
-    , NDVec
-    , PVec(..)
-    , RVec(..)
-    ) where
-
-import           Data.Aeson.TH
-
-import           Database.Algebra.Dag.Common
-
-import           Database.DSH.VL.Lang
-
--- | Common properties of data vectors
-class DagVector v where
-    -- | Return all graph nodes which represent the vector.
-    vectorNodes :: v -> [AlgNode]
-
-    -- | Replace a node in the vector
-    updateVector :: AlgNode -> AlgNode -> v -> v
-
--- | Data vectors. A data vector references a result in an algebra DAG
--- and stores the number of payload columns that it has. 'ADVec'
--- abstracts over the type of references into the graph.
-data ADVec r = ADVec r [DBCol]
-    deriving (Show, Read)
-
--- | Data vectors that reference single nodes in an algebra graph
--- (used for table algebra and X100 with an n-ary storage model).
-type NDVec = ADVec AlgNode
-
-instance DagVector NDVec where
-    vectorNodes (ADVec q _) = [q]
-
-    updateVector n1 n2 (ADVec q cols) 
-        | q == n1   = ADVec n2 cols
-        | otherwise = ADVec q cols
-
--- | A VL data vector references an operator in a VL DAG.
-newtype VLDVec = VLDVec AlgNode
-    deriving (Show, Read)
-
-instance DagVector VLDVec where
-    vectorNodes (VLDVec q) = [q]
-
-    updateVector n1 n2 (VLDVec q) 
-        | q == n1   = VLDVec n2
-        | otherwise = VLDVec q
-
-
--- | Propagation vectors. A @PVec@ simply references a node in an
--- algebra Dag.
-data PVec = PVec AlgNode
-
--- | Rename vectors. A @RVec@ simply references a node in an algebra
--- Dag.
-data RVec = RVec AlgNode
-
-$(deriveJSON defaultOptions ''ADVec)
-$(deriveJSON defaultOptions ''PVec)
-$(deriveJSON defaultOptions ''RVec)
diff --git a/src/Database/DSH/VL/VectorAlgebra.hs b/src/Database/DSH/VL/VectorAlgebra.hs
--- a/src/Database/DSH/VL/VectorAlgebra.hs
+++ b/src/Database/DSH/VL/VectorAlgebra.hs
@@ -1,91 +1,88 @@
+{-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 
 module Database.DSH.VL.VectorAlgebra where
 
 import qualified Data.List.NonEmpty              as N
 import           Database.DSH.Common.Lang
-import           Database.DSH.VL.Vector
+import           Database.DSH.Common.Type
 import           Database.DSH.VL.Lang
 import           Database.Algebra.Dag.Build
 
-class VectorAlgebra v a where
-    -- | A vector with one segment
-    singletonDescr :: Build a v
+class VectorAlgebra a where
+    -- | Data Vector
+    type DVec a
 
+    -- | Re-Keying Vector
+    type KVec a
+
+    -- | Replication Vector
+    type RVec a
+
+    -- | Sorting Vector
+    type SVec a
+
+    -- | Filtering Vector
+    type FVec a
+
+    -- | Turn a flat vector into a nested vector with one segment.
+    vecNest :: DVec a -> Build a (DVec a, DVec a)
+
     -- | A vector representing a literal list.
-    vecLit :: [ScalarType] -> [[VLVal]] -> Build a v
+    vecLit :: [ScalarType] -> [[ScalarVal]] -> Build a (DVec a)
 
     -- | A reference to a database-resident table.
-    vecTableRef :: String -> [VLColumn] -> TableHints -> Build a v
+    vecTableRef :: String -> BaseTableSchema -> Build a (DVec a)
 
+    -- | Eliminate duplicates
+    vecUnique :: DVec a -> Build a (DVec a)
+
     -- | Perform duplicate elimination per segment.
-    vecUniqueS :: v -> Build a v
+    vecUniqueS :: DVec a -> Build a (DVec a)
 
     -- | /Materialize/ vector positions. The operator adds an item
     -- column that contains the dense positions of the vector's
     -- elements.
-    vecNumber :: v -> Build a v
+    vecNumber :: DVec a -> Build a (DVec a)
 
     -- | /Materialize/ vector positions per segment. The operator adds
     -- an item column that contains the dense positions of the
     -- vector's elements in each segment.
-    vecNumberS :: v -> Build a v
+    vecNumberS :: DVec a -> Build a (DVec a)
 
-    descToRename :: v -> Build a RVec
+    vecUnboxKey :: DVec a -> Build a (KVec a)
 
     -- | From a vector with only one segment, create a segmented
     -- version in which every value in the original segment inhabits
     -- its own segment.
-    vecSegment :: v -> Build a v
-
-    vecUnsegment :: v -> Build a v
-
-    vecAggr :: AggrFun -> v -> Build a v
-    vecAggrS :: AggrFun -> v -> v -> Build a v
-    vecAggrNonEmpty :: N.NonEmpty AggrFun -> v -> Build a v
-    vecAggrNonEmptyS :: N.NonEmpty AggrFun -> v -> Build a v
-
-    vecWinFun :: WinFun -> FrameSpec -> v -> Build a v
-
-    -- | SelectPos filters a vector positionally as specified by the
-    -- comparison operator and the position value from the right
-    -- input. Next to the filtered value vector it produces two rename
-    -- vectors:
-    --
-    -- * Mapping old to new positions (for re-aligning inner vectors)
-    -- * Mapping old positions to segment descriptors (for unboxing one
-    -- inner segment)
-    -- FIXME should be restricted to RelOp!
-    vecSelectPos :: v -> ScalarBinOp -> v -> Build a (v, RVec, RVec)
-
-    -- | Filter a vector positionally /by segment/. The right input
-    -- vector provides a position offset /for each segment/. The
-    -- operator produces the same triple of vectors as its non-segmented
-    -- variant.
-    vecSelectPosS :: v -> ScalarBinOp -> v -> Build a (v, RVec, RVec)
+    vecSegment :: DVec a -> Build a (DVec a, DVec a)
 
-    -- | Filter a vector positionally on a /constant/ position.
-    vecSelectPos1 :: v -> ScalarBinOp -> Int -> Build a (v, RVec, RVec)
+    vecAggr :: AggrFun -> DVec a -> Build a (DVec a)
+    vecAggrS :: AggrFun -> DVec a -> DVec a -> Build a (DVec a)
 
-    -- | Filter a vector positionally based on a /constant
-    -- position/. The operator filters by segment, but the constant
-    -- position argument is the same for all segments.
-    vecSelectPos1S :: v -> ScalarBinOp -> Int -> Build a (v, RVec, RVec)
+    vecWinFun :: WinFun -> FrameSpec -> DVec a -> Build a (DVec a)
 
     -- | Reverse a vector.
-    vecReverse :: v -> Build a (v, PVec)
+    vecReverse :: DVec a -> Build a (DVec a, SVec a)
 
     -- | Reverse each segment of a vector individually.
-    vecReverseS :: v -> Build a (v, PVec)
+    vecReverseS :: DVec a -> Build a (DVec a, SVec a)
 
     -- | Filter a vector by applying a scalar boolean predicate.
-    vecSelect:: Expr -> v -> Build a (v, RVec)
+    vecSelect:: Expr -> DVec a -> Build a (DVec a, FVec a)
 
-    -- | Segmented sorting of a vector. 
-    vecSortS :: [Expr] -> v -> Build a (v, PVec)
+    -- | Sort a vector
+    vecSort :: [Expr] -> DVec a -> Build a (DVec a, SVec a)
 
-    vecGroupS :: [Expr] -> v -> Build a (v, v, PVec)
+    -- | Per-segment sorting of a vector.
+    vecSortS :: [Expr] -> DVec a -> Build a (DVec a, SVec a)
 
+    -- | Regular grouping of a vector
+    vecGroup :: [Expr] -> DVec a -> Build a (DVec a, DVec a, SVec a)
+
+    -- | Per-segment grouping of a vector
+    vecGroupS :: [Expr] -> DVec a -> Build a (DVec a, DVec a, SVec a)
+
     -- | The VL aggregation operator groups the input vector by the
     -- given columns and then performs the list of aggregations
     -- described by the second argument. The result is a flat vector,
@@ -95,94 +92,64 @@
     -- complete set of descr value to check for empty inner lists.
     -- The output payload columns are the grouping columns followed by
     -- the aggregation results.
-    vecGroupAggr :: [Expr] -> N.NonEmpty AggrFun -> v -> Build a v
+    vecGroupAggr :: [Expr] -> N.NonEmpty AggrFun -> DVec a -> Build a (DVec a)
 
 
     -- | Construct a new vector as the result of a list of scalar
     -- expressions per result column.
-    vecProject :: [Expr] -> v -> Build a v
+    vecProject :: [Expr] -> DVec a -> Build a (DVec a)
 
     -- FIXME is distprim really necessary? could maybe be replaced by distdesc
-    vecDistDesc :: v -> v -> Build a (v, PVec)
-    vecDistLift :: v -> v -> Build a (v, PVec)
+    vecDistLift :: DVec a -> DVec a -> Build a (DVec a, RVec a)
 
-    -- | propRename uses a propagation vector to rename a vector (no
-    -- filtering or reordering).
-    vecPropRename :: RVec -> v -> Build a v
+    vecDistSng :: DVec a -> DVec a -> Build a (DVec a, RVec a)
 
-    -- | propFilter uses a propagation vector to rename and filter a
-    -- vector (no reordering).
-    vecPropFilter :: RVec -> v -> Build a (v, RVec)
+    -- | Apply a sorting vector to a data vector
+    vecAppSort   :: SVec a -> DVec a -> Build a (DVec a, SVec a)
 
-    -- | propReorder uses a propagation vector to rename, filter and
-    -- reorder a vector.
-    vecPropReorder :: PVec -> v -> Build a (v, PVec)
+    -- | Apply a filter vector to a data vector
+    vecAppFilter :: FVec a -> DVec a -> Build a (DVec a, FVec a)
 
-    -- | Specialized unbox operator that merges DescrToRename
-    -- and PropRename. It takes an inner and outer vector, and
-    -- pulls the segment that is referenced by the outer vector
-    -- into the outer segment. Notice that there must be
-    -- /exactly one/ segment referenced by the outer
-    -- vector. Inner segments that are not referenced are
-    -- silently discarded.
-    --
-    -- Output: @(DVec r, RVec)@
-    vecUnboxNested :: RVec -> v -> Build a (v, RVec)
+    -- | Apply a rekeying vector to a data vector
+    vecAppKey    :: KVec a -> DVec a -> Build a (DVec a, KVec a)
 
-    vecUnboxScalar :: v -> v -> Build a v
+    -- | Apply a replication vector to a data vector
+    vecAppRep    :: RVec a -> DVec a -> Build a (DVec a, RVec a)
 
-    vecAppend :: v -> v -> Build a (v, RVec, RVec)
-    vecAppendS :: v -> v -> Build a (v, RVec, RVec)
+    vecUnboxSng :: DVec a -> DVec a -> Build a (DVec a, KVec a)
 
+    vecAppend :: DVec a -> DVec a -> Build a (DVec a, KVec a, KVec a)
+    vecAppendS :: DVec a -> DVec a -> Build a (DVec a, KVec a, KVec a)
+
     -- | Align two vectors positionally. However, in contrast to
     -- 'vecZip', these are not arbitrary vectors, but vectors which
     -- are guaranteed to have the same length because they are
     -- operands to lifted operators.
-    vecAlign :: v -> v -> Build a v
+    vecAlign :: DVec a -> DVec a -> Build a (DVec a)
 
     -- | Positionally align two vectors. Basically: @zip xs ys@
-    vecZip :: v -> v -> Build a v
+    vecZip :: (DVec a) -> DVec a -> Build a (DVec a, KVec a, KVec a)
 
     -- | Positionally align two vectors per segment: @map zip xss
     -- yss@.
-    vecZipS :: v -> v -> Build a (v, RVec, RVec)
-
-    vecCartProduct :: v -> v -> Build a (v, PVec, PVec)
-    vecCartProductS :: v -> v -> Build a (v, PVec, PVec)
-    vecNestProduct :: v -> v -> Build a (v, PVec, PVec)
-    -- FIXME inner result vector contains the outer values. Produce a
-    -- propagation vector to align the layout.
-    vecNestProductS :: v -> v -> Build a (v, PVec)
-
-    vecThetaJoin :: JoinPredicate Expr -> v -> v -> Build a (v, PVec, PVec)
-    vecNestJoin :: JoinPredicate Expr -> v -> v -> Build a (v, PVec, PVec)
-    vecThetaJoinS :: JoinPredicate Expr -> v -> v -> Build a (v, PVec, PVec)
-    vecNestJoinS :: JoinPredicate Expr -> v -> v -> Build a (v, PVec)
-
-    vecSemiJoin :: JoinPredicate Expr -> v -> v -> Build a (v, RVec)
-    vecSemiJoinS :: JoinPredicate Expr -> v -> v -> Build a (v, RVec)
-
-    vecAntiJoin :: JoinPredicate Expr -> v -> v -> Build a (v, RVec)
-    vecAntiJoinS :: JoinPredicate Expr -> v -> v -> Build a (v, RVec)
+    vecZipS :: DVec a -> DVec a -> Build a (DVec a, KVec a, KVec a)
 
-    vecCombine :: v -> v -> v -> Build a (v, RVec, RVec)
+    vecCartProduct :: DVec a -> DVec a -> Build a (DVec a, RVec a, RVec a)
+    vecCartProductS :: DVec a -> DVec a -> Build a (DVec a, RVec a, RVec a)
+    vecNestProduct :: DVec a -> DVec a -> Build a (DVec a, RVec a, RVec a)
+    vecNestProductS :: DVec a -> DVec a -> Build a (DVec a, RVec a, RVec a)
 
-    -- | Experimental: @reshape m@ partitions a vector of length @n*m@
-    -- into @n@ vectors of length @m@.
-    --
-    -- reshapeS can be computed only on the inner vector. As its
-    -- result is one list nesting level deeper, it computes the new
-    -- innermost vector from the old inner vector and then derives
-    -- from that a 'middle' descriptor vector which represents lists
-    -- at nesting depth 1.
-    vecReshape :: Integer -> v -> Build a (v, v)
+    vecThetaJoin :: JoinPredicate Expr -> DVec a -> DVec a -> Build a (DVec a, RVec a, RVec a)
+    vecNestJoin :: JoinPredicate Expr -> DVec a -> DVec a -> Build a (DVec a, RVec a, RVec a)
+    vecThetaJoinS :: JoinPredicate Expr -> DVec a -> DVec a -> Build a (DVec a, RVec a, RVec a)
+    vecNestJoinS :: JoinPredicate Expr -> DVec a -> DVec a -> Build a (DVec a, RVec a, RVec a)
 
-    -- | Experimental: segmented version of reshape.
-    vecReshapeS :: Integer -> v -> Build a (v, v)
+    vecGroupJoin :: JoinPredicate Expr -> AggrFun -> DVec a -> DVec a -> Build a (DVec a)
 
-    -- | Experimental: Matrix transposition
-    vecTranspose :: v -> Build a (v, v)
+    vecSemiJoin :: JoinPredicate Expr -> DVec a -> DVec a -> Build a (DVec a, FVec a)
+    vecSemiJoinS :: JoinPredicate Expr -> DVec a -> DVec a -> Build a (DVec a, FVec a)
 
-    -- | Experimental: Segmented matrix transposition
-    vecTransposeS :: v -> v -> Build a (v, v)
+    vecAntiJoin :: JoinPredicate Expr -> DVec a -> DVec a -> Build a (DVec a, FVec a)
+    vecAntiJoinS :: JoinPredicate Expr -> DVec a -> DVec a -> Build a (DVec a, FVec a)
 
+    vecCombine :: DVec a -> DVec a -> DVec a -> Build a (DVec a, KVec a, KVec a)
diff --git a/src/Database/DSH/VL/VectorAlgebra/TA.hs b/src/Database/DSH/VL/VectorAlgebra/TA.hs
deleted file mode 100644
--- a/src/Database/DSH/VL/VectorAlgebra/TA.hs
+++ /dev/null
@@ -1,908 +0,0 @@
-{-# LANGUAGE FlexibleInstances     #-}
-{-# LANGUAGE ParallelListComp      #-}
-{-# LANGUAGE TemplateHaskell       #-}
-{-# LANGUAGE TypeSynonymInstances  #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-
--- | Implementation of vector primitives in terms of table algebra
--- operators.
-module Database.DSH.VL.VectorAlgebra.TA () where
-
-import           Control.Applicative              hiding (Const)
-import qualified Data.List.NonEmpty               as N
-import           GHC.Exts
-
-import           Database.Algebra.Dag.Build
-import           Database.Algebra.Dag.Common
-import           Database.Algebra.Table.Construct
-import           Database.Algebra.Table.Lang
-
-import qualified Database.DSH.Common.Lang         as L
-import           Database.DSH.Impossible
-import           Database.DSH.VL.Vector
-import qualified Database.DSH.VL.Lang             as VL
-import           Database.DSH.VL.VectorAlgebra
-
-
---------------------------------------------------------------------------------
--- Some general helpers
-
--- | Results are stored in column:
-pos, item', item, descr, descr', descr'', pos', pos'', pos''', posold, posnew, ordCol, resCol, absPos, descri, descro, posi, poso:: Attr
-pos       = "pos"
-item      = "item1"
-item'     = "itemtmp"
-descr     = "descr"
-descr'    = "descr1"
-descr''   = "descr2"
-pos'      = "pos1"
-pos''     = "pos2"
-pos'''    = "pos3"
-posold    = "posold"
-posnew    = "posnew"
-ordCol    = "ord"
-resCol    = "res"
-absPos    = "abspos"
-descro    = "descro"
-descri    = "descri"
-poso      = "poso"
-posi      = "posi"
-
-itemi :: Int -> Attr
-itemi i = "item" ++ show i
-
-itemi' :: Int -> Attr
-itemi' i = "itemtmp" ++ show i
-
-algVal :: VL.VLVal -> AVal
-algVal (VL.VLInt i) = int (fromIntegral i)
-algVal (VL.VLBool t) = bool t
-algVal VL.VLUnit = int (-1)
-algVal (VL.VLString s) = string s
-algVal (VL.VLDouble d) = double d
-
-algTy :: VL.ScalarType -> ATy
-algTy (VL.Int)    = intT
-algTy (VL.Double) = doubleT
-algTy (VL.Bool)   = boolT
-algTy (VL.String) = stringT
-algTy (VL.Unit)   = intT
-
-cP :: Attr -> Proj
-cP a = (a, ColE a)
-
-eP :: Attr -> Expr -> Proj
-eP = (,)
-
-mP :: Attr -> Attr -> Proj
-mP n o = (n, ColE o)
-
-projAddCols :: [DBCol] -> [Proj] -> AlgNode -> Build TableAlgebra AlgNode
-projAddCols cols projs q = proj ([cP descr, cP pos] ++ map (cP . itemi) cols ++ projs) q
-
-itemProj :: [DBCol] -> [Proj] -> [Proj]
-itemProj cols projs = projs ++ [ cP $ itemi i | i <- cols ]
-
-binOp :: L.ScalarBinOp -> BinFun
-binOp (L.SBNumOp L.Add)     = Plus
-binOp (L.SBNumOp L.Sub)     = Minus
-binOp (L.SBNumOp L.Div)     = Div
-binOp (L.SBNumOp L.Mul)     = Times
-binOp (L.SBNumOp L.Mod)     = Modulo
-binOp (L.SBRelOp L.Eq)      = Eq
-binOp (L.SBRelOp L.NEq)     = NEq
-binOp (L.SBRelOp L.Gt)      = Gt
-binOp (L.SBRelOp L.GtE)     = GtE
-binOp (L.SBRelOp L.Lt)      = Lt
-binOp (L.SBRelOp L.LtE)     = LtE
-binOp (L.SBBoolOp L.Conj)   = And
-binOp (L.SBBoolOp L.Disj)   = Or
-binOp (L.SBStringOp L.Like) = Like
-
-unOp :: L.ScalarUnOp -> UnFun
-unOp (L.SUBoolOp L.Not)             = Not
-unOp (L.SUCastOp (L.CastDouble))    = Cast doubleT
-unOp (L.SUNumOp L.Sin)              = Sin
-unOp (L.SUNumOp L.Cos)              = Cos
-unOp (L.SUNumOp L.Tan)              = Tan
-unOp (L.SUNumOp L.ASin)             = ASin
-unOp (L.SUNumOp L.ACos)             = ACos
-unOp (L.SUNumOp L.ATan)             = ATan
-unOp (L.SUNumOp L.Sqrt)             = Sqrt
-unOp (L.SUNumOp L.Exp)              = Exp
-unOp (L.SUNumOp L.Log)              = Log
-unOp (L.SUTextOp (L.SubString f t)) = SubString f t
-unOp L.SUDateOp                     = $unimplemented
-
-taExprOffset :: Int -> VL.Expr -> Expr
-taExprOffset o (VL.BinApp op e1 e2) = BinAppE (binOp op) (taExprOffset o e1) (taExprOffset o e2)
-taExprOffset o (VL.UnApp op e)      = UnAppE (unOp op) (taExprOffset o e)
-taExprOffset o (VL.Column c)        = ColE $ itemi $ c + o
-taExprOffset _ (VL.Constant v)      = ConstE $ algVal v
-taExprOffset o (VL.If c t e)        = IfE (taExprOffset o c) (taExprOffset o t) (taExprOffset o e)
-
-taExpr :: VL.Expr -> Expr
-taExpr = taExprOffset 0
-
-aggrFun :: VL.AggrFun -> AggrType
-aggrFun (VL.AggrSum _ e) = Sum $ taExpr e
-aggrFun (VL.AggrMin e)   = Min $ taExpr e
-aggrFun (VL.AggrMax e)   = Max $ taExpr e
-aggrFun (VL.AggrAvg e)   = Avg $ taExpr e
-aggrFun (VL.AggrAll e)   = All $ taExpr e
-aggrFun (VL.AggrAny e)   = Any $ taExpr e
-aggrFun VL.AggrCount     = Count
-
--- Common building blocks
-
--- | For a segmented aggregate operator, apply the aggregate
--- function's default value for the empty segments. The first argument
--- specifies the outer descriptor vector, while the second argument
--- specifies the result vector of the aggregate.
-segAggrDefault :: AlgNode -> AlgNode -> AVal -> Build TableAlgebra AlgNode
-segAggrDefault qo qa dv =
-    return qa
-    `unionM`
-    projM [cP descr, eP item (ConstE dv)]
-        (differenceM
-            (proj [mP descr pos] qo)
-            (proj [cP descr] qa))
-
--- | If an aggregate's input is empty, add the aggregate functions
--- default value. The first argument 'q' is the original input vector,
--- whereas the second argument 'qa' is the aggregate's output.
-aggrDefault :: AlgNode -> AlgNode -> AVal -> Build TableAlgebra AlgNode
-aggrDefault q qa dv = do
-    -- If the input is empty, produce a tuple with the default value.
-    qd <- projM [eP descr (ConstE $ nat 2), eP pos (ConstE $ nat 1), eP item (ConstE dv)]
-          $ (litTable (nat 1) descr ANat)
-            `differenceM`
-            (proj [cP descr] q)
-
-    -- For an empty input, there will be two tuples in
-    -- the union result: the aggregate output with NULL
-    -- and the default value.
-    qu <- qa `union` qd
-
-    -- Perform an argmax on the descriptor to get either
-    -- the sum output (for a non-empty input) or the
-    -- default value (which has a higher descriptor).
-    projM [eP descr (ConstE $ nat 1), cP pos, cP item]
-       $ eqJoinM descr' descr
-            (aggr [(Max $ ColE descr, descr')] [] qu)
-            (return qu)
-
-
--- | The default value for sums over empty lists for all possible
--- numeric input types.
-sumDefault :: VL.ScalarType -> (ATy, AVal)
-sumDefault VL.Int    = (AInt, int 0)
-sumDefault VL.Double = (ADouble, double 0)
-sumDefault _         = $impossible
-
-doZip :: (AlgNode, [DBCol]) -> (AlgNode, [DBCol]) -> Build TableAlgebra (AlgNode, [DBCol])
-doZip (q1, cols1) (q2, cols2) = do
-  let offset = length cols1
-  let cols' = cols1 ++ map (+offset) cols2
-  r <- projM (cP descr : cP pos : map (cP . itemi) cols')
-         $ eqJoinM pos pos'
-           (return q1)
-           (proj ((mP pos' pos):[ mP (itemi $ i + offset) (itemi i) | i <- cols2 ]) q2)
-  return (r, cols')
-
-joinPredicate :: Int -> L.JoinPredicate VL.Expr -> [(Expr, Expr, JoinRel)]
-joinPredicate o (L.JoinPred conjs) = N.toList $ fmap joinConjunct conjs
-  where
-    joinConjunct :: L.JoinConjunct VL.Expr -> (Expr, Expr, JoinRel)
-    joinConjunct (L.JoinConjunct e1 op e2) = (taExpr e1, taExprOffset o e2, joinOp op)
-
-    joinOp :: L.BinRelOp -> JoinRel
-    joinOp L.Eq  = EqJ
-    joinOp L.Gt  = GtJ
-    joinOp L.GtE = GeJ
-    joinOp L.Lt  = LtJ
-    joinOp L.LtE = LeJ
-    joinOp L.NEq = NeJ
-
-windowFunction :: VL.WinFun -> WinFun
-windowFunction (VL.WinSum e)        = WinSum $ taExpr e
-windowFunction (VL.WinMin e)        = WinMin $ taExpr e
-windowFunction (VL.WinMax e)        = WinMax $ taExpr e
-windowFunction (VL.WinAvg e)        = WinAvg $ taExpr e
-windowFunction (VL.WinAll e)        = WinAll $ taExpr e
-windowFunction (VL.WinAny e)        = WinAny $ taExpr e
-windowFunction (VL.WinFirstValue e) = WinFirstValue $ taExpr e
-windowFunction VL.WinCount          = WinCount
-
-frameSpecification :: VL.FrameSpec -> FrameBounds
-frameSpecification VL.FAllPreceding   = ClosedFrame FSUnboundPrec FECurrRow
-frameSpecification (VL.FNPreceding n) = ClosedFrame (FSValPrec n) FECurrRow
-
--- The VectorAlgebra instance for TA algebra
-
-instance VectorAlgebra NDVec TableAlgebra where
-  vecAlign (ADVec q1 cols1) (ADVec q2 cols2) = do
-    (r, cols') <- doZip (q1, cols1) (q2, cols2)
-    return $ ADVec r cols'
-
-  vecZip (ADVec q1 cols1) (ADVec q2 cols2) = do
-    (r, cols') <- doZip (q1, cols1) (q2, cols2)
-    return $ ADVec r cols'
-
-  vecLit tys vs = do
-    qr <- flip litTable' ((descr, natT):(pos, natT):[(itemi i, algTy t) | (i, t) <- zip [1..] tys])
-                                 $ map (map algVal) vs
-    return $ ADVec qr [1..length tys]
-
-  vecPropRename (RVec q1) (ADVec q2 cols) = do
-    q <- tagM "propRename"
-         $ projM (itemProj cols [mP descr posnew, cP pos])
-         $ eqJoin posold descr q1 q2
-    return $ ADVec q cols
-
-  vecPropFilter (RVec q1) (ADVec q2 cols) = do
-    q <- rownumM pos' [posnew, pos] [] $ eqJoin posold descr q1 q2
-    qr1 <- flip ADVec cols <$> proj (itemProj cols [mP descr posnew, mP pos pos']) q
-    qr2 <- RVec <$> proj [mP posold pos, mP posnew pos'] q
-    return $ (qr1, qr2)
-
-  -- For TA algebra, the filter and reorder cases are the same, since
-  -- numbering to generate positions is done with a rownum and involves sorting.
-  vecPropReorder (PVec q1) e2 = do
-    (p, (RVec r)) <- vecPropFilter (RVec q1) e2
-    return (p, PVec r)
-
-  vecUnboxNested (RVec qu) (ADVec qi cols) = do
-    -- Perform a segment join between inner vector and outer unboxing
-    -- rename vector. This implicitly discards any unreferenced
-    -- segments in qi.
-    q <- projM (itemProj cols [mP descr posnew, cP pos, mP posold pos'])
-         $ rownumM pos [pos'] []
-         $ eqJoinM posold descr'
-             (return qu)
-             (proj (itemProj cols [mP descr' descr, mP pos' pos]) qi)
-
-    -- The unboxed vector containing one segment from the inner vector.
-    qv <- proj (itemProj cols [cP descr, cP pos]) q
-    -- A rename vector in case the inner vector has inner vectors as
-    -- well.
-    qr <- proj [mP posnew pos, cP posold] q
-
-    return (ADVec qv cols, RVec qr)
-
-  vecCombine (ADVec qb _) (ADVec q1 cols) (ADVec q2 _) = do
-    d1 <- projM [cP pos', cP pos]
-            $ rownumM pos' [pos] []
-            $ select (ColE item) qb
-    d2 <- projM [cP pos', cP pos]
-          $ rownumM pos' [pos] []
-          $ select (UnAppE Not (ColE item)) qb
-    q <- eqJoinM pos' posold
-            (return d1)
-            (proj (itemProj cols [mP posold pos, cP descr]) q1)
-         `unionM`
-         eqJoinM pos' posold
-            (return d2)
-            (proj (itemProj cols [mP posold pos, cP descr]) q2)
-    qr <- proj (itemProj cols [cP descr, cP pos]) q
-    qp1 <- proj [mP posnew pos, mP posold pos'] d1
-    qp2 <- proj [mP posnew pos, mP posold pos'] d2
-    return $ (ADVec qr cols, RVec qp1, RVec qp2)
-
-  vecSegment (ADVec q cols) = do
-    flip ADVec cols <$> proj (itemProj cols [mP descr pos, cP pos]) q
-
-  vecUnsegment (ADVec q cols) = do
-    qr <- proj (itemProj cols [cP pos, eP descr (ConstE $ nat 1)]) q
-    return $ ADVec qr cols
-
-  vecDistDesc (ADVec q1 cols) (ADVec q2 _) = do
-    q <- projM (itemProj cols [mP descr pos, mP pos pos'', cP posold])
-           $ rownumM pos'' [pos, pos'] []
-           $ crossM
-               (proj [cP pos] q2)
-               (proj (itemProj cols [mP pos' pos, mP posold pos]) q1)
-    qr1 <- flip ADVec cols <$> proj (itemProj cols [cP descr, cP pos]) q
-    qr2 <- PVec <$> proj [cP posold, mP posnew pos] q
-    return $ (qr1, qr2)
-
-  vecDistLift (ADVec q1 cols1) (ADVec q2 cols2) = do
-    let cols2'    = [ i + length cols1 | i <- cols2 ]
-        shiftProj = [ mP (itemi i') (itemi i) | i <- cols2 | i' <- cols2' ]
-        resCols   = cols1 ++ cols2'
-    q   <- eqJoinM pos' descr
-             (proj (itemProj cols1 [mP pos' pos]) q1)
-             (proj ([cP descr, cP pos] ++ shiftProj) q2)
-
-    qr1 <- proj (itemProj resCols [cP descr, cP pos]) q
-    qr2 <- proj [mP posold pos', mP posnew pos] q
-    return (ADVec qr1 resCols, PVec qr2)
-
-  vecWinFun a w (ADVec q cols1) = do
-    let wfun      = windowFunction a
-        frameSpec = frameSpecification w
-        winCol    = itemi $ length cols1 + 1
-    qw <- winFun (winCol, wfun) [] [(ColE pos, Asc)] (Just frameSpec) q
-    return $ ADVec qw (cols1 ++ [length cols1 + 1])
-
-  vecAggr a (ADVec q _) = do
-    -- The aggr operator itself
-    qa <- projM [eP descr (ConstE $ nat 1), eP pos (ConstE $ nat 1), cP item]
-          $ aggr [(aggrFun a, item)] [] q
-    -- For sum, add the default value for empty inputs
-    qd <- case a of
-              VL.AggrSum t _ -> aggrDefault q qa (snd $ sumDefault t)
-              VL.AggrAll _   -> aggrDefault q qa (bool True)
-              VL.AggrAny _   -> aggrDefault q qa (bool False)
-              _              -> return qa
-
-    return $ ADVec qd [1]
-
-  vecAggrNonEmpty as (ADVec q _) = do
-    let resCols = [1 .. N.length as]
-
-    let aggrFuns = [ (aggrFun a, itemi i)
-                   | a <- N.toList as
-                   | i <- resCols
-                   ]
-
-    qa <- projM (itemProj resCols [eP descr (ConstE $ nat 1), eP pos (ConstE $ nat 1)])
-          $ aggr aggrFuns [] q
-
-    return $ ADVec qa resCols
-
-
-  vecAggrS a (ADVec qo _) (ADVec qi _) = do
-    qa <- aggr [(aggrFun a, item)] [(descr, ColE descr)] qi
-    qd <- case a of
-              VL.AggrSum t _ -> segAggrDefault qo qa (snd $ sumDefault t)
-              VL.AggrAny _   -> segAggrDefault qo qa (bool False)
-              VL.AggrAll _   -> segAggrDefault qo qa (bool True)
-
-              VL.AggrCount   -> segAggrDefault qo qa (int 0)
-              _              -> return qa
-
-    qr <- rownum' pos [(ColE descr, Asc)] [] qd
-
-    return $ ADVec qr [1]
-
-  vecAggrNonEmptyS as (ADVec q _) = do
-    let resCols = [1 .. N.length as]
-
-    let aggrFuns = [ (aggrFun a, itemi i)
-                   | a <- N.toList as
-                   | i <- resCols
-                   ]
-
-    -- Compute aggregate output per segment and new positions
-    qa <- projM (itemProj resCols [cP descr, cP pos])
-          $ rownumM pos [descr] []
-          $ aggr aggrFuns [(descr, ColE descr)] q
-
-    return $ ADVec qa resCols
-
-  vecReverse (ADVec q cols) = do
-    q' <- rownum' pos' [(ColE pos, Desc)] [] q
-    r <- proj (itemProj cols [cP descr, mP pos pos']) q'
-    p <- proj [mP posold pos, mP posnew pos'] q'
-    return (ADVec r cols, PVec p)
-
-  vecReverseS (ADVec q cols) = do
-    q' <- rownum' pos' [(ColE descr, Asc), (ColE pos, Desc)] [] q
-    r <- proj (itemProj cols [cP descr, mP pos pos']) q'
-    p <- proj [mP posold pos, mP posnew pos'] q'
-    return (ADVec r cols, PVec p)
-
-  vecUniqueS (ADVec q cols) = do
-    let groupCols = map (\c -> (c, ColE c)) (descr : map itemi cols)
-    qr <- rownumM pos [pos] []
-          $ aggr [(Min (ColE pos), pos)] groupCols q
-    return $ ADVec qr cols
-
-  descToRename (ADVec q1 _) = RVec <$> proj [mP posnew descr, mP posold pos] q1
-
-  singletonDescr = do
-    q <- litTable' [[nat 1, nat 1]] [(descr, natT), (pos, natT)]
-    return $ ADVec q []
-
-  vecAppend (ADVec q1 cols) (ADVec q2 _) = do
-    q <- rownumM posnew [ordCol, pos] []
-           $ projAddCols cols [eP ordCol (ConstE (nat 1))] q1
-             `unionM`
-             projAddCols cols [eP ordCol (ConstE (nat 2))] q2
-    qv <- tagM "append r" (proj (itemProj cols [mP pos posnew, cP descr]) q)
-    qp1 <- tagM "append r1"
-           $ projM [mP posold pos, cP posnew]
-           $ select (BinAppE Eq (ColE ordCol) (ConstE $ nat 1)) q
-    qp2 <- tagM "append r2"
-           $ projM [mP posold pos, cP posnew]
-           $ select (BinAppE Eq (ColE ordCol) (ConstE $ nat 2)) q
-    return $ (ADVec qv cols, RVec qp1, RVec qp2)
-
-  vecAppendS (ADVec q1 cols) (ADVec q2 _) = do
-    q <- rownumM posnew [descr, ordCol, pos] []
-           $ projAddCols cols [eP ordCol (ConstE (nat 1))] q1
-             `unionM`
-             projAddCols cols [eP ordCol (ConstE (nat 2))] q2
-    qv <- tagM "append r" (proj (itemProj cols [mP pos posnew, cP descr]) q)
-    qp1 <- tagM "append r1"
-           $ projM [mP posold pos, cP posnew]
-           $ select (BinAppE Eq (ColE ordCol) (ConstE $ nat 1)) q
-    qp2 <- tagM "append r2"
-           $ projM [mP posold pos, cP posnew]
-           $ select (BinAppE Eq (ColE ordCol) (ConstE $ nat 2)) q
-    return $ (ADVec qv cols, RVec qp1, RVec qp2)
-
-  vecSelect expr (ADVec q cols) = do
-    qs <- rownumM posnew [pos] []
-          $ select (taExpr expr) q
-    qv <- proj (itemProj cols [cP descr, mP pos posnew]) qs
-    qr <- proj [mP posold pos, cP posnew] qs
-    return (ADVec qv cols, RVec qr)
-
-  vecTableRef tableName columns hints = do
-    q <- -- generate the pos column
-         rownumM pos orderCols []
-         -- map table columns to item columns, add constant descriptor
-         $ projM (eP descr (ConstE (nat 1)) : [ mP (itemi i) c | (c, i) <- numberedColNames ])
-         $ dbTable tableName taColumns (map Key taKeys)
-    return $ ADVec q (map snd numberedColNames)
-
-    where
-      numberedColNames = zipWith (\((L.ColName c), _) i -> (c, i)) columns [1..]
-
-      taColumns = [ (c, algTy t) | (L.ColName c, t) <- columns ]
-
-      taKeys =    [ [ itemi $ colIndex c | L.ColName c <- k ] | L.Key k <- L.keysHint hints ]
-
-      colIndex :: Attr -> Int
-      colIndex n =
-          case lookup n numberedColNames of
-              Just i  -> i
-              Nothing -> $impossible
-
-      -- the initial table order is generated as follows:
-      -- * if there are known keys for the table, we take the shortest one, in the hope
-      --   that it will be the primary key. A sorting operation then might be able to
-      --   use a primary key index.
-      -- * without a key, we just take an arbitrary column (here, the first).
-      orderCols = case sortWith length taKeys of
-                      k : _ -> k
-                      []    -> [itemi 1]
-
-  vecGroupS groupExprs (ADVec q1 cols1) = do
-      -- apply the grouping expressions and compute surrogate values
-      -- from the grouping values
-      let groupProjs = [ eP (itemi' i) (taExpr e) | e <- groupExprs | i <- [1..] ]
-          groupCols = map fst groupProjs
-      qg <- rowrankM resCol [ (ColE c, Asc) | c <- (descr : groupCols) ]
-            $ proj (itemProj cols1 ([cP descr, cP pos] ++ groupProjs)) q1
-
-      -- Create the outer vector, containing surrogate values and the
-      -- grouping values
-      qo <- distinctM
-            $ proj ([cP descr, mP pos resCol]
-                    ++ [ mP (itemi i) c | c <- groupCols | i <- [1..] ]) qg
-
-      -- Create new positions for the inner vector
-      qp <- rownum posnew [resCol, pos] [] qg
-
-      -- Create the inner vector, containing the actual groups
-      qi <- proj (itemProj cols1 [mP descr resCol, mP pos posnew]) qp
-
-      qprop <- proj [mP posold pos, cP posnew] qp
-
-      return (ADVec qo [1 .. length groupExprs], ADVec qi cols1, PVec qprop)
-
-  vecCartProduct (ADVec q1 cols1) (ADVec q2 cols2) = do
-    let itemProj1  = map (cP . itemi) cols1
-        cols2'     = [((length cols1) + 1) .. ((length cols1) + (length cols2))]
-        shiftProj2 = zipWith mP (map itemi cols2') (map itemi cols2)
-        itemProj2  = map (cP . itemi) cols2'
-
-    q <- projM ([cP descr, cP pos, cP pos', cP pos''] ++ itemProj1 ++ itemProj2)
-           $ rownumM pos [pos', pos''] []
-           $ crossM
-             (proj ([cP descr, mP pos' pos] ++ itemProj1) q1)
-             (proj ((mP pos'' pos) : shiftProj2) q2)
-
-    qv <- proj ([cP  descr, cP pos] ++ itemProj1 ++ itemProj2) q
-    qp1 <- proj [mP posold pos', mP posnew pos] q
-    qp2 <- proj [mP posold pos'', mP posnew pos] q
-    return (ADVec qv (cols1 ++ cols2'), PVec qp1, PVec qp2)
-
-  vecCartProductS (ADVec q1 cols1) (ADVec q2 cols2) = do
-    let itemProj1  = map (cP . itemi) cols1
-        cols2'     = [((length cols1) + 1) .. ((length cols1) + (length cols2))]
-        shiftProj2 = zipWith mP (map itemi cols2') (map itemi cols2)
-        itemProj2  = map (cP . itemi) cols2'
-    q <- projM ([cP descr, cP pos, cP pos', cP pos''] ++ itemProj1 ++ itemProj2)
-           $ rownumM pos [descr, descr', pos', pos''] []
-           $ eqJoinM descr descr'
-             (proj ([cP descr, mP pos' pos] ++ itemProj1) q1)
-             (proj ([mP descr' descr, mP pos'' pos] ++ shiftProj2) q2)
-    qv <- proj ([cP  descr, cP pos] ++ itemProj1 ++ itemProj2) q
-    qp1 <- proj [mP posold pos', mP posnew pos] q
-    qp2 <- proj [mP posold pos'', mP posnew pos] q
-    return (ADVec qv (cols1 ++ cols2'), PVec qp1, PVec qp2)
-
-  vecNestProduct (ADVec q1 cols1) (ADVec q2 cols2) = do
-    let itemProj1  = map (cP . itemi) cols1
-        cols2'     = [((length cols1) + 1) .. ((length cols1) + (length cols2))]
-        shiftProj2 = zipWith mP (map itemi cols2') (map itemi cols2)
-        itemProj2  = map (cP . itemi) cols2'
-
-    q <- projM ([mP descr pos', cP pos, cP pos', cP pos''] ++ itemProj1 ++ itemProj2)
-           $ rownumM pos [pos', pos''] []
-           $ crossM
-             (proj ([cP descr, mP pos' pos] ++ itemProj1) q1)
-             (proj ((mP pos'' pos) : shiftProj2) q2)
-
-    qv <- proj ([cP descr, cP pos] ++ itemProj1 ++ itemProj2) q
-    qp1 <- proj [mP posold pos', mP posnew pos] q
-    qp2 <- proj [mP posold pos'', mP posnew pos] q
-    return (ADVec qv (cols1 ++ cols2'), PVec qp1, PVec qp2)
-
-  -- FIXME merge common parts of vecCartProductS and vecNestProductS
-  vecNestProductS (ADVec q1 cols1) (ADVec q2 cols2) = do
-    let itemProj1  = map (cP . itemi) cols1
-        cols2'     = [((length cols1) + 1) .. ((length cols1) + (length cols2))]
-        shiftProj2 = zipWith mP (map itemi cols2') (map itemi cols2)
-        itemProj2  = map (cP . itemi) cols2'
-
-    q <- projM ([mP descr pos', cP pos, cP pos', cP pos''] ++ itemProj1 ++ itemProj2)
-           $ rownumM pos [descr, pos', pos''] []
-           $ eqJoinM descr descr'
-             (proj ([cP descr, mP pos' pos] ++ itemProj1) q1)
-             (proj ([mP descr' descr, mP pos'' pos] ++ shiftProj2) q2)
-    qv <- proj ([cP  descr, cP pos] ++ itemProj1 ++ itemProj2) q
-    qp2 <- proj [mP posold pos'', mP posnew pos] q
-    return (ADVec qv (cols1 ++ cols2'), PVec qp2)
-
-  vecThetaJoin joinPred (ADVec q1 cols1) (ADVec q2 cols2) = do
-    let itemProj1  = map (cP . itemi) cols1
-        cols2'     = [((length cols1) + 1) .. ((length cols1) + (length cols2))]
-        shiftProj2 = zipWith mP (map itemi cols2') (map itemi cols2)
-        itemProj2  = map (cP . itemi) cols2'
-
-    q <- projM ([cP descr, cP pos, cP pos', cP pos''] ++ itemProj1 ++ itemProj2)
-           $ rownumM pos [pos', pos''] []
-           $ thetaJoinM (joinPredicate (length cols1) joinPred)
-             (proj ([ cP descr
-                    , mP pos' pos
-                    ] ++ itemProj1) q1)
-             (proj ([ mP pos'' pos
-                    ] ++ shiftProj2) q2)
-
-    qv <- tagM "eqjoin/1" $ proj ([cP  descr, cP pos] ++ itemProj1 ++ itemProj2) q
-    qp1 <- proj [mP posold pos', mP posnew pos] q
-    qp2 <- proj [mP posold pos'', mP posnew pos] q
-    return (ADVec qv (cols1 ++ cols2'), PVec qp1, PVec qp2)
-
-  vecNestJoin joinPred (ADVec q1 cols1) (ADVec q2 cols2) = do
-    let itemProj1  = map (cP . itemi) cols1
-        cols2'     = [((length cols1) + 1) .. ((length cols1) + (length cols2))]
-        shiftProj2 = zipWith mP (map itemi cols2') (map itemi cols2)
-        itemProj2  = map (cP . itemi) cols2'
-
-    q <- projM ([cP pos, cP pos', cP pos''] ++ itemProj1 ++ itemProj2)
-           $ rownumM pos [pos', pos''] []
-           $ thetaJoinM (joinPredicate (length cols1) joinPred)
-             (proj ([ mP pos' pos
-                    ] ++ itemProj1) q1)
-             (proj ([ mP pos'' pos
-                    ] ++ shiftProj2) q2)
-
-    qv <- tagM "eqjoin/1" $ proj ([mP descr pos', cP pos] ++ itemProj1 ++ itemProj2) q
-    qp1 <- proj [mP posold pos', mP posnew pos] q
-    qp2 <- proj [mP posold pos'', mP posnew pos] q
-    return (ADVec qv (cols1 ++ cols2'), PVec qp1, PVec qp2)
-
-  vecThetaJoinS joinPred (ADVec q1 cols1) (ADVec q2 cols2) = do
-    let itemProj1  = map (cP . itemi) cols1
-        cols2'     = [((length cols1) + 1) .. ((length cols1) + (length cols2))]
-        shiftProj2 = zipWith mP (map itemi cols2') (map itemi cols2)
-        itemProj2  = map (cP . itemi) cols2'
-
-    q <- projM ([cP descr, cP pos, cP pos', cP pos''] ++ itemProj1 ++ itemProj2)
-           $ rownumM pos [pos', pos''] []
-           $ thetaJoinM ((ColE descr, ColE descr', EqJ) : joinPredicate (length cols1) joinPred)
-             (proj ([ cP descr
-                    , mP pos' pos
-                    ] ++ itemProj1) q1)
-             (proj ([ mP descr' descr
-                    , mP pos'' pos
-                    ] ++ shiftProj2) q2)
-
-    qv <- proj ([cP  descr, cP pos] ++ itemProj1 ++ itemProj2) q
-    qp1 <- proj [mP posold pos', mP posnew pos] q
-    qp2 <- proj [mP posold pos'', mP posnew pos] q
-    return (ADVec qv (cols1 ++ cols2'), PVec qp1, PVec qp2)
-
-  -- There is only one difference between EquiJoinS and NestJoinS. For
-  -- NestJoinS, we 'segment' after the join, i.e. use the left input
-  -- positions as the result descriptor.
-  -- FIXME merge the common parts.
-  vecNestJoinS joinPred (ADVec q1 cols1) (ADVec q2 cols2) = do
-    let itemProj1  = map (cP . itemi) cols1
-        cols2'     = [((length cols1) + 1) .. ((length cols1) + (length cols2))]
-        shiftProj2 = zipWith mP (map itemi cols2') (map itemi cols2)
-        itemProj2  = map (cP . itemi) cols2'
-
-    q <- projM ([mP descr pos', cP pos, cP pos', cP pos''] ++ itemProj1 ++ itemProj2)
-           $ rownumM pos [descr, pos', pos''] []
-           $ thetaJoinM ((ColE descr, ColE descr', EqJ) : joinPredicate (length cols1) joinPred)
-             (proj ([ cP descr
-                    , mP pos' pos
-                    ] ++ itemProj1) q1)
-             (proj ([ mP descr' descr
-                    , mP pos'' pos
-                    ] ++ shiftProj2) q2)
-
-    qv <- proj ([cP  descr, cP pos] ++ itemProj1 ++ itemProj2) q
-    qp2 <- proj [mP posold pos'', mP posnew pos] q
-    return (ADVec qv (cols1 ++ cols2'), PVec qp2)
-
-  vecUnboxScalar (ADVec qo colso) (ADVec qi colsi) = do
-    let colsi'     = [((length colso) + 1) .. ((length colso) + (length colsi))]
-        shiftProji = zipWith mP (map itemi colsi') (map itemi colsi)
-        itemProji  = map (cP . itemi) colsi'
-
-    qu <- projM ([cP descr, cP pos] ++ (map (cP . itemi) colso) ++ itemProji)
-              $ eqJoinM pos descr'
-                  (return qo)
-                  (proj ([mP descr' descr] ++ shiftProji) qi)
-    return $ ADVec qu (colso ++ colsi')
-
-  vecSelectPos (ADVec qe cols) op (ADVec qi _) = do
-    qs <- selectM (BinAppE (binOp op) (ColE pos) (UnAppE (Cast natT) (ColE item')))
-          $ crossM
-              (return qe)
-              (proj [mP item' item] qi)
-
-    q' <- case op of
-            -- If we select positions from the beginning, we can re-use the old
-            -- positions
-            (L.SBRelOp L.Lt)  -> projAddCols cols [mP posnew pos] qs
-            (L.SBRelOp L.LtE) -> projAddCols cols [mP posnew pos] qs
-            -- Only if selected positions don't start at the beginning (i.e. 1)
-            -- do we have to recompute them.
-            _      -> rownum posnew [pos] [] qs
-
-    qr <- proj (itemProj cols [cP descr, mP pos posnew]) q'
-    -- A regular rename vector for re-aligning inner vectors
-    qp <- proj [ mP posold pos, cP posnew ] q'
-    -- An unboxing rename vector
-    qu <- proj [ mP posold pos, mP posnew descr ] q'
-    return $ (ADVec qr cols, RVec qp, RVec qu)
-
-  vecSelectPosS (ADVec qe cols) op (ADVec qi _) = do
-    qs <- rownumM posnew [pos] []
-          $ selectM (BinAppE (binOp op) (ColE absPos) (UnAppE (Cast natT) (ColE item')))
-          $ eqJoinM descr pos'
-              (rownum absPos [pos] [ColE descr] qe)
-              (proj [mP pos' pos, mP item' item] qi)
-
-    qr <- proj (itemProj cols [cP descr, mP pos posnew]) qs
-    qp <- proj [ mP posold pos, cP posnew ] qs
-    qu <- proj [ mP posnew descr, mP posold pos] qs
-    return $ (ADVec qr cols, RVec qp, RVec qu)
-
-  vecSelectPos1 (ADVec qe cols) op posConst = do
-    let posConst' = VNat $ fromIntegral posConst
-    qs <- select (BinAppE (binOp op) (ColE pos) (ConstE posConst')) qe
-
-    q' <- case op of
-            -- If we select positions from the beginning, we can re-use the old
-            -- positions
-            (L.SBRelOp L.Lt)  -> projAddCols cols [mP posnew pos] qs
-            (L.SBRelOp L.LtE) -> projAddCols cols [mP posnew pos] qs
-            -- Only if selected positions don't start at the beginning (i.e. 1)
-            -- do we have to recompute them.
-            _      -> rownum posnew [pos] [] qs
-
-    qr <- proj (itemProj cols [cP descr, mP pos posnew]) q'
-    qp <- proj [ mP posold pos, cP posnew ] q'
-    qu <- proj [ mP posold pos, mP posnew descr ] q'
-    return $ (ADVec qr cols, RVec qp, RVec qu)
-
-  -- If we select positions in a lifted way, we need to recompute
-  -- positions in any case.
-  vecSelectPos1S (ADVec qe cols) op posConst = do
-    let posConst' = VNat $ fromIntegral posConst
-    qs <- rownumM posnew [pos] []
-          $ selectM (BinAppE (binOp op) (ColE absPos) (ConstE posConst'))
-          $ rownum absPos [pos] [ColE descr] qe
-
-    qr <- proj (itemProj cols [cP descr, mP pos posnew]) qs
-    qp <- proj [ mP posold pos, cP posnew ] qs
-    qu <- proj [ mP posold pos, mP posnew descr ] qs
-    return $ (ADVec qr cols, RVec qp, RVec qu)
-
-  vecProject projs (ADVec q _) = do
-    let projs' = zipWith (\i e -> (itemi i, taExpr e)) [1 .. length projs] projs
-    qr <- proj ([cP descr, cP pos] ++ projs') q
-    return $ ADVec qr [1 .. (length projs)]
-
-  vecZipS (ADVec q1 cols1) (ADVec q2 cols2) = do
-    q1' <- rownum pos'' [pos] [ColE descr] q1
-    q2' <- rownum pos''' [pos] [ColE descr] q2
-    let offset      = length cols1
-        cols2'      = map (+ offset) cols2
-        allCols     = cols1 ++ cols2'
-        allColsProj = map (cP . itemi) allCols
-        shiftProj   = zipWith mP (map itemi cols2') (map itemi cols2)
-    qz <- rownumM posnew [descr, pos''] []
-          $ projM ([cP pos', cP pos, cP descr] ++ allColsProj)
-          $ thetaJoinM [(ColE descr, ColE descr', EqJ), (ColE pos'', ColE pos''', EqJ)]
-              (return q1')
-              (proj ([mP descr' descr, mP pos' pos, cP pos'''] ++ shiftProj) q2')
-
-    r1 <- proj [mP posold pos'', cP posnew] qz
-    r2 <- proj [mP posold pos''', cP posnew] qz
-    qr <- proj ([cP descr, mP pos posnew] ++ allColsProj) qz
-    return (ADVec qr allCols, RVec r1, RVec r2)
-
-  vecGroupAggr groupExprs aggrFuns (ADVec q _) = do
-    let partAttrs = (descr, cP descr)
-                    :
-                    [ (itemi i, eP (itemi i) (taExpr e)) | e <- groupExprs | i <- [1..] ]
-
-        pw = length groupExprs
-
-        pfAggrFuns = [ (aggrFun a, itemi $ pw + i) | a <- N.toList aggrFuns | i <- [1..] ]
-
-    -- GroupAggr(e, f) has to mimic the behaviour of GroupS(e) +
-    -- AggrS(f) exactly. GroupScalarS determines the order of the
-    -- groups by the sort order of the grouping keys (implicitly via
-    -- RowRank). GroupAggr has to provide the aggregated groups in the
-    -- same order to be aligned. Therefore, we sort by /all/ grouping
-    -- attributes.
-    qa <- rownumM pos (map fst partAttrs) []
-          $ aggr pfAggrFuns (map snd partAttrs) q
-
-    return $ ADVec qa [1 .. length groupExprs + N.length aggrFuns]
-
-  vecNumber (ADVec q cols) = do
-    let nrIndex = length cols + 1
-        nrItem = itemi nrIndex
-    qr <- projAddCols cols [eP nrItem (UnAppE (Cast natT) (ColE pos))] q
-    return $ ADVec qr (cols ++ [nrIndex])
-
-  -- The TA implementation of lifted number does not come for
-  -- free: To generate the absolute numbers for every sublist
-  -- (i.e. descriptor partition), we have to use a partitioned
-  -- rownumber.
-  vecNumberS (ADVec q cols) = do
-    let nrIndex = length cols + 1
-        nrItem = itemi nrIndex
-    qr <- rownum nrItem [pos] [ColE descr] q
-    return $ ADVec qr (cols ++ [nrIndex])
-
-  vecSemiJoin joinPred (ADVec q1 cols1) (ADVec q2 cols2) = do
-    let cols2'     = [((length cols1) + 1) .. ((length cols1) + (length cols2))]
-        shiftProj2 = zipWith mP (map itemi cols2') (map itemi cols2)
-
-    q <- rownumM pos [posold] []
-         $ projM (itemProj cols1 [cP descr, mP posold pos])
-         $ semiJoinM (joinPredicate (length cols1) joinPred)
-             (proj (itemProj cols1 [cP descr, cP pos]) q1)
-             (proj shiftProj2 q2)
-    qj <- tagM "semijoin/1" $ proj (itemProj cols1 [cP descr, cP pos]) q
-    r  <- proj [cP posold, mP posold posnew] q
-    return $ (ADVec qj cols1, RVec r)
-
-  vecSemiJoinS joinPred (ADVec q1 cols1) (ADVec q2 cols2) = do
-    let cols2'     = [((length cols1) + 1) .. ((length cols1) + (length cols2))]
-        shiftProj2 = zipWith mP (map itemi cols2') (map itemi cols2)
-
-    q <- rownumM pos [descr, posold] []
-         $ projM (itemProj cols1 [cP descr, mP posold pos])
-         $ semiJoinM ((ColE descr, ColE descr', EqJ) : joinPredicate (length cols1) joinPred)
-             (proj (itemProj cols1 [cP descr, cP pos]) q1)
-             (proj ([mP descr' descr] ++ shiftProj2) q2)
-    qj <- tagM "semijoinLift/1" $ proj (itemProj cols1 [cP descr, cP pos]) q
-    r  <- proj [cP posold, mP posold posnew] q
-    return $ (ADVec qj cols1, RVec r)
-
-  vecAntiJoin joinPred (ADVec q1 cols1) (ADVec q2 cols2) = do
-    let cols2'     = [((length cols1) + 1) .. ((length cols1) + (length cols2))]
-        shiftProj2 = zipWith mP (map itemi cols2') (map itemi cols2)
-
-    q <- rownumM pos [posold] []
-         $ projM (itemProj cols1 [cP descr, mP posold pos])
-         $ antiJoinM (joinPredicate (length cols1) joinPred)
-             (proj (itemProj cols1 [cP descr, cP pos]) q1)
-             (proj shiftProj2 q2)
-    qj <- tagM "antijoin/1" $ proj (itemProj cols1 [cP descr, cP pos]) q
-    r  <- proj [cP posold, mP posold posnew] q
-    return $ (ADVec qj cols1, RVec r)
-
-  vecAntiJoinS joinPred (ADVec q1 cols1) (ADVec q2 cols2) = do
-    let cols2'     = [((length cols1) + 1) .. ((length cols1) + (length cols2))]
-        shiftProj2 = zipWith mP (map itemi cols2') (map itemi cols2)
-
-    q <- rownumM pos [descr, posold] []
-         $ projM (itemProj cols1 [cP descr, mP posold pos])
-         $ antiJoinM ((ColE descr, ColE descr', EqJ) : joinPredicate (length cols1) joinPred)
-             (proj (itemProj cols1 [cP descr, cP pos]) q1)
-             (proj ([mP descr' descr] ++ shiftProj2) q2)
-    qj <- tagM "antijoinLift/1" $ proj (itemProj cols1 [cP descr, cP pos]) q
-    r  <- proj [cP posold, mP posold posnew] q
-    return $ (ADVec qj cols1, RVec r)
-
-  vecSortS sortExprs (ADVec q1 cols1) = do
-    let sortProjs = zipWith (\i e -> (itemi' i, taExpr e)) [1..] sortExprs
-    -- Including positions de facto implements stable sorting
-    qs <- rownumM pos' ([descr] ++ map fst sortProjs ++ [pos]) []
-          $ projAddCols cols1 sortProjs q1
-
-    qr1 <- proj (itemProj cols1 [cP descr, mP pos pos']) qs
-    qr2 <- proj [mP posold pos, mP posnew pos'] qs
-
-    return (ADVec qr1 cols1, PVec qr2)
-
-  -- FIXME none of vecReshape, vecReshapeS, vecTranspose and
-  -- vecTransposeS deal with empty inner inputs correctly!
-  vecReshape n (ADVec q cols) = do
-    let dExpr = BinAppE Div (BinAppE Minus (ColE pos) (ConstE $ int 1)) (ConstE $ int $ n + 1)
-    qi <- proj (itemProj cols [cP pos, eP descr dExpr]) q
-    qo <- projM [eP descr (ConstE $ nat 1), cP pos]
-          $ distinctM
-          $ proj [mP pos descr] qi
-    return (ADVec qo [], ADVec qi cols)
-
-  vecReshapeS n (ADVec q cols) = do
-    let dExpr = BinAppE Div (BinAppE Minus (ColE absPos) (ConstE $ int 1)) (ConstE $ int $ n + 1)
-    qr <- -- Make the new descriptors valid globally
-          -- FIXME need a rowrank instead!
-          rownumM descr'' [descr, descr'] []
-          -- Assign the inner list elements to sublists. Generated
-          -- descriptors are _per_ inner list!
-          $ projM (itemProj cols [cP descr, cP pos, eP descr' dExpr])
-          -- Generate absolute positions for the inner lists
-          $ rownum absPos [pos] [ColE descr] q
-
-    -- We can compute the 'middle' descriptor vector from the original
-    -- inner vector.
-    qm <- distinctM $ proj [cP descr, mP pos descr''] qr
-
-    qi <- proj (itemProj cols [mP descr descr'', cP pos]) qr
-
-    return (ADVec qm [], ADVec qi cols)
-
-  vecTranspose (ADVec q cols) = do
-    qi <- projM (itemProj cols [mP descr descr', mP pos pos'])
-          -- Generate new positions. We use absolute positions as the
-          -- new descriptor here. This implements the swapping of row
-          -- and column ids (here: descr and pos) that is the core of
-          -- transposition.
-          $ rownumM pos' [descr', pos] []
-          -- Generate absolute positions for the inner lists
-          $ rownum descr' [pos] [ColE descr] q
-
-    qo <- projM [eP descr (ConstE $ nat 1), cP pos]
-          $ distinctM
-          $ proj [mP pos descr] qi
-
-    return (ADVec qo [], ADVec qi cols)
-
-  vecTransposeS (ADVec qo _) (ADVec qi cols) = do
-    qr  <- -- Generate new globally valid positions for the inner vector
-           rownumM pos' [descr', absPos] []
-           -- Absolute positions form the new inner descriptor. However, so
-           -- far they are relative to the outer descriptor. Here, make them
-           -- "globally" valid.
-           $ rowrankM descr' [(ColE descro, Asc), (ColE absPos, Asc)]
-           -- As usual, generate absolute positions
-           $ rownumM absPos [posi] [ColE descri]
-           -- Join middle and inner vector because we need to know to which
-           -- outer list each leaf element belongs
-           $ eqJoinM poso descri
-               (proj [mP descro descr, mP poso pos] qo)
-               (proj (itemProj cols [mP descri descr, mP posi pos]) qi)
-
-    qi' <- proj (itemProj cols [mP descr descr', mP pos pos']) qr
-    qm  <- distinctM $ proj [mP descr descro, mP pos descr'] qr
-
-    return (ADVec qm [], ADVec qi' cols)
diff --git a/src/Database/DSH/VL/Vectorize.hs b/src/Database/DSH/VL/Vectorize.hs
--- a/src/Database/DSH/VL/Vectorize.hs
+++ b/src/Database/DSH/VL/Vectorize.hs
@@ -9,6 +9,7 @@
 
 import           Control.Applicative
 import qualified Data.List                     as List
+import qualified Data.List.NonEmpty            as N
 import           Prelude                       hiding (reverse, zip)
 import qualified Prelude                       as P
 
@@ -18,264 +19,218 @@
 import           Database.DSH.Common.Nat
 import           Database.DSH.Common.QueryPlan
 import           Database.DSH.Common.Type
-import           Database.DSH.Impossible
-import           Database.DSH.VL.Lang          (AggrFun (..), Expr (..), VL (),
-                                                VLVal (..))
+import           Database.DSH.Common.Impossible
+import           Database.DSH.VL.Lang          (AggrFun (..), Expr (..), VL ())
 import           Database.DSH.VL.Primitives
-import           Database.DSH.VL.Vector
+import           Database.DSH.Common.Vector
 
 --------------------------------------------------------------------------------
 -- Construction of not-lifted primitives
 
+binOp :: L.ScalarBinOp -> Shape VLDVec -> Shape VLDVec -> Build VL (Shape VLDVec)
+binOp o (SShape dv1 _) (SShape dv2 _) = do
+    (dv, _, _) <- vlCartProduct dv1 dv2
+    dv'        <- vlProject [BinApp o (Column 1) (Column 2)] dv
+    return $ SShape dv' LCol
+binOp _ _ _ = $impossible
+
 zip ::  Shape VLDVec -> Shape VLDVec -> Build VL (Shape VLDVec)
-zip (VShape q1 lyt1) (VShape q2 lyt2) = do
-    q' <- vlZip q1 q2
-    return $ VShape q' $ zipLayout lyt1 lyt2
+zip (VShape dv1 lyt1) (VShape dv2 lyt2) = do
+    (dv, fv1, fv2) <- vlZip dv1 dv2
+    lyt1'          <- rekeyOuter fv1 lyt1
+    lyt2'          <- rekeyOuter fv2 lyt2
+    return $ VShape dv $ LTuple [lyt1', lyt2']
 zip _ _ = $impossible
 
 cartProduct :: Shape VLDVec -> Shape VLDVec -> Build VL (Shape VLDVec)
-cartProduct (VShape q1 lyt1) (VShape q2 lyt2) = do
-    (q', p1, p2) <- vlCartProduct q1 q2
-    lyt1'        <- chainReorder p1 lyt1
-    lyt2'        <- chainReorder p2 lyt2
-    return $ VShape q' $ zipLayout lyt1' lyt2'
+cartProduct (VShape dv1 lyt1) (VShape dv2 lyt2) = do
+    (dv, rv1, rv2) <- vlCartProduct dv1 dv2
+    lyt1'          <- repLayout rv1 lyt1
+    lyt2'          <- repLayout rv2 lyt2
+    return $ VShape dv $ LTuple [lyt1', lyt2']
 cartProduct _ _ = $impossible
 
 nestProduct :: Shape VLDVec -> Shape VLDVec -> Build VL (Shape VLDVec)
-nestProduct (VShape q1 lyt1) (VShape q2 lyt2) = do
-  (q', p1, p2) <- vlNestProduct q1 q2
-  lyt1'        <- chainReorder p1 lyt1
-  lyt2'        <- chainReorder p2 lyt2
-  return $ VShape q1 (LTuple [lyt1, LNest q' (zipLayout lyt1' lyt2')])
+nestProduct (VShape dv1 lyt1) (VShape dv2 lyt2) = do
+  (dvi, rv1, rv2) <- vlNestProduct dv1 dv2
+  lyt1'           <- repLayout rv1 lyt1
+  lyt2'           <- repLayout rv2 lyt2
+  return $ VShape dv1 (LTuple [lyt1, LNest dvi (LTuple [lyt1', lyt2'])])
 nestProduct _ _ = $impossible
 
 thetaJoin :: L.JoinPredicate L.JoinExpr -> Shape VLDVec -> Shape VLDVec -> Build VL (Shape VLDVec)
-thetaJoin joinPred (VShape q1 lyt1) (VShape q2 lyt2) = do
-    (q', p1, p2) <- vlThetaJoin joinPred q1 q2
-    lyt1'        <- chainReorder p1 lyt1
-    lyt2'        <- chainReorder p2 lyt2
-    return $ VShape q' $ zipLayout lyt1' lyt2'
+thetaJoin joinPred (VShape dv1 lyt1) (VShape dv2 lyt2) = do
+    (dv, rv1, rv2) <- vlThetaJoin joinPred dv1 dv2
+    lyt1'          <- repLayout rv1 lyt1
+    lyt2'          <- repLayout rv2 lyt2
+    return $ VShape dv $ LTuple [lyt1', lyt2']
 thetaJoin _ _ _ = $impossible
 
 nestJoin :: L.JoinPredicate L.JoinExpr -> Shape VLDVec -> Shape VLDVec -> Build VL (Shape VLDVec)
-nestJoin joinPred (VShape q1 lyt1) (VShape q2 lyt2) = do
-    (q', p1, p2) <- vlNestJoin joinPred q1 q2
-    lyt1'        <- chainReorder p1 lyt1
-    lyt2'        <- chainReorder p2 lyt2
-    return $ VShape q1 (LTuple [lyt1, LNest q' (zipLayout lyt1' lyt2')])
+nestJoin joinPred (VShape dv1 lyt1) (VShape dv2 lyt2) = do
+    (dv, rv1, rv2) <- vlNestJoin joinPred dv1 dv2
+    lyt1'          <- repLayout rv1 lyt1
+    lyt2'          <- repLayout rv2 lyt2
+    return $ VShape dv1 (LTuple [lyt1, LNest dv (LTuple [lyt1', lyt2'])])
 nestJoin _ _ _ = $impossible
 
 semiJoin :: L.JoinPredicate L.JoinExpr -> Shape VLDVec -> Shape VLDVec -> Build VL (Shape VLDVec)
-semiJoin joinPred (VShape q1 lyt1) (VShape q2 _) = do
-    (qj, r) <- vlSemiJoin joinPred q1 q2
-    lyt1'   <- chainRenameFilter r lyt1
-    return $ VShape qj lyt1'
+semiJoin joinPred (VShape dv1 lyt1) (VShape dv2 _) = do
+    (dv, fv) <- vlSemiJoin joinPred dv1 dv2
+    lyt1'    <- filterLayout fv lyt1
+    return $ VShape dv lyt1'
 semiJoin _ _ _ = $impossible
 
 antiJoin :: L.JoinPredicate L.JoinExpr -> Shape VLDVec -> Shape VLDVec -> Build VL (Shape VLDVec)
-antiJoin joinPred (VShape q1 lyt1) (VShape q2 _) = do
-    (qj, r) <- vlAntiJoin joinPred q1 q2
-    lyt1'   <- chainRenameFilter r lyt1
-    return $ VShape qj lyt1'
+antiJoin joinPred (VShape dv1 lyt1) (VShape dv2 _) = do
+    (dv, fv) <- vlAntiJoin joinPred dv1 dv2
+    lyt1'    <- filterLayout fv lyt1
+    return $ VShape dv lyt1'
 antiJoin _ _ _ = $impossible
 
 nub ::  Shape VLDVec -> Build VL (Shape VLDVec)
-nub (VShape q lyt) = VShape <$> vlUniqueS q <*> pure lyt
+nub (VShape dv lyt) = VShape <$> vlUnique dv <*> pure lyt
 nub _ = $impossible
 
 number ::  Shape VLDVec -> Build VL (Shape VLDVec)
 number (VShape q lyt) =
-    VShape <$> vlNumber q <*> (pure $ zipLayout lyt (LCol 1))
+    VShape <$> vlNumber q <*> (pure $ LTuple [lyt, LCol])
 number _ = $impossible
 
-init ::  Shape VLDVec -> Build VL (Shape VLDVec)
-init (VShape q lyt) = do
-    i          <- vlAggr AggrCount q
-    (q', r, _) <- vlSelectPos q (L.SBRelOp L.Lt) i
-    lyt'       <- chainRenameFilter r lyt
-    return $ VShape q' lyt'
-init _ = $impossible
-
-last ::  Shape VLDVec -> Build VL (Shape VLDVec)
-last (VShape qs lyt@(LNest _ _)) = do
-    i              <- vlAggr AggrCount qs
-    (q, r, _)      <- vlSelectPos qs (L.SBRelOp L.Eq) i
-    (LNest qr lyt') <- chainRenameFilter r lyt
-    re             <- vlUnboxRename q
-    renameOuter re $ VShape qr lyt'
-last (VShape qs lyt) = do
-    i         <- vlAggr AggrCount qs
-    (q, r, _) <- vlSelectPos qs (L.SBRelOp L.Eq) i
-    lyt'      <- chainRenameFilter r lyt
-    return $ SShape q lyt'
-last _ = $impossible
-
-index ::  Shape VLDVec -> Shape VLDVec -> Build VL (Shape VLDVec)
-index (VShape qs (LNest qi lyti)) (SShape i _) = do
-    one       <- literal intT (VLInt 1)
-    i'        <- vlBinExpr (L.SBNumOp L.Add) i one
-    -- Use the unboxing rename vector
-    (_, _, r) <- vlSelectPos qs (L.SBRelOp L.Eq) i'
-    (qu, ri)  <- vlUnboxNested r qi
-    lyti'     <- chainRenameFilter ri lyti
-    return $ VShape qu lyti'
-index (VShape qs lyt) (SShape i _) = do
-    one       <- literal intT (VLInt 1)
-    i'        <- vlBinExpr (L.SBNumOp L.Add) i one
-    (q, r, _) <- vlSelectPos qs (L.SBRelOp L.Eq) i'
-    lyt'      <- chainRenameFilter r lyt
-    return $ SShape q lyt'
-index _ _ = $impossible
-
 append ::  Shape VLDVec -> Shape VLDVec -> Build VL (Shape VLDVec)
-append (VShape q1 lyt1) (VShape q2 lyt2) = do
+append (VShape dv1 lyt1) (VShape dv2 lyt2) = do
     -- Append the current vectors
-    (v, p1, p2) <- vlAppend q1 q2
+    (dv12, kv1, kv2) <- vlAppend dv1 dv2
     -- Propagate position changes to descriptors of any inner vectors
-    lyt1'       <- renameOuterLyt p1 lyt1
-    lyt2'       <- renameOuterLyt p2 lyt2
+    lyt1'       <- rekeyOuter kv1 lyt1
+    lyt2'       <- rekeyOuter kv2 lyt2
     -- Append the layouts, i.e. actually append all inner vectors
     lyt'        <- appendLayout lyt1' lyt2'
-    return $ VShape v lyt'
-appendVec _ _ = $impossible
-
--- FIXME looks fishy, there should be an unboxing join.
-the ::  Shape VLDVec -> Build VL (Shape VLDVec)
-the (VShape d lyt@(LNest _ _)) = do
-    (_, prop, _)   <- vlSelectPos1 d (L.SBRelOp L.Eq) 1
-    (LNest q' lyt') <- chainRenameFilter prop lyt
-    return $ VShape q' lyt'
-the (VShape d lyt) = do
-    (q', prop, _) <- vlSelectPos1 d (L.SBRelOp L.Eq) 1
-    lyt'          <- chainRenameFilter prop lyt
-    return $ SShape q' lyt'
-the _ = $impossible
+    return $ VShape dv12 lyt'
+append _ _ = $impossible
 
 reverse ::  Shape VLDVec -> Build VL (Shape VLDVec)
-reverse (VShape d lyt) = do
-    (d', p) <- vlReverse d
-    lyt'    <- chainReorder p lyt
-    return (VShape d' lyt')
+reverse (VShape dv lyt) = do
+    (dv', sv) <- vlReverse dv
+    lyt'      <- sortLayout sv lyt
+    return (VShape dv' lyt')
 reverse _ = $impossible
 
-tail ::  Shape VLDVec -> Build VL (Shape VLDVec)
-tail (VShape d lyt) = do
-    p          <- literal intT (VLInt 1)
-    (q', r, _) <- vlSelectPos d (L.SBRelOp L.Gt) p
-    lyt'       <- chainRenameFilter r lyt
-    return $ VShape q' lyt'
-tail _ = $impossible
-
-sort :: Shape VLDVec -> Shape VLDVec -> Build VL (Shape VLDVec)
-sort (VShape q1 lyt1) (VShape q2 lyt2) = do
-    let leftWidth  = columnsInLayout lyt1
-        rightWidth = columnsInLayout lyt2
+sort :: Shape VLDVec -> Build VL (Shape VLDVec)
+sort (VShape dv (LTuple [xl, sl])) = do
+    let leftWidth  = columnsInLayout xl
+        rightWidth = columnsInLayout sl
 
         sortExprs = map Column [leftWidth+1..leftWidth+rightWidth]
 
-    -- Sort by all columns from the right vector
-    (sortedVec, propVec) <- vlSortS sortExprs =<< vlAlign q1 q2
+    -- Sort by all sorting columns from the right tuple component
+    (dv', sv) <- vlSort sortExprs dv
 
-    -- After sorting, discard the sorting criteria columns from the
-    -- right vector
-    resVec               <- vlProject (map Column [1..leftWidth]) sortedVec
-    lyt1'  <- chainReorder propVec lyt1
-    return $ VShape resVec lyt1'
-sort _e1 _e2 = $impossible
+    -- After sorting, discard the sorting criteria columns
+    dv''      <- vlProject (map Column [1..leftWidth]) dv'
+    xl'       <- sortLayout sv xl
+    return $ VShape dv'' xl'
+sort _e1 = $impossible
 
 -- | The right input contains the grouping columns.
-group ::  Shape VLDVec -> Shape VLDVec -> Build VL (Shape VLDVec)
-group (VShape q1 lyt1) (VShape q2 lyt2) = do
+group ::  Shape VLDVec -> Build VL (Shape VLDVec)
+group (VShape dv (LTuple [lyt1, lyt2])) = do
     let leftWidth  = columnsInLayout lyt1
         rightWidth = columnsInLayout lyt2
 
         groupExprs = map Column [leftWidth+1..leftWidth+rightWidth]
 
-    (outerVec, innerVec, propVec) <- vlGroupS groupExprs =<< vlAlign q1 q2
+    (dvo, dvi, sv) <- vlGroup groupExprs dv
 
     -- Discard the grouping columns in the inner vector
-    innerVec' <- vlProject (map Column [1..leftWidth]) innerVec
+    dvi'           <- vlProject (map Column [1..leftWidth]) dvi
 
-    lyt1'     <- chainReorder propVec lyt1
-    return $ VShape outerVec (LTuple [lyt2, LNest innerVec' lyt1'])
-group _e1 _e2 = $impossible
+    lyt1'          <- sortLayout sv lyt1
+    return $ VShape dvo (LTuple [lyt2, LNest dvi' lyt1'])
+group _e1 = $impossible
 
 length_ ::  Shape VLDVec -> Build VL (Shape VLDVec)
 length_ (VShape q _) = do
     v  <- vlAggr AggrCount q
-    return $ SShape v (LCol 1)
+    return $ SShape v LCol
+length_ _ = $impossible
 
-restrict ::  Shape VLDVec -> Shape VLDVec -> Build VL (Shape VLDVec)
-restrict(VShape q1 lyt) (VShape q2 (LCol 1)) = do
+restrict ::  Shape VLDVec -> Build VL (Shape VLDVec)
+restrict (VShape dv (LTuple [l, LCol])) = do
     -- The right input vector has only one boolean column which
     -- defines wether the tuple at the same position in the left input
     -- is preserved.
-    let leftWidth = columnsInLayout lyt
+    let leftWidth = columnsInLayout l
         predicate = Column $ leftWidth + 1
 
     -- Filter the vector according to the boolean column
-    (filteredVec, renameVec) <- vlSelect predicate =<< vlAlign q1 q2
+    (dv', fv) <- vlSelect predicate dv
 
     -- After the selection, discard the boolean column from the right
-    resVec                   <- vlProject (map Column [1..leftWidth]) filteredVec
-    
+    dv''      <- vlProject (map Column [1..leftWidth]) dv'
+
     -- Filter any inner vectors
-    lyt'                     <- chainRenameFilter renameVec lyt
-    return $ VShape resVec lyt'
-restrict _e1 _e2 = $impossible
+    l'        <- filterLayout fv l
+    return $ VShape dv'' l'
+restrict e1 = trace (show e1) $ $impossible
 
 combine ::  Shape VLDVec -> Shape VLDVec -> Shape VLDVec -> Build VL (Shape VLDVec)
-combine (VShape qb (LCol 1)) (VShape q1 lyt1) (VShape q2 lyt2) = do
-    (v, p1, p2) <- vlCombine qb q1 q2
-    lyt1'       <- renameOuterLyt p1 lyt1
-    lyt2'       <- renameOuterLyt p2 lyt2
-    lyt'        <- appendLayout lyt1' lyt2'
-    return $ VShape v lyt'
+combine (VShape dvb LCol) (VShape dv1 lyt1) (VShape dv2 lyt2) = do
+    (dv, kv1, kv2) <- vlCombine dvb dv1 dv2
+    lyt1'          <- rekeyOuter kv1 lyt1
+    lyt2'          <- rekeyOuter kv2 lyt2
+    lyt'           <- appendLayout lyt1' lyt2'
+    return $ VShape dv lyt'
 combine l1 l2 l3 = trace (show l1 ++ " " ++ show l2 ++ " " ++ show l3) $ $impossible
 
--- | Distribute a single value in vector 'q2' over an arbitrary shape.
--- FIXME accepting a scalar shape makes no sense here. we can only distribute over a list.
-distSingleton :: Shape VLDVec -> VLDVec -> Layout VLDVec -> Build VL (Shape VLDVec)
-distSingleton shape1 q2 lyt2 = do
-    let (shapeCon, q1, lyt1) = unwrapShape shape1
-
-        leftWidth  = columnsInLayout lyt1
-        rightWidth = columnsInLayout lyt2
-        proj       = map Column [leftWidth+1..leftWidth+rightWidth]
+-- | Distribute a single value in vector 'dv2' over an arbitrary
+-- (inner) vector.
+distSingleton :: VLDVec                  -- ^ The singleton outer vector
+              -> Layout VLDVec           -- ^ The outer vector's layout
+              -> VLDVec                  -- ^ The inner vector distributed over
+              -> Build VL (Shape VLDVec)
+distSingleton dv1 lyt1 dv2 = do
+    let leftWidth  = columnsInLayout lyt1
+        proj       = map Column [1..leftWidth]
 
-    (prodVec, _, propVec) <- q1 `vlCartProduct` q2
-    resVec                <- vlProject proj prodVec
+    (dv, rv) <- dv1 `vlDistSng` dv2
+    dv'      <- vlProject proj dv
 
-    lyt'                  <- chainReorder propVec lyt2
-    return $ shapeCon resVec lyt'
+    lyt'     <- repLayout rv lyt1
+    return $ VShape dv' lyt'
 
 dist ::  Shape VLDVec -> Shape VLDVec -> Build VL (Shape VLDVec)
 -- Distributing a single value is implemented using a cartesian
 -- product. After the product, we discard columns from the vector that
 -- we distributed over. Vectors are swapped because CartProduct uses
 -- the descriptor of its left input and that is what we want.
-dist (SShape q lyt) v = distSingleton v q lyt
-dist (VShape q lyt) (VShape qo lyto) = do
+dist (SShape dv lyt) (VShape dv1 _)    = distSingleton dv lyt dv1
+dist (VShape dv lyt) (VShape dvo lyto) = do
     let leftWidth  = columnsInLayout lyto
         rightWidth = columnsInLayout lyt
         innerProj  = map Column [leftWidth+1..leftWidth+rightWidth]
 
-    (prodVec, _, propVec) <- vlNestProduct qo q
-    innerVec              <- vlProject innerProj prodVec
+    (prodVec, _, rv) <- vlNestProduct dvo dv
+    innerVec         <- vlProject innerProj prodVec
 
     -- The outer vector does not have columns, it only describes the
     -- shape.
-    outerVec              <- vlProject [] qo
-    
+    outerVec         <- vlProject [] dvo
+
     -- Replicate any inner vectors
-    lyt'                  <- chainReorder propVec lyt
+    lyt'             <- repLayout rv lyt
 
     return $ VShape outerVec (LNest innerVec lyt')
 dist _ _ = $impossible
 
+only :: Shape VLDVec -> Build VL (Shape VLDVec)
+only (VShape _ (LNest qi lyti)) = return $ VShape qi lyti
+only (VShape q lyt)             = return $ SShape q lyt
+only _                          = $impossible
+
 aggr :: (Expr -> AggrFun) -> Shape VLDVec -> Build VL (Shape VLDVec)
-aggr afun (VShape q (LCol 1)) =
-    SShape <$> vlAggr (afun (Column 1)) q <*> (pure $ LCol 1)
+aggr afun (VShape q LCol) =
+    SShape <$> vlAggr (afun (Column 1)) q <*> pure LCol
 aggr _ _ = $impossible
 
 ifList ::  Shape VLDVec -> Shape VLDVec -> Shape VLDVec -> Build VL (Shape VLDVec)
@@ -283,23 +238,23 @@
     let leftWidth = columnsInLayout lyt1
         predicate = Column $ leftWidth + 1
 
-    VShape trueSelVec _        <- distSingleton (VShape q1 lyt1) qb lytb
-    (trueVec, trueRenameVec)   <- vlSelect predicate 
-                                  =<< vlAlign q1 trueSelVec
-    trueVec'                   <- vlProject (map Column [1..leftWidth]) trueVec
+    VShape trueSelVec _  <- distSingleton qb lytb q1
+    (trueVec, truefv)    <- vlSelect predicate
+                            =<< vlAlign q1 trueSelVec
+    trueVec'             <- vlProject (map Column [1..leftWidth]) trueVec
 
     let predicate' = UnApp (L.SUBoolOp L.Not) predicate
 
-    VShape falseSelVec _       <- distSingleton (VShape q2 lyt2) qb lytb
-    (falseVec, falseRenameVec) <- vlSelect predicate' 
-                                  =<< vlAlign q2 falseSelVec
-    falseVec'                  <- vlProject (map Column [1..leftWidth]) falseVec
+    VShape falseSelVec _ <- distSingleton qb lytb q2
+    (falseVec, falsefv)  <- vlSelect predicate'
+                            =<< vlAlign q2 falseSelVec
+    falseVec'            <- vlProject (map Column [1..leftWidth]) falseVec
 
-    lyt1'                      <- renameOuterLyt trueRenameVec lyt1
-    lyt2'                      <- renameOuterLyt falseRenameVec lyt2
-    lyt'                       <- appendLayout lyt1' lyt2'
+    lyt1'                <- filterLayout truefv lyt1
+    lyt2'                <- filterLayout falsefv lyt2
+    lyt'                 <- appendLayout lyt1' lyt2'
 
-    (bothBranches, _, _)       <- vlAppend trueVec' falseVec'
+    (bothBranches, _, _) <- vlAppend trueVec' falseVec'
 
     return $ VShape bothBranches lyt'
 ifList qb (SShape q1 lyt1) (SShape q2 lyt2) = do
@@ -309,86 +264,85 @@
 
 tuple :: [Shape VLDVec] -> Build VL (Shape VLDVec)
 tuple shapes@(_ : _) = do
-    (q, lyts) <- tupleVectors shapes
-    let lyts' = zipLayouts lyts
-    return $ SShape q (LTuple lyts')
+    (q, lyts) <- boxVectors shapes
+    return $ SShape q (LTuple lyts)
 tuple _ = $impossible
 
 tupElem :: TupleIndex -> Shape VLDVec -> Build VL (Shape VLDVec)
 tupElem i (SShape q (LTuple lyts)) =
     case lyts !! (tupleIndex i - 1) of
         LNest qi lyt -> return $ VShape qi lyt
-        lyt          -> do
-            let (lyt', cols) = projectFromPos lyt
+        _            -> do
+            let (lyt', cols) = projectColumns i lyts
             proj <- vlProject (map Column cols) q
             return $ SShape proj lyt'
 tupElem _ _ = $impossible
 
-transpose :: Shape VLDVec -> Build VL (Shape VLDVec)
-transpose (VShape _ (LNest qi lyt)) = do
-    (qo', qi') <- vlTranspose qi
-    return $ VShape qo' (LNest qi' lyt)
-transpose _ = $impossible
-
-
-reshape :: Integer -> Shape VLDVec -> Build VL (Shape VLDVec)
-reshape n (VShape q lyt) = do
-    (qo, qi) <- vlReshape n q
-    return $ VShape qo (LNest qi lyt)
-reshape _ _ = $impossible
-
 concat :: Shape VLDVec -> Build VL (Shape VLDVec)
-concat (VShape _ (LNest q lyt)) = VShape <$> vlUnsegment q <*> pure lyt
+concat (VShape _ (LNest q lyt)) = return $ VShape q lyt
 concat _e                       = $impossible
 
+onlyL :: Shape VLDVec -> Build VL (Shape VLDVec)
+onlyL (VShape dvo (LNest dvi lyt)) = do
+    (dv, kv) <- vlUnboxSng dvo dvi
+    lyt'     <- rekeyOuter kv lyt
+    return $ VShape dv lyt'
+onlyL _                           = $impossible
+
 --------------------------------------------------------------------------------
 -- Construction of lifted primitives
 
-restrictL :: Shape VLDVec -> Shape VLDVec -> Build VL (Shape VLDVec)
-restrictL (VShape qo (LNest qi lyt)) (VShape _ (LNest qb (LCol 1))) = do
-    VShape qi' lyt' <- restrict (VShape qi lyt) (VShape qb (LCol 1))
+binOpL :: L.ScalarBinOp -> Shape VLDVec -> Shape VLDVec -> Build VL (Shape VLDVec)
+binOpL o (VShape dv1 _) (VShape dv2 _) = do
+    dv <- vlProject [BinApp o (Column 1) (Column 2)] =<< vlAlign dv1 dv2
+    return $ VShape dv LCol
+binOpL _ _ _ = $impossible
+
+restrictL :: Shape VLDVec -> Build VL (Shape VLDVec)
+restrictL (VShape qo (LNest qi lyt)) = do
+    VShape qi' lyt' <- restrict (VShape qi lyt)
     return $ VShape qo (LNest qi' lyt')
-restrictL l1                              l2                          =
-    trace (show l1 ++ " " ++ show l2) $ $impossible
+restrictL l1 = trace (show l1) $ $impossible
 
 combineL :: Shape VLDVec -> Shape VLDVec -> Shape VLDVec -> Build VL (Shape VLDVec)
-combineL (VShape qo (LNest qb (LCol 1)))
+combineL (VShape qo (LNest qb LCol))
          (VShape _ (LNest qi1 lyt1))
          (VShape _ (LNest qi2 lyt2)) = do
-    VShape qi' lyt' <- combine (VShape qb (LCol 1)) (VShape qi1 lyt1) (VShape qi2 lyt2)
+    VShape qi' lyt' <- combine (VShape qb LCol) (VShape qi1 lyt1) (VShape qi2 lyt2)
     return $ VShape qo (LNest qi' lyt')
 combineL _ _ _ = $impossible
 
 zipL ::  Shape VLDVec -> Shape VLDVec -> Build VL (Shape VLDVec)
 zipL (VShape d1 (LNest q1 lyt1)) (VShape _ (LNest q2 lyt2)) = do
     (q', r1, r2) <- vlZipS q1 q2
-    lyt1'        <- chainRenameFilter r1 lyt1
-    lyt2'        <- chainRenameFilter r2 lyt2
-    return $ VShape d1 (LNest q' $ zipLayout lyt1' lyt2')
+    lyt1'        <- rekeyLayout r1 lyt1
+    lyt2'        <- rekeyLayout r2 lyt2
+    return $ VShape d1 (LNest q' $ LTuple [lyt1', lyt2'])
 zipL _ _ = $impossible
 
 cartProductL :: Shape VLDVec -> Shape VLDVec -> Build VL (Shape VLDVec)
-cartProductL (VShape d1 (LNest q1 lyt1)) (VShape _ (LNest q2 lyt2)) = do
-    (q', p1, p2) <- vlCartProductS q1 q2
-    lyt1'        <- chainReorder p1 lyt1
-    lyt2'        <- chainReorder p2 lyt2
-    return $ VShape d1 (LNest q' $ zipLayout lyt1' lyt2')
+cartProductL (VShape dvo1 (LNest dvi1 lyt1)) (VShape _ (LNest dvi2 lyt2)) = do
+    (dv, rv1, rv2) <- vlCartProductS dvi1 dvi2
+    lyt1'        <- repLayout rv1 lyt1
+    lyt2'        <- repLayout rv2 lyt2
+    return $ VShape dvo1 (LNest dv $ LTuple [lyt1', lyt2'])
 cartProductL _ _ = $impossible
 
 nestProductL :: Shape VLDVec -> Shape VLDVec -> Build VL (Shape VLDVec)
-nestProductL (VShape qd1 (LNest qv1 lyt1)) (VShape _qd2 (LNest qv2 lyt2)) = do
-    (qj, qp2) <- vlNestProductS qv1 qv2
-    lyt2'     <- chainReorder qp2 lyt2
-    let lytJ  = zipLayout lyt1 lyt2'
-    return $ VShape qd1 (LNest qv1 (LTuple [lyt1, (LNest qj lytJ)]))
+nestProductL (VShape dvo1 (LNest dvi1 lyt1)) (VShape _dvo2 (LNest dvi2 lyt2)) = do
+    (dvi, rv1, rv2) <- vlNestProductS dvi1 dvi2
+    lyt1'           <- repLayout rv1 lyt1
+    lyt2'           <- repLayout rv2 lyt2
+    let lyt  = LTuple [lyt1', lyt2']
+    return $ VShape dvo1 (LNest dvi1 (LTuple [lyt1, (LNest dvi lyt)]))
 nestProductL _ _ = $impossible
 
 thetaJoinL :: L.JoinPredicate L.JoinExpr -> Shape VLDVec -> Shape VLDVec -> Build VL (Shape VLDVec)
-thetaJoinL joinPred (VShape d1 (LNest q1 lyt1)) (VShape _ (LNest q2 lyt2)) = do
-    (q', p1, p2) <- vlThetaJoinS joinPred q1 q2
-    lyt1'        <- chainReorder p1 lyt1
-    lyt2'        <- chainReorder p2 lyt2
-    return $ VShape d1 (LNest q' $ zipLayout lyt1' lyt2')
+thetaJoinL joinPred (VShape dvo1 (LNest dvi1 lyt1)) (VShape _ (LNest dvi2 lyt2)) = do
+    (dvi, rv1, rv2) <- vlThetaJoinS joinPred dvi1 dvi2
+    lyt1'           <- repLayout rv1 lyt1
+    lyt2'           <- repLayout rv2 lyt2
+    return $ VShape dvo1 (LNest dvi $ LTuple [lyt1', lyt2'])
 thetaJoinL _ _ _ = $impossible
 
 -- △^L :: [[a]] -> [[b]] -> [[(a, [(a, b)])]]
@@ -399,29 +353,28 @@
 -- descriptors. Therefore, we have to 'segment' **after** the join,
 -- i.e. use the left input positions as descriptors
 nestJoinL :: L.JoinPredicate L.JoinExpr -> Shape VLDVec -> Shape VLDVec -> Build VL (Shape VLDVec)
-nestJoinL joinPred (VShape qd1 (LNest qv1 lyt1)) (VShape _qd2 (LNest qv2 lyt2)) = do
-    (qj, qp2) <- vlNestJoinS joinPred qv1 qv2
-    lyt2'     <- chainReorder qp2 lyt2
-    let lytJ  = zipLayout lyt1 lyt2'
-    return $ VShape qd1 (LNest qv1 (LTuple [lyt1,(LNest qj lytJ)]))
+nestJoinL joinPred (VShape dvo1 (LNest dvi1 lyt1)) (VShape _ (LNest dvi2 lyt2)) = do
+    (dv, rv1, rv2) <- vlNestJoinS joinPred dvi1 dvi2
+    lyt1'          <- repLayout rv1 lyt1
+    lyt2'          <- repLayout rv2 lyt2
+    let lyt  = LTuple [lyt1', lyt2']
+    return $ VShape dvo1 (LNest dvo1 (LTuple [lyt1, LNest dv lyt]))
 nestJoinL _ _ _ = $impossible
 
 semiJoinL :: L.JoinPredicate L.JoinExpr -> Shape VLDVec -> Shape VLDVec -> Build VL (Shape VLDVec)
-semiJoinL joinPred (VShape d1 (LNest q1 lyt1)) (VShape _ (LNest q2 _)) = do
-    (qj, r) <- vlSemiJoinS joinPred q1 q2
-    lyt1'   <- chainRenameFilter r lyt1
-    return $ VShape d1 (LNest qj lyt1')
+semiJoinL joinPred (VShape dvo1 (LNest dvi1 lyt1)) (VShape _ (LNest dvi2 _)) = do
+    (dv, fv) <- vlSemiJoinS joinPred dvi1 dvi2
+    lyt1'    <- filterLayout fv lyt1
+    return $ VShape dvo1 (LNest dv lyt1')
 semiJoinL _ _ _ = $impossible
 
 antiJoinL :: L.JoinPredicate L.JoinExpr -> Shape VLDVec -> Shape VLDVec -> Build VL (Shape VLDVec)
-antiJoinL joinPred (VShape d1 (LNest q1 lyt1)) (VShape _ (LNest q2 _)) = do
-    (qj, r) <- vlAntiJoinS joinPred q1 q2
-    lyt1'   <- chainRenameFilter r lyt1
-    return $ VShape d1 (LNest qj lyt1')
+antiJoinL joinPred (VShape dvo1 (LNest dvi1 lyt1)) (VShape _ (LNest dvi2 _)) = do
+    (dv, fv) <- vlAntiJoinS joinPred dvi1 dvi2
+    lyt1'    <- filterLayout fv lyt1
+    return $ VShape dvo1 (LNest dv lyt1')
 antiJoinL _ _ _ = $impossible
 
-
-
 nubL ::  Shape VLDVec -> Build VL (Shape VLDVec)
 nubL (VShape d (LNest q lyt)) =  VShape d <$> (LNest <$> vlUniqueS q <*> pure lyt)
 nubL _ = $impossible
@@ -429,101 +382,65 @@
 numberL ::  Shape VLDVec -> Build VL (Shape VLDVec)
 numberL (VShape d (LNest q lyt)) =
     VShape d <$> (LNest <$> vlNumberS q
-                            <*> (pure $ zipLayout lyt (LCol 1)))
+                        <*> (pure $ LTuple [lyt, LCol]))
 numberL _ = $impossible
 
-initL ::  Shape VLDVec -> Build VL (Shape VLDVec)
-initL (VShape qs (LNest q lyt)) = do
-    is         <- vlAggrS AggrCount qs q
-    (q', r, _) <- vlSelectPosS q (L.SBRelOp L.Lt) is
-    lyt'       <- chainRenameFilter r lyt
-    return $ VShape qs (LNest q' lyt')
-initL _ = $impossible
-
-lastL ::  Shape VLDVec -> Build VL (Shape VLDVec)
-lastL (VShape d (LNest qs lyt@(LNest _ _))) = do
-    is          <- vlAggrS AggrCount d qs
-    (qs', r, _) <- vlSelectPosS qs (L.SBRelOp L.Eq) is
-    lyt'        <- chainRenameFilter r lyt
-    re          <- vlUnboxRename qs'
-    VShape d <$> renameOuterLyt re lyt'
-lastL (VShape d (LNest qs lyt)) = do
-    is          <- vlAggrS AggrCount d qs
-    (qs', r, _) <- vlSelectPosS qs (L.SBRelOp L.Eq) is
-    lyt'        <- chainRenameFilter r lyt
-    re          <- vlUnboxRename d
-    renameOuter re (VShape qs' lyt')
-lastL _ = $impossible
-
-indexL ::  Shape VLDVec -> Shape VLDVec -> Build VL (Shape VLDVec)
-indexL (VShape d (LNest qs (LNest qi lyti))) (VShape idxs (LCol 1)) = do
-    idxs'          <- vlProject [BinApp (L.SBNumOp L.Add) (Column 1) (Constant $ VLInt 1)] idxs
-    (_, _, u)      <- vlSelectPosS qs (L.SBRelOp L.Eq) idxs'
-    (qu, ri)       <- vlUnboxNested u qi
-    lyti'          <- chainRenameFilter ri lyti
-    return $ VShape d (LNest qu lyti')
-indexL (VShape d (LNest qs lyt)) (VShape idxs (LCol 1)) = do
-    idxs'          <- vlProject [BinApp (L.SBNumOp L.Add) (Column 1) (Constant $ VLInt 1)] idxs
-    (qs', r, _)    <- vlSelectPosS qs (L.SBRelOp L.Eq) idxs'
-    lyt'           <- chainRenameFilter r lyt
-    re             <- vlUnboxRename d
-    renameOuter re (VShape qs' lyt')
-indexL _ _ = $impossible
-
 appendL ::  Shape VLDVec -> Shape VLDVec -> Build VL (Shape VLDVec)
 appendL (VShape d lyt1) (VShape _ lyt2) = do
     VShape d <$> appendLayout lyt1 lyt2
 appendL _ _ = $impossible
 
 reverseL ::  Shape VLDVec -> Build VL (Shape VLDVec)
-reverseL (VShape d (LNest d1 lyt)) = do
-    (d1', p) <- vlReverseS d1
-    lyt'     <- chainReorder p lyt
-    return (VShape d (LNest d1' lyt'))
+reverseL (VShape dvo (LNest dvi lyt)) = do
+    (dv, sv) <- vlReverseS dvi
+    lyt'     <- sortLayout sv lyt
+    return (VShape dvo (LNest dv lyt'))
 reverseL _ = $impossible
 
-theL ::  Shape VLDVec -> Build VL (Shape VLDVec)
-theL (VShape d (LNest q lyt)) = do
-    (v, p2, _) <- vlSelectPos1S q (L.SBRelOp L.Eq) 1
-    prop       <- vlUnboxRename d
-    lyt'       <- chainRenameFilter p2 lyt
-    v'         <- vlPropRename prop v
-    return $ VShape v' lyt'
-theL _ = $impossible
+sortL ::  Shape VLDVec -> Build VL (Shape VLDVec)
+sortL (VShape dvo (LNest dvi (LTuple [xl, sl]))) = do
+    let leftWidth  = columnsInLayout xl
+        rightWidth = columnsInLayout sl
 
-tailL ::  Shape VLDVec -> Build VL (Shape VLDVec)
-tailL (VShape d (LNest q lyt)) = do
-    p              <- vlProject [Constant $ VLInt 1] d
-    (v, p2, _)     <- vlSelectPosS q (L.SBRelOp L.Gt) p
-    lyt'           <- chainRenameFilter p2 lyt
-    return $ VShape d (LNest v lyt')
-tailL _ = $impossible
+        sortExprs = map Column [leftWidth+1..leftWidth+rightWidth]
 
-sortL ::  Shape VLDVec -> Shape VLDVec -> Build VL (Shape VLDVec)
-sortL (VShape _ (LNest v1 lyt1)) (VShape d2 (LNest v2 lyt2)) = do
-    VShape innerVec lyt <- sort (VShape v1 lyt1) (VShape v2 lyt2)
-    return $ VShape d2 (LNest innerVec lyt)
-sortL _ _ = $impossible
+    -- Sort by all sorting columns from the right tuple component
+    (sortedVec, sv) <- vlSortS sortExprs dvi
 
-groupL ::  Shape VLDVec -> Shape VLDVec -> Build VL (Shape VLDVec)
-groupL (VShape _ (LNest v1 lyt1)) (VShape d2 (LNest v2 lyt2)) = do
-    let flatRes = group (VShape v1 lyt1) (VShape v2 lyt2)
-    (VShape middleVec (LTuple [groupLyt, LNest innerVec innerLyt])) <- flatRes
-    return $ VShape d2 (LNest middleVec (LTuple [groupLyt, LNest innerVec innerLyt]))
-groupL _ _ = $impossible
+    -- After sorting, discard the sorting criteria columns
+    resVec          <- vlProject (map Column [1..leftWidth]) sortedVec
+    xl'             <- sortLayout sv xl
+    return $ VShape dvo (LNest resVec xl')
+sortL _ = $impossible
 
+groupL ::  Shape VLDVec -> Build VL (Shape VLDVec)
+groupL (VShape dvo (LNest dvi (LTuple [xl, gl]))) = do
+    let leftWidth  = columnsInLayout xl
+        rightWidth = columnsInLayout gl
+
+        groupExprs = map Column [leftWidth+1..leftWidth+rightWidth]
+
+    (dvo', dvi', rv) <- vlGroupS groupExprs dvi
+
+    -- Discard the grouping columns in the inner vector
+    dvi''            <- vlProject (map Column [1..leftWidth]) dvi'
+
+    xl'              <- sortLayout rv xl
+    return $ VShape dvo (LNest dvo' (LTuple [gl, LNest dvi'' xl']))
+groupL _ = $impossible
+
 concatL ::  Shape VLDVec -> Build VL (Shape VLDVec)
 concatL (VShape d (LNest d' vs)) = do
-    p   <- vlUnboxRename d'
-    vs' <- renameOuterLyt p vs
+    p   <- vlUnboxKey d'
+    vs' <- rekeyOuter p vs
     return $ VShape d vs'
 concatL _ = $impossible
 
 lengthL ::  Shape VLDVec -> Build VL (Shape VLDVec)
 lengthL (VShape q (LNest qi _)) = do
     ls  <- vlAggrS AggrCount q qi
-    lsu <- vlUnboxScalar q ls
-    return $ VShape lsu (LCol 1)
+    lsu <- fst <$> vlUnboxSng q ls
+    return $ VShape lsu LCol
 lengthL s = trace (show s) $ $impossible
 
 outer ::  Shape VLDVec -> Build VL VLDVec
@@ -531,85 +448,67 @@
 outer (VShape q _)        = return q
 
 aggrL :: (Expr -> AggrFun) -> Shape VLDVec -> Build VL (Shape VLDVec)
-aggrL afun (VShape d (LNest q (LCol 1))) = do
+aggrL afun (VShape d (LNest q LCol)) = do
     qr <- vlAggrS (afun (Column 1)) d q
-    qu <- vlUnboxScalar d qr
-    return $ VShape qu (LCol 1)
+    qu <- fst <$> vlUnboxSng d qr
+    return $ VShape qu LCol
 aggrL _ _ = $impossible
 
 distL ::  Shape VLDVec -> Shape VLDVec -> Build VL (Shape VLDVec)
-distL (VShape q1 lyt1) (VShape d (LNest q2 lyt2)) = do
-    (qa, p)             <- vlDistLift q1 q2
-    lyt1'               <- chainReorder p lyt1
-    let lyt             = zipLayout lyt1' lyt2
-    VShape qf lytf <- tupElemL First $ VShape qa lyt
-    return $ VShape d (LNest qf lytf)
+distL (VShape dv1 lyt1) (VShape dvo2 (LNest dvi2 lyt2)) = do
+    (dv, rv)        <- vlDistLift dv1 dvi2
+    lyt1'           <- repLayout rv lyt1
+    let lyt = LTuple [lyt1', lyt2]
+    VShape dv' lytf <- tupElemL First $ VShape dv lyt
+    return $ VShape dvo2 (LNest dv' lytf)
 distL _e1 _e2 = $impossible
 
 tupleL :: [Shape VLDVec] -> Build VL (Shape VLDVec)
 tupleL shapes@(_ : _) = do
-    (q, lyts) <- zipVectors shapes
-    let lyts' = zipLayouts lyts
-    return $ VShape q (LTuple lyts')
+    (q, lyts) <- alignVectors shapes
+    return $ VShape q (LTuple lyts)
 tupleL _ = $impossible
 
 tupElemL :: TupleIndex -> Shape VLDVec -> Build VL (Shape VLDVec)
 tupElemL i (VShape q (LTuple lyts)) = do
-    let (lyt', cols) = projectFromPos $ lyts !! (tupleIndex i - 1)
+    let (lyt', cols) = projectColumns i lyts
     proj <- vlProject (map Column cols) q
     return $ VShape proj lyt'
 tupElemL i s = trace (show i ++ " " ++ show s) $impossible
 
-transposeL :: Shape VLDVec -> Build VL (Shape VLDVec)
-transposeL (VShape qo (LNest qm (LNest qi lyt))) = do
-    (qm', qi') <- vlTransposeS qm qi
-    return $ VShape qo (LNest qm' (LNest qi' lyt))
-transposeL _ = $impossible
-
-reshapeL :: Integer -> Shape VLDVec -> Build VL (Shape VLDVec)
-reshapeL n (VShape qo (LNest qi lyt)) = do
-    (qm, qi') <- vlReshapeS n qi
-    return $ VShape qo (LNest qm (LNest qi' lyt))
-reshapeL _ _ = $impossible
-
--- | Create a projection list that extracts only those columns
--- referenced in the sub-layout passed as argument, and shift column
--- names in the sub-layout to the beginning.
-projectFromPos :: Layout VLDVec -> (Layout VLDVec , [DBCol])
-projectFromPos = (\(x,y,_) -> (x,y)) . (projectFromPosWork 1)
-  where
-    projectFromPosWork :: Int -> Layout VLDVec -> (Layout VLDVec, [DBCol], Int)
-    projectFromPosWork c (LCol i)      = (LCol c, [i], c + 1)
-    projectFromPosWork c (LNest q l)   = (LNest q l, [], c)
-    projectFromPosWork c (LTuple lyts) = (LTuple psRes, colsRes, cRes)
-      where
-        (psRes, colsRes, cRes) = List.foldl' tupleWorker ([], [], c) lyts
-
-    tupleWorker (psAcc, colsAcc, cAcc) lyt = (psAcc ++ [lyt'], colsAcc ++ cols, c')
-      where
-        (lyt', cols, c') = projectFromPosWork cAcc lyt
+projectColumns :: TupleIndex -> [Layout VLDVec] -> (Layout VLDVec, [DBCol])
+projectColumns i lyts =
+    let (prefixLyts, lyt : _) = splitAt (tupleIndex i - 1) lyts
+        lytWidth              = columnsInLayout lyt
+        prefixWidth           = sum $ map columnsInLayout prefixLyts
+    in (lyt, [ c + prefixWidth | c <- [1..lytWidth] ])
 
 singleton :: Shape VLDVec -> Build VL (Shape VLDVec)
 singleton (VShape q lyt) = do
-    VLDVec d <- vlSingletonDescr
-    return $ VShape (VLDVec d) (LNest q lyt)
+    (dvo, dvi) <- vlNest q
+    return $ VShape dvo (LNest dvi lyt)
 singleton (SShape q1 lyt) = return $ VShape q1 lyt
 
 singletonL :: Shape VLDVec -> Build VL (Shape VLDVec)
 singletonL (VShape q lyt) = do
-    innerVec <- vlSegment q
-    outerVec <- vlProject [] q
-    return $ VShape outerVec (LNest innerVec lyt)
+    (dvo, dvi) <- vlSegment q
+    return $ VShape dvo (LNest dvi lyt)
 singletonL _ = $impossible
 
 --------------------------------------------------------------------------------
 -- Construction of base tables and literal tables
 
 -- | Create a VL reference to a base table.
-dbTable ::  String -> [L.Column] -> L.TableHints -> Build VL (Shape VLDVec)
-dbTable n cs ks = do
-    t <- vlTableRef n (map (mapSnd typeToScalarType) cs) ks
-    return $ VShape t (LTuple [LCol i | i <- [1..length cs]])
+dbTable ::  String -> L.BaseTableSchema -> Build VL (Shape VLDVec)
+dbTable n schema = do
+    tab <- vlTableRef n schema
+    -- Single-column tables are represented by a flat list and map to
+    -- a flat one-column layout. Multi-column tables map to a list of
+    -- tuples and the corresponding tuple layout.
+    let lyt = case L.tableCols schema of
+                  _ N.:| [] -> LCol
+                  cs        -> LTuple $ map (const LCol) $ N.toList cs
+    return $ VShape tab lyt
 
 -- | Create a VL representation of a literal value.
 mkLiteral ::  Type -> L.Val -> Build VL (Shape VLDVec)
@@ -628,7 +527,7 @@
     litNode <- vlLit L.NonEmpty (P.reverse tabTys) [(P.reverse tabCols)]
     return $ SShape litNode layout
 
-type Table = ([Type], [[VLVal]])
+type Table = ([Type], [[L.ScalarVal]])
 
 -- | Add values to a vector. If necessary (i.e. inner lists are
 -- encountered), create new inner vectors. 'toPlan' receives a
@@ -636,7 +535,7 @@
 -- are currently encoded.
 
 -- FIXME Check if inner list literals are nonempty and flag VL
--- literals appropriately.  
+-- literals appropriately.
 toPlan ::  Table -> Type -> Int -> [L.Val] -> Build VL (Table, Layout VLDVec, Int)
 toPlan (tabTys, tabCols) (ListT t) nextCol es =
     -- Inspect the element type of the list to be encoded
@@ -659,11 +558,11 @@
             mkTupleTable (tabTys, tabCols) nextCol [] colsVals elemTys
 
         _ -> let (hd, vs) = mkColumn t es
-             in return ((hd:tabTys, zipWith (:) vs tabCols), (LCol nextCol), nextCol + 1)
+             in return ((hd:tabTys, zipWith (:) vs tabCols), LCol, nextCol + 1)
 
 toPlan (tabTys, tabCols) t c v =
     let (hd, v') = mkColumn t v
-    in return $ ((hd:tabTys, zipWith (:) v' tabCols), (LCol c), c + 1)
+    in return $ ((hd:tabTys, zipWith (:) v' tabCols), LCol, c + 1)
 
 -- | Construct the literal table for a list of tuples.
 mkTupleTable :: Table                         -- ^ The literal table so far.
@@ -679,8 +578,8 @@
     return $ (tab, LTuple $ P.reverse lyts, nextCol)
 mkTupleTable _   _       _    _                    _        = $impossible
 
-literal :: Type -> VLVal -> Build VL VLDVec
-literal t v = vlLit L.NonEmpty [t] [[VLInt 1, VLInt 1, v]]
+literal :: Type -> L.ScalarVal -> Build VL VLDVec
+literal t v = vlLit L.NonEmpty [t] [[L.IntV 1, L.IntV 1, v]]
 
 listElems :: L.Val -> [L.Val]
 listElems (L.ListV es) = es
@@ -690,14 +589,14 @@
 tupleElems (L.TupleV es) = es
 tupleElems _             = $impossible
 
-mkColumn :: Type -> [L.Val] -> (Type, [VLVal])
+mkColumn :: Type -> [L.Val] -> (Type, [L.ScalarVal])
 mkColumn t vs = (t, [pVal v | v <- vs])
 
 mkDescriptor :: [Int] -> Table
 mkDescriptor lengths =
     let header = []
-        body   = [ [VLInt $ fromInteger p, VLInt $ fromInteger d]
-                 | d <- P.concat [ replicate l p | p <- [1..] | l <- lengths ]  
+        body   = [ [L.IntV $ fromInteger p, L.IntV $ fromInteger d]
+                 | d <- P.concat [ replicate l p | p <- [1..] | l <- lengths ]
                  | p <- [1..]
                  ]
     in (header, body)
@@ -705,48 +604,36 @@
 --------------------------------------------------------------------------------
 -- Helper functions for zipping/tuple construction
 
-zipLayout :: Layout VLDVec -> Layout VLDVec -> Layout VLDVec
-zipLayout l1 l2 = let offSet = columnsInLayout l1
-                      l2' = incrementPositions offSet l2
-                   in LTuple [l1, l2']
-
-incrementPositions :: Int -> Layout VLDVec -> Layout VLDVec
-incrementPositions i (LCol n)       = LCol $ n + i
-incrementPositions _i v@(LNest _ _) = v
-incrementPositions i (LTuple lyts)  = LTuple $ map (incrementPositions i) lyts
-
-zipLayouts :: [Layout VLDVec] -> [Layout VLDVec]
-zipLayouts layouts = go 0 layouts
-
-  where
-    go :: Int -> [Layout VLDVec] -> [Layout VLDVec]
-    go 0 (lyt : lyts) = lyt : go (columnsInLayout lyt) lyts
-    go o (lyt : lyts) = incrementPositions o lyt : go (o + columnsInLayout lyt) lyts
-    go _ []           = []
-
-zipVectors :: [Shape VLDVec] -> Build VL (VLDVec, [Layout VLDVec])
-zipVectors (VShape q1 lyt1 : [])     = return (q1, [lyt1])
-zipVectors (VShape q1 lyt1 : shapes) = do
-    (q, lyts) <- zipVectors shapes
+-- | Simply align a list of shapes and collect their layouts.
+alignVectors :: [Shape VLDVec] -> Build VL (VLDVec, [Layout VLDVec])
+alignVectors (VShape q1 lyt1 : [])     = return (q1, [lyt1])
+alignVectors (VShape q1 lyt1 : shapes) = do
+    (q, lyts) <- alignVectors shapes
     qz' <- vlAlign q1 q
     return (qz', lyt1 : lyts)
-zipVectors _ = $impossible
+alignVectors _ = $impossible
 
-tupleVectors :: [Shape VLDVec] -> Build VL (VLDVec, [Layout VLDVec])
-tupleVectors (SShape q1 lyt1 : [])     = return (q1, [lyt1])
-tupleVectors (VShape q1 lyt1 : [])     = do
-    qo <- vlSingletonDescr
-    qi <- vlUnsegment q1
-    return (qo, [LNest qi lyt1])
-tupleVectors (SShape q1 lyt1 : shapes) = do
-    (q, lyts) <- tupleVectors shapes
-    qz'       <- vlAlign q1 q
-    return (qz', lyt1 : lyts)
-tupleVectors (VShape q1 lyt1 : shapes) = do
-    (q, lyts) <- tupleVectors shapes
-    q1'       <- vlUnsegment q1
-    return (q, LNest q1' lyt1 : lyts)
-tupleVectors s = error $ show s
+-- | Align a list of shapes and nest vectors if necessary. This helper
+-- function covers tuple construction in the unlifted case.
+boxVectors :: [Shape VLDVec] -> Build VL (VLDVec, [Layout VLDVec])
+boxVectors (SShape q1 lyt1 : [])     = return (q1, [lyt1])
+boxVectors (VShape q1 lyt1 : [])     = do
+    (dvo, dvi) <- vlNest q1
+    return (dvo, [LNest dvi lyt1])
+boxVectors (SShape dv1 lyt1 : shapes) = do
+    (dv, lyts)      <- boxVectors shapes
+    (dv', rv1, rv2) <- vlCartProduct dv1 dv
+    lyt1'           <- repLayout rv1 lyt1
+    lyts'           <- mapM (repLayout rv2) lyts
+    return (dv', lyt1' : lyts')
+boxVectors (VShape dv1 lyt1 : shapes) = do
+    (dv, lyts)      <- boxVectors shapes
+    (dvo, dvi)      <- vlNest dv1
+    (dv', rv1, rv2) <- vlCartProduct dvo dv
+    lyt1'           <- repLayout rv1 (LNest dvi lyt1)
+    lyts'           <- mapM (repLayout rv2) lyts
+    return (dv', lyt1' : lyts')
+boxVectors s = error $ show s
 
 --------------------------------------------------------------------------------
 -- Compile-time operations that implement higher-lifted primitives.
@@ -785,77 +672,51 @@
 --------------------------------------------------------------------------------
 -- Vectorization Helper Functions
 
--- | Take a shape apart by extracting the vector, the layout and the
--- shape constructor itself.
-unwrapShape :: Shape VLDVec -> (VLDVec -> Layout VLDVec -> Shape VLDVec, VLDVec, Layout VLDVec)
-unwrapShape (VShape q lyt) = (VShape, q, lyt)
-unwrapShape (SShape q lyt) = (SShape, q, lyt)
-
-fromLayout :: Layout VLDVec -> [DBCol]
-fromLayout (LCol i)      = [i]
-fromLayout (LNest _ _)   = []
-fromLayout (LTuple lyts) = concatMap fromLayout lyts
+appLayout :: v
+          -> (v -> VLDVec -> Build VL (VLDVec, v))
+          -> Layout VLDVec
+          -> Build VL (Layout VLDVec)
+appLayout _ _ LCol = return LCol
+appLayout v appVec (LNest d l) = do
+    (d', v') <- appVec v d
+    l'       <- appLayout v' appVec l
+    return $ LNest d' l'
+appLayout v appVec (LTuple ls) =
+    LTuple <$> mapM (appLayout v appVec) ls
 
--- | chainRenameFilter renames and filters a vector according to a rename vector
--- and propagates these changes to all inner vectors. No reordering is applied,
--- that is the propagation vector must not change the order of tuples.
-chainRenameFilter :: RVec -> Layout VLDVec -> Build VL (Layout VLDVec)
-chainRenameFilter _ l@(LCol _) = return l
-chainRenameFilter r (LNest q lyt) = do
-    (q', r') <- vlPropFilter r q
-    lyt'     <- chainRenameFilter r' lyt
-    return $ LNest q' lyt'
-chainRenameFilter r (LTuple lyts) =
-    LTuple <$> mapM (chainRenameFilter r) lyts
+filterLayout :: VLFVec -> Layout VLDVec -> Build VL (Layout VLDVec)
+filterLayout v l = appLayout v vlAppFilter l
 
--- | chainReorder renames and filters a vector according to a propagation vector
--- and propagates these changes to all inner vectors. The propagation vector
--- may change the order of tuples.
-chainReorder :: PVec -> Layout VLDVec -> Build VL (Layout VLDVec)
-chainReorder _ l@(LCol _) = return l
-chainReorder p (LNest q lyt) = do
-    (q', p') <- vlPropReorder p q
-    lyt'     <- chainReorder p' lyt
-    return $ LNest q' lyt'
-chainReorder p (LTuple lyts) =
-    LTuple <$> mapM (chainReorder p) lyts
+repLayout :: VLRVec -> Layout VLDVec -> Build VL (Layout VLDVec)
+repLayout v l = appLayout v vlAppRep l
 
--- | renameOuter renames and filters a vector according to a rename
--- vector. Changes are not propagated to inner vectors.
-renameOuter :: RVec -> Shape VLDVec -> Build VL (Shape VLDVec)
-renameOuter p (VShape q lyt) = flip VShape lyt <$> vlPropRename p q
-renameOuter _ _ = error "renameOuter: Not possible"
+sortLayout :: VLSVec -> Layout VLDVec -> Build VL (Layout VLDVec)
+sortLayout v l = appLayout v vlAppSort l
 
-renameOuterLyt :: RVec -> Layout VLDVec -> Build VL (Layout VLDVec)
-renameOuterLyt _ l@(LCol _)    = return l
-renameOuterLyt r (LNest q lyt) = flip LNest lyt <$> vlPropRename r q
-renameOuterLyt r (LTuple lyts) = LTuple <$> mapM (renameOuterLyt r) lyts
+rekeyLayout :: VLKVec -> Layout VLDVec -> Build VL (Layout VLDVec)
+rekeyLayout v l = appLayout v vlAppKey l
 
--- | Append two inner vectors (segment-wise).
-appendInnerVec :: Shape VLDVec -> Shape VLDVec -> Build VL (Shape VLDVec)
-appendInnerVec (VShape q1 lyt1) (VShape q2 lyt2) = do
-    -- Append the current vectors
-    (v, p1, p2) <- vlAppendS q1 q2
-    -- Propagate position changes to descriptors of any inner vectors
-    lyt1'       <- renameOuterLyt p1 lyt1
-    lyt2'       <- renameOuterLyt p2 lyt2
-    -- Append the layouts, i.e. actually append all inner vectors
-    lyt'        <- appendLayout lyt1' lyt2'
-    return $ VShape v lyt'
-appendInnerVec _ _ = $impossible
+-- | Apply a rekeying vector to the outermost nested vectors in the
+-- layout.
+rekeyOuter :: VLKVec -> Layout VLDVec -> Build VL (Layout VLDVec)
+rekeyOuter _ LCol          = return LCol
+rekeyOuter r (LNest q lyt) = LNest <$> (fst <$> vlAppKey r q) <*> pure lyt
+rekeyOuter r (LTuple lyts) = LTuple <$> mapM (rekeyOuter r) lyts
 
 -- | Traverse a layout and append all nested vectors that are
 -- encountered.
 appendLayout :: Layout VLDVec -> Layout VLDVec -> Build VL (Layout VLDVec)
-appendLayout (LCol i1) (LCol i2)
-    | i1 == i2  = return $ LCol i1
-    | otherwise = error "appendR': Incompatible vectors"
+appendLayout LCol LCol = return LCol
 -- Append two nested vectors
-appendLayout (LNest q1 lyt1) (LNest q2 lyt2) = do
-    a <- appendInnerVec (VShape q1 lyt1) (VShape q2 lyt2)
-    case a of
-        VShape q lyt -> return $ LNest q lyt
-        _            -> $impossible
+appendLayout (LNest dv1 lyt1) (LNest dv2 lyt2) = do
+    -- Append the current vectors
+    (dv12, kv1, kv2) <- vlAppendS dv1 dv2
+    -- Propagate position changes to descriptors of any inner vectors
+    lyt1'       <- rekeyOuter kv1 lyt1
+    lyt2'       <- rekeyOuter kv2 lyt2
+    -- Append the layouts, i.e. actually append all inner vectors
+    lyt'        <- appendLayout lyt1' lyt2'
+    return $ LNest dv12 lyt'
 appendLayout (LTuple lyts1) (LTuple lyts2) =
     LTuple <$> (sequence $ zipWith appendLayout lyts1 lyts2)
 appendLayout _ _ = $impossible
diff --git a/tests/CombinatorTests.hs b/tests/CombinatorTests.hs
deleted file mode 100644
--- a/tests/CombinatorTests.hs
+++ /dev/null
@@ -1,1241 +0,0 @@
-{-# LANGUAGE TemplateHaskell       #-}
-{-# LANGUAGE GADTs                 #-}
-{-# LANGUAGE TypeFamilies          #-}
-{-# LANGUAGE FlexibleInstances     #-}
-{-# LANGUAGE FlexibleContexts      #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE ViewPatterns          #-}
-
-module CombinatorTests 
-    ( tests_types
-    , tests_boolean
-    , tests_tuples
-    , tests_numerics
-    , tests_maybe
-    , tests_either
-    , tests_lists
-    , tests_lifted
-    , tests_combinators_hunit
-    ) where
-
-import           Common
-
-import qualified Database.DSH as Q
-
-import           Test.QuickCheck
-import           Test.HUnit(Assertion)
-import           Test.Framework (Test, testGroup)
-import           Test.Framework.Providers.QuickCheck2 (testProperty)
-import           Test.Framework.Providers.HUnit
--- import           Data.DeriveTH
-
-import           Data.Char
-import           Data.Text (Text)
-import qualified Data.Text as Text
-
-import           Data.List
-import           Data.Maybe
-import           Data.Either
-import           GHC.Exts
-
-{-
-data D0 = C01 deriving (Eq,Ord,Show)
-
-derive makeArbitrary ''D0
-Q.deriveDSH ''D0
-
-data D1 a = C11 a deriving (Eq,Ord,Show)
-
-derive makeArbitrary ''D1
-Q.deriveDSH ''D1
-
-data D2 a b = C21 a b b a deriving (Eq,Ord,Show)
-
-derive makeArbitrary ''D2
-Q.deriveDSH ''D2
-
-data D3 = C31 
-        | C32 
-        deriving (Eq,Ord,Show)
-
-derive makeArbitrary ''D3
-Q.deriveDSH ''D3
-
-data D4 a = C41 a 
-          | C42 
-          deriving (Eq,Ord,Show)
-
-derive makeArbitrary ''D4
-Q.deriveDSH ''D4
-
-data D5 a = C51 a 
-          | C52 
-          | C53 a a 
-          | C54 a a a 
-          deriving (Eq,Ord,Show)
-
-derive makeArbitrary ''D5
-Q.deriveDSH ''D5
-
-data D6 a b c d e = C61 { c611 :: a, c612 :: (a,b,c,d) } 
-                  | C62 
-                  | C63 a b 
-                  | C64 (a,b,c) 
-                  | C65 a b c d e 
-                  deriving (Eq,Ord,Show)
-
-derive makeArbitrary ''D6
-Q.deriveDSH ''D6
-
--}
-
-tests_types :: Test
-tests_types = testGroup "Supported Types"
-  [ testProperty "()" $ prop_unit
-  , testProperty "Bool" $ prop_bool
-  , testProperty "Char" $ prop_char
-  , testProperty "Text" $ prop_text
-  , testProperty "Integer" $ prop_integer
-  , testProperty "Double" $ prop_double
-  , testProperty "[Integer]" $ prop_list_integer_1
-  , testProperty "[[Integer]]" $ prop_list_integer_2
-  , testProperty "[[[Integer]]]" $ prop_list_integer_3
-  , testProperty "[(Integer, Integer)]" $ prop_list_tuple_integer
-  , testProperty "([], [])" $ prop_tuple_list_integer
-  , testProperty "(,[])" $ prop_tuple_integer_list
-  , testProperty "(,[],)" $ prop_tuple_integer_list_integer
-  , testProperty "Maybe Integer" $ prop_maybe_integer
-  , testProperty "Either Integer Integer" $ prop_either_integer
-  , testProperty "(Int, Int, Int, Int)" $ prop_tuple4
-  , testProperty "(Int, Int, Int, Int, Int)" $ prop_tuple5
-{-
-  , testProperty "D0" $ prop_d0
-  , testProperty "D1" $ prop_d1
-  , testProperty "D2" $ prop_d2
-  , testProperty "D3" $ prop_d3
-  , testProperty "D4" $ prop_d4
-  , testProperty "D5" $ prop_d5
-  , testProperty "D6" $ prop_d6
--}
-  ]
-
-tests_boolean :: Test
-tests_boolean = testGroup "Equality, Boolean Logic and Ordering"
-  [ testProperty "&&" $ prop_infix_and
-  , testProperty "||" $ prop_infix_or
-  , testProperty "not" $ prop_not
-  , testProperty "eq" $ prop_eq
-  , testProperty "neq" $ prop_neq
-  , testProperty "cond" $ prop_cond
-  , testProperty "cond tuples" $ prop_cond_tuples
-  , testProperty "cond ([[Integer]], [[Integer]])" $ prop_cond_list_tuples
-  , testProperty "lt" $ prop_lt
-  , testProperty "lte" $ prop_lte
-  , testProperty "gt" $ prop_gt
-  , testProperty "gte" $ prop_gte
-  , testProperty "min_integer" $ prop_min_integer
-  , testProperty "min_double" $ prop_min_double
-  , testProperty "max_integer" $ prop_max_integer
-  , testProperty "max_double" $ prop_max_double
-  ]
-
-tests_tuples :: Test
-tests_tuples = testGroup "Tuples"
-  [ testProperty "fst" $ prop_fst
-  , testProperty "snd" $ prop_snd
-  , testProperty "fst ([], [])" prop_fst_nested
-  , testProperty "snd ([], [])" prop_snd_nested
-  , testProperty "tup3_1" prop_tup3_1
-  , testProperty "tup3_2" prop_tup3_2
-  , testProperty "tup3_3" prop_tup3_3
-  , testProperty "tup4_2" prop_tup4_2
-  , testProperty "tup4_4" prop_tup4_4
-  , testProperty "tup3_nested" prop_tup3_nested
-  , testProperty "tup4_tup3" prop_tup4_tup3
-  ]
-
-tests_numerics :: Test
-tests_numerics = testGroup "Numerics"
-  [ testProperty "add_integer" $ prop_add_integer
-  , testProperty "add_double" $ prop_add_double
-  , testProperty "mul_integer" $ prop_mul_integer
-  , testProperty "mul_double" $ prop_mul_double
-  , testProperty "div_double" $ prop_div_double
-  , testProperty "integer_to_double" $ prop_integer_to_double
-  , testProperty "integer_to_double_+" $ prop_integer_to_double_arith
-  , testProperty "abs_integer" $ prop_abs_integer
-  , testProperty "abs_double" $ prop_abs_double
-  , testProperty "signum_integer" $ prop_signum_integer
-  , testProperty "signum_double" $ prop_signum_double
-  , testProperty "negate_integer" $ prop_negate_integer
-  , testProperty "negate_double" $ prop_negate_double
-  , testProperty "trig_sin" $ prop_trig_sin
-  , testProperty "trig_cos" $ prop_trig_cos
-  , testProperty "trig_tan" $ prop_trig_tan
-  , testProperty "trig_asin" $ prop_trig_asin
-  , testProperty "trig_acos" $ prop_trig_acos
-  , testProperty "trig_atan" $ prop_trig_atan
-  , testProperty "sqrt" $ prop_sqrt
-  , testProperty "log" $ prop_log
-  , testProperty "exp" $ prop_exp
-  ]
-
-tests_maybe :: Test
-tests_maybe = testGroup "Maybe"
-        [ testProperty "maybe" $ prop_maybe
-        , testProperty "just" $ prop_just
-        , testProperty "isJust" $ prop_isJust
-        , testProperty "isNothing" $ prop_isNothing
-        , testProperty "fromJust" $ prop_fromJust
-        , testProperty "fromMaybe" $ prop_fromMaybe
-        , testProperty "listToMaybe" $ prop_listToMaybe
-        , testProperty "maybeToList" $ prop_maybeToList
-        , testProperty "catMaybes" $ prop_catMaybes
-        , testProperty "mapMaybe" $ prop_mapMaybe
-        ]
-
-tests_either :: Test
-tests_either = testGroup "Either"
-        [ testProperty "left" $ prop_left
-        , testProperty "right" $ prop_right
-        , testProperty "isLeft" $ prop_isLeft
-        , testProperty "isRight" $ prop_isRight
-        , testProperty "either" $ prop_either
-        , testProperty "lefts" $ prop_lefts
-        , testProperty "rights" $ prop_rights
-        , testProperty "partitionEithers" $ prop_partitionEithers
-        ]
-
-tests_lists :: Test
-tests_lists = testGroup "Lists"
-        [ testProperty "singleton" prop_singleton
-        , testProperty "head" $ prop_head
-        , testProperty "tail" $ prop_tail
-        , testProperty "cons" $ prop_cons
-        , testProperty "snoc" $ prop_snoc
-        , testProperty "take" $ prop_take
-        , testProperty "drop" $ prop_drop
-        , testProperty "take ++ drop" $ prop_takedrop
-        , testProperty "map" $ prop_map
-        , testProperty "filter" $ prop_filter
-        , testProperty "filter > 42" $ prop_filter_gt
-        , testProperty "filter > 42 (,[])" $ prop_filter_gt_nested
-        , testProperty "the" $ prop_the
-        , testProperty "last" $ prop_last
-        , testProperty "init" $ prop_init
-        , testProperty "null" $ prop_null
-        , testProperty "length" $ prop_length
-        , testProperty "length tuple list" $ prop_length_tuple
-        , testProperty "index [Integer]" $ prop_index
-        , testProperty "index [(Integer, [Integer])]" $ prop_index_pair
-        , testProperty "index [[]]" $ prop_index_nest
-        , testProperty "reverse" $ prop_reverse
-        , testProperty "reverse [[]]" $ prop_reverse_nest
-        , testProperty "append" $ prop_append
-        , testProperty "append nest" $ prop_append_nest
-        , testProperty "groupWith" $ prop_groupWith
-        , testProperty "groupWithKey" $ prop_groupWithKey
-        , testProperty "groupWith length" $ prop_groupWith_length
-        , testProperty "groupWithKey length" $ prop_groupWithKey_length
-        , testProperty "sortWith" $ prop_sortWith
-        , testProperty "sortWith [(,)]" $ prop_sortWith_pair
-        , testProperty "sortWith [(,[])]" $ prop_sortWith_nest
-        , testProperty "and" $ prop_and
-        , testProperty "or" $ prop_or
-        , testProperty "any_zero" $ prop_any_zero
-        , testProperty "all_zero" $ prop_all_zero
-        , testProperty "sum_integer" $ prop_sum_integer
-        , testProperty "sum_double" $ prop_sum_double
-        , testProperty "avg_integer" $ prop_avg_integer
-        , testProperty "avg_double" $ prop_avg_double
-        , testProperty "concat" $ prop_concat
-        , testProperty "concatMap" $ prop_concatMap
-        , testProperty "maximum" $ prop_maximum
-        , testProperty "minimum" $ prop_minimum
-        , testProperty "splitAt" $ prop_splitAt
-        , testProperty "takeWhile" $ prop_takeWhile
-        , testProperty "dropWhile" $ prop_dropWhile
-        , testProperty "span" $ prop_span
-        , testProperty "break" $ prop_break
-        , testProperty "elem" $ prop_elem
-        , testProperty "notElem" $ prop_notElem
-        , testProperty "lookup" $ prop_lookup
-        , testProperty "zip" $ prop_zip
-        , testProperty "zip3" $ prop_zip3
-        , testProperty "zipWith" $ prop_zipWith
-        , testProperty "zipWith3" $ prop_zipWith3
-        , testProperty "unzip" $ prop_unzip
-        , testProperty "unzip3" $ prop_unzip3
-        , testProperty "nub" $ prop_nub
-        , testProperty "number" $ prop_number
-        , testProperty "reshape" $ prop_reshape
-        , testProperty "reshape2" $ prop_reshape2
-        , testProperty "transpose" $ prop_transpose
-        ]
-
-tests_lifted :: Test
-tests_lifted = testGroup "Lifted operations"
-        [ testProperty "Lifted &&" $ prop_infix_map_and
-        , testProperty "Lifted ||" $ prop_infix_map_or
-        , testProperty "Lifted not" $ prop_map_not
-        , testProperty "Lifted eq" $ prop_map_eq
-        , testProperty "Lifted neq" $ prop_map_neq
-        , testProperty "Lifted cond" $ prop_map_cond
-        , testProperty "Lifted cond tuples" $ prop_map_cond_tuples
-        , testProperty "Lifted cond + concat" $ prop_concatmapcond
-        , testProperty "Lifted lt" $ prop_map_lt
-        , testProperty "Lifted lte" $ prop_map_lte
-        , testProperty "Lifted gt" $ prop_map_gt
-        , testProperty "Lifted gte" $ prop_map_gte
-        , testProperty "Lifted cons" $ prop_map_cons
-        , testProperty "Lifted concat" $ prop_map_concat
-        , testProperty "Lifted fst" $ prop_map_fst
-        , testProperty "Lifted snd" $ prop_map_snd
-        , testProperty "Lifted the" $ prop_map_the
-        --, testProperty "Lifed and" $ prop_map_and
-        , testProperty "map (map (*2))" $ prop_map_map_mul
-        , testProperty "map (map (map (*2)))" $ prop_map_map_map_mul
-        , testProperty "map (\\x -> map (\\y -> x + y) ..) .." $ prop_map_map_add
-        , testProperty "Lifted groupWith" $ prop_map_groupWith
-        , testProperty "Lifted groupWithKey" $ prop_map_groupWithKey
-        , testProperty "Lifted sortWith" $ prop_map_sortWith
-        , testProperty "Lifted sortWith [(,)]" $ prop_map_sortWith_pair
-        , testProperty "Lifted sortWith [(,[])]" $ prop_map_sortWith_nest
-        , testProperty "Lifted sortWith length" $ prop_map_sortWith_length
-        , testProperty "Lifted groupWithKey length" $ prop_map_groupWithKey_length
-        , testProperty "Lifted length" $ prop_map_length
-        , testProperty "Lifted length on [[(a,b)]]" $ prop_map_length_tuple
-        , testProperty "Sortwith length nested" $ prop_sortWith_length_nest
-        , testProperty "GroupWithKey length nested" $ prop_groupWithKey_length_nest
-        , testProperty "Lift minimum" $ prop_map_minimum
-        , testProperty "map (map minimum)" $ prop_map_map_minimum
-        , testProperty "Lift maximum" $ prop_map_maximum
-        , testProperty "map (map maximum)" $ prop_map_map_maximum
-        , testProperty "map integer_to_double" $ prop_map_integer_to_double
-        , testProperty "map tail" $ prop_map_tail
-        , testProperty "map unzip" $ prop_map_unzip
-        , testProperty "map reverse" $ prop_map_reverse
-        , testProperty "map reverse [[]]" $ prop_map_reverse_nest
-        , testProperty "map and" $ prop_map_and
-        , testProperty "map (map and)" $ prop_map_map_and
-        , testProperty "map sum" $ prop_map_sum
-        , testProperty "map avg" $ prop_map_avg
-        , testProperty "map (map sum)" $ prop_map_map_sum
-        , testProperty "map or" $ prop_map_or
-        , testProperty "map (map or)" $ prop_map_map_or
-        , testProperty "map any zero" $ prop_map_any_zero
-        , testProperty "map all zero" $ prop_map_all_zero
-        , testProperty "map filter" $ prop_map_filter
-        , testProperty "map filter > 42" $ prop_map_filter_gt
-        , testProperty "map filter > 42 (,[])" $ prop_map_filter_gt_nested
-        , testProperty "map append" $ prop_map_append
-        , testProperty "map index" $ prop_map_index
-        , testProperty "map index [[]]" $ prop_map_index_nest
-        , testProperty "map init" $ prop_map_init
-        , testProperty "map last" $ prop_map_last
-        , testProperty "map null" $ prop_map_null
-        , testProperty "map nub" $ prop_map_nub
-        , testProperty "map snoc" $ prop_map_snoc
-        , testProperty "map take" $ prop_map_take
-        , testProperty "map drop" $ prop_map_drop
-        , testProperty "map zip" $ prop_map_zip
-        , testProperty "map takeWhile" $ prop_map_takeWhile
-        , testProperty "map dropWhile" $ prop_map_dropWhile
-        , testProperty "map span" $ prop_map_span
-        , testProperty "map break" $ prop_map_break
-        , testProperty "map number" $ prop_map_number
-        , testProperty "map reshape" $ prop_map_reshape
-        , testProperty "map reshape2" $ prop_map_reshape2
-        -- , testProperty "map transpose" $ prop_map_transpose
-        , testProperty "map sin" $ prop_map_trig_sin
-        , testProperty "map cos" $ prop_map_trig_cos
-        , testProperty "map tan" $ prop_map_trig_tan
-        , testProperty "map asin" $ prop_map_trig_asin
-        , testProperty "map acos" $ prop_map_trig_acos
-        , testProperty "map atan" $ prop_map_trig_atan
-        , testProperty "map log" $ prop_map_log
-        , testProperty "map exp" $ prop_map_exp
-        , testProperty "map sqrt" $ prop_map_sqrt
-        ]
-
-tests_combinators_hunit :: Test
-tests_combinators_hunit = testGroup "HUnit combinators"
-    [ testCase "hnegative_sum" hnegative_sum
-    , testCase "hnegative_map_sum" hnegative_map_sum
-    , testCase "hmap_transpose" hmap_transpose
-    ]
-
--- * Supported Types
-
-prop_unit :: () -> Property
-prop_unit = makeProp id id
-
-prop_bool :: Bool -> Property
-prop_bool = makeProp id id
-
-prop_integer :: Integer -> Property
-prop_integer = makeProp id id
-
-prop_double :: Double -> Property
-prop_double = makePropDouble id id
-
-prop_char :: Char -> Property
-prop_char c = isPrint c ==> makeProp id id c
-
-prop_text :: Text -> Property
-prop_text t = Text.all isPrint t ==> makeProp id id t
-
-prop_list_integer_1 :: [Integer] -> Property
-prop_list_integer_1 = makeProp id id
-
-prop_list_integer_2 :: [[Integer]] -> Property
-prop_list_integer_2 = makeProp id id
-
-prop_list_integer_3 :: [[[Integer]]] -> Property
-prop_list_integer_3 = makeProp id id
-
-prop_list_tuple_integer :: [(Integer, Integer)] -> Property
-prop_list_tuple_integer = makeProp id id
-
-prop_maybe_integer :: Maybe Integer -> Property
-prop_maybe_integer = makeProp id id
-
-prop_tuple_list_integer :: ([Integer], [Integer]) -> Property
-prop_tuple_list_integer = makeProp id id
-
-prop_tuple_integer_list :: (Integer, [Integer]) -> Property
-prop_tuple_integer_list = makeProp id id
-
-prop_tuple_integer_list_integer :: (Integer, [Integer], Integer) -> Property
-prop_tuple_integer_list_integer = makeProp id id
-
-prop_either_integer :: Either Integer Integer -> Property
-prop_either_integer = makeProp id id
-
-prop_tuple4 :: [(Integer, Integer, Integer, Integer)] -> Property
-prop_tuple4 = makeProp (Q.map (\(Q.view -> (a, b, c, d)) -> Q.tup4 (a + c) (b - d) b d))
-                       (map (\(a, b, c, d) -> (a + c, b - d, b, d)))
-
-prop_tuple5 :: [(Integer, Integer, Integer, Integer, Integer)] -> Property
-prop_tuple5 = makeProp (Q.map (\(Q.view -> (a, _, c, _, e)) -> Q.tup3 a c e))
-                       (map (\(a, _, c, _, e) -> (a, c, e)))
-
-{-
-
-prop_d0 :: D0 -> Property
-prop_d0 = makeProp id id
-
-prop_d1 :: D1 Integer -> Property
-prop_d1 = makeProp id id
-
-prop_d2 :: D2 Integer Integer -> Property
-prop_d2 = makeProp id id
-
-prop_d3 :: D3 -> Property
-prop_d3 = makeProp id id
-
-prop_d4 :: D4 Integer -> Property
-prop_d4 = makeProp id id
-
-prop_d5 :: D5 Integer -> Property
-prop_d5 = makeProp id id
-
-prop_d6 :: D6 Integer Integer Integer Integer Integer -> Property
-prop_d6 = makeProp id id
-
--}
-
--- * Equality, Boolean Logic and Ordering
-
-prop_infix_and :: (Bool,Bool) -> Property
-prop_infix_and = makeProp (uncurryQ (Q.&&)) (uncurry (&&))
-
-prop_infix_map_and :: (Bool, [Bool]) -> Property
-prop_infix_map_and = makeProp (\x -> Q.map ((Q.fst x) Q.&&) $ Q.snd x) (\(x,xs) -> map (x &&) xs)
-
-prop_infix_or :: (Bool,Bool) -> Property
-prop_infix_or = makeProp (uncurryQ (Q.||)) (uncurry (||))
-
-prop_infix_map_or :: (Bool, [Bool]) -> Property
-prop_infix_map_or = makeProp (\x -> Q.map ((Q.fst x) Q.||) $ Q.snd x) (\(x,xs) -> map (x ||) xs)
-
-prop_not :: Bool -> Property
-prop_not = makeProp Q.not not
-
-prop_map_not :: [Bool] -> Property
-prop_map_not = makeProp (Q.map Q.not) (map not)
-
-prop_eq :: (Integer,Integer) -> Property
-prop_eq = makeProp (uncurryQ (Q.==)) (uncurry (==))
-
-prop_map_eq :: (Integer, [Integer]) -> Property
-prop_map_eq = makeProp (\x -> Q.map ((Q.fst x) Q.==) $ Q.snd x) (\(x,xs) -> map (x ==) xs)
-
-prop_neq :: (Integer,Integer) -> Property
-prop_neq = makeProp (uncurryQ (Q./=)) (uncurry (/=))
-
-prop_map_neq :: (Integer, [Integer]) -> Property
-prop_map_neq = makeProp (\x -> Q.map ((Q.fst x) Q./=) $ Q.snd x) (\(x,xs) -> map (x /=) xs)
-
-prop_cond :: Bool -> Property
-prop_cond = makeProp (\b -> Q.cond b 0 1) (\b -> if b then (0 :: Integer) else 1)
-
-prop_cond_tuples :: (Bool, (Integer, Integer)) -> Property
-prop_cond_tuples = makeProp (\b -> Q.cond (Q.fst b) 
-                                          (Q.pair (Q.fst $ Q.snd b) (Q.fst $ Q.snd b)) 
-                                          (Q.pair (Q.snd $ Q.snd b) (Q.snd $ Q.snd b))) 
-                            (\b -> if fst b 
-                                   then (fst $ snd b, fst $ snd b) 
-                                   else (snd $ snd b, snd $ snd b))
-
-prop_cond_list_tuples :: (Bool, ([[Integer]], [[Integer]])) -> Property
-prop_cond_list_tuples = makeProp (\b -> Q.cond (Q.fst b) 
-                                               (Q.pair (Q.fst $ Q.snd b) (Q.fst $ Q.snd b)) 
-                                               (Q.pair (Q.snd $ Q.snd b) (Q.snd $ Q.snd b))) 
-                                 (\b -> if fst b 
-                                        then (fst $ snd b, fst $ snd b) 
-                                        else (snd $ snd b, snd $ snd b))
-
-prop_map_cond :: [Bool] -> Property
-prop_map_cond = makeProp (Q.map (\b -> Q.cond b (0 :: Q.Q Integer) 1)) 
-                         (map (\b -> if b then 0 else 1))
-
-prop_map_cond_tuples :: [Bool] -> Property
-prop_map_cond_tuples = makeProp (Q.map (\b -> Q.cond b 
-                                                     (Q.toQ (0, 10) :: Q.Q (Integer, Integer)) 
-                                                     (Q.toQ (1, 11)))) 
-                                (map (\b -> if b 
-                                            then (0, 10) 
-                                            else (1, 11)))
-
-prop_concatmapcond :: [Integer] -> Property
-prop_concatmapcond l1 =
-        -- FIXME remove precondition as soon as X100 is fixed
-    (not $ null l1)
-    ==>
-    makeProp q n l1
-        where q l = Q.concatMap (\x -> Q.cond ((Q.>) x (Q.toQ 0)) (x Q.<| el) el) l
-              n l = concatMap (\x -> if x > 0 then [x] else []) l
-              el = Q.toQ []
-
-prop_lt :: (Integer, Integer) -> Property
-prop_lt = makeProp (uncurryQ (Q.<)) (uncurry (<))
-
-prop_map_lt :: (Integer, [Integer]) -> Property
-prop_map_lt = makeProp (\x -> Q.map ((Q.fst x) Q.<) $ Q.snd x) (\(x,xs) -> map (x <) xs)
-
-prop_lte :: (Integer, Integer) -> Property
-prop_lte = makeProp (uncurryQ (Q.<=)) (uncurry (<=))
-
-prop_map_lte :: (Integer, [Integer]) -> Property
-prop_map_lte = makeProp (\x -> Q.map ((Q.fst x) Q.<=) $ Q.snd x) (\(x,xs) -> map (x <=) xs)
-
-prop_gt :: (Integer, Integer) -> Property
-prop_gt = makeProp (uncurryQ (Q.>)) (uncurry (>))
-
-prop_map_gt :: (Integer, [Integer]) -> Property
-prop_map_gt = makeProp (\x -> Q.map ((Q.fst x) Q.>) $ Q.snd x) (\(x,xs) -> map (x >) xs)
-
-prop_gte :: (Integer, Integer) -> Property
-prop_gte = makeProp (uncurryQ (Q.>=)) (uncurry (>=))
-
-prop_map_gte :: (Integer, [Integer]) -> Property
-prop_map_gte = makeProp (\x -> Q.map ((Q.fst x) Q.>=) $ Q.snd x) (\(x,xs) -> map (x >=) xs)
-
-prop_min_integer :: (Integer,Integer) -> Property
-prop_min_integer = makeProp (uncurryQ Q.min) (uncurry min)
-
-prop_max_integer :: (Integer,Integer) -> Property
-prop_max_integer = makeProp (uncurryQ Q.max) (uncurry max)
-
-prop_min_double :: (Double,Double) -> Property
-prop_min_double = makePropDouble (uncurryQ Q.min) (uncurry min)
-
-prop_max_double :: (Double,Double) -> Property
-prop_max_double = makePropDouble (uncurryQ Q.max) (uncurry max)
-
--- * Maybe
-
-prop_maybe :: (Integer, Maybe Integer) -> Property
-prop_maybe =  makeProp (\a -> Q.maybe (Q.fst a) id (Q.snd a)) (\(i,mi) -> maybe i id mi)
-
-prop_just :: Integer -> Property
-prop_just = makeProp Q.just Just
-
-prop_isJust :: Maybe Integer -> Property
-prop_isJust = makeProp Q.isJust isJust
-
-prop_isNothing :: Maybe Integer -> Property
-prop_isNothing = makeProp Q.isNothing isNothing
-
-prop_fromJust :: Maybe Integer -> Property
-prop_fromJust mi = isJust mi ==> makeProp Q.fromJust fromJust mi
-
-prop_fromMaybe :: (Integer,Maybe Integer) -> Property
-prop_fromMaybe = makeProp (uncurryQ Q.fromMaybe) (uncurry fromMaybe)
-
-prop_listToMaybe :: [Integer] -> Property
-prop_listToMaybe = makeProp Q.listToMaybe listToMaybe
-
-prop_maybeToList :: Maybe Integer -> Property
-prop_maybeToList = makeProp Q.maybeToList maybeToList
-
-prop_catMaybes :: [Maybe Integer] -> Property
-prop_catMaybes = makeProp Q.catMaybes catMaybes
-
-prop_mapMaybe :: [Maybe Integer] -> Property
-prop_mapMaybe = makeProp (Q.mapMaybe id) (mapMaybe id)
-
--- * Either
-
-prop_left :: Integer -> Property
-prop_left = makeProp (Q.left :: Q.Q Integer -> Q.Q (Either Integer Integer)) Left
-
-prop_right :: Integer -> Property
-prop_right = makeProp (Q.right :: Q.Q Integer -> Q.Q (Either Integer Integer)) Right
-
-prop_isLeft :: Either Integer Integer -> Property
-prop_isLeft = makeProp Q.isLeft (\e -> case e of {Left _ -> True; Right _ -> False;})
-
-prop_isRight :: Either Integer Integer -> Property
-prop_isRight = makeProp Q.isRight (\e -> case e of {Left _ -> False; Right _ -> True;})
-
-prop_either :: Either Integer Integer -> Property
-prop_either =  makeProp (Q.either id id) (either id id)
-
-prop_lefts :: [Either Integer Integer] -> Property
-prop_lefts =  makeProp Q.lefts lefts
-
-prop_rights :: [Either Integer Integer] -> Property
-prop_rights =  makeProp Q.rights rights
-
-prop_partitionEithers :: [Either Integer Integer] -> Property
-prop_partitionEithers =  makeProp Q.partitionEithers partitionEithers
-
--- * Lists
-
-prop_cons :: (Integer, [Integer]) -> Property
-prop_cons = makeProp (uncurryQ (Q.<|)) (uncurry (:))
-
-prop_map_cons :: (Integer, [[Integer]]) -> Property
-prop_map_cons = makeProp (\x -> Q.map ((Q.fst x) Q.<|) $ Q.snd x) 
-                         (\(x,xs) -> map (x:) xs)
-
-prop_snoc :: ([Integer], Integer) -> Property
-prop_snoc = makeProp (uncurryQ (Q.|>)) (\(a,b) -> a ++ [b])
-
-prop_map_snoc :: ([Integer], [Integer]) -> Property
-prop_map_snoc = makeProp (\z -> Q.map ((Q.fst z) Q.|>) (Q.snd z)) (\(a,b) -> map (\z -> a ++ [z]) b)
-
-prop_singleton :: Integer -> Property
-prop_singleton = makeProp Q.singleton (: [])
-
-prop_head  :: [Integer] -> Property
-prop_head  = makePropNotNull Q.head head
-
-prop_tail  :: [Integer] -> Property
-prop_tail  = makePropNotNull Q.tail tail
-
-prop_last  :: [Integer] -> Property
-prop_last  = makePropNotNull Q.last last
-
-prop_map_last :: [[Integer]] -> Property
-prop_map_last ps = and (map ((>0) . length) ps) ==> makeProp (Q.map Q.last) (map last) ps
-
-prop_init  :: [Integer] -> Property
-prop_init  = makePropNotNull Q.init init
-
-prop_map_init  :: [[Integer]] -> Property
-prop_map_init  ps = and (map ((>0) . length) ps)
-    ==>
-     makeProp (Q.map Q.init) (map init) ps
-
-prop_the   :: (Int, Integer) -> Property
-prop_the (n, i) =
-  n > 0
-  ==>
-  let l = replicate n i in makeProp Q.head the l
-
-prop_map_the :: [(Int, Integer)] -> Property
-prop_map_the ps =
-  let ps' = filter ((>0) . fst) ps in
-  (length ps') > 0
-  ==>
-  let xss = map (\(n, i) -> replicate n i) ps' in
-  makeProp (Q.map Q.head) (map the) xss
-
-prop_map_tail :: [[Integer]] -> Property
-prop_map_tail ps =
-    and [length p > 0 | p <- ps]
-    ==>
-    makeProp (Q.map Q.tail) (map tail) ps
-
-prop_index :: ([Integer], Integer)  -> Property
-prop_index (l, i) =
-        i > 0 && i < fromIntegral (length l)
-    ==> makeProp (uncurryQ (Q.!!))
-                 (\(a,b) -> a !! fromIntegral b)
-                 (l, i)
-
-prop_index_pair :: ([(Integer, [Integer])], Integer) -> Property
-prop_index_pair (l, i) =
-        i > 0 && i < fromIntegral (length l)               
-    ==> makeProp (uncurryQ (Q.!!))
-                 (\(a,b) -> a !! fromIntegral b)
-                 (l, i)
-
-prop_index_nest :: ([[Integer]], Integer)  -> Property
-prop_index_nest (l, i) =
-     i > 0 && i < fromIntegral (length l)
- ==> makeProp (uncurryQ (Q.!!))
-              (\(a,b) -> a !! fromIntegral b)
-              (l, i)
-
-prop_map_index :: ([Integer], [Integer])  -> Property
-prop_map_index (l, is) =
-     and [i >= 0 && i < 2 * fromIntegral (length l) | i <-  is]
- ==> makeProp (\z -> Q.map (((Q.fst z) Q.++ (Q.fst z) Q.++ (Q.fst z)) Q.!!) (Q.snd z))
-              (\(a,b) -> map ((a ++ a ++ a) !!) (map fromIntegral b))
-              (l, is)
-
-prop_map_index_nest :: ([[Integer]], [Integer])  -> Property
-prop_map_index_nest (l, is) =
-     and [i >= 0 && i < 3 * fromIntegral (length l) | i <-  is]
- ==> makeProp (\z -> Q.map (((Q.fst z) Q.++ (Q.fst z) Q.++ (Q.fst z)) Q.!!) (Q.snd z))
-            (\(a,b) -> map ((a ++ a ++ a) !!) (map fromIntegral b))
-            (l, is)
-
-prop_take :: (Integer, [Integer]) -> Property
-prop_take = makeProp (uncurryQ Q.take) (\(n,l) -> take (fromIntegral n) l)
-
-prop_map_take :: (Integer, [[Integer]]) -> Property
-prop_map_take = makeProp (\z -> Q.map (Q.take $ Q.fst z) $ Q.snd z) (\(n,l) -> map (take (fromIntegral n)) l)
-
-prop_drop :: (Integer, [Integer]) -> Property
-prop_drop = makeProp (uncurryQ Q.drop) (\(n,l) -> drop (fromIntegral n) l)
-
-prop_map_drop :: (Integer, [[Integer]]) -> Property
-prop_map_drop = makeProp (\z -> Q.map (Q.drop $ Q.fst z) $ Q.snd z) (\(n,l) -> map (drop (fromIntegral n)) l)
-
-prop_takedrop :: (Integer, [Integer]) -> Property
-prop_takedrop = makeProp takedrop_q takedrop
-  where takedrop_q = \p -> Q.append ((Q.take (Q.fst p)) (Q.snd p)) ((Q.drop (Q.fst p)) (Q.snd p))
-        takedrop (n, l) = (take (fromIntegral n) l) ++ (drop (fromIntegral n) l)
-
-prop_map :: [Integer] -> Property
-prop_map = makeProp (Q.map id) (map id)
-
-prop_map_map_mul :: [[Integer]] -> Property
-prop_map_map_mul = makeProp (Q.map (Q.map (*2))) (map (map (*2)))
-
-prop_map_map_add :: ([Integer], [Integer]) -> Property
-prop_map_map_add = makeProp (\z -> Q.map (\x -> (Q.map (\y -> x + y) $ Q.snd z)) $ Q.fst z) (\(l,r) -> map (\x -> map (\y -> x + y) r) l)
-
-prop_map_map_map_mul :: [[[Integer]]] -> Property
-prop_map_map_map_mul = makeProp (Q.map (Q.map (Q.map (*2)))) (map (map (map (*2))))
-
-prop_append :: ([Integer], [Integer]) -> Property
-prop_append = makeProp (uncurryQ (Q.++)) (uncurry (++))
-
-prop_append_nest :: ([[Integer]], [[Integer]]) -> Property
-prop_append_nest = makeProp (uncurryQ (Q.append)) (\(a,b) -> a ++ b)
-
-prop_map_append :: ([Integer], [[Integer]]) -> Property
-prop_map_append = makeProp (\z -> Q.map (Q.fst z Q.++) (Q.snd z)) (\(a,b) -> map (a ++) b)
-
-prop_filter :: [Integer] -> Property
-prop_filter = makeProp (Q.filter (const $ Q.toQ True)) (filter $ const True)
-
-prop_filter_gt :: [Integer] -> Property
-prop_filter_gt = makeProp (Q.filter (Q.> 42)) (filter (> 42))
-
-prop_filter_gt_nested :: [(Integer, [Integer])] -> Property
-prop_filter_gt_nested = makeProp (Q.filter ((Q.> 42) . Q.fst)) (filter ((> 42) . fst))
-
-prop_map_filter :: [[Integer]] -> Property
-prop_map_filter = makeProp (Q.map (Q.filter (const $ Q.toQ True))) (map (filter $ const True))
-
-prop_map_filter_gt :: [[Integer]] -> Property
-prop_map_filter_gt = makeProp (Q.map (Q.filter (Q.> 42))) (map (filter (> 42)))
-
-prop_map_filter_gt_nested :: [[(Integer, [Integer])]] -> Property
-prop_map_filter_gt_nested = makeProp (Q.map (Q.filter ((Q.> 42) . Q.fst))) (map (filter ((> 42) . fst)))
-
-prop_groupWith :: [Integer] -> Property
-prop_groupWith = makeProp (Q.groupWith id) (groupWith id)
-
-groupWithKey :: Ord b => (a -> b) -> [a] -> [(b, [a])]
-groupWithKey p as = map (\g -> (the $ map p g, g)) $ groupWith p as
-
-prop_groupWithKey :: [Integer] -> Property
-prop_groupWithKey = makeProp (Q.groupWithKey id) (groupWithKey id)
-
-prop_map_groupWith :: [[Integer]] -> Property
-prop_map_groupWith = makeProp (Q.map (Q.groupWith id)) (map (groupWith id))
-
-prop_map_groupWithKey :: [[Integer]] -> Property
-prop_map_groupWithKey = makeProp (Q.map (Q.groupWithKey id)) (map (groupWithKey id))
-
-prop_groupWith_length :: [[Integer]] -> Property
-prop_groupWith_length = makeProp (Q.groupWith Q.length) (groupWith length)
-
-prop_groupWithKey_length :: [[Integer]] -> Property
-prop_groupWithKey_length = makeProp (Q.groupWithKey Q.length) (groupWithKey (fromIntegral . length))
-
-prop_sortWith  :: [Integer] -> Property
-prop_sortWith = makeProp (Q.sortWith id) (sortWith id)
-
-prop_sortWith_pair :: [(Integer, Integer)] -> Property
-prop_sortWith_pair = makeProp (Q.sortWith Q.fst) (sortWith fst)
-
-prop_sortWith_nest  :: [(Integer, [Integer])] -> Property
-prop_sortWith_nest = makeProp (Q.sortWith Q.fst) (sortWith fst)
-
-prop_map_sortWith :: [[Integer]] -> Property
-prop_map_sortWith = makeProp (Q.map (Q.sortWith id)) (map (sortWith id))
-
-prop_map_sortWith_pair :: [[(Integer, Integer)]] -> Property
-prop_map_sortWith_pair = makeProp (Q.map (Q.sortWith Q.fst)) (map (sortWith fst))
-
-prop_map_sortWith_nest :: [[(Integer, [Integer])]] -> Property
-prop_map_sortWith_nest = makeProp (Q.map (Q.sortWith Q.fst)) (map (sortWith fst))
-
-prop_map_sortWith_length :: [[[Integer]]] -> Property
-prop_map_sortWith_length = makeProp (Q.map (Q.sortWith Q.length)) (map (sortWith length))
-
-prop_map_groupWith_length :: [[[Integer]]] -> Property
-prop_map_groupWith_length = makeProp (Q.map (Q.groupWith Q.length)) (map (groupWith length))
-
-prop_map_groupWithKey_length :: [[[Integer]]] -> Property
-prop_map_groupWithKey_length = makeProp (Q.map (Q.groupWithKey Q.length)) (map (groupWithKey (fromIntegral . length)))
-
-prop_sortWith_length_nest  :: [[[Integer]]] -> Property
-prop_sortWith_length_nest = makeProp (Q.sortWith Q.length) (sortWith length)
-
-prop_groupWith_length_nest :: [[[Integer]]] -> Property
-prop_groupWith_length_nest = makeProp (Q.groupWith Q.length) (groupWith length)
-
-prop_groupWithKey_length_nest :: [[[Integer]]] -> Property
-prop_groupWithKey_length_nest = makeProp (Q.groupWithKey Q.length) (groupWithKey (fromIntegral . length))
-
-prop_null :: [Integer] -> Property
-prop_null = makeProp Q.null null
-
-prop_map_null :: [[Integer]] -> Property
-prop_map_null = makeProp (Q.map Q.null) (map null)
-
-prop_length :: [Integer] -> Property
-prop_length = makeProp Q.length ((fromIntegral :: Int -> Integer) . length)
-
-prop_length_tuple :: [(Integer, Integer)] -> Property
-prop_length_tuple = makeProp Q.length (fromIntegral . length)
-
-prop_map_length :: [[Integer]] -> Property
-prop_map_length = makeProp (Q.map Q.length) (map (fromIntegral . length))
-
-prop_map_minimum :: [[Integer]] -> Property
-prop_map_minimum ps = and (map (\p -> length p > 0) ps)
-        ==>
-    makeProp (Q.map Q.minimum) (map (fromIntegral . minimum)) ps
-
-prop_map_maximum :: [[Integer]] -> Property
-prop_map_maximum ps = and (map (\p -> length p > 0) ps)
-        ==>
-    makeProp (Q.map Q.maximum) (map (fromIntegral . maximum)) ps
-
-prop_map_map_minimum :: [[[Integer]]] -> Property
-prop_map_map_minimum ps = and (map (and . map (\p -> length p > 0)) ps)
-        ==>
-    makeProp (Q.map (Q.map Q.minimum)) (map (map(fromIntegral . minimum))) ps
-
-prop_map_map_maximum :: [[[Integer]]] -> Property
-prop_map_map_maximum ps = and (map (and . map (\p -> length p > 0)) ps)
-        ==>
-    makeProp (Q.map (Q.map Q.maximum)) (map (map(fromIntegral . maximum))) ps
-
-
-prop_map_length_tuple :: [[(Integer, Integer)]] -> Property
-prop_map_length_tuple = makeProp (Q.map Q.length) (map (fromIntegral . length))
-
-prop_reverse :: [Integer] -> Property
-prop_reverse = makeProp Q.reverse reverse
-
-prop_reverse_nest :: [[Integer]] -> Property
-prop_reverse_nest = makeProp Q.reverse reverse
-
-prop_map_reverse :: [[Integer]] -> Property
-prop_map_reverse = makeProp (Q.map Q.reverse) (map reverse)
-
-prop_map_reverse_nest :: [[[Integer]]] -> Property
-prop_map_reverse_nest = makeProp (Q.map Q.reverse) (map reverse)
-
-prop_and :: [Bool] -> Property
-prop_and = makeProp Q.and and
-
-prop_map_and :: [[Bool]] -> Property
-prop_map_and = makeProp (Q.map Q.and) (map and)
-
-prop_map_map_and :: [[[Bool]]] -> Property
-prop_map_map_and = makeProp (Q.map (Q.map Q.and)) (map (map and))
-
-prop_or :: [Bool] -> Property
-prop_or = makeProp Q.or or
-
-prop_map_or :: [[Bool]] -> Property
-prop_map_or = makeProp (Q.map Q.or) (map or)
-
-prop_map_map_or :: [[[Bool]]] -> Property
-prop_map_map_or = makeProp (Q.map (Q.map Q.or)) (map (map or))
-
-prop_any_zero :: [Integer] -> Property
-prop_any_zero = makeProp (Q.any (Q.== 0)) (any (== 0))
-
-prop_map_any_zero :: [[Integer]] -> Property
-prop_map_any_zero = makeProp (Q.map (Q.any (Q.== 0))) (map (any (== 0)))
-
-prop_all_zero :: [Integer] -> Property
-prop_all_zero = makeProp (Q.all (Q.== 0)) (all (== 0))
-
-prop_map_all_zero :: [[Integer]] -> Property
-prop_map_all_zero = makeProp (Q.map (Q.all (Q.== 0))) (map (all (== 0)))
-
-prop_sum_integer :: [Integer] -> Property
-prop_sum_integer = makeProp Q.sum sum
-                 
-avgInt :: [Integer] -> Double
-avgInt is = (realToFrac $ sum is) / (fromIntegral $ length is)
-
-prop_avg_integer :: [Integer] -> Property
-prop_avg_integer is = (not $ null is) ==> makeProp Q.avg avgInt is
-
-prop_map_sum :: [[Integer]] -> Property
-prop_map_sum = makeProp (Q.map Q.sum) (map sum)
-
-prop_map_avg :: [[Integer]] -> Property
-prop_map_avg is = (not $ any null is) ==> makeProp (Q.map Q.avg) (map avgInt) is
-
-prop_map_map_sum :: [[[Integer]]] -> Property
-prop_map_map_sum = makeProp (Q.map (Q.map Q.sum)) (map (map sum))
-
-prop_map_map_avg :: [[[Integer]]] -> Property
-prop_map_map_avg is = (not $ any (any null) is) ==> makeProp (Q.map (Q.map Q.avg)) (map (map avgInt))
-
-prop_sum_double :: [Double] -> Property
-prop_sum_double = makePropDouble Q.sum sum
-
-avgDouble :: [Double] -> Double
-avgDouble ds = sum ds / (fromIntegral $ length ds)
-
-prop_avg_double :: [Double] -> Property
-prop_avg_double ds = (not $ null ds) ==> makePropDouble Q.avg avgDouble ds
-
-prop_concat :: [[Integer]] -> Property
-prop_concat = makeProp Q.concat concat
-
-prop_map_concat :: [[[Integer]]] -> Property
-prop_map_concat = makeProp (Q.map Q.concat) (map concat)
-
-prop_concatMap :: [Integer] -> Property
-prop_concatMap = makeProp (Q.concatMap Q.singleton) (concatMap (: []))
-
-prop_maximum :: [Integer] -> Property
-prop_maximum = makePropNotNull Q.maximum maximum
-
-prop_minimum :: [Integer] -> Property
-prop_minimum = makePropNotNull Q.minimum minimum
-
-prop_splitAt :: (Integer, [Integer]) -> Property
-prop_splitAt = makeProp (uncurryQ Q.splitAt) (\(a,b) -> splitAt (fromIntegral a) b)
-
-prop_takeWhile :: (Integer, [Integer]) -> Property
-prop_takeWhile = makeProp (uncurryQ $ Q.takeWhile . (Q.==))
-                          (uncurry  $   takeWhile . (==))
-
-prop_dropWhile :: (Integer, [Integer]) -> Property
-prop_dropWhile = makeProp (uncurryQ $ Q.dropWhile . (Q.==))
-                          (uncurry  $   dropWhile . (==))
-
-prop_map_takeWhile :: (Integer, [[Integer]]) -> Property
-prop_map_takeWhile = makeProp (\z -> Q.map (Q.takeWhile (Q.fst z Q.==)) (Q.snd z))
-                              (\z -> map (takeWhile (fst z ==)) (snd z))
-
-prop_map_dropWhile :: (Integer, [[Integer]]) -> Property
-prop_map_dropWhile = makeProp (\z -> Q.map (Q.dropWhile (Q.fst z Q.==)) (Q.snd z))
-                              (\z -> map (dropWhile (fst z ==)) (snd z))
-
-prop_span :: (Integer, [Integer]) -> Property
-prop_span = makeProp (uncurryQ $ Q.span . (Q.==))
-                     (uncurry   $   span . (==) . fromIntegral)
-
-prop_map_span :: (Integer, [[Integer]]) -> Property
-prop_map_span = makeProp (\z -> Q.map (Q.span ((Q.fst z) Q.==)) (Q.snd z))
-                         (\z -> map (span (fst z ==)) (snd z))
-
-prop_break :: (Integer, [Integer]) -> Property
-prop_break = makeProp (uncurryQ $ Q.break . (Q.==))
-                      (uncurry   $   break . (==) . fromIntegral)
-
-prop_map_break :: (Integer, [[Integer]]) -> Property
-prop_map_break = makeProp (\z -> Q.map (Q.break ((Q.fst z) Q.==)) (Q.snd z))
-                          (\z -> map (break (fst z ==)) (snd z))
-
-prop_elem :: (Integer, [Integer]) -> Property
-prop_elem = makeProp (uncurryQ Q.elem)
-                     (uncurry    elem)
-
-prop_notElem :: (Integer, [Integer]) -> Property
-prop_notElem = makeProp (uncurryQ Q.notElem)
-                        (uncurry    notElem)
-
-prop_lookup :: (Integer, [(Integer,Integer)]) -> Property
-prop_lookup = makeProp (uncurryQ Q.lookup)
-                       (uncurry    lookup)
-
-prop_zip :: ([Integer], [Integer]) -> Property
-prop_zip = makeProp (uncurryQ Q.zip) (uncurry zip)
-
-prop_map_zip :: ([Integer], [[Integer]]) -> Property
-prop_map_zip = makeProp (\z -> Q.map (Q.zip $ Q.fst z) $ Q.snd z) (\(x, y) -> map (zip x) y)
-
-prop_zipWith :: ([Integer], [Integer]) -> Property
-prop_zipWith = makeProp (uncurryQ $ Q.zipWith (+)) (uncurry $ zipWith (+))
-
-prop_unzip :: [(Integer, Integer)] -> Property
-prop_unzip = makeProp Q.unzip unzip
-
-prop_map_unzip :: [[(Integer, Integer)]] -> Property
-prop_map_unzip = makeProp (Q.map Q.unzip) (map unzip)
-
-prop_zip3 :: ([Integer], [Integer],[Integer]) -> Property
-prop_zip3 = makeProp (\q -> (case Q.view q of (as,bs,cs) -> Q.zip3 as bs cs))
-                     (\(as,bs,cs) -> zip3 as bs cs)
-
-prop_zipWith3 :: ([Integer], [Integer],[Integer]) -> Property
-prop_zipWith3 = makeProp (\q -> (case Q.view q of (as,bs,cs) -> Q.zipWith3 (\a b c -> a + b + c) as bs cs))
-                         (\(as,bs,cs) -> zipWith3 (\a b c -> a + b + c) as bs cs)
-
-prop_unzip3 :: [(Integer, Integer, Integer)] -> Property
-prop_unzip3 = makeProp Q.unzip3 unzip3
-
-prop_nub :: [Integer] -> Property
-prop_nub = makeProp Q.nub nub
-
-prop_map_nub :: [[(Integer, Integer)]] -> Property
-prop_map_nub = makeProp (Q.map Q.nub) (map nub)
-
--- * Tuples
-
-prop_fst :: (Integer, Integer) -> Property
-prop_fst = makeProp Q.fst fst
-
-prop_fst_nested :: ([Integer], [Integer]) -> Property
-prop_fst_nested = makeProp Q.fst fst
-
-prop_map_fst :: [(Integer, Integer)] -> Property
-prop_map_fst = makeProp (Q.map Q.fst) (map fst)
-
-prop_snd :: (Integer, Integer) -> Property
-prop_snd = makeProp Q.snd snd
-
-prop_map_snd :: [(Integer, Integer)] -> Property
-prop_map_snd = makeProp (Q.map Q.snd) (map snd)
-
-prop_snd_nested :: ([Integer], [Integer]) -> Property
-prop_snd_nested = makeProp Q.snd snd
-
-prop_tup3_1 :: (Integer, Integer, Integer) -> Property
-prop_tup3_1 = makeProp (\q -> case Q.view q of (a, _, _) -> a) (\(a, _, _) -> a)
-
-prop_tup3_2 :: (Integer, Integer, Integer) -> Property
-prop_tup3_2 = makeProp (\q -> case Q.view q of (_, b, _) -> b) (\(_, b, _) -> b)
-
-prop_tup3_3 :: (Integer, Integer, Integer) -> Property
-prop_tup3_3 = makeProp (\q -> case Q.view q of (_, _, c) -> c) (\(_, _, c) -> c)
-
-prop_tup4_2 :: (Integer, Integer, Integer, Integer) -> Property
-prop_tup4_2 = makeProp (\q -> case Q.view q of (_, b, _, _) -> b) (\(_, b, _, _) -> b)
-
-prop_tup4_4 :: (Integer, Integer, Integer, Integer) -> Property
-prop_tup4_4 = makeProp (\q -> case Q.view q of (_, _, _, d) -> d) (\(_, _, _, d) -> d)
-
-prop_tup3_nested :: (Integer, [Integer], Integer) -> Property
-prop_tup3_nested = makeProp (\q -> case Q.view q of (_, b, _) -> b) (\(_, b, _) -> b)
-
-prop_tup4_tup3 :: (Integer, Integer, Integer, Integer) -> Property
-prop_tup4_tup3 = makeProp (\q -> case Q.view q of (a, b, _, d) -> Q.tup3 a b d) 
-                          (\(a, b, _, d) -> (a, b, d))
-
--- * Numerics
-
-prop_add_integer :: (Integer,Integer) -> Property
-prop_add_integer = makeProp (uncurryQ (+)) (uncurry (+))
-
-prop_add_double :: (Double,Double) -> Property
-prop_add_double = makePropDouble (uncurryQ (+)) (uncurry (+))
-
-prop_mul_integer :: (Integer,Integer) -> Property
-prop_mul_integer = makeProp (uncurryQ (*)) (uncurry (*))
-
-prop_mul_double :: (Double,Double) -> Property
-prop_mul_double = makePropDouble (uncurryQ (*)) (uncurry (*))
-
-prop_div_double :: (Double,Double) -> Property
-prop_div_double (x,y) =
-      y /= 0
-  ==> makePropDouble (uncurryQ (/)) (uncurry (/)) (x,y)
-
-prop_integer_to_double :: Integer -> Property
-prop_integer_to_double = makePropDouble Q.integerToDouble fromInteger
-
-prop_integer_to_double_arith :: (Integer, Double) -> Property
-prop_integer_to_double_arith = makePropDouble (\x -> (Q.integerToDouble (Q.fst x)) + (Q.snd x))
-                                              (\(i, d) -> fromInteger i + d)
-
-prop_map_integer_to_double :: [Integer] -> Property
-prop_map_integer_to_double = makePropListDouble (Q.map Q.integerToDouble) (map fromInteger)
-
-prop_abs_integer :: Integer -> Property
-prop_abs_integer = makeProp Q.abs abs
-
-prop_abs_double :: Double -> Property
-prop_abs_double = makePropDouble Q.abs abs
-
-prop_signum_integer :: Integer -> Property
-prop_signum_integer = makeProp Q.signum signum
-
-prop_signum_double :: Double -> Property
-prop_signum_double = makePropDouble Q.signum signum
-
-prop_negate_integer :: Integer -> Property
-prop_negate_integer = makeProp Q.negate negate
-
-prop_negate_double :: Double -> Property
-prop_negate_double = makePropDouble Q.negate negate
-
-prop_trig_sin :: Double -> Property
-prop_trig_sin = makePropDouble Q.sin sin
-
-prop_trig_cos :: Double -> Property
-prop_trig_cos = makePropDouble Q.cos cos
-
-prop_trig_tan :: Double -> Property
-prop_trig_tan = makePropDouble Q.tan tan
-
-prop_exp :: Double -> Property
-prop_exp = makePropDouble Q.exp exp
-
-prop_log :: Double -> Property
-prop_log d = d > 0 ==> makePropDouble Q.log log d
-
-prop_sqrt :: Double -> Property
-prop_sqrt d = d > 0 ==> makePropDouble Q.sqrt sqrt d
-
-arc :: Double -> Bool
-arc d = d >= -1 && d <= 1
-
-prop_trig_asin :: Double -> Property
-prop_trig_asin d = arc d ==>  makePropDouble Q.asin asin d
-
-prop_trig_acos :: Double -> Property
-prop_trig_acos d = arc d ==> makePropDouble Q.acos acos d
-
-prop_trig_atan :: Double -> Property
-prop_trig_atan = makePropDouble Q.atan atan
-
-prop_number :: [Integer] -> Property
-prop_number = makeProp (Q.map Q.snd . Q.number) (\xs -> map snd $ zip xs [1..])
-
-prop_map_number :: [[Integer]] -> Property
-prop_map_number = makeProp (Q.map (Q.map Q.snd . Q.number))
-                            (map (\xs -> map snd $ zip xs [1..]))
-
-prop_transpose :: [[Integer]] -> Property
-prop_transpose = makeProp Q.transpose transpose
-
-{-
-prop_map_transpose :: [[[Integer]]] -> Property
-prop_map_transpose xss = 
-    (all (not . null) (xss :: [[[Integer]]])
-    &&
-    and (map (all (not . null)) xss))
-    ==> makeProp (Q.map Q.transpose) (map transpose)
--}
-
-reshape :: Int -> [a] -> [[a]]
-reshape _ [] = []
-reshape i xs = take i xs : reshape i (drop i xs)
-
-prop_reshape :: [Integer] -> Property
-prop_reshape = makeProp (Q.reshape 5) (reshape 5)
-
-prop_reshape2 :: [Integer] -> Property
-prop_reshape2 = makeProp (Q.reshape 2) (reshape 2)
-             
-prop_map_reshape :: [[Integer]] -> Property
-prop_map_reshape = makeProp (Q.map (Q.reshape 8)) (map (reshape 8))
-
-prop_map_reshape2 :: [[Integer]] -> Property
-prop_map_reshape2 = makeProp (Q.map (Q.reshape 2)) (map (reshape 2))
-
-prop_map_trig_sin :: [Double] -> Property
-prop_map_trig_sin = makePropListDouble (Q.map Q.sin) (map sin)
-
-prop_map_trig_cos :: [Double] -> Property
-prop_map_trig_cos = makePropListDouble (Q.map Q.cos) (map cos)
-
-prop_map_trig_tan :: [Double] -> Property
-prop_map_trig_tan = makePropListDouble (Q.map Q.tan) (map tan)
-
-prop_map_trig_asin :: [Double] -> Property
-prop_map_trig_asin ds = all arc ds ==> makePropListDouble (Q.map Q.asin) (map asin) ds
-
-prop_map_trig_acos :: [Double] -> Property
-prop_map_trig_acos ds = all arc ds ==> makePropListDouble (Q.map Q.acos) (map acos) ds
-
-prop_map_trig_atan :: [Double] -> Property
-prop_map_trig_atan = makePropListDouble (Q.map Q.atan) (map atan)
-
-prop_map_exp :: [Double] -> Property
-prop_map_exp = makePropListDouble (Q.map Q.exp) (map exp)
-
-prop_map_log :: [Double] -> Property
-prop_map_log ds = all (> 0) ds ==> makePropListDouble (Q.map Q.log) (map log) ds
-
-prop_map_sqrt :: [Double] -> Property
-prop_map_sqrt ds = all (> 0) ds ==> makePropListDouble (Q.map Q.sqrt) (map sqrt) ds
-                   
-
-hnegative_sum :: Assertion
-hnegative_sum = makeEqAssertion "hnegative_sum" (Q.sum (Q.toQ xs)) (sum xs)
-  where
-    xs :: [Integer]
-    xs = [-1, -4, -5, 2]
-
-hnegative_map_sum :: Assertion
-hnegative_map_sum = makeEqAssertion "hnegative_map_sum" 
-                                    (Q.map Q.sum (Q.toQ xss)) 
-                                    (map sum xss)
-  where
-    xss :: [[Integer]]
-    xss = [[10, 20, 30], [-10, -20, -30], [], [0]]
-
-hmap_transpose :: Assertion
-hmap_transpose = makeEqAssertion "hmap_transpose" (Q.map Q.transpose (Q.toQ xss)) res
-  where
-    xss :: [[[Integer]]]
-    xss = [ [ [10, 20, 30]
-            , [40, 50, 60]]
-          , [ [100, 200]
-            , [300, 400]
-            , [500, 600]]
-          ]
-
-    res :: [[[Integer]]]
-    res = [ [ [10, 40]
-            , [20, 50]
-            , [30, 60]
-            ]
-          , [ [100, 300, 500]
-            , [200, 400, 600]
-            ]
-          ]
diff --git a/tests/ComprehensionTests.hs b/tests/ComprehensionTests.hs
deleted file mode 100644
--- a/tests/ComprehensionTests.hs
+++ /dev/null
@@ -1,526 +0,0 @@
-module ComprehensionTests where
-
-import           Common
-import qualified DSHComprehensions                    as C
-
-import           Test.Framework                       (Test, testGroup)
-import           Test.Framework.Providers.HUnit
-import           Test.Framework.Providers.QuickCheck2 (testProperty)
-import           Test.HUnit                           (Assertion)
-import           Test.QuickCheck
-
-tests_comprehensions :: Test
-tests_comprehensions = testGroup "Comprehensions"
-    [ testProperty "cartprod" prop_cartprod
-    , testProperty "eqjoin" prop_eqjoin
-    , testProperty "eqjoinproj" prop_eqjoinproj
-    , testProperty "eqjoinpred" prop_eqjoinpred
-    , testProperty "eqjointuples" prop_eqjointuples
-    , testProperty "thetajoin_eq" prop_thetajoin_eq
-    , testProperty "thetajoin_neq" prop_thetajoin_neq
-    , testProperty "eqjoin3" prop_eqjoin3
-    , testProperty "eqjoin_nested_left" prop_eqjoin_nested_left
-    , testProperty "eqjoin_nested_right" prop_eqjoin_nested_right
-    , testProperty "eqjoin_nested_both" prop_eqjoin_nested_both
-    , testProperty "nestjoin" prop_nestjoin
-    , testProperty "nestjoin3" prop_nestjoin3
-    , testProperty "antijoin class12" prop_aj_class12
-    , testProperty "antijoin class15" prop_aj_class15
-    , testProperty "antijoin class16" prop_aj_class16
-    , testProperty "backdep1" prop_backdep
-    , testProperty "backdep_filter" prop_backdep_filter
-    , testProperty "backdep2" prop_backdep2
-    , testProperty "backdep3" prop_backdep3
-    , testProperty "backdep4" prop_backdep4
-    , testProperty "backdep5" prop_backdep5
-    , testProperty "deep" prop_deep_iter
-    ]
-
-tests_join_hunit :: Test
-tests_join_hunit = testGroup "HUnit joins"
-    [ testCase "heqjoin_nested1" heqjoin_nested1
-    , testCase "hsemijoin" hsemijoin
-    , testCase "hsemijoin_range" hsemijoin_range
-    , testCase "hsemijoin_quant" hsemijoin_quant
-    , testCase "hsemijoin_not_null" hsemijoin_not_null
-    , testCase "hantijoin" hantijoin
-    , testCase "hantijoin_range" hantijoin_range
-    , testCase "hantijoin_null" hantijoin_null
-    , testCase "hantijoin_class12" hantijoin_class12
-    , testCase "hantijoin_class15" hantijoin_class15
-    , testCase "hantijoin_class16" hantijoin_class16
-    , testCase "hfrontguard" hfrontguard
-    ]
-
-tests_nest_head_hunit :: Test
-tests_nest_head_hunit = testGroup "HUnit head nesting"
-    [ testCase "hnj1" hnj1
-    , testCase "hnj2" hnj2
-    , testCase "hnj3" hnj3
-    , testCase "hnj4" hnj4
-    , testCase "hnj5" hnj5
-    , testCase "hnj6" hnj6
-    , testCase "hnj7" hnj7
-    , testCase "hnj8" hnj8
-    , testCase "hnj9" hnj9
-    , testCase "hnj10" hnj10
-    , testCase "hnj11" hnj11
-    , testCase "hnj12" hnj12
-    , testCase "hnp1" hnp1
-    , testCase "hnp2" hnp2
-    , testCase "hnp3" hnp3
-    , testCase "hnp4" hnp4
-    ]
-
-tests_nest_guard_hunit :: Test
-tests_nest_guard_hunit = testGroup "HUnit guard nesting"
-    [ testCase "hnjg1" hnjg1
-    , testCase "hnjg2" hnjg2
-    , testCase "hnjg3" hnjg3
-    , testCase "hnjg4" hnjg4
-    , testCase "hnjg5" hnjg5
-    ]
-
----------------------------------------------------------------------------------
--- QuickCheck properties for comprehensions
-
-prop_cartprod :: ([Integer], [Integer]) -> Property
-prop_cartprod = makeProp C.cartprod cartprod_native
-  where
-    cartprod_native (xs, ys) = [ (x, y) | x <- xs, y <- ys]
-
-prop_eqjoin :: ([Integer], [Integer]) -> Property
-prop_eqjoin = makeProp C.eqjoin eqjoin_native
-  where
-    eqjoin_native (xs, ys) = [ (x, y) | x <- xs , y <- ys , x == y ]
-
-prop_eqjoinproj :: ([Integer], [Integer]) -> Property
-prop_eqjoinproj = makeProp C.eqjoinproj eqjoinproj_native
-  where
-    eqjoinproj_native (xs, ys) = [ (x, y) | x <- xs , y <- ys , (2 * x) == y ]
-
-prop_eqjoinpred :: (Integer, [Integer], [Integer]) -> Property
-prop_eqjoinpred = makeProp C.eqjoinpred eqjoinpred_native
-  where
-    eqjoinpred_native (x', xs, ys) = [ (x, y) | x <- xs , y <- ys , x == y , x > x']
-
-prop_eqjointuples :: ([(Integer, Integer)], [(Integer, Integer)]) -> Property
-prop_eqjointuples = makeProp C.eqjointuples eqjointuples_native
-  where
-    eqjointuples_native (xs, ys) = [ (x1 * x2, y1, y2)
-                                   | (x1, x2) <- xs
-                                   , (y1, y2) <- ys
-                                   , x1 == y2
-                                   ]
-
-prop_thetajoin_eq :: ([(Integer, Integer)], [(Integer, Integer)]) -> Property
-prop_thetajoin_eq = makeProp C.thetajoin_eq thetajoin_eq_native
-  where
-    thetajoin_eq_native (xs, ys) = [ (x1 * x2, y1, y2)
-                                   | (x1, x2) <- xs
-                                   , (y1, y2) <- ys
-                                   , x1 == y2
-                                   , y1 == x2
-                                   ]
-
-prop_thetajoin_neq :: ([(Integer, Integer)], [(Integer, Integer)]) -> Property
-prop_thetajoin_neq = makeProp C.thetajoin_neq thetajoin_neq_native
-  where
-    thetajoin_neq_native (xs, ys) = [ (x1 * x2, y1, y2)
-                                    | (x1, x2) <- xs
-                                    , (y1, y2) <- ys
-                                    , x1 == y2
-                                    , y1 /= x2
-                                    ]
-
-
-prop_eqjoin3 :: ([Integer], [Integer], [Integer]) -> Property
-prop_eqjoin3 = makeProp C.eqjoin3 eqjoin3_native
-  where
-    eqjoin3_native (xs, ys, zs) = [ (x, y, z) | x <- xs , y <- ys , z <- zs , x == y , y == z]
-
-prop_eqjoin_nested_left :: ([(Integer, [Integer])], [Integer]) -> Property
-prop_eqjoin_nested_left = makeProp C.eqjoin_nested_left eqjoin_nested_left_native
-  where
-    eqjoin_nested_left_native (xs, ys) = [ (x, y) | x <- xs , y <- ys , fst x == y]
-
-prop_eqjoin_nested_right :: ([Integer], [(Integer, [Integer])]) -> Property
-prop_eqjoin_nested_right = makeProp C.eqjoin_nested_right eqjoin_nested_right_native
-  where
-    eqjoin_nested_right_native (xs, ys) = [ (x, y) | x <- xs , y <- ys , x == fst y]
-
-prop_eqjoin_nested_both :: ([(Integer, [Integer])], [(Integer, [Integer])]) -> Property
-prop_eqjoin_nested_both = makeProp C.eqjoin_nested_both eqjoin_nested_both_native
-  where
-    eqjoin_nested_both_native (xs, ys) = [ (x, y) | x <- xs , y <- ys , fst x == fst y]
-
-prop_nestjoin :: ([Integer], [Integer]) -> Property
-prop_nestjoin = makeProp C.nestjoin nestjoin_native
-  where
-    nestjoin_native (xs, ys) = [ (x, [ y | y <- ys, x == y ]) | x <- xs]
-
-prop_nestjoin3 :: ([Integer], [Integer], [Integer]) -> Property
-prop_nestjoin3 = makeProp C.nestjoin3 nestjoin3_native
-  where
-    nestjoin3_native (njxs, njys, njzs) = 
-        [ [ [ (x,y,z) | z <- njzs, y == z ]
-          | y <- njys
-          , x == y
-          ]
-        | x <- njxs
-        ]
-
-prop_aj_class12 :: ([Integer], [Integer]) -> Property
-prop_aj_class12 = makeProp C.aj_class12 aj_class12_native
-  where
-    aj_class12_native (ajxs, ajys) = [ x 
-                                     | x <- ajxs
-                                     , and [ x == y | y <- ajys, y > 10 ]
-                                     ]
-
-prop_aj_class15 :: ([Integer], [Integer]) -> Property
-prop_aj_class15 = makeProp C.aj_class15 aj_class15_native
-  where
-    aj_class15_native (ajxs, ajys) = [ x 
-                                     | x <- ajxs
-                                     , and [ y `mod` 4 == 0 | y <- ajys, x < y ]
-                                     ]
-
-prop_aj_class16 :: ([Integer], [Integer]) -> Property
-prop_aj_class16 = makeProp C.aj_class16 aj_class16_native
-  where
-    aj_class16_native (ajxs, ajys) = [ x 
-                                     | x <- ajxs
-                                     , and [ y <= 2 * x | y <- ajys, x < y ]
-                                     ]
-
-prop_backdep :: [[Integer]] -> Property
-prop_backdep = makeProp C.backdep backdep_native
-  where
-    backdep_native xss = [x | xs <- xss, x <- xs]
-
-prop_backdep_filter :: [[Integer]] -> Property
-prop_backdep_filter = makeProp C.backdep_filter backdep_filter_native
-  where
-    backdep_filter_native xss = [x | xs <- xss, x <- xs, fromIntegral (length xs) > x]
-
-prop_backdep2 :: [[Integer]] -> Property
-prop_backdep2 = makeProp C.backdep2 backdep2
-  where
-    backdep2 xss = [ [ x * 42 | x <- xs ] | xs <- xss ]
-
-prop_backdep3 :: [[Integer]] -> Property
-prop_backdep3 = makeProp C.backdep3 backdep3
-  where
-    backdep3 xss = [ [ x + fromIntegral (length xs) | x <- xs ] | xs <- xss ]
-
-prop_backdep4 :: [[[Integer]]] -> Property
-prop_backdep4 = makeProp C.backdep4 backdep4
-  where
-    backdep4 xsss = [ [ [ x + fromIntegral (length xs) + fromIntegral (length xss)
-                        | x <- xs
-                        ]
-                      | xs <- xss
-                      ]
-                    | xss <- xsss
-                    ]
-
-prop_backdep5 :: [[Integer]] -> Property
-prop_backdep5 = makeProp C.backdep5 backdep5
-  where
-    backdep5 xss = [ [ x + fromIntegral (length xs) 
-                     | x <- take (length xs - 3) xs ] 
-                   | xs <- xss ]
-
-
-
------------------------------------------------------------------------
--- HUnit tests for comprehensions
-
-heqjoin_nested1 :: Assertion
-heqjoin_nested1 = makeEqAssertion "heqjoin_nested" C.eqjoin_nested1 res
-  where
-    res = [ ((20, ['b']), 20)
-          , ((30, ['c', 'd']), 30)
-          , ((30, ['c', 'd']), 30)
-          , ((40, []), 40)
-          ]
-
-hsemijoin :: Assertion
-hsemijoin = makeEqAssertion "hsemijoin" C.semijoin res
-  where
-    res = [2, 4, 6, 7]
-
-hsemijoin_range :: Assertion
-hsemijoin_range = makeEqAssertion "hsemijoin_range" C.semijoin_range res
-  where
-    res = [2, 4]
-
-hsemijoin_not_null :: Assertion
-hsemijoin_not_null = makeEqAssertion "hsemijoin_range" C.semijoin_not_null res
-  where
-    res = [2, 4, 6, 7]
-
-hsemijoin_quant :: Assertion
-hsemijoin_quant = makeEqAssertion "hsemijoin_quant" C.semijoin_quant res
-  where
-    res = [6,7]
-
-hantijoin :: Assertion
-hantijoin = makeEqAssertion "hantijoin" C.antijoin res
-  where
-    res = [1, 3, 5]
-
-hantijoin_range :: Assertion
-hantijoin_range = makeEqAssertion "hantijoin_range" C.antijoin_range res
-  where
-    res = [1, 3, 5, 6, 7]
-
-hantijoin_null :: Assertion
-hantijoin_null = makeEqAssertion "hantijoin_range" C.antijoin_null res
-  where
-    res = [1, 3, 5]
-
-hantijoin_class12 :: Assertion
-hantijoin_class12 = makeEqAssertion "hantijoin_class12" C.antijoin_class12 res
-  where
-    res = [6,7,8,9,10]
-
-hantijoin_class15 :: Assertion
-hantijoin_class15 = makeEqAssertion "hantijoin_class15" C.antijoin_class15 res
-  where
-    res = [5,6,7,8]
-
-hantijoin_class16 :: Assertion
-hantijoin_class16 = makeEqAssertion "hantijoin_class16" C.antijoin_class16 res
-  where
-    res = [4,5,6]
-
-hfrontguard :: Assertion
-hfrontguard = makeEqAssertion "hfrontguard" C.frontguard res
-  where
-    res = [[],[1,2],[1,2]] 
-
------------------------------------------------------------------------
--- HUnit tests for nestjoin/nestproduct
-
-njxs1 :: [Integer]
-njxs1 = [1,2,3,4,5,6]
-
-njys1 :: [Integer]
-njys1 = [3,4,5,6,3,6,4,1,1,1]
-
-hnj1 :: Assertion
-hnj1 = makeEqAssertion "hnj1" (C.nj1 njxs1 njys1) (nj1 njxs1 njys1)
-
-hnj2 :: Assertion
-hnj2 = makeEqAssertion "hnj2" (C.nj2 njxs1 njys1) (nj2 njxs1 njys1)
-
-hnj3 :: Assertion
-hnj3 = makeEqAssertion "hnj3" (C.nj3 njxs1 njys1) (nj3 njxs1 njys1)
-
-hnj4 :: Assertion
-hnj4 = makeEqAssertion "hnj4" (C.nj4 njxs1 njys1) (nj4 njxs1 njys1)
-
-hnj5 :: Assertion
-hnj5 = makeEqAssertion "hnj5" (C.nj5 njxs1 njys1) (nj5 njxs1 njys1)
-
-hnj6 :: Assertion
-hnj6 = makeEqAssertion "hnj6" (C.nj6 njxs1 njys1) (nj6 njxs1 njys1)
-
-hnj7 :: Assertion
-hnj7 = makeEqAssertion "hnj7" (C.nj7 njxs1 njys1) (nj7 njxs1 njys1)
-
-hnj8 :: Assertion
-hnj8 = makeEqAssertion "hnj8" (C.nj8 njxs1 njys1) (nj8 njxs1 njys1)
-
-hnj9 :: Assertion
-hnj9 = makeEqAssertion "hnj9" (C.nj9 njxs1 njys1) (nj9 njxs1 njys1)
-
-hnj10 :: Assertion
-hnj10 = makeEqAssertion "hnj10" (C.nj10 njxs1 njys1) (nj10 njxs1 njys1)
-
-hnj11 :: Assertion
-hnj11 = makeEqAssertion "hnj11" (C.nj11 njxs1 njys1) (nj11 njxs1 njys1)
-
--- Test data for testcase hnj12
-njxs2, njys2, njzs2 :: [Integer]
-njxs2 = [1,2,3,4,5,5,2]
-njys2 = [2,1,0,5,4,4,4]
-njzs2 = [6,1,1,3,2,5]
-
-hnj12 :: Assertion
-hnj12 = makeEqAssertion "hnj12" (C.nj12 njxs2 njys2 njzs2) (nj12 njxs2 njys2 njzs2)
-
-hnp1 :: Assertion
-hnp1 = makeEqAssertion "hnp1" (C.np1 njxs1 njys1) (np1 njxs1 njys1)
-
-hnp2 :: Assertion
-hnp2 = makeEqAssertion "hnp2" (C.np2 njxs1 njys1) (np2 njxs1 njys1)
-
-hnp3 :: Assertion
-hnp3 = makeEqAssertion "hnp3" (C.np3 njxs1 njys1) (np3 njxs1 njys1)
-
-hnp4 :: Assertion
-hnp4 = makeEqAssertion "hnp4" (C.np4 njxs1 njys1) (np4 njxs1 njys1)
-
-hnjg1 :: Assertion
-hnjg1 = makeEqAssertion "hnjg1" (C.njg1 njgxs1 njgzs1) (njg1 njgxs1 njgzs1)
-
-hnjg2 :: Assertion
-hnjg2 = makeEqAssertion "hnjg2" (C.njg2 njgxs1 njgys1) (njg2 njgxs1 njgys1)
-
-hnjg3 :: Assertion
-hnjg3 = makeEqAssertion "hnjg3" (C.njg3 njgxs1 njgys1 njgzs1) (njg3 njgxs1 njgys1 njgzs1)
-
-hnjg4 :: Assertion
-hnjg4 = makeEqAssertion "hnjg4" (C.njg4 njgxs1 njgys1 njgzs1) (njg4 njgxs1 njgys1 njgzs1)
-
-hnjg5 :: Assertion
-hnjg5 = makeEqAssertion "hnjg5" (C.njg5 njgxs1 njgys1) (njg5 njgxs1 njgys1)
-
-pair :: a -> b -> (a, b)
-pair = (,)
-
--- Head/NestJoin
-nj1 :: [Integer] -> [Integer] -> [[Integer]]
-nj1 njxs njys =
-    [ [ y | y <- njys, x == y ]
-    | x <- njxs
-    ]
-
-nj2 :: [Integer] -> [Integer] -> [(Integer, [Integer])]
-nj2 njxs njys =
-    [ pair x [ y | y <- njys, x == y ]
-    | x <- njxs
-    ]
-
-nj3 :: [Integer] -> [Integer] -> [(Integer, [Integer])]
-nj3 njxs njys =
-    [ pair x ([ y | y <- njys, x == y ] ++ ([100, 200, 300]))
-    | x <- njxs
-    ]
-
-nj4 :: [Integer] -> [Integer] -> [(Integer, [Integer])]
-nj4 njxs njys =
-      [ pair x ([ y | y <- njys, x == y ] ++ [ z | z <- njys, x == z ])
-      | x <- njxs
-      ]
-
-nj5 :: [Integer] -> [Integer] -> [(Integer, [Integer])]
-nj5 njxs njys =
-      [ pair x [ y | y <- njys, x + y > 15 ]
-      | x <- njxs
-      ]
-
-nj6 :: [Integer] -> [Integer] -> [(Integer, [Integer])]
-nj6 njxs njys =
-      [ pair x [ y | y <- njys, x + y > 10, y < 7 ]
-      | x <- njxs
-      ]
-
-nj7 :: [Integer] -> [Integer] -> [[Integer]]
-nj7 njxs njys =
-    [ [ x + y | y <- njys, x + 2 == y ] | x <- njxs ]
-
-nj8 :: [Integer] -> [Integer] -> [[Integer]]
-nj8 njxs njys = [ [ x + y | y <- njys, x == y, y < 5 ] | x <- njxs, x > 3 ]
-
-nj9 :: [Integer] -> [Integer] -> [[Integer]]
-nj9 njxs njys = [ [ x + y | y <- njys, x + 1 == y, y > 2, x < 6 ] | x <- njxs ]
-
-nj10 :: [Integer] -> [Integer] -> [Integer]
-nj10 njxs njys = [ x + sum [ x * y | y <- njys, x == y ] | x <- njxs ]
-
-nj11 :: [Integer] -> [Integer] -> [[Integer]]
-nj11 njxs njys = [ [ x + y | y <- njys, x > y, x < y * 2 ] | x <- njxs ]
-
-nj12 :: [Integer] -> [Integer] -> [Integer] -> [[[(Integer, Integer, Integer)]]]
-nj12 njxs njys njzs =
-    [ [ [ (x,y,z) | z <- njzs, y == z ]
-      | y <- njys
-      , x == y
-      ]
-    | x <- njxs
-    ]
-
--- Head/NestProduct
-np1 :: [Integer] -> [Integer] -> [[Integer]]
-np1 njxs njys = [ [ x * y * 2 | y <- njys ] | x <- njxs ]
-
-np2 :: [Integer] -> [Integer] -> [(Integer, [Integer])]
-np2 njxs njys = [ pair x [ y * 2 | y <- njys ] | x <- njxs ]
-
-np3 :: [Integer] -> [Integer] -> [[Integer]]
-np3 njxs njys = [ [ x + y | y <- njys ] | x <- njxs ]
-
-np4 :: [Integer] -> [Integer] -> [[Integer]]
-np4 njxs njys = [ [ y | y <- njys, x > y ] | x <- njxs ]
-
--- Guard/NestJoin
-
-njgxs1 :: [Integer]
-njgxs1 = [1,2,3,4,5,6,7,8,12]
-
-njgys1 :: [Integer]
-njgys1 = [2,3,2,4,5,5,9,12,2,2,13]
-
-njgzs1 :: [(Integer, Integer)]
-njgzs1 = [(2, 20), (5, 60), (3, 30), (3, 80), (4, 40), (5, 10), (5, 30), (12, 120)]
-
-njg1 :: [Integer] -> [(Integer, Integer)] -> [Integer]
-njg1 njgxs njgzs =
-  [ x
-  | x <- njgxs
-  , x < 8
-  , sum [ snd z | z <- njgzs, fst z == x ] > 100
-  ]
-
-njg2 :: [Integer] -> [Integer] -> [Integer]
-njg2 njgxs njgys =
-  [ x
-  | x <- njgxs
-  , and [ y > 1 | y <- njgys, x == y ]
-  , x < 8
-  ]
-
-njg3 :: [Integer] -> [Integer] -> [(Integer, Integer)] -> [(Integer, Integer)]
-njg3 njgxs njgys njgzs =
-  [ pair x y
-  | x <- njgxs
-  , y <- njgys
-  , length [ () | z <- njgzs, fst z == x ] > 2
-  ]
-
-njg4 :: [Integer] -> [Integer] -> [(Integer, Integer)] -> [Integer]
-njg4 njgxs njgys njgzs =
-  [ x
-  | x <- njgxs
-  , length [ () | y <- njgys, x == y ]
-    > length [ () | z <- njgzs, fst z == x ]
-  ]
-
-njg5 :: [Integer] -> [Integer] -> [Integer]
-njg5 njgxs njgys =
-  [ x
-  | x <- njgxs
-  , sum [ y | y <- njgys, x < y, y > 5 ] < 10
-  ]
-
---------------------------------------------------------------------------------
---
-
-prop_deep_iter :: ([Integer], [Integer], [Integer], [Integer], [Integer]) -> Property
-prop_deep_iter = makeProp C.deep_iter deep_iter_native
-  where
-    deep_iter_native (ws1, ws2, xs, ys, zs) = 
-      [ [ [ [ w1 * 23 - y | w1 <- ws1 ]
-            ++
-            [ w2 + 42 - y | w2 <- ws2 ]
-          | z <- zs
-          , z > x
-          ]
-        | y <- ys
-        ]
-      | x <- xs
-      ]
diff --git a/tests/DSHComprehensions.hs b/tests/DSHComprehensions.hs
deleted file mode 100644
--- a/tests/DSHComprehensions.hs
+++ /dev/null
@@ -1,384 +0,0 @@
-{-# LANGUAGE RebindableSyntax    #-}
-{-# LANGUAGE ViewPatterns        #-}
-{-# LANGUAGE MonadComprehensions #-}
-    
--- | This module contains testcases for monad comprehensions. We store them in a
--- separate module because they rely on RebindableSyntax and hidden Prelude.
-   
-module DSHComprehensions where
-
-import qualified Prelude as P
-import Database.DSH
-       
----------------------------------------------------------------
--- Comprehensions for quickcheck tests
-
-cartprod :: Q ([Integer], [Integer]) -> Q [(Integer, Integer)]
-cartprod (view -> (xs, ys)) =
-  [ tup2 x y
-  | x <- xs
-  , y <- ys
-  ]
-
-eqjoin :: Q ([Integer], [Integer]) -> Q [(Integer, Integer)]
-eqjoin (view -> (xs, ys)) = 
-  [ tup2 x y
-  | x <- xs
-  , y <- ys
-  , x == y
-  ]
-
-  
-eqjoinproj :: Q ([Integer], [Integer]) -> Q [(Integer, Integer)]
-eqjoinproj (view -> (xs, ys)) = 
-  [ tup2 x y
-  | x <- xs
-  , y <- ys
-  , (2 * x) == y
-  ]
-
-eqjoinpred :: Q (Integer, [Integer], [Integer]) -> Q [(Integer, Integer)]
-eqjoinpred (view -> (x', xs, ys)) = 
-  [ tup2 x y
-  | x <- xs
-  , y <- ys
-  , x == y
-  , x > x'
-  ]
-
-eqjointuples :: Q ([(Integer, Integer)], [(Integer, Integer)]) -> Q [(Integer, Integer, Integer)]
-eqjointuples (view -> (xs, ys)) =
-  [ tup3 (x1 * x2) y1 y2
-  | (view -> (x1, x2)) <- xs
-  , (view -> (y1, y2)) <- ys
-  , x1 == y2
-  ]
-
-thetajoin_eq :: Q ([(Integer, Integer)], [(Integer, Integer)]) -> Q [(Integer, Integer, Integer)]
-thetajoin_eq (view -> (xs, ys)) =
-  [ tup3 (x1 * x2) y1 y2
-  | (view -> (x1, x2)) <- xs
-  , (view -> (y1, y2)) <- ys
-  , x1 == y2
-  , y1 == x2
-  ]
-
-thetajoin_neq :: Q ([(Integer, Integer)], [(Integer, Integer)]) -> Q [(Integer, Integer, Integer)]
-thetajoin_neq (view -> (xs, ys)) =
-  [ tup3 (x1 * x2) y1 y2
-  | (view -> (x1, x2)) <- xs
-  , (view -> (y1, y2)) <- ys
-  , x1 == y2
-  , y1 /= x2
-  ]
-
-eqjoin3 :: Q ([Integer], [Integer], [Integer]) -> Q [(Integer, Integer, Integer)]
-eqjoin3 (view -> (xs, ys, zs)) = 
-  [ tup3 x y z
-  | x <- xs
-  , y <- ys
-  , z <- zs
-  , x == y
-  , y == z
-  ]
-  
-eqjoin_nested_left :: Q ([(Integer, [Integer])], [Integer]) -> Q [((Integer, [Integer]), Integer)]
-eqjoin_nested_left args =
-  [ pair x y
-  | x <- fst args
-  , y <- snd args
-  , fst x == y
-  ]
-
-eqjoin_nested_right :: Q ([Integer], [(Integer, [Integer])]) -> Q [(Integer, (Integer, [Integer]))]
-eqjoin_nested_right args =
-  [ pair x y
-  | x <- fst args
-  , y <- snd args
-  , x == fst y
-  ]
-
-eqjoin_nested_both :: Q ([(Integer, [Integer])], [(Integer, [Integer])]) 
-                   -> Q [((Integer, [Integer]), (Integer, [Integer]))]
-eqjoin_nested_both args =
-  [ pair x y
-  | x <- fst args
-  , y <- snd args
-  , fst x == fst y
-  ]
-
-nestjoin :: Q ([Integer], [Integer]) -> Q [(Integer, [Integer])]
-nestjoin (view -> (xs, ys)) =
-  [ tup2 x [ y | y <- ys, x == y]
-  | x <- xs
-  ]
-
-nestjoin3 :: Q ([Integer], [Integer], [Integer]) -> Q [[[(Integer, Integer, Integer)]]]
-nestjoin3 (view -> (xs, ys, zs)) =
-    [ [ [ tup3 x y z | z <- zs, y == z ]
-      | y <- ys
-      , x == y
-      ]
-    | x <- xs
-    ]
-  
---------------------------------------------------------------
--- Comprehensions for HUnit tests
-
-eqjoin_nested1 :: Q [((Integer, [Char]), Integer)]
-eqjoin_nested1 =
-    [ pair x y
-    | x <- (toQ ([(10, ['a']), (20, ['b']), (30, ['c', 'd']), (40, [])] :: [(Integer, [Char])]))
-    , y <- (toQ [20, 30, 30, 40, 50])
-    , fst x == y
-    ]
-
-semijoin :: Q [Integer]
-semijoin = 
-    let xs = (toQ [1, 2, 3, 4, 5, 6, 7] :: Q [Integer])
-        ys = (toQ [2, 4, 6, 7] :: Q [Integer])
-    in [ x | x <- xs , x `elem` ys ]
-
-semijoin_range :: Q [Integer]
-semijoin_range = 
-    let xs = (toQ [1, 2, 3, 4, 5, 6, 7] :: Q [Integer])
-        ys = (toQ [2, 4, 6] :: Q [Integer])
-    in [ x | x <- xs , x `elem` [ y | y <- ys, y < 6 ] ]
-
-semijoin_quant :: Q [Integer]
-semijoin_quant = 
-    let xs = (toQ [1, 2, 3, 4, 5, 6, 7] :: Q [Integer])
-        ys = (toQ [2, 4, 6, 7] :: Q [Integer])
-    in [ x | x <- xs, or [ y > 5 | y <- ys, x == y ] ]
-
-semijoin_not_null :: Q [Integer]
-semijoin_not_null =
-    let xs = (toQ [1, 2, 3, 4, 5, 6, 7] :: Q [Integer])
-        ys = (toQ [2, 4, 6, 7] :: Q [Integer])
-    in [ x | x <- xs, not $ null [ y | y <- ys, x == y] ]
-    
-
-antijoin :: Q [Integer]
-antijoin =
-    let xs = (toQ [1, 2, 3, 4, 5, 6, 7] :: Q [Integer])
-        ys = (toQ [2, 4, 6, 7] :: Q [Integer])
-    in [ x | x <- xs , not $ x `elem` ys ]
-
-antijoin_null :: Q [Integer]
-antijoin_null =
-    let xs = (toQ [1, 2, 3, 4, 5, 6, 7] :: Q [Integer])
-        ys = (toQ [2, 4, 6, 7] :: Q [Integer])
-    in [ x | x <- xs, null [ y | y <- ys, x == y] ]
-
-antijoin_range :: Q [Integer]
-antijoin_range =
-    let xs = (toQ [1, 2, 3, 4, 5, 6, 7] :: Q [Integer])
-        ys = (toQ [2, 4, 6, 7] :: Q [Integer])
-    in [ x | x <- xs , not $ x `elem` [ y | y <- ys, y < 5 ] ]
-
-antijoin_class12 :: Q [Integer]
-antijoin_class12 =
-    let xs = toQ ([6,7,8,9,10,12] :: [Integer])
-        ys = toQ ([8,9,12,13,15,16] :: [Integer])
-    in [ x | x <- xs, and [ x < y | y <- ys, y > 10 ]]
-
-antijoin_class15 :: Q [Integer]
-antijoin_class15 =
-    let xs = toQ ([3,4,5,6,7,8] :: [Integer])
-        ys = toQ ([4,5,8,16] :: [Integer])
-    in [ x | x <- xs, and [ y `mod` 4 == 0 | y <- ys, x < y ]]
-
-antijoin_class16 :: Q [Integer]
-antijoin_class16 =
-    let xs = toQ ([3,4,5,6] :: [Integer])
-        ys = toQ ([1,2,3,4,5,6,7,8] :: [Integer])
-    in [ x | x <- xs, and [ y <= 2 * x | y <- ys, x < y ]]
-
-frontguard :: Q [[Integer]]
-frontguard =
-    [ [ y | x > 13, y <- toQ ([1,2,3,4] :: [Integer]), y < 3 ]
-    | x <- toQ ([10, 20, 30] :: [Integer])
-    ]
-
-----------------------------------------------------------------------
--- Comprehensions for HUnit NestJoin/NestProduct tests
-
-nj1 :: [Integer] -> [Integer] -> Q [[Integer]]
-nj1 njxs njys = 
-    [ [ y | y <- toQ njys, x == y ]
-    | x <- toQ njxs
-    ]
-
-nj2 :: [Integer] -> [Integer] -> Q [(Integer, [Integer])]
-nj2 njxs njys = 
-    [ pair x [ y | y <- toQ njys, x == y ]
-    | x <- toQ njxs
-    ]
-
-nj3 :: [Integer] -> [Integer] -> Q [(Integer, [Integer])]
-nj3 njxs njys = 
-    [ pair x ([ y | y <- toQ njys, x == y ] ++ (toQ [100, 200, 300]))
-    | x <- toQ njxs
-    ]
-
-nj4 :: [Integer] -> [Integer] -> Q [(Integer, [Integer])]
-nj4 njxs njys = 
-      [ pair x ([ y | y <- toQ njys, x == y ] ++ [ z | z <- toQ njys, x == z ])
-      | x <- toQ njxs
-      ]
-
--- Code incurs DistSeg for the literal 15.
-nj5 :: [Integer] -> [Integer] -> Q [(Integer, [Integer])]
-nj5 njxs njys = 
-      [ pair x [ y | y <- toQ njys, x + y > 15 ]
-      | x <- toQ njxs
-      ]
-
-nj6 :: [Integer] -> [Integer] -> Q [(Integer, [Integer])]
-nj6 njxs njys = 
-      [ pair x [ y | y <- toQ njys, x + y > 10, y < 7 ]
-      | x <- toQ njxs
-      ]
-
-nj7 :: [Integer] -> [Integer] -> Q [[Integer]]
-nj7 njxs njys = 
-    [ [ x + y | y <- toQ njys, x + 2 == y ] | x <- toQ njxs ]
-
-nj8 :: [Integer] -> [Integer] -> Q [[Integer]]
-nj8 njxs njys = [ [ x + y | y <- toQ njys, x == y, y < 5 ] | x <- toQ njxs, x > 3 ]
-
-nj9 :: [Integer] -> [Integer] -> Q [[Integer]]
-nj9 njxs njys = [ [ x + y | y <- toQ njys, x + 1 == y, y > 2, x < 6 ] | x <- toQ njxs ]
-
-nj10 :: [Integer] -> [Integer] -> Q [Integer]
-nj10 njxs njys = [ x + sum [ x * y | y <- toQ njys, x == y ] | x <- toQ njxs ]
-
-nj11 :: [Integer] -> [Integer] -> Q [[Integer]]
-nj11 njxs njys = [ [ x + y | y <- toQ njys, x > y, x < y * 2 ] | x <- toQ njxs ]
-
-nj12 :: [Integer] -> [Integer] -> [Integer] -> Q [[[(Integer, Integer, Integer)]]]
-nj12 njxs njys njzs =
-    [ [ [ tup3 x y z | z <- toQ njzs, y == z ]
-      | y <- toQ njys
-      , x == y
-      ]
-    | x <- toQ njxs
-    ]
-
-np1 :: [Integer] -> [Integer] -> Q [[Integer]]
-np1 njxs njys = [ [ x * y * 2 | y <- toQ njys ] | x <- toQ njxs ]
-	
-
-np2 :: [Integer] -> [Integer] -> Q [(Integer, [Integer])]
-np2 njxs njys = [ pair x [ y * 2 | y <- toQ njys ] | x <- toQ njxs ]
-
-np3 :: [Integer] -> [Integer] -> Q [[Integer]]
-np3 njxs njys = [ [ x + y | y <- toQ njys ] | x <- toQ njxs ]
-
-np4 :: [Integer] -> [Integer] -> Q [[Integer]]
-np4 njxs njys = [ [ y | y <- toQ njys, x > y ] | x <- toQ njxs ]
-
-njg1 :: [Integer] -> [(Integer, Integer)] -> Q [Integer]
-njg1 njgxs njgzs =
-  [ x
-  | x <- toQ njgxs
-  , x < 8
-  , sum [ snd z | z <- toQ njgzs, fst z == x ] > 100
-  ]
-
-njg2 :: [Integer] -> [Integer] -> Q [Integer]
-njg2 njgxs njgys =
-  [ x
-  | x <- toQ njgxs
-  , and [ y > 1 | y <- toQ njgys, x == y ]
-  , x < 8
-  ]
-
-njg3 :: [Integer] -> [Integer] -> [(Integer, Integer)] -> Q [(Integer, Integer)]
-njg3 njgxs njgys njgzs =
-  [ pair x y
-  | x <- toQ njgxs
-  , y <- toQ njgys
-  , length [ toQ () | z <- toQ njgzs, fst z == x ] > 2
-  ]
-
-njg4 :: [Integer] -> [Integer] -> [(Integer, Integer)] -> Q [Integer]
-njg4 njgxs njgys njgzs =
-  [ x
-  | x <- toQ njgxs
-  , length [ toQ () | y <- toQ njgys, x == y ] 
-    > length [ toQ () | z <- toQ njgzs, fst z == x ]
-  ]
-
-njg5 :: [Integer] -> [Integer] -> Q [Integer]
-njg5 njgxs njgys =
-  [ x
-  | x <- toQ njgxs
-  , sum [ y | y <- toQ njgys, x < y, y > 5 ] < 10
-  ]
-
---------------------------------------------------------------------------------
--- Comprehensions for QuickCheck antijoin/semijoin tests
-
-aj_class12 :: Q ([Integer], [Integer]) -> Q [Integer]
-aj_class12 (view -> (xs, ys)) = 
-  [ x 
-  | x <- xs
-  , and [ x == y | y <- ys, y > 10 ]
-  ]
-
-aj_class15 :: Q ([Integer], [Integer]) -> Q [Integer]
-aj_class15 (view -> (xs, ys)) = 
-  [ x 
-  | x <- xs
-  , and [ y `mod` 4 == 0 | y <- ys, x < y ]
-  ]
-
-aj_class16 :: Q ([Integer], [Integer]) -> Q [Integer]
-aj_class16 (view -> (xs, ys)) = 
-  [ x 
-  | x <- xs
-  , and [ y <= 2 * x | y <- ys, x < y ]
-  ]
-
-
-
---------------------------------------------------------------------------------
--- Comprehensions for 
-
-backdep :: Q [[Integer]] -> Q [Integer]
-backdep xss = [ x | xs <- xss, x <- xs ]
-
-backdep_filter :: Q [[Integer]] -> Q [Integer]
-backdep_filter xss = [ x | xs <- xss, x <- xs, length xs > x ]
-
-backdep2 :: Q [[Integer]] -> Q [[Integer]]
-backdep2 xss = [ [ x * 42 | x <- xs ] | xs <- xss ]
-
-backdep3 :: Q [[Integer]] -> Q [[Integer]]
-backdep3 xss = [ [ x + length xs | x <- xs ] | xs <- xss ]
-
-backdep4 :: Q [[[Integer]]] -> Q [[[Integer]]]
-backdep4 xsss = [ [ [ x + length xs + length xss
-                    | x <- xs
-                    ]
-                  | xs <- xss
-                  ]
-                | xss <- xsss
-                ]
-
-backdep5 :: Q [[Integer]] -> Q [[Integer]]
-backdep5 xss = [ [ x + length xs | x <- take (length xs - 3) xs ] | xs <- xss ]
-
-deep_iter :: Q ([Integer], [Integer], [Integer], [Integer], [Integer]) -> Q [[[[Integer]]]]
-deep_iter (view -> (ws1, ws2, xs, ys, zs)) = 
-  [ [ [ [ w1 * 23 - y | w1 <- ws1 ]
-        ++
-        [ w2 + 42 - y | w2 <- ws2 ]
-      | z <- zs
-      , z > x
-      ]
-    | y <- ys
-    ]
-  | x <- xs
-  ]
diff --git a/tests/Main.hs b/tests/Main.hs
deleted file mode 100644
--- a/tests/Main.hs
+++ /dev/null
@@ -1,60 +0,0 @@
-{-# LANGUAGE TemplateHaskell       #-}
-{-# LANGUAGE GADTs                 #-}
-{-# LANGUAGE TypeFamilies          #-}
-{-# LANGUAGE FlexibleInstances     #-}
-{-# LANGUAGE FlexibleContexts      #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-
-{-# OPTIONS_GHC -Wall -O3 -fno-warn-orphans -fno-warn-overlapping-patterns #-}
-module Main where
-       
-import           ComprehensionTests
-import           CombinatorTests
-
-#ifdef TESTSQL
-import           Database.HDBC.PostgreSQL
-#endif
-
-import           System.Environment
-import           Test.Framework (Test, defaultMainWithArgs)
-import           Test.QuickCheck
-
-import           Data.List
-
-
-#ifdef TESTSQL
-getConn :: IO Connection
-getConn = connectPostgreSQL "user = 'au' password = 'foobar' host = 'localhost' dbname = 'test'"
-#endif
-
-qc :: Testable prop => prop -> IO ()
-qc = quickCheckWith stdArgs{maxSuccess = 100, maxSize = 5}
-
-putStrPad :: String -> IO ()
-putStrPad s = putStr (s ++ replicate (32 - length s) ' ' )
-
-
-main :: IO ()
-main = do
-            args <- getArgs
-            let args' = if or $ map (isPrefixOf "-s") args
-                         then args
-                         else "-s5":args
-            defaultMainWithArgs tests args'
-
-tests :: [Test]
-tests =
-    [ tests_types
-    , tests_tuples
-    , tests_join_hunit
-    , tests_nest_head_hunit
-    , tests_nest_guard_hunit
-    , tests_combinators_hunit
-    , tests_comprehensions
-    , tests_boolean
-    , tests_numerics
-    , tests_maybe
-    , tests_either
-    , tests_lists
-    , tests_lifted
-    ]