diff --git a/benchmark/Benchmark.hs b/benchmark/Benchmark.hs
--- a/benchmark/Benchmark.hs
+++ b/benchmark/Benchmark.hs
@@ -11,6 +11,7 @@
 import Control.DeepSeq
 import Test.QuickCheck.Arbitrary
 import Test.QuickCheck.Gen
+import Test.QuickCheck.Random
 import System.Random
 
 aExpr :: SugarExpr
@@ -138,7 +139,7 @@
 
 randStdBenchmarks :: Int -> IO Benchmark
 randStdBenchmarks s = do
-  rand <- newStdGen
+  rand <- newQCGen
   let ty = unGen arbitrary rand s
   putStr "size of the type term: "
   print $ size ty
diff --git a/benchmark/DataTypes/Comp.hs b/benchmark/DataTypes/Comp.hs
--- a/benchmark/DataTypes/Comp.hs
+++ b/benchmark/DataTypes/Comp.hs
@@ -7,7 +7,8 @@
   TypeOperators,
   ScopedTypeVariables,
   TypeSynonymInstances,
-  DeriveFunctor#-}
+  DeriveFunctor,
+  ConstraintKinds #-}
 
 module DataTypes.Comp 
     ( module DataTypes.Comp,
diff --git a/benchmark/Functions/Comp/Desugar.hs b/benchmark/Functions/Comp/Desugar.hs
--- a/benchmark/Functions/Comp/Desugar.hs
+++ b/benchmark/Functions/Comp/Desugar.hs
@@ -6,7 +6,8 @@
   UndecidableInstances,
   TypeOperators,
   ScopedTypeVariables,
-  TypeSynonymInstances #-}
+  TypeSynonymInstances,
+  ConstraintKinds #-}
 
 module Functions.Comp.Desugar where
 
diff --git a/benchmark/Functions/Comp/Eval.hs b/benchmark/Functions/Comp/Eval.hs
--- a/benchmark/Functions/Comp/Eval.hs
+++ b/benchmark/Functions/Comp/Eval.hs
@@ -6,7 +6,8 @@
   UndecidableInstances,
   TypeOperators,
   ScopedTypeVariables,
-  TypeSynonymInstances #-}
+  TypeSynonymInstances,
+  ConstraintKinds #-}
 
 module Functions.Comp.Eval where
 
@@ -14,7 +15,7 @@
 import Functions.Comp.Desugar
 import Data.Comp
 import Data.Comp.Ops
-import Data.Comp.Thunk
+import Data.Comp.Thunk hiding (eval, eval2)
 import Data.Comp.Derive
 import Control.Monad
 import Data.Traversable
@@ -30,9 +31,9 @@
 $(derive [liftSum] [''EvalT])
 
 instance (Monad m, Traversable v, Value :<: v) => EvalT Value v m where
-    evalTAlg = inject
+    evalTAlg = injectT
 
-instance (Value :<: v, Traversable v, EqF v, Monad m) => EvalT Op v m where
+instance (Value :<: (m :+: v), Value :<: v, Traversable v, EqF v, Monad m) => EvalT Op v m where
     evalTAlg (Plus x y) = thunk $ do
                            VInt i <- whnfPr x
                            VInt j <- whnfPr y
@@ -65,7 +66,7 @@
                               ProjLeft -> x
                               ProjRight -> y
 
-instance (Value :<: v, Traversable v, Monad m) => EvalT Sugar v m where
+instance (Value :<: (m :+: v), Value :<: v, Traversable v, Monad m) => EvalT Sugar v m where
     evalTAlg (Neg x) = thunk $ do
                          VInt i <- whnfPr x
                          return $ iVInt (-i)
diff --git a/benchmark/Functions/Comp/FreeVars.hs b/benchmark/Functions/Comp/FreeVars.hs
--- a/benchmark/Functions/Comp/FreeVars.hs
+++ b/benchmark/Functions/Comp/FreeVars.hs
@@ -6,7 +6,8 @@
   UndecidableInstances,
   TypeOperators,
   ScopedTypeVariables,
-  TypeSynonymInstances #-}
+  TypeSynonymInstances,
+  ConstraintKinds #-}
 
 module Functions.Comp.FreeVars where
 
diff --git a/benchmark/Functions/Comp/HOAS.hs b/benchmark/Functions/Comp/HOAS.hs
new file mode 100644
--- /dev/null
+++ b/benchmark/Functions/Comp/HOAS.hs
@@ -0,0 +1,54 @@
+{-# LANGUAGE
+  TemplateHaskell,
+  MultiParamTypeClasses,
+  FlexibleInstances,
+  FlexibleContexts,
+  UndecidableInstances,
+  TypeOperators,
+  ScopedTypeVariables,
+  TypeSynonymInstances #-}
+
+module Functions.Comp.Desugar where
+
+import DataTypes.Comp
+import Data.Comp.ExpFunctor
+import Data.Comp
+import Data.Foldable
+import Prelude hiding (foldr)
+
+ex1 :: HOASExpr
+ex1 = iLam (\x -> case project x of
+                    Just (VInt _) -> x 
+                    _ -> x `iPlus` x)
+ex2 :: HOASExpr
+ex2 = iLam (\x -> case x of
+                    Term t -> case proj t of
+                                Just (VInt _) -> x 
+                                _ -> x `iPlus` x)
+                                
+
+class Vars f where
+    varsAlg :: Alg f Int
+
+instance (Vars f, Vars g) => Vars (g :+: f) where
+    varsAlg (Inl v) = varsAlg v
+    varsAlg (Inr v) = varsAlg v
+
+instance Vars Lam where
+    varsAlg (Lam f) = f 1
+
+instance Vars App where
+    varsAlg = foldr (+) 0
+
+instance Vars Value where
+    varsAlg = foldr (+) 0
+
+instance Vars Op where
+    varsAlg = foldr (+) 0
+
+
+instance Vars Sugar where
+    varsAlg = foldr (+) 0
+
+vars :: (ExpFunctor f, Vars f) => Term f -> Int
+vars = cataE varsAlg
diff --git a/benchmark/Functions/Comp/Inference.hs b/benchmark/Functions/Comp/Inference.hs
--- a/benchmark/Functions/Comp/Inference.hs
+++ b/benchmark/Functions/Comp/Inference.hs
@@ -6,7 +6,8 @@
   UndecidableInstances,
   TypeOperators,
   ScopedTypeVariables,
-  TypeSynonymInstances #-}
+  TypeSynonymInstances,
+  ConstraintKinds#-}
 
 module Functions.Comp.Inference where
 
diff --git a/compdata.cabal b/compdata.cabal
--- a/compdata.cabal
+++ b/compdata.cabal
@@ -1,5 +1,5 @@
 Name:			compdata
-Version:		0.7.0.2
+Version:		0.8
 Synopsis:            	Compositional Data Types
 Description:
 
@@ -69,18 +69,6 @@
      to families of mutually recursive data types and (more generally) GADTs.
      This extension resides in the module "Data.Comp.Multi".
   .
-  * /Parametric compositional data types/ (Workshop on Mathematically
-     Structured Functional Programming, 3-24, 2012,
-     <http://dx.doi.org/10.4204/EPTCS.76.3>). All of the above is also
-     lifted to parametric data types, which enables support for
-     parametric higher-order abstract syntax (PHOAS). This extension
-     resides in the module "Data.Comp.Param".
-  .
-  *  /Generalised parametric compositional data types/. All of the above is also
-     lifted to generalised parametric data types, which enables support for
-     typed parametric higher-order abstract syntax (PHOAS). This extension
-     resides in the module "Data.Comp.MultiParam".
-  .
   * Advanced recursion schemes derived from tree automata. These
     recursion schemes allow for a higher degree of modularity and make
     it possible to apply fusion. See /Modular Tree Automata/
@@ -90,8 +78,8 @@
     2013, <http://dx.doi.org/10.1145/2502488.2502489>).
   .
 
-  Examples of using (generalised) (parametric) compositional data types are
-  bundled with the package in the libray @examples@.
+  Examples of using (generalised) compositional data types are bundled
+  with the package in the folder @examples@.
 
 Category:            	Generics
 License:		BSD3
@@ -103,178 +91,97 @@
 
 extra-source-files:
   -- test files
-  testsuite/tests/Data_Test.hs,
-  testsuite/tests/Data/Comp_Test.hs,
-  testsuite/tests/Data/Comp/Equality_Test.hs,
-  testsuite/tests/Data/Comp/Variables_Test.hs,
-  testsuite/tests/Data/Comp/Multi_Test.hs,
-  testsuite/tests/Data/Comp/Multi/Variables_Test.hs,
-  testsuite/tests/Data/Comp/Examples_Test.hs,
-  testsuite/tests/Data/Comp/Examples/Comp.hs,
-  testsuite/tests/Data/Comp/Examples/Multi.hs,
-  testsuite/tests/Data/Comp/Examples/Param.hs,
-  testsuite/tests/Data/Comp/Examples/MultiParam.hs,
+  testsuite/tests/*.hs
+  testsuite/tests/Data/*.hs
+  testsuite/tests/Data/Comp/*.hs
+  testsuite/tests/Data/Comp/Multi/*.hs
+  testsuite/tests/Data/Comp/Examples/*.hs
   testsuite/tests/Test/Utils.hs
   -- benchmark files
-  benchmark/Test.hs
-  benchmark/Benchmark.hs
-  benchmark/DataTypes.hs
-  benchmark/Functions.hs
-  benchmark/DataTypes/Comp.hs
-  benchmark/DataTypes/Transform.hs
-  benchmark/DataTypes/Standard.hs
-  benchmark/Multi/DataTypes/Comp.hs
-  benchmark/Multi/Functions/Comp/Eval.hs
-  benchmark/Multi/Functions/Comp/Desugar.hs
-  benchmark/Transformations.hs
-  benchmark/Functions/Comp.hs
-  benchmark/Functions/Comp/Eval.hs
-  benchmark/Functions/Comp/Desugar.hs
-  benchmark/Functions/Comp/FreeVars.hs
-  benchmark/Functions/Comp/Inference.hs
-  benchmark/Functions/Standard/Eval.hs
-  benchmark/Functions/Standard/Desugar.hs
-  benchmark/Functions/Standard/FreeVars.hs
-  benchmark/Functions/Standard/Inference.hs
-  benchmark/Functions/Standard.hs
+  benchmark/*.hs
+  benchmark/DataTypes/*.hs
+  benchmark/Functions/*.hs
+  benchmark/Functions/Comp/*.hs
+  benchmark/Functions/Standard/*.hs
+  benchmark/Multi/DataTypes/*.hs
+  benchmark/Multi/Functions/Comp/*.hs
   -- example files
-  examples/Examples/Common.hs
-  examples/Examples/Eval.hs
-  examples/Examples/EvalM.hs
-  examples/Examples/Desugar.hs
-  examples/Examples/Automata/Compiler.hs,
-  examples/Examples/Multi/Common.hs
-  examples/Examples/Multi/Eval.hs
-  examples/Examples/Multi/EvalI.hs
-  examples/Examples/Multi/EvalM.hs
-  examples/Examples/Multi/Desugar.hs
-  examples/Examples/Param/Lambda.hs
-  examples/Examples/Param/Names.hs
-  examples/Examples/Param/Graph.hs
-  examples/Examples/MultiParam/Lambda.hs
-  examples/Examples/MultiParam/FOL.hs
+  examples/Examples/*.hs
+  examples/Examples/Automata/*.hs
+  examples/Examples/Multi/*.hs
 
 library
-  Exposed-Modules:      Data.Comp,
-                        Data.Comp.Annotation,
-                        Data.Comp.Sum,
-                        Data.Comp.Term,
-                        Data.Comp.Algebra,
-                        Data.Comp.Equality,
-                        Data.Comp.Ordering,
-                        Data.Comp.DeepSeq,
+  Exposed-Modules:      Data.Comp
+                        Data.Comp.Annotation
+                        Data.Comp.Sum
+                        Data.Comp.Term
+                        Data.Comp.Algebra
+                        Data.Comp.Equality
+                        Data.Comp.Ordering
+                        Data.Comp.DeepSeq
                         Data.Comp.Generic
-                        Data.Comp.TermRewriting,
-                        Data.Comp.Arbitrary,
-                        Data.Comp.Show,
-                        Data.Comp.Variables,
-                        Data.Comp.Decompose,
-                        Data.Comp.Unification,
-                        Data.Comp.Derive,
-                        Data.Comp.Matching,
-                        Data.Comp.Desugar,
-                        Data.Comp.Automata,
-                        Data.Comp.MacroAutomata,
-                        Data.Comp.Automata.Product,
-                        Data.Comp.Number,
-                        Data.Comp.Thunk,
-                        Data.Comp.Ops,
+                        Data.Comp.TermRewriting
+                        Data.Comp.Arbitrary
+                        Data.Comp.Show
+                        Data.Comp.Render
+                        Data.Comp.Variables
+                        Data.Comp.Decompose
+                        Data.Comp.Unification
+                        Data.Comp.Derive
+                        Data.Comp.Derive.Utils
+                        Data.Comp.Matching
+                        Data.Comp.Desugar
+                        Data.Comp.Automata
+                        Data.Comp.MacroAutomata
+                        Data.Comp.Automata.Product
+                        Data.Comp.Number
+                        Data.Comp.Thunk
+                        Data.Comp.Ops
 
-                        Data.Comp.Multi,
-                        Data.Comp.Multi.Term,
-                        Data.Comp.Multi.Sum,
-                        Data.Comp.Multi.HFunctor,
-                        Data.Comp.Multi.HFoldable,
-                        Data.Comp.Multi.HTraversable,
-                        Data.Comp.Multi.Algebra,
-                        Data.Comp.Multi.Annotation,
-                        Data.Comp.Multi.Show,
-                        Data.Comp.Multi.Equality,
-                        Data.Comp.Multi.Ordering,
-                        Data.Comp.Multi.Variables,
-                        Data.Comp.Multi.Ops,
-                        Data.Comp.Multi.Number,
+                        Data.Comp.Multi
+                        Data.Comp.Multi.Term
+                        Data.Comp.Multi.Sum
+                        Data.Comp.Multi.HFunctor
+                        Data.Comp.Multi.HFoldable
+                        Data.Comp.Multi.HTraversable
+                        Data.Comp.Multi.Algebra
+                        Data.Comp.Multi.Annotation
+                        Data.Comp.Multi.Show
+                        Data.Comp.Multi.Equality
+                        Data.Comp.Multi.Ordering
+                        Data.Comp.Multi.Variables
+                        Data.Comp.Multi.Ops
+                        Data.Comp.Multi.Number
                         Data.Comp.Multi.Derive
-                        Data.Comp.Multi.Generic,
-                        Data.Comp.Multi.Desugar,
-
-                        Data.Comp.Param,
-                        Data.Comp.Param.Term,
-                        Data.Comp.Param.FreshM,
-                        Data.Comp.Param.Sum,
-                        Data.Comp.Param.Difunctor,
-                        Data.Comp.Param.Ditraversable,
-                        Data.Comp.Param.Algebra,
-                        Data.Comp.Param.Annotation,
-                        Data.Comp.Param.Ops
-                        Data.Comp.Param.Equality
-                        Data.Comp.Param.Ordering
-                        Data.Comp.Param.Show
-                        Data.Comp.Param.Derive,
-                        Data.Comp.Param.Desugar
-                        Data.Comp.Param.Thunk
-
-                        Data.Comp.MultiParam,
-                        Data.Comp.MultiParam.Term,
-                        Data.Comp.MultiParam.FreshM,
-                        Data.Comp.MultiParam.Sum,
-                        Data.Comp.MultiParam.HDifunctor,
-                        Data.Comp.MultiParam.HDitraversable,
-                        Data.Comp.MultiParam.Algebra,
-                        Data.Comp.MultiParam.Annotation,
-                        Data.Comp.MultiParam.Ops
-                        Data.Comp.MultiParam.Equality
-                        Data.Comp.MultiParam.Ordering
-                        Data.Comp.MultiParam.Show
-                        Data.Comp.MultiParam.Derive,
-                        Data.Comp.MultiParam.Desugar
+                        Data.Comp.Multi.Generic
+                        Data.Comp.Multi.Desugar
 
-  Other-Modules:        Data.Comp.Derive.Utils,
-                        Data.Comp.Derive.Equality,
-                        Data.Comp.Derive.Ordering,
-                        Data.Comp.Derive.Arbitrary,
-                        Data.Comp.Derive.Show,
-                        Data.Comp.Derive.DeepSeq,
-                        Data.Comp.Derive.SmartConstructors,
-                        Data.Comp.Derive.SmartAConstructors,
-                        Data.Comp.Derive.Foldable,
-                        Data.Comp.Derive.Traversable,
-                        Data.Comp.Derive.Injections,
-                        Data.Comp.Derive.Projections,
-                        Data.Comp.Derive.HaskellStrict,
-                        Data.Comp.Automata.Product.Derive,
+  Other-Modules:        Data.Comp.Derive.Equality
+                        Data.Comp.Derive.Ordering
+                        Data.Comp.Derive.Arbitrary
+                        Data.Comp.Derive.Show
+                        Data.Comp.Derive.DeepSeq
+                        Data.Comp.Derive.SmartConstructors
+                        Data.Comp.Derive.SmartAConstructors
+                        Data.Comp.Derive.Foldable
+                        Data.Comp.Derive.Traversable
+                        Data.Comp.Derive.Projections
+                        Data.Comp.Derive.HaskellStrict
+                        Data.Comp.Automata.Product.Derive
 
-                        Data.Comp.Multi.Derive.HFunctor,
-                        Data.Comp.Multi.Derive.HFoldable,
-                        Data.Comp.Multi.Derive.HTraversable,
-                        Data.Comp.Multi.Derive.Equality,
-                        Data.Comp.Multi.Derive.Ordering,
-                        Data.Comp.Multi.Derive.Show,
+                        Data.Comp.Multi.Derive.HFunctor
+                        Data.Comp.Multi.Derive.HFoldable
+                        Data.Comp.Multi.Derive.HTraversable
+                        Data.Comp.Multi.Derive.Equality
+                        Data.Comp.Multi.Derive.Ordering
+                        Data.Comp.Multi.Derive.Show
                         Data.Comp.Multi.Derive.SmartConstructors
                         Data.Comp.Multi.Derive.SmartAConstructors
-                        Data.Comp.Multi.Derive.Injections,
-                        Data.Comp.Multi.Derive.Projections,
-
-                        Data.Comp.Param.Derive.Difunctor,
-                        Data.Comp.Param.Derive.Ditraversable,
-                        Data.Comp.Param.Derive.Equality,
-                        Data.Comp.Param.Derive.Ordering,
-                        Data.Comp.Param.Derive.Show,
-                        Data.Comp.Param.Derive.SmartConstructors,
-                        Data.Comp.Param.Derive.SmartAConstructors,
-                        Data.Comp.Param.Derive.Injections,
-                        Data.Comp.Param.Derive.Projections,
-
-                        Data.Comp.MultiParam.Derive.HDifunctor,
-                        Data.Comp.MultiParam.Derive.Equality,
-                        Data.Comp.MultiParam.Derive.Ordering,
-                        Data.Comp.MultiParam.Derive.Show,
-                        Data.Comp.MultiParam.Derive.SmartConstructors,
-                        Data.Comp.MultiParam.Derive.SmartAConstructors,
-                        Data.Comp.MultiParam.Derive.Injections,
-                        Data.Comp.MultiParam.Derive.Projections
+                        Data.Comp.Multi.Derive.Injections
+                        Data.Comp.Multi.Derive.Projections
 
-  Build-Depends:	base == 4.*, template-haskell, containers, mtl, QuickCheck >= 2, derive, deepseq, th-expand-syns, transformers
+  Build-Depends:	base == 4.*, template-haskell, containers, mtl, QuickCheck >= 2, derive,
+                        deepseq, th-expand-syns, transformers, tree-view
   hs-source-dirs:	src
   ghc-options:          -W
 
@@ -282,8 +189,10 @@
 Test-Suite test
   Type:                 exitcode-stdio-1.0
   Main-is:		Data_Test.hs
-  hs-source-dirs:	src testsuite/tests examples
-  Build-Depends:        base == 4.*, template-haskell, containers, mtl, QuickCheck >= 2, HUnit, test-framework, test-framework-hunit, test-framework-quickcheck2, derive, th-expand-syns, deepseq, transformers
+  hs-source-dirs:	testsuite/tests examples
+  Build-Depends:        compdata, base == 4.*, template-haskell, containers, mtl, QuickCheck >= 2, 
+                        HUnit, test-framework, test-framework-hunit, test-framework-quickcheck2, derive,
+                        th-expand-syns, deepseq, transformers
 
 Benchmark algebra
   Type:                 exitcode-stdio-1.0
@@ -301,7 +210,8 @@
   ghc-options:          -W -O2
   -- Disable short-cut fusion rules in order to compare optimised and unoptimised code.
   cpp-options:          -DNO_RULES
-  Build-Depends:        base == 4.*, template-haskell, containers, mtl, QuickCheck >= 2, derive, deepseq, criterion, random, uniplate, th-expand-syns, transformers
+  Build-Depends:        base == 4.*, template-haskell, containers, mtl, QuickCheck >= 2, derive, 
+                        deepseq, criterion, random, uniplate, th-expand-syns, transformers
 
 
 source-repository head
diff --git a/examples/Examples/Automata.hs b/examples/Examples/Automata.hs
new file mode 100644
--- /dev/null
+++ b/examples/Examples/Automata.hs
@@ -0,0 +1,147 @@
+{-# LANGUAGE RankNTypes #-}
+--------------------------------------------------------------------------------
+-- |
+-- Module      :  Examples.Automata
+-- Copyright   :  (c) 2010-2011 Patrick Bahr
+-- License     :  BSD3
+-- Maintainer  :  Patrick Bahr <paba@diku.dk>
+-- Stability   :  experimental
+-- Portability :  non-portable (GHC Extensions)
+--
+-- This module defines tree automata based on compositional data types.
+--
+--------------------------------------------------------------------------------
+
+module Examples.Automata where
+
+import Data.Comp
+import Data.Maybe
+import Data.Traversable
+import Control.Monad
+
+
+{-| This type represents transition functions of deterministic
+bottom-up tree acceptors (DUTAs).  -}
+
+type DUTATrans f q = Alg f q
+
+{-| This data type represents deterministic bottom-up tree acceptors (DUTAs).
+-}
+data DUTA f q = DUTA {
+      dutaTrans :: DUTATrans f q,
+      dutaAccept :: q -> Bool
+    }
+
+{-| This function runs the transition function of a DUTA on the given
+term. -}
+
+runDUTATrans :: Functor f => DUTATrans f q -> Term f -> q
+runDUTATrans = cata
+
+{-| This function checks whether a given DUTA accepts a term.  -}
+
+duta :: Functor f => DUTA f q -> Term f -> Bool
+duta DUTA{dutaTrans = trans, dutaAccept = accept} = accept . runDUTATrans trans
+
+
+
+{-| This type represents transition functions of non-deterministic
+bottom-up tree acceptors (NUTAs).  -}
+
+type NUTATrans f q = AlgM [] f q
+
+
+{-| This type represents non-deterministic bottom-up tree acceptors.
+-}
+data NUTA f q = NUTA {
+      nutaTrans :: AlgM [] f q,
+      nutaAccept :: q -> Bool
+    }
+
+{-| This function runs the given transition function of a NUTA on the
+given term -}
+
+runNUTATrans :: Traversable f => NUTATrans f q -> Term f -> [q]
+runNUTATrans = cataM
+
+{-| This function checks whether a given NUTA accepts a term. -}
+
+nuta :: Traversable f => NUTA f q -> Term f -> Bool
+nuta NUTA{nutaTrans = trans, nutaAccept = accept} = any accept . runNUTATrans trans
+
+
+{-| This function determinises the given NUTA.  -}
+
+determNUTA :: (Traversable f) => NUTA f q -> DUTA f [q]
+determNUTA n = DUTA{
+               dutaTrans = algM $ nutaTrans n,
+               dutaAccept = any $ nutaAccept n}
+
+{-| This function represents transition functions of
+deterministic bottom-up tree transducers (DUTTs).  -}
+
+type DUTTTrans f g q = forall a. f (q,a) -> (q, Cxt Hole g a)
+
+{-| This function transforms a DUTT transition function into an
+algebra.  -}
+
+duttTransAlg :: (Functor f, Functor g)  => DUTTTrans f g q -> Alg f (q, Term g)
+duttTransAlg trans = fmap injectCxt . trans 
+
+{-| This function runs the given DUTT transition function on the given
+term.  -}
+
+runDUTTTrans :: (Functor f, Functor g)  => DUTTTrans f g q -> Term f -> (q, Term g)
+runDUTTTrans = cata . duttTransAlg
+
+{-| This data type represents deterministic bottom-up tree
+transducers. -}
+
+data DUTT f g q = DUTT {
+      duttTrans :: DUTTTrans f g q,
+      duttAccept :: q -> Bool
+    }
+
+{-| This function transforms the given term according to the given
+DUTT and returns the resulting term provided it is accepted by the
+DUTT. -}
+
+dutt :: (Functor f, Functor g) => DUTT f g q -> Term f -> Maybe (Term g)
+dutt DUTT{duttTrans = trans, duttAccept = accept} = accept' . runDUTTTrans trans
+    where accept' (q,res)
+              | accept q = Just res
+              | otherwise = Nothing
+
+{-| This type represents transition functions of non-deterministic
+bottom-up tree transducers (NUTTs).  -}
+
+type NUTTTrans f g q = forall a. f (q,a) -> [(q, Cxt Hole g a)]
+
+{-| This function transforms a NUTT transition function into a monadic
+algebra.  -}
+
+nuttTransAlg :: (Functor f, Functor g)  => NUTTTrans f g q -> AlgM [] f (q, Term g)
+nuttTransAlg trans = liftM (fmap injectCxt) . trans 
+
+{-| This function runs the given NUTT transition function on the given
+term.  -}
+
+runNUTTTrans :: (Traversable f, Functor g)  => NUTTTrans f g q -> Term f -> [(q, Term g)]
+runNUTTTrans = cataM . nuttTransAlg
+
+{-| This data type represents non-deterministic bottom-up tree
+transducers (NUTTs). -}
+
+data NUTT f g q = NUTT {
+      nuttTrans :: NUTTTrans f g q,
+      nuttAccept :: q -> Bool
+    }
+
+{-| This function transforms the given term according to the given
+NUTT and returns a list containing all accepted results. -}
+
+nutt :: (Traversable f, Functor g) => NUTT f g q -> Term f -> [Term g]
+nutt NUTT{nuttTrans = trans, nuttAccept = accept} = mapMaybe accept' . runNUTTTrans trans
+    where accept' (q,res)
+              | accept q = Just res
+              | otherwise = Nothing
diff --git a/examples/Examples/Automata/MHom.hs b/examples/Examples/Automata/MHom.hs
new file mode 100644
--- /dev/null
+++ b/examples/Examples/Automata/MHom.hs
@@ -0,0 +1,229 @@
+{-# LANGUAGE RankNTypes, MultiParamTypeClasses, FlexibleInstances,
+  FlexibleContexts, UndecidableInstances, TypeOperators,
+  ImplicitParams, GADTs, IncoherentInstances, ScopedTypeVariables,
+  TupleSections #-}
+--------------------------------------------------------------------------------
+-- |
+-- Module      :  Examples.MHom
+-- Copyright   :  (c) 2011 Patrick Bahr
+-- License     :  BSD3
+-- Maintainer  :  Patrick Bahr <paba@diku.dk>
+-- Stability   :  experimental
+-- Portability :  non-portable (GHC Extensions)
+--
+--
+--------------------------------------------------------------------------------
+
+module Examples.Automata.MHom
+    ( module Examples.Automata.MHom
+    , module Data.Stream ) where
+
+import Data.Comp.Zippable
+import Data.Comp
+import Data.Comp.Ops
+import Data.Stream (Stream(..), (<:>))
+import Data.Comp.Show ()
+import Data.Map (Map)
+import qualified Data.Map as Map
+import Control.Monad
+import Control.Arrow (first, (&&&))
+import Data.Comp.Derive
+
+-- | An instance @a :< b@ means that @a@ is a component of @b@. @a@
+-- can be extracted from @b@ via the method 'ex'.
+class p :< q where
+    pr :: q a -> p a
+    up :: p a -> q a -> q a
+
+instance q :< q where
+    pr = id
+    up = const
+
+instance p :< p :*: q where
+    pr = ffst
+    up x (_ :*: y) = x :*: y
+
+instance (p :< q) => p :< (p' :*: q) where
+    pr = pr . fsnd
+    up  y (x :*: y') = x :*: up y y'
+
+-- | This function provides access to components of the states from
+-- "below".
+below :: (?below :: i -> q a, p :< q) => i -> p a
+below = pr . ?below
+
+-- | This function provides access to components of the state from
+-- "above"
+above :: (?above :: q a, p :< q) => p a
+above = pr ?above
+
+hole :: (?get :: i -> a) => i -> Context f a
+hole = Hole . ?get
+
+-- | Turns the explicit parameters @?above@ and @?below@ into explicit
+-- ones.
+explicit :: q a -> (i -> q a) -> (i -> a)
+         -> ((?get :: i -> a, ?below :: i -> q a, ?above :: q a) => b) -> b
+explicit ab bel get x = x
+    where ?above = ab
+          ?below = bel
+          ?get = get
+-- | This type represents generalised term homomorphisms. Generalised
+-- term homomorphisms have access to a state that is provided
+-- (separately) by a DUTA or a DDTA (or both).
+type MHom q f g = forall a i . (?get :: i -> a, ?below :: i -> q a, ?above :: q a)
+    => f i -> Context g a
+
+
+-- | This type represents transition functions of deterministic
+-- bottom-up tree transducers (DUTTs).
+
+type UpTrans q f g = forall a. f (q a,a) -> (q (Context g a), Context g a)
+
+-- | This function transforms DUTT transition function into an
+-- algebra.
+upAlg :: (Functor g, Functor q)  => UpTrans q f g -> Alg f (q (Term g), Term g)
+upAlg trans t = let (q , c) = trans t
+                in (fmap appCxt q, appCxt c)
+
+
+-- | This function runs the given DUTT on the given term.
+
+runUpTrans :: (Functor f, Functor g, Functor q) => UpTrans q f g -> Term f -> (q (Term g), Term g)
+runUpTrans = cata . upAlg
+
+-- | This function generalises 'runUpTrans' to contexts. Therefore,
+-- additionally, a transition function for the holes is needed.
+runUpTrans' :: (Functor f, Functor g, Functor q)
+            => UpTrans q f g -> Context f (q a,a) -> (q (Context g a), Context g a)
+runUpTrans' trans = run where
+    run (Hole (q,a)) = (fmap Hole q, Hole a)
+    run (Term t) = let (q, c) = trans $ fmap run t
+                   in (fmap appCxt q, appCxt c)
+
+-- | This function composes two DUTTs. (I'm not sure whether it is correct, yet.)
+compUpTrans :: (Functor f, Functor g, Functor h, Functor q1, Functor q2)
+               => UpTrans q2 g h -> UpTrans q1 f g -> UpTrans (q1 :*: q2) f h
+compUpTrans t2 t1 x = (q1' :*: q2, c2) where
+    (q1, c1) = t1 $ fmap shuffle  x
+    shuffle (q1 :*: q2,a) = (fmap (q2,) q1 ,(q2,a) )
+    q1' = fmap (snd . runUpTrans' t2) q1
+    (q2, c2) = runUpTrans' t2 c1
+
+-- | This type represents transition functions of deterministic
+-- bottom-up tree acceptors (DUTAs).
+type UpState f q = forall a . f (q a, a) -> q a
+
+-- | This combinator runs the given DUTA on a term returning the final
+-- state of the run.
+runUpState :: (Functor f) => UpState f q -> Term f -> q (Term f)
+runUpState st = run where
+    run (Term t) = st $ fmap (\ s -> (run s, s)) t
+
+
+-- | This function combines the product DUTA of the two given DUTAs.
+prodUpState :: Functor f => UpState f p -> UpState f q -> UpState f (p :*:q)
+prodUpState sp sq t = p :*: q where
+    p = sp $ fmap (first ffst) t
+    q = sq $ fmap (first fsnd) t
+
+-- | This function turns constructs a DUTT from a given macro term
+-- homomorphism with the state propagated by the given DUTA.
+toUpTrans :: (Functor f, Functor g, Functor q)
+          => UpState f q -> MHom q f g -> UpTrans q f g
+toUpTrans st f t = (fmap Hole q, c)
+    where q = st t
+          c = explicit q (pr . fst) snd f t
+
+-- | This function applies a given generalised term homomorphism with
+-- a state space propagated by the given DUTA to a term.
+upHom :: (Functor f, Functor g, Functor q) => UpState f q -> MHom q f g -> Term f -> (q (Term g),Term g)
+upHom alg h = runUpTrans (toUpTrans alg h)
+
+-- | This type represents transition functions of generalised
+-- deterministic bottom-up tree acceptors (GDUTAs) which have access
+-- to an extended state space.
+type GUpState f q p = forall a i . (?get :: i -> a, ?below :: i -> p a, ?above :: p a, q :< p) => f i -> q a
+
+-- | This combinator turns an arbitrary DUTA into a GDUTA.
+gUpState :: Functor f => UpState f q -> GUpState f q p
+gUpState f = f . fmap (below &&& (?get))
+
+-- | This combinator turns a GDUTA with the smallest possible state
+-- space into a DUTA.
+upState :: GUpState f q q -> UpState f q
+upState f s = let res = explicit res fst snd f s in res
+
+-- | This combinator runs a GDUTA on a term.
+runGUpState :: Functor f => GUpState f q q -> Term f -> q (Term f)
+runGUpState s = runUpState (upState s)
+
+-- | This combinator constructs the product of two GDUTA.
+prodGUpState :: (p :< pq, q :< pq)
+             => GUpState f p pq -> GUpState f q pq -> GUpState f (p :*: q) pq
+prodGUpState sp sq t = sp t :*: sq t
+
+-- | This type represents transition functions of deterministic
+-- top-down tree transducers (DDTTs).
+
+type DownTrans q f g = forall a. (q a, f a) -> Context g (q (Context f a),a)
+
+-- | This function runs the given DDTT on the given tree.
+runDownTrans :: (Functor f, Functor g, Functor q) => DownTrans q f g -> q (Cxt h g a) -> Cxt h f a -> Cxt h g a
+runDownTrans tr q t = run (q,t) where
+    run (q,Term t) = appCxt $ fmap (\(q,a) -> run (fmap appCxt q,a)) $  tr (q, t)
+    run (_,Hole a) = Hole a
+
+-- | This function runs the given DDTT on the given tree.
+runDownTrans' :: (Functor f, Functor g, Functor q) => DownTrans q f g -> q (Cxt h f a)
+              -> Cxt h f a -> Cxt h g (q (Cxt h f a),a)
+runDownTrans' tr q t = run (q,t) where
+    run (q,Term t) = appCxt $ fmap (\(q,a) -> run (fmap appCxt q,a)) $  tr (q, t)
+    run (q,Hole a)      = Hole (q,a)
+
+-- | This function composes two DDTTs. (not implemented yet)
+compDownTrans :: (Functor f, Functor g, Functor h)
+              => DownTrans p g h -> DownTrans q f g -> DownTrans (q :*:p) f h
+compDownTrans = undefined
+
+-- | This type represents transition functions of deterministic
+-- top-down tree acceptors (DDTAs).
+type DownState f q = forall a i. Ord i => (q a, f (i,a)) -> Map i (q a)
+
+-- | This function constructs the product DDTA of the given two DDTAs.
+prodDownState :: DownState f p -> DownState f q -> DownState f (p :*: q)
+prodDownState sp sq (p :*: q,t) = prodMap p q (sp (p, t)) (sq (q, t))
+
+
+
+-- | This type is needed to construct the product of two DDTAs.
+data ProdState p q = LState p
+                   | RState q
+                   | BState p q
+-- | This function constructs the pointwise product of two maps each
+-- with a default value.
+prodMap :: (Ord i) => p a -> q a -> Map i (p a) -> Map i (q a) -> Map i ((p :*: q) a)
+prodMap p q mp mq = Map.map final $ Map.unionWith combine ps qs
+    where ps = Map.map LState mp
+          qs = Map.map RState mq
+          combine (LState p) (RState q) = BState p q
+          combine (RState q) (LState p) = BState p q
+          combine _ _                   = error "unexpected merging"
+          final (LState p) = p :*: q
+          final (RState q) = p :*: q
+          final (BState p q) = p :*: q
+
+-- | Apply the given state mapping to the given functorial value by
+-- adding the state to the corresponding index if it is in the map and
+-- otherwise adding the provided default state.
+appMap :: Zippable f => DownState f q -> q a -> f a -> f (q a,a)
+appMap qmap q s = fmap qfun s'
+    where s' = number' s
+          mapping  = qmap (q,s')
+          qfun (k,a) = (Map.findWithDefault q k mapping ,a)
+
+-- -- | This function constructs a DDTT from a given stateful term
+-- -- homomorphism with the state propagated by the given DDTA.
+-- toDownTrans :: (Zippable f, Functor q) => DownState f q -> MHom q f g -> DownTrans q f g
+-- toDownTrans st f (q, s) = fmap mkQCxt $ explicit q fst id f (appMap st q s)
+--     where mkQCxt (q,a) = (fmap Hole q, a)
diff --git a/examples/Examples/Automata/SimpComp.hs b/examples/Examples/Automata/SimpComp.hs
new file mode 100644
--- /dev/null
+++ b/examples/Examples/Automata/SimpComp.hs
@@ -0,0 +1,79 @@
+{-# LANGUAGE TemplateHaskell, FlexibleContexts, MultiParamTypeClasses,
+  TypeOperators, FlexibleInstances, UndecidableInstances,
+  ScopedTypeVariables, TypeSynonymInstances, RankNTypes #-}
+
+module Examples.Automata.Compiler where
+
+
+import Data.Comp.Automata hiding (DUpState, (<*>), runDUpState, dUpState)
+import Data.Comp.Zippable
+import Data.Comp.Derive
+import Data.Comp.Ops
+import Data.Comp hiding (height)
+import Prelude hiding (foldl)
+
+
+
+type Var = String
+
+data Sig a = Const Int | Plus a a
+data Let a = Let Var a a
+           | Var Var
+
+
+$(derive [makeFunctor, makeFoldable, smartConstructors, makeShowF] [''Sig, ''Let])
+
+instance Zippable Sig where
+    fzip _ (Const i) = Const i
+    fzip (Cons a (Cons b _)) (Plus x y) = Plus (a,x) (b,y)
+
+instance Zippable Let where
+    fzip (Cons a (Cons b _)) (Let v x y) = Let v (a,x) (b,y)
+    fzip _ (Var v) = Var v
+
+
+instance (Zippable f, Zippable g) => Zippable (f :+: g) where
+    fzip x (Inl v) = Inl $ fzip x v
+    fzip x (Inr v) = Inr $ fzip x v
+
+evalSt :: UpState Sig Int
+evalSt (Const i) = i
+evalSt (Plus x y) = x + y
+
+type Addr = Int
+
+data Instr = Acc Int
+           | Load Addr
+           | Store Addr
+           | Add Addr
+             deriving (Show)
+
+type Code = [Instr]
+
+
+
+type DUpState f q p = (q :< p) => f p -> q
+
+dUpState :: Functor f => UpState f q -> DUpState f q p
+dUpState st = st . fmap pr
+
+
+heightSt :: UpState Sig Int
+heightSt (Const _) = 0
+heightSt (Plus x y) = 1 + max x y
+
+codeSt :: (Int :< q) => DUpState Sig Code q
+codeSt (Const x) = [Acc x]
+codeSt (Plus x y) = pr x ++ [Store a] ++ pr y ++ [Add a] where a = pr y
+
+-- | This combinator constructs the product of two GDUTA.
+(<*>) :: (p :< pq, q :< pq)
+             => DUpState f p pq -> DUpState f q pq -> DUpState f (p,q) pq
+(sp <*> sq) t = (sp t, sq t)
+    
+runDUpState :: Functor f => DUpState f q q -> Term f -> q
+runDUpState = cata
+
+code :: Term Sig -> Code
+code = fst . runDUpState (codeSt <*> dUpState heightSt)
+ 
diff --git a/examples/Examples/Automata/SimpComp2.hs b/examples/Examples/Automata/SimpComp2.hs
new file mode 100644
--- /dev/null
+++ b/examples/Examples/Automata/SimpComp2.hs
@@ -0,0 +1,153 @@
+{-# LANGUAGE TemplateHaskell, FlexibleContexts, MultiParamTypeClasses,
+  TypeOperators, FlexibleInstances, UndecidableInstances,
+  ScopedTypeVariables, TypeSynonymInstances, RankNTypes, ImplicitParams, DeriveDataTypeable #-}
+
+module Examples.Automata.Compiler where
+
+import Data.Comp.Automata
+import Data.Comp.Zippable
+import Data.Comp.Derive
+import Data.Comp.Ops
+import Data.Comp hiding (height)
+import Data.Foldable
+import Prelude hiding (foldl)
+
+import Data.Set (Set, union, singleton, delete, member)
+import qualified Data.Set as Set
+
+import Data.Map (Map)
+import qualified Data.Map as Map
+
+
+
+
+type Var = String
+
+data Sig e = Const Int | Plus e e | LetIn Var e e | Var Var
+
+
+$(derive [makeFunctor, makeFoldable, smartConstructors, makeShowF] [''Sig])
+
+instance Zippable Sig where
+    fzip _ (Const i) = Const i
+    fzip (Cons a (Cons b _)) (Plus x y) = Plus (a,x) (b,y)
+    fzip (Cons a (Cons b _)) (LetIn v x y) = LetIn v (a,x) (b,y)
+    fzip _ (Var v) = Var v
+
+
+instance (Zippable f, Zippable g) => Zippable (f :+: g) where
+    fzip x (Inl v) = Inl $ fzip x v
+    fzip x (Inr v) = Inr $ fzip x v
+
+-- evalSt :: UpState Sig Int
+-- evalSt (Const i) = i
+-- evalSt (Plus x y) = x + y
+
+type Addr = Int
+
+data Instr = Acc Int
+           | Load Addr
+           | Store Addr
+           | Add Addr
+             deriving (Show)
+
+type Code = [Instr]
+
+
+
+-- heightSt :: UpState Sig Int
+-- heightSt (Const _) = 0
+-- heightSt (Plus x y) = 1 + max x y
+-- heightSt (LetIn _ e b) = 1 + max e b
+-- heightSt (Var _) = 0
+
+-- codeSt :: (Int :< q) => DUpState Sig q Code 
+-- codeSt (Const x) = [Acc x]
+-- codeSt (Plus x y) = below x ++ [Store a] ++ below y ++ [Add a] where a = below y
+
+
+-- code :: Term Sig -> Code
+-- code = fst . runDUpState (codeSt <*> dUpState heightSt)
+
+
+type Vars = Set Var
+
+fvSt :: UpState Sig Vars
+fvSt (Var v)  = singleton v
+fvSt (LetIn v e b)  | v `member` b  = e `union` delete v b
+                    | otherwise     =  delete v b
+fvSt t        = foldl union Set.empty t
+
+-- | Stateful homomorphism that removes unnecessary let bindings.
+remLetHom :: (Vars :< q) => QHom Sig q Sig
+remLetHom (LetIn v _ y) | not (v `Set.member` below y) = Hole y
+remLetHom  t = simpCxt t
+
+remLet :: Term Sig -> Term Sig
+remLet = runUpHom fvSt remLetHom
+
+ldepthSt :: DownState Sig Int
+ldepthSt (d,LetIn _ _ b) = b |-> d + 1
+ldepthSt _               = o
+
+type Ren = Map Var Var
+
+
+newVar :: (?above :: q, Int :< q) => Var
+newVar = show (above :: Int)
+
+renSt :: (Int :< q) => DDownState Sig q Ren
+renSt (LetIn v _ b) = b |-> (v |-> newVar & above)
+renSt _             = o
+
+renameHom :: (Ren :< q, Int :< q) => QHom Sig q Sig
+renameHom (LetIn _ a b) = iLetIn newVar (Hole a) (Hole b)
+renameHom (Var v) = case Map.lookup v above of
+                      Nothing -> iVar v
+                      Just v' -> iVar v'
+renameHom t = simpCxt t
+
+renameInit :: (Ren, Int)
+renameInit = (o, 0)
+
+rename :: Term Sig -> Term Sig
+rename = runDownHom (downState (renSt >*< dDownState ldepthSt))
+         renameHom renameInit
+
+
+heightSt :: Foldable f => UpState f Int
+heightSt t = foldl max 0 t + 1
+
+newtype Height = Height {height :: Int}
+
+heightSt' :: (Functor f,Foldable f) => UpState f Height
+heightSt' = tagUpState Height height heightSt
+
+
+newtype Depth = Depth {depth :: Int}
+
+ldepthSt' :: DownState Sig Depth
+ldepthSt' = tagDownState Depth depth ldepthSt
+
+type Bind = Map Var Int
+
+bindSt :: (Depth :< q) => DDownState Sig q Bind 
+bindSt (LetIn v _ e)  = e |-> (v |-> 2 * depth above & above)
+bindSt _              = o
+
+codeSt :: (Height :< q, Depth :< q, Bind :< q) => DUpState Sig q Code 
+codeSt (Const x) = [Acc x]
+codeSt (Plus x y) = below x ++ [Store a] ++ below y ++ [Add a] 
+    where a = 2 * height (below y) + 1
+codeSt (LetIn _ b e) = below b ++ [Store a] ++ below e
+    where a = 2 * depth above
+codeSt (Var v) = case Map.lookup v above of
+                       Nothing -> error $ "unbound variable " ++ v
+                       Just i -> [Load i]
+
+
+code :: Term Sig -> (Code, Height)
+code = runDState 
+          (codeSt <*> dUpState heightSt')
+          (bindSt >*< dDownState ldepthSt')
+          (o :: Bind, Depth 0)
diff --git a/examples/Examples/Desugar.hs b/examples/Examples/Desugar.hs
--- a/examples/Examples/Desugar.hs
+++ b/examples/Examples/Desugar.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE TemplateHaskell, TypeOperators, MultiParamTypeClasses,
   FlexibleInstances, FlexibleContexts, UndecidableInstances,
-  OverlappingInstances #-}
+  OverlappingInstances, ConstraintKinds #-}
 --------------------------------------------------------------------------------
 -- |
 -- Module      :  Examples.Desugar
diff --git a/examples/Examples/Eval.hs b/examples/Examples/Eval.hs
--- a/examples/Examples/Eval.hs
+++ b/examples/Examples/Eval.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE TemplateHaskell, TypeOperators, MultiParamTypeClasses,
   FlexibleInstances, FlexibleContexts, UndecidableInstances,
-  OverlappingInstances #-}
+  OverlappingInstances, ConstraintKinds #-}
 --------------------------------------------------------------------------------
 -- |
 -- Module      :  Examples.Eval
diff --git a/examples/Examples/EvalM.hs b/examples/Examples/EvalM.hs
--- a/examples/Examples/EvalM.hs
+++ b/examples/Examples/EvalM.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE TemplateHaskell, TypeOperators, MultiParamTypeClasses,
   FlexibleInstances, FlexibleContexts, UndecidableInstances,
-  OverlappingInstances #-}
+  OverlappingInstances, ConstraintKinds #-}
 --------------------------------------------------------------------------------
 -- |
 -- Module      :  Examples.EvalM
diff --git a/examples/Examples/MultiParam/FOL.hs b/examples/Examples/MultiParam/FOL.hs
deleted file mode 100644
--- a/examples/Examples/MultiParam/FOL.hs
+++ /dev/null
@@ -1,436 +0,0 @@
-{-# LANGUAGE TemplateHaskell, TypeOperators, FlexibleInstances,
-  FlexibleContexts, UndecidableInstances, GADTs, KindSignatures,
-  OverlappingInstances, TypeSynonymInstances, EmptyDataDecls #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Examples.MultiParam.FOL
--- Copyright   :  (c) 2011 Patrick Bahr, Tom Hvitved
--- License     :  BSD3
--- Maintainer  :  Tom Hvitved <hvitved@diku.dk>
--- Stability   :  experimental
--- Portability :  non-portable (GHC Extensions)
---
--- First-Order Logic a la Carte
---
--- This example illustrates how to implement First-Order Logic a la Carte
--- (Knowles, The Monad.Reader Issue 11, '08) using Generalised Parametric
--- Compositional Data Types.
---
--- Rather than using a fixed domain 'Term' for binders as Knowles, our encoding
--- uses a mutually recursive data structure for terms and formulae. This makes
--- terms modular too, and hence we only introduce variables when they are
--- actually needed in stage 5.
---
---------------------------------------------------------------------------------
-
-module Examples.MultiParam.FOL where
-
-import Data.Comp.MultiParam hiding (Var)
-import qualified Data.Comp.MultiParam as MP
-import Data.Comp.MultiParam.Show ()
-import Data.Comp.MultiParam.Derive
-import Data.Comp.MultiParam.FreshM (Name, withName, evalFreshM)
-import Data.List (intercalate)
-import Data.Maybe
-import Control.Monad.State
-import Control.Monad.Reader
-
--- Phantom types indicating whether a (recursive) term is a formula or a term
-data TFormula
-data TTerm
-
--- Terms
-data Const :: (* -> *) -> (* -> *) -> * -> * where
-    Const :: String -> [e TTerm] -> Const a e TTerm
-data Var :: (* -> *) -> (* -> *) -> * -> * where
-    Var :: String -> Var a e TTerm
-
--- Formulae
-data TT :: (* -> *) -> (* -> *) -> * -> * where
-    TT :: TT a e TFormula
-data FF :: (* -> *) -> (* -> *) -> * -> * where
-    FF :: FF a e TFormula
-data Atom :: (* -> *) -> (* -> *) -> * -> * where
-    Atom :: String -> [e TTerm] -> Atom a e TFormula
-data NAtom :: (* -> *) -> (* -> *) -> * -> * where
-    NAtom :: String -> [e TTerm] -> NAtom a e TFormula
-data Not :: (* -> *) -> (* -> *) -> * -> * where
-    Not :: e TFormula -> Not a e TFormula
-data Or :: (* -> *) -> (* -> *) -> * -> * where
-    Or :: e TFormula -> e TFormula -> Or a e TFormula
-data And :: (* -> *) -> (* -> *) -> * -> * where
-    And :: e TFormula -> e TFormula -> And a e TFormula
-data Impl :: (* -> *) -> (* -> *) -> * -> * where
-    Impl :: e TFormula -> e TFormula -> Impl a e TFormula
-data Exists :: (* -> *) -> (* -> *) -> * -> * where
-    Exists :: (a TTerm -> e TFormula) -> Exists a e TFormula
-data Forall :: (* -> *) -> (* -> *) -> * -> * where
-    Forall :: (a TTerm -> e TFormula) -> Forall a e TFormula
-
-$(derive [makeHDifunctor, smartConstructors]
-         [''Const, ''Var, ''TT, ''FF, ''Atom, ''NAtom,
-          ''Not, ''Or, ''And, ''Impl, ''Exists, ''Forall])
-
---------------------------------------------------------------------------------
--- (Custom) pretty printing of terms and formulae
---------------------------------------------------------------------------------
-
-instance ShowHD Const where
-  showHD (Const f t) = do ts <- mapM unK t
-                          return $ f ++ "(" ++ intercalate ", " ts ++ ")"
-
-instance ShowHD Var where
-  showHD (Var x) = return x
-
-instance ShowHD TT where
-  showHD TT = return "true"
-
-instance ShowHD FF where
-  showHD FF = return "false"
-
-instance ShowHD Atom where
-  showHD (Atom p t) = do ts <- mapM unK t
-                         return $ p ++ "(" ++ intercalate ", " ts ++ ")"
-
-instance ShowHD NAtom where
-  showHD (NAtom p t) = do ts <- mapM unK t
-                          return $ "not " ++ p ++ "(" ++ intercalate ", " ts ++ ")"
-
-instance ShowHD Not where
-  showHD (Not (K f)) = liftM (\x -> "not (" ++ x ++ ")") f
-
-instance ShowHD Or where
-  showHD (Or (K f1) (K f2)) =
-      liftM2 (\x y -> "(" ++ x ++ ") or (" ++ y ++ ")") f1 f2
-
-instance ShowHD And where
-  showHD (And (K f1) (K f2)) =
-      liftM2 (\x y -> "(" ++ x ++ ") and (" ++ y ++ ")") f1 f2
-
-instance ShowHD Impl where
-  showHD (Impl (K f1) (K f2)) =
-      liftM2 (\x y -> "(" ++ x ++ ") -> (" ++ y ++ ")") f1 f2
-
-instance ShowHD Exists where
-  showHD (Exists f) =
-      withName (\x -> do b <- unK (f x)
-                         return $ "exists " ++ show x ++ ". " ++ b)
-
-instance ShowHD Forall where
-  showHD (Forall f) =
-      withName (\x -> do b <- unK (f x)
-                         return $ "forall " ++ show x ++ ". " ++ b)
-
---------------------------------------------------------------------------------
--- Stage 0
---------------------------------------------------------------------------------
-
-type Input = Const :+:
-             TT :+: FF :+: Atom :+: Not :+: Or :+: And :+: Impl :+:
-             Exists :+: Forall
-
-foodFact :: Term Input TFormula
-foodFact = Term $
-  iExists (\p -> iAtom "Person" [p] `iAnd`
-                 iForall (\f -> iAtom "Food" [f] `iImpl`
-                                iAtom "Eats" [p,f])) `iImpl`
-  iNot (iExists $ \f -> iAtom "Food" [f] `iAnd`
-                        iNot (iExists $ \p -> iAtom "Person" [p] `iAnd`
-                                              iAtom "Eats" [p,f]))
-
---------------------------------------------------------------------------------
--- Stage 1: Eliminate Implications
---------------------------------------------------------------------------------
-
-type Stage1 = Const :+:
-              TT :+: FF :+: Atom :+: Not :+: Or :+: And :+: Exists :+: Forall
-
-class HDifunctor f => ElimImp f where
-  elimImpHom :: Hom f Stage1
-
-$(derive [liftSum] [''ElimImp])
-
-elimImp :: Term Input :-> Term Stage1
-elimImp (Term t) = Term (appHom elimImpHom t)
-
-instance (HDifunctor f, f :<: Stage1) => ElimImp f where
-  elimImpHom = simpCxt . inj
-
-instance ElimImp Impl where
-  elimImpHom (Impl f1 f2) = iNot (Hole f1) `iOr` (Hole f2)
-
-foodFact1 :: Term Stage1 TFormula
-foodFact1 = elimImp foodFact
-
---------------------------------------------------------------------------------
--- Stage 2: Move Negation Inwards
---------------------------------------------------------------------------------
-
-type Stage2 = Const :+:
-              TT :+: FF :+: Atom :+: NAtom :+: Or :+: And :+: Exists :+: Forall
-
-class HDifunctor f => Dualize f where
-  dualizeHom :: f a (Cxt h Stage2 a b) :-> Cxt h Stage2 a b
-
-$(derive [liftSum] [''Dualize])
-
-dualize :: Trm Stage2 a :-> Trm Stage2 a
-dualize = appHom (dualizeHom . hfmap Hole)
-
-instance Dualize Const where
-  dualizeHom (Const f t) = iConst f t
-
-instance Dualize TT where
-  dualizeHom TT = iFF
-
-instance Dualize FF where
-  dualizeHom FF = iTT
-
-instance Dualize Atom where
-  dualizeHom (Atom p t) = iNAtom p t
-
-instance Dualize NAtom where
-  dualizeHom (NAtom p t) = iAtom p t
-
-instance Dualize Or where
-  dualizeHom (Or f1 f2) = f1 `iAnd` f2
-
-instance Dualize And where
-  dualizeHom (And f1 f2) = f1 `iOr` f2
-
-instance Dualize Exists where
-  dualizeHom (Exists f) = inject $ Forall f
-
-instance Dualize Forall where
-  dualizeHom (Forall f) = inject $ Exists f
-
-class PushNot f where
-  pushNotAlg :: Alg f (Trm Stage2 a)
-
-$(derive [liftSum] [''PushNot])
-
-pushNotInwards :: Term Stage1 :-> Term Stage2
-pushNotInwards t = Term (cata pushNotAlg t)
-
-instance (HDifunctor f, f :<: Stage2) => PushNot f where
-  pushNotAlg = inject . hdimap MP.Var id -- default
-
-instance PushNot Not where
-  pushNotAlg (Not f) = dualize f
-
-foodFact2 :: Term Stage2 TFormula
-foodFact2 = pushNotInwards foodFact1
-
---------------------------------------------------------------------------------
--- Stage 4: Skolemization
---------------------------------------------------------------------------------
-
-type Stage4 = Const :+:
-              TT :+: FF :+: Atom :+: NAtom :+: Or :+: And :+: Forall
-
-type Unique = Int
-data UniqueSupply = UniqueSupply Unique UniqueSupply UniqueSupply
-
-initialUniqueSupply :: UniqueSupply
-initialUniqueSupply = genSupply 1
-    where genSupply n = UniqueSupply n (genSupply (2 * n))
-                                       (genSupply (2 * n + 1))
-
-splitUniqueSupply :: UniqueSupply -> (UniqueSupply, UniqueSupply)
-splitUniqueSupply (UniqueSupply	_ l r) = (l,r)
-
-getUnique :: UniqueSupply -> (Unique, UniqueSupply)
-getUnique (UniqueSupply n l _) = (n,l)
-
-type Supply = State UniqueSupply
-type S a = ReaderT [Trm Stage4 a TTerm] Supply
-
-evalS :: S a b -> [Trm Stage4 a TTerm] -> UniqueSupply -> b
-evalS m env = evalState (runReaderT m env)
-
-fresh :: S a Int
-fresh = do supply <- get
-           let (uniq,rest) = getUnique supply
-           put rest
-           return uniq
-
-freshes :: S a UniqueSupply
-freshes = do supply <- get
-             let (l,r) = splitUniqueSupply supply
-             put r
-             return l
-
-class Skolem f where
-  skolemAlg :: AlgM' (S a) f (Trm Stage4 a)
-
-$(derive [liftSum] [''Skolem])
-
-skolemize :: Term Stage2 :-> Term Stage4
-skolemize f = Term (evalState (runReaderT (cataM' skolemAlg f) [])
-                              initialUniqueSupply)
-
-instance Skolem Const where
-  skolemAlg (Const f t) = liftM (iConst f) $ mapM getCompose t
-
-instance Skolem TT where
-  skolemAlg TT = return iTT
-
-instance Skolem FF where
-  skolemAlg FF = return iFF
-
-instance Skolem Atom where
-  skolemAlg (Atom p t) = liftM (iAtom p) $ mapM getCompose t
-
-instance Skolem NAtom where
-  skolemAlg (NAtom p t) = liftM (iNAtom p) $ mapM getCompose t
-
-instance Skolem Or where
-  skolemAlg (Or (Compose f1) (Compose f2)) = liftM2 iOr f1 f2
-
-instance Skolem And where
-  skolemAlg (And (Compose f1) (Compose f2)) = liftM2 iAnd f1 f2
-
-instance Skolem Forall where
-  skolemAlg (Forall f) = do
-    supply <- freshes
-    xs <- ask
-    return $ iForall $ \x -> evalS (getCompose $ f x) (x : xs) supply
-
-instance Skolem Exists where
-  skolemAlg (Exists f) = do
-    uniq <- fresh
-    xs <- ask
-    getCompose $ f (iConst ("Skol" ++ show uniq) xs)
-
-foodFact4 :: Term Stage4 TFormula
-foodFact4 = skolemize foodFact2
-
---------------------------------------------------------------------------------
--- Stage 5: Prenex Normal Form
---------------------------------------------------------------------------------
-
-type Stage5 = Const :+: Var :+:
-              TT :+: FF :+: Atom :+: NAtom :+: Or :+: And
-
-class Prenex f where
-  prenexAlg :: AlgM' (S a) f (Trm Stage5 a)
-
-$(derive [liftSum] [''Prenex])
-
-prenex :: Term Stage4 :-> Term Stage5
-prenex f = Term (evalState (runReaderT (cataM' prenexAlg f) [])
-                           initialUniqueSupply)
-
-instance Prenex Const where
-  prenexAlg (Const f t) = liftM (iConst f) $ mapM getCompose t
-
-instance Prenex TT where
-  prenexAlg TT = return iTT
-
-instance Prenex FF where
-  prenexAlg FF = return iFF
-
-instance Prenex Atom where
-  prenexAlg (Atom p t) = liftM (iAtom p) $ mapM getCompose t
-
-instance Prenex NAtom where
-  prenexAlg (NAtom p t) = liftM (iNAtom p) $ mapM getCompose t
-
-instance Prenex Or where
-  prenexAlg (Or (Compose f1) (Compose f2)) = liftM2 iOr f1 f2
-
-instance Prenex And where
-  prenexAlg (And (Compose f1) (Compose f2)) = liftM2 iAnd f1 f2
-
-instance Prenex Forall where
-  prenexAlg (Forall f) = do uniq <- fresh
-                            getCompose $ f (iVar ('x' : show uniq))
-
-foodFact5 :: Term Stage5 TFormula
-foodFact5 = prenex foodFact4
-
---------------------------------------------------------------------------------
--- Stage 6: Conjunctive Normal Form
---------------------------------------------------------------------------------
-
-type Literal a     = Trm (Const :+: Var :+: Atom :+: NAtom) a
-newtype Clause a i = Clause {unClause :: [Literal a i]} -- implicit disjunction
-newtype CNF a i    = CNF {unCNF :: [Clause a i]}        -- implicit conjunction
-
-instance (HDifunctor f, ShowHD f) => Show (Trm f Name i) where
-  show = evalFreshM . showHD . toCxt
-
-instance Show (Clause Name i) where
-  show c = intercalate " or " $ map show $ unClause c
-
-instance Show (CNF Name i) where
-  show c = intercalate "\n" $ map show $ unCNF c
-
-class ToCNF f where
-  cnfAlg :: f (CNF a) (CNF a) i -> [Clause a i]
-
-$(derive [liftSum] [''ToCNF])
-
-cnf :: Term Stage5 :-> CNF a
-cnf = cata (CNF . cnfAlg)
-
-instance ToCNF Const where
-  cnfAlg (Const f t) =
-      [Clause [iConst f (map (head . unClause . head . unCNF) t)]]
-
-instance ToCNF Var where
-  cnfAlg (Var x) = [Clause [iVar x]]
-
-instance ToCNF TT where
-  cnfAlg TT = []
-
-instance ToCNF FF where
-  cnfAlg FF = [Clause []]
-
-instance ToCNF Atom where
-  cnfAlg (Atom p t) =
-      [Clause [iAtom p (map (head . unClause . head . unCNF) t)]]
-
-instance ToCNF NAtom where
-  cnfAlg (NAtom p t) =
-      [Clause [iNAtom p (map (head . unClause . head . unCNF) t)]]
-
-instance ToCNF And where
-  cnfAlg (And f1 f2) = unCNF f1 ++ unCNF f2
-
-instance ToCNF Or where
-  cnfAlg (Or f1 f2) =
-      [Clause (x ++ y) | Clause x <- unCNF f1, Clause y <- unCNF f2]
-
-foodFact6 :: CNF a TFormula
-foodFact6 = cnf foodFact5
-
---------------------------------------------------------------------------------
--- Stage 7: Implicative Normal Form
---------------------------------------------------------------------------------
-
-type T              = Const :+: Var :+: Atom :+: NAtom
-newtype IClause a i = IClause ([Trm T a i], -- implicit conjunction
-                               [Trm T a i]) -- implicit disjunction
-newtype INF a i     = INF [IClause a i]     -- implicit conjunction
-
-instance Show (IClause Name i) where
-  show (IClause (cs,ds)) = let cs' = intercalate " and " $ map show cs
-                               ds' = intercalate " or " $ map show ds
-                           in "(" ++ cs' ++ ") -> (" ++ ds' ++ ")"
-
-instance Show (INF Name i) where
-  show (INF fs) = intercalate "\n" $ map show fs
-
-inf :: CNF a TFormula -> INF a TFormula
-inf (CNF f) = INF $ map (toImpl . unClause) f
-    where toImpl :: [Literal a TFormula] -> IClause a TFormula
-          toImpl disj = IClause ([iAtom p t | NAtom p t <- mapMaybe proj1 disj],
-                                 [inject t | t <- mapMaybe proj2 disj])
-          proj1 :: NatM Maybe (Trm T a) (NAtom a (Trm T a))
-          proj1 = project
-          proj2 :: NatM Maybe (Trm T a) (Atom a (Trm T a))
-          proj2 = project
-
-foodFact7 :: INF a TFormula
-foodFact7 = inf foodFact6
diff --git a/examples/Examples/MultiParam/Lambda.hs b/examples/Examples/MultiParam/Lambda.hs
deleted file mode 100644
--- a/examples/Examples/MultiParam/Lambda.hs
+++ /dev/null
@@ -1,106 +0,0 @@
-{-# LANGUAGE TemplateHaskell, TypeOperators, MultiParamTypeClasses,
-  FlexibleInstances, FlexibleContexts, UndecidableInstances,
-  OverlappingInstances, Rank2Types, GADTs, KindSignatures,
-  ScopedTypeVariables, TypeFamilies #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Examples.MultiParam.Lambda
--- Copyright   :  (c) 2011 Patrick Bahr, Tom Hvitved
--- License     :  BSD3
--- Maintainer  :  Tom Hvitved <hvitved@diku.dk>
--- Stability   :  experimental
--- Portability :  non-portable (GHC Extensions)
---
--- Tagless (monadic) interpretation of extended lambda calculus
---
---------------------------------------------------------------------------------
-
-module Examples.MultiParam.Lambda where
-
-import Data.Comp.MultiParam
-import Data.Comp.MultiParam.Show ()
-import Data.Comp.MultiParam.Equality ()
-import Data.Comp.MultiParam.Derive
-import Control.Monad (liftM2)
-import Control.Monad.Error (MonadError, throwError)
-
-data Lam :: (* -> *) -> (* -> *) -> * -> * where
-  Lam :: (a i -> b j) -> Lam a b (i -> j)
-data App :: (* -> *) -> (* -> *) -> * -> * where
-  App :: b (i -> j) -> b i -> App a b j
-data Const :: (* -> *) -> (* -> *) -> * -> * where
-  Const :: Int -> Const a b Int
-data Plus :: (* -> *) -> (* -> *) -> * -> * where
-  Plus :: b Int -> b Int -> Plus a b Int
-data Err :: (* -> *) -> (* -> *) -> * -> * where
-  Err :: Err a b i
-type Sig = Lam :+: App :+: Const :+: Plus :+: Err
-
-$(derive [smartConstructors, makeHDifunctor, makeShowHD, makeEqHD]
-         [''Lam, ''App, ''Const, ''Plus, ''Err])
-
--- * Tagless interpretation
-class Eval f where
-  evalAlg :: f I I i -> i -- I . evalAlg :: Alg f I is the actual algebra
-
-$(derive [liftSum] [''Eval])
-
-eval :: (HDifunctor f, Eval f) => Term f i -> i
-eval = unI . cata (I . evalAlg)
-
-instance Eval Lam where
-  evalAlg (Lam f) = unI . f . I
-
-instance Eval App where
-  evalAlg (App (I f) (I x)) = f x
-
-instance Eval Const where
-  evalAlg (Const n) = n
-
-instance Eval Plus where
-  evalAlg (Plus (I x) (I y)) = x + y
-
-instance Eval Err where
-  evalAlg Err = error "error"
-
--- * Tagless monadic interpretation
-type family Sem (m :: * -> *) i
-type instance Sem m (i -> j) = Sem m i -> m (Sem m j)
-type instance Sem m Int = Int
-
-newtype M m i = M {unM :: m (Sem m i)}
-
-class Monad m => EvalM m f where
-  evalMAlg :: f (M m) (M m) i -> m (Sem m i) -- M . evalMAlg :: Alg f (M m)
-
-$(derive [liftSum] [''EvalM])
-
-evalM :: (Monad m, HDifunctor f, EvalM m f) => Term f i -> m (Sem m i)
-evalM = unM . cata (M . evalMAlg)
-
-instance Monad m => EvalM m Lam where
-  evalMAlg (Lam f) = return $ unM . f . M . return
-
-instance Monad m => EvalM m App where
-  evalMAlg (App (M mf) (M mx)) = do f <- mf; f =<< mx
-  
-instance Monad m => EvalM m Const where
-  evalMAlg (Const n) = return n
-
-instance Monad m => EvalM m Plus where
-  evalMAlg (Plus (M mx) (M my)) = liftM2 (+) mx my
-
-instance MonadError String m => EvalM m Err where
-  evalMAlg Err = throwError "error" -- 'throwError' rather than 'error'
-
-e :: Term Sig Int
-e = Term ((iLam $ \x -> (iLam (\y -> y `iPlus` x) `iApp` iConst 3)) `iApp` iConst 2)
-
-v :: Either String Int
-v = evalM e
-
-e' :: Term Sig (Int -> Int)
-e' = Term iErr --(iLam id)
-
-v' :: Either String (Int -> Either String Int)
-v' = evalM e'
diff --git a/examples/Examples/Param/Graph.hs b/examples/Examples/Param/Graph.hs
deleted file mode 100644
--- a/examples/Examples/Param/Graph.hs
+++ /dev/null
@@ -1,77 +0,0 @@
-{-# LANGUAGE TypeOperators, MultiParamTypeClasses, TemplateHaskell,
-  FlexibleInstances, FlexibleContexts, UndecidableInstances,
-  OverlappingInstances #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Examples.Param.Graph
--- Copyright   :  (c) 2011 Patrick Bahr, Tom Hvitved
--- License     :  BSD3
--- Maintainer  :  Tom Hvitved <hvitved@diku.dk>
--- Stability   :  experimental
--- Portability :  non-portable (GHC Extensions)
---
--- Graph representation. The example is taken from (Fegaras and Sheard,
--- Revisiting Catamorphisms over Datatypes with Embedded Functions, '96).
---
---------------------------------------------------------------------------------
-
-module Examples.Param.Graph where
-
-import Data.Comp.Param
-import Data.Comp.Param.Derive
-import Data.Comp.Param.Show ()
-import Data.Comp.Param.Equality ()
-
-data N p a b = N p [b] -- Node
-data R a b = R (a -> b) -- Recursion
-data S a b = S (a -> b) b -- Sharing
-
-$(derive [makeDifunctor, makeShowD, makeEqD, makeOrdD, smartConstructors]
-         [''N, ''R, ''S])
-$(derive [makeDitraversable] [''N])
-
-type Graph p = Term (N p :+: R :+: S)
-
-class FlatG f p where
-  flatGAlg :: Alg f [p]
-
-$(derive [liftSum] [''FlatG])
-
-flatG :: (Difunctor f, FlatG f p) => Term f -> [p]
-flatG = cata flatGAlg
-
-instance FlatG (N p) p where
-  flatGAlg (N p ps) = p : concat ps
-
-instance FlatG R p where
-  flatGAlg (R f) = f []
-
-instance FlatG S p where
-  flatGAlg (S f g) = f g
-
-class SumG f where
-  sumGAlg :: Alg f Int
-
-$(derive [liftSum] [''SumG])
-
-sumG :: (Difunctor f, SumG f) => Term f -> Int
-sumG = cata sumGAlg
-
-instance SumG (N Int) where
-  sumGAlg (N p ps) = p + sum ps
-
-instance SumG R where
-  sumGAlg (R f) = f 0
-
-instance SumG S where
-  sumGAlg (S f g) = f g
-
-g :: Graph Int
-g = Term $ iR (\x -> iS (\z -> iN (0 :: Int) [z,iR $ \y -> iN (1 :: Int) [y,z]])
-                        (iN (2 :: Int) [x]))
-
-f :: [Int]
-f = flatG g
-
-n :: Int
-n = sumG g
diff --git a/examples/Examples/Param/Lambda.hs b/examples/Examples/Param/Lambda.hs
deleted file mode 100644
--- a/examples/Examples/Param/Lambda.hs
+++ /dev/null
@@ -1,131 +0,0 @@
-{-# LANGUAGE TemplateHaskell, TypeOperators, MultiParamTypeClasses,
-  FlexibleInstances, FlexibleContexts, UndecidableInstances,
-  OverlappingInstances, Rank2Types, GADTs #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Examples.Param.Lambda
--- Copyright   :  (c) 2011 Patrick Bahr, Tom Hvitved
--- License     :  BSD3
--- Maintainer  :  Tom Hvitved <hvitved@diku.dk>
--- Stability   :  experimental
--- Portability :  non-portable (GHC Extensions)
---
--- Lambda calculus examples
---
--- We define a pretty printer, a desugaring transformation, constant folding,
--- and call-by-value interpreter for an extended variant of the simply typed
--- lambda calculus.
---
---------------------------------------------------------------------------------
-
-module Examples.Param.Lambda where
-
-import Data.Comp.Param
-import Data.Comp.Param.Show ()
-import Data.Comp.Param.Equality ()
-import Data.Comp.Param.Ordering ()
-import Data.Comp.Param.Derive
-import Data.Comp.Param.Desugar
-
-data Lam a b   = Lam (a -> b)
-data App a b   = App b b
-data Const a b = Const Int
-data Plus a b  = Plus b b
-data Let a b   = Let b (a -> b)
-data Err a b   = Err
-
-type Sig       = Lam :+: App :+: Const :+: Plus :+: Let :+: Err
-type Sig'      = Lam :+: App :+: Const :+: Plus :+: Err
-
-$(derive [smartConstructors, makeDifunctor, makeShowD, makeEqD, makeOrdD]
-         [''Lam, ''App, ''Const, ''Plus, ''Let, ''Err])
-
--- * Pretty printing
-data Stream a = Cons a (Stream a)
-
-class Pretty f where
-  prettyAlg :: Alg f (Stream String -> String)
-
-$(derive [liftSum] [''Pretty])
-
-pretty :: (Difunctor f, Pretty f) => Term f -> String
-pretty t = cata prettyAlg t (nominals 1)
-    where nominals n = Cons ('x' : show n) (nominals (n + 1))
-
-instance Pretty Lam where
-  prettyAlg (Lam f) (Cons x xs) = "(\\" ++ x ++ ". " ++ f (const x) xs ++ ")"
-
-instance Pretty App where
-  prettyAlg (App e1 e2) xs = "(" ++ e1 xs ++ " " ++ e2 xs ++ ")"
-
-instance Pretty Const where
-  prettyAlg (Const n) _ = show n
-
-instance Pretty Plus where
-  prettyAlg (Plus e1 e2) xs = "(" ++ e1 xs ++ " + " ++ e2 xs ++ ")"
-
-instance Pretty Err where
-  prettyAlg Err _ = "error"
-
-instance Pretty Let where
-  prettyAlg (Let e1 e2) (Cons x xs) = "let " ++ x ++ " = " ++ e1 xs ++ " in " ++ e2 (const x) xs
-
--- * Desugaring
-instance (Difunctor f, App :<: f, Lam :<: f) => Desugar Let f where
-  desugHom' (Let e1 e2) = inject (Lam e2) `iApp` e1
-
--- * Constant folding
-class Constf f g where
-  constfAlg :: forall a. Alg f (Trm g a)
-
-$(derive [liftSum] [''Constf])
-
-constf :: (Difunctor f, Constf f g) => Term f -> Term g
-constf t = Term (cata constfAlg t)
-
-instance (Difunctor f, f :<: g) => Constf f g where
-  constfAlg = inject . dimap Var id -- default instance
-
-instance (Plus :<: f, Const :<: f) => Constf Plus f where
-  constfAlg (Plus e1 e2) = case (project e1, project e2) of
-                             (Just (Const n),Just (Const m)) -> iConst (n + m)
-                             _                               -> e1 `iPlus` e2
-
--- * Call-by-value evaluation
-data Sem m = Fun (Sem m -> m (Sem m)) | Int Int
-
-class Monad m => Eval f m where
-  evalAlg :: Alg f (m (Sem m))
-
-$(derive [liftSum] [''Eval])
-
-eval :: (Difunctor f, Eval f m) => Term f -> m (Sem m)
-eval = cata evalAlg
-
-instance Monad m => Eval Lam m where
-  evalAlg (Lam f) = return (Fun (f . return))
-
-instance Monad m => Eval App m where
-  evalAlg (App mx my) = do x <- mx
-                           case x of Fun f -> f =<< my; _ -> fail "stuck"
-
-instance Monad m => Eval Const m where
-  evalAlg (Const n) = return (Int n)
-
-instance Monad m => Eval Plus m where
-  evalAlg (Plus mx my) = do x <- mx
-                            y <- my
-                            case (x,y) of (Int n,Int m) -> return (Int (n + m))
-                                          _             -> fail "stuck"
-
-instance Monad m => Eval Err m where
-  evalAlg Err = fail "error"
-
-e :: Term Sig
-e = Term (iLet (iConst 2) (\x -> (iLam (\y -> y `iPlus` x) `iApp` iConst 3)))
-
-e' :: Term Sig'
-e' = desugar e
-
-evalEx :: Maybe (Sem Maybe)
-evalEx = eval e'
diff --git a/examples/Examples/Param/Names.hs b/examples/Examples/Param/Names.hs
deleted file mode 100644
--- a/examples/Examples/Param/Names.hs
+++ /dev/null
@@ -1,113 +0,0 @@
-{-# LANGUAGE TemplateHaskell, TypeOperators, MultiParamTypeClasses,
-  FlexibleInstances, FlexibleContexts, UndecidableInstances,
-  OverlappingInstances #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Examples.Param.Names
--- Copyright   :  (c) 2011 Patrick Bahr, Tom Hvitved
--- License     :  BSD3
--- Maintainer  :  Tom Hvitved <hvitved@diku.dk>
--- Stability   :  experimental
--- Portability :  non-portable (GHC Extensions)
---
--- From names to parametric higher-order abstract syntax and back
---
--- The example illustrates how to convert a parse tree with explicit names into
--- an AST that uses parametric higher-order abstract syntax, and back again. The
--- example shows how we can easily convert object language binders to Haskell
--- binders, without having to worry about capture avoidance.
---
---------------------------------------------------------------------------------
-
-module Examples.Param.Names where
-
-import Data.Comp.Param hiding (Var)
-import qualified Data.Comp.Param as P
-import Data.Comp.Param.Derive
-import Data.Comp.Param.Ditraversable
-import Data.Comp.Param.Show ()
-import Data.Maybe
-import qualified Data.Map as Map
-import Control.Monad.Reader
-
-data Lam a b  = Lam (a -> b)
-data App a b  = App b b
-data Lit a b  = Lit Int
-data Plus a b = Plus b b
-type Name     = String                 -- The type of names
-data NLam a b = NLam Name b
-data NVar a b = NVar Name
-type SigB     = App :+: Lit :+: Plus
-type SigN     = NLam :+: NVar :+: SigB -- The name signature
-type SigP     = Lam :+: SigB           -- The PHOAS signature
-
-$(derive [makeDifunctor, makeShowD, makeEqD, smartConstructors]
-         [''Lam, ''App, ''Lit, ''Plus, ''NLam, ''NVar])
-$(derive [makeDitraversable]
-         [''App, ''Lit, ''Plus, ''NLam, ''NVar])
-
---------------------------------------------------------------------------------
--- Names to PHOAS translation
---------------------------------------------------------------------------------
-
-type M f a = Reader (Map.Map Name (Trm f a))
-
-class N2PTrans f g where
-  n2pAlg :: Alg f (M g a (Trm g a))
-
-
--- We make the lifting to sums explicit in order to make the N2PTrans
--- work with the default instance declaration further below.
-instance (N2PTrans f1 g, N2PTrans f2 g) => N2PTrans (f1 :+: f2) g where
-    n2pAlg = caseD n2pAlg n2pAlg
-
-n2p :: (Difunctor f, N2PTrans f g) => Term f -> Term g
-n2p t = Term $ runReader (cata n2pAlg t) Map.empty
-
-instance (Lam :<: g) => N2PTrans NLam g where
-  n2pAlg (NLam x b) = do vars <- ask
-                         return $ iLam $ \y -> runReader b (Map.insert x y vars)
-
-instance (Ditraversable f, f :<: g) => N2PTrans f g where
-  n2pAlg = liftM inject . disequence . dimap (return . P.Var) id -- default
-
-instance N2PTrans NVar g where
-  n2pAlg (NVar x) = liftM fromJust (asks (Map.lookup x))
-
-en :: Term SigN
-en = Term $ iNLam "x1" $ iNLam "x2" (iNLam "x3" $ iNVar "x2") `iApp` iNVar "x1"
-
-ep :: Term SigP
-ep = n2p en
-
---------------------------------------------------------------------------------
--- PHOAS to names translation
---------------------------------------------------------------------------------
-
-type M' = Reader [Name]
-
-class P2NTrans f g where
-  p2nAlg :: Alg f (M' (Trm g a))
-
-
--- We make the lifting to sums explicit in order to make the P2NTrans
--- work with the default instance declaration further below.
-instance (P2NTrans f1 g, P2NTrans f2 g) => P2NTrans (f1 :+: f2) g where
-    p2nAlg = caseD p2nAlg p2nAlg
-
-
-p2n :: (Difunctor f, P2NTrans f g) => Term f -> Term g
-p2n t = Term $ runReader (cata p2nAlg t) ['x' : show n | n <- [1..]]
-
-instance (Ditraversable f, f :<: g) => P2NTrans f g where
-  p2nAlg = liftM inject . disequence . dimap (return . P.Var) id -- default
-
-instance (NLam :<: g, NVar :<: g) => P2NTrans Lam g where
-  p2nAlg (Lam f) = do n:names <- ask
-                      return $ iNLam n (runReader (f (return $ iNVar n)) names)
-
-ep' :: Term SigP
-ep' = Term $ iLam $ \a -> iLam (\b -> (iLam $ \_ -> b)) `iApp` a
-
-en' :: Term SigN
-en' = p2n ep'
diff --git a/examples/Examples/Thunk.hs b/examples/Examples/Thunk.hs
new file mode 100644
--- /dev/null
+++ b/examples/Examples/Thunk.hs
@@ -0,0 +1,83 @@
+{-# LANGUAGE TemplateHaskell, TypeOperators, MultiParamTypeClasses,
+  FlexibleInstances, FlexibleContexts, UndecidableInstances, OverlappingInstances #-}
+--------------------------------------------------------------------------------
+-- |
+-- Module      :  Examples.Thunk
+-- Copyright   :  (c) 2011 Patrick Bahr, Tom Hvitved
+-- License     :  BSD3
+-- Maintainer  :  Tom Hvitved <hvitved@diku.dk>
+-- Stability   :  experimental
+-- Portability :  non-portable (GHC Extensions)
+--
+-- This example illustrates how the ''Data.Comp.Thunk'' package can be
+-- used to implement a non-strict language (or a partially non-strict
+-- language).
+--
+--------------------------------------------------------------------------------
+
+module Examples.Thunk where
+
+import Data.Comp
+import Data.Comp.Thunk
+import Data.Comp.Derive
+import Data.Comp.Show()
+import Control.Monad
+import Examples.Common hiding (Value(..), Sig)
+
+-- Signature for values, strict pairs
+data Value a = Const Int | Pair !a !a
+
+-- Signature for the simple expression language
+type Sig = Op :+: Value
+
+-- Derive boilerplate code using Template Haskell
+$(derive [makeFunctor, makeTraversable, makeFoldable,
+          makeEqF, makeShowF, smartConstructors, makeHaskellStrict]
+         [''Value])
+
+-- Monadic term evaluation algebra
+class EvalT f v where
+  evalAlgT :: Monad m => AlgT m f v
+
+$(derive [liftSum] [''EvalT])
+
+-- Lift the monadic evaluation algebra to a monadic catamorphism
+evalT :: (Traversable v, Functor f, EvalT f v, Monad m) => Term f -> m (Term v)
+evalT = nf . cata evalAlgT
+
+instance (Value :<: v) => EvalT Value v where
+-- make pairs strict in both components
+--  evalAlgT x@Pair{} = strict x
+-- or explicitly:
+--  evalAlgT (Pair x y) = thunk $ liftM2 iPair (dethunk' x) (dethunk' )y
+--  evalAlgT x = inject x
+
+-- or only partially strict
+  evalAlgT = haskellStrict'
+
+instance (Value :<: v) => EvalT Op v where
+  evalAlgT (Add x y) = thunk $ do
+                         Const n1 <- whnfPr x
+                         Const n2 <- whnfPr y
+                         return $ iConst $ n1 + n2
+  evalAlgT (Mult x y) = thunk $ do
+                          Const n1 <- whnfPr x
+                          Const n2 <- whnfPr y
+                          return $ iConst $ n1 * n2
+  evalAlgT (Fst v)    = thunk $ do 
+                          Pair x _  <- whnfPr v
+                          return x
+  evalAlgT (Snd v)    = thunk $ do 
+                          Pair _ y <- whnfPr v
+                          return y
+
+
+{-instance Monad (Either String) where
+    Left msg >>= _ = Left msg
+    Right x >>= f = f x
+                      
+    return = Right
+    fail = Left-}
+
+evalTEx :: Either String (Term Value)
+evalTEx = evalT (iSnd (iFst (iConst 5) `iPair` iConst 4) :: Term Sig)
diff --git a/src/Data/Comp/Algebra.hs b/src/Data/Comp/Algebra.hs
--- a/src/Data/Comp/Algebra.hs
+++ b/src/Data/Comp/Algebra.hs
@@ -607,6 +607,7 @@
 
 
 appAlgHom :: forall f g d . (Functor g) => Alg g d -> Hom f g -> Term f -> d
+{-# NOINLINE [1] appAlgHom #-}
 appAlgHom alg hom = run where
     run :: Term f -> d
     run (Term t) = run' $ hom t
@@ -632,6 +633,7 @@
 -- requirements on the source signature @f@.
 appAlgHomM :: forall m f g a. (Traversable g, Monad m)
                => AlgM m g a -> HomM m f g -> Term f -> m a
+{-# NOINLINE [1] appAlgHomM #-}
 appAlgHomM alg hom = run
     where run :: Term f -> m a
           run (Term t) = hom t >>= mapM run >>= run'
diff --git a/src/Data/Comp/Annotation.hs b/src/Data/Comp/Annotation.hs
--- a/src/Data/Comp/Annotation.hs
+++ b/src/Data/Comp/Annotation.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE TypeOperators, MultiParamTypeClasses, FlexibleInstances,
-  UndecidableInstances, Rank2Types, GADTs, ScopedTypeVariables, FlexibleContexts #-}
+  UndecidableInstances, Rank2Types, GADTs, ScopedTypeVariables, FlexibleContexts,
+  ConstraintKinds #-}
 --------------------------------------------------------------------------------
 -- |
 -- Module      :  Data.Comp.Annotation
diff --git a/src/Data/Comp/Automata.hs b/src/Data/Comp/Automata.hs
--- a/src/Data/Comp/Automata.hs
+++ b/src/Data/Comp/Automata.hs
@@ -66,7 +66,7 @@
     , upState
     , runDUpState
     , prodDUpState
-    , (<*>)
+    , (|*|)
     -- * Deterministic Top-Down Tree Transducers
     , DownTrans
     , DownTrans'
@@ -315,9 +315,9 @@
              => DUpState f c p -> DUpState f c q -> DUpState f c (p,q)
 prodDUpState sp sq t = (sp t, sq t)
 
-(<*>) :: (p :< c, q :< c)
+(|*|) :: (p :< c, q :< c)
              => DUpState f c p -> DUpState f c q -> DUpState f c (p,q)
-(<*>) = prodDUpState
+(|*|) = prodDUpState
 
 
 
diff --git a/src/Data/Comp/Derive/DeepSeq.hs b/src/Data/Comp/Derive/DeepSeq.hs
--- a/src/Data/Comp/Derive/DeepSeq.hs
+++ b/src/Data/Comp/Derive/DeepSeq.hs
@@ -33,18 +33,16 @@
 makeNFDataF :: Name -> Q [Dec]
 makeNFDataF fname = do
   TyConI (DataD _cxt name args constrs _deriving) <- abstractNewtypeQ $ reify fname
-  let fArg = VarT . tyVarBndrName $ last args
-      argNames = map (VarT . tyVarBndrName) (init args)
+  let argNames = map (VarT . tyVarBndrName) (init args)
       complType = foldl AppT (ConT name) argNames
       preCond = map (ClassP ''NFData . (: [])) argNames
       classType = AppT (ConT ''NFDataF) complType
   constrs' <- mapM normalConExp constrs
-  rnfFDecl <- funD 'rnfF (rnfFClauses fArg constrs')
+  rnfFDecl <- funD 'rnfF (rnfFClauses constrs')
   return [InstanceD preCond classType [rnfFDecl]]
-      where rnfFClauses fArg = map (genRnfFClause fArg)
-            genRnfFClause fArg (constr, args) = do 
-              let isFargs = map (==fArg) args
-                  n = length args
+      where rnfFClauses = map genRnfFClause
+            genRnfFClause (constr, args) = do 
+              let n = length args
               varNs <- newNames n "x"
               let pat = ConP constr $ map VarP varNs
                   allVars = map varE varNs 
diff --git a/src/Data/Comp/Derive/Equality.hs b/src/Data/Comp/Derive/Equality.hs
--- a/src/Data/Comp/Derive/Equality.hs
+++ b/src/Data/Comp/Derive/Equality.hs
@@ -40,7 +40,6 @@
   return [InstanceD preCond classType [eqFDecl]]
       where eqFClauses constrs = map (genEqClause.abstractConType) constrs
                                    ++ defEqClause constrs
-            filterFarg fArg ty x = (fArg == ty, x)
             defEqClause constrs
                 | length constrs  < 2 = []
                 | otherwise = [clause [wildP,wildP] (normalB [|False|]) []]
diff --git a/src/Data/Comp/Derive/HaskellStrict.hs b/src/Data/Comp/Derive/HaskellStrict.hs
--- a/src/Data/Comp/Derive/HaskellStrict.hs
+++ b/src/Data/Comp/Derive/HaskellStrict.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE TemplateHaskell, TypeOperators, CPP #-}
+{-# LANGUAGE TemplateHaskell, TypeOperators, CPP, FlexibleContexts, ConstraintKinds #-}
 --------------------------------------------------------------------------------
 -- |
 -- Module      :  Data.Comp.Derive.HaskellStrict
@@ -24,6 +24,7 @@
 import Data.Maybe
 import Data.Comp.Thunk
 import Data.Comp.Sum
+import Data.Comp.Ops
 import Data.Traversable
 import Data.Foldable hiding (any,or)
 import Control.Monad hiding (mapM, sequence)
@@ -34,7 +35,7 @@
 class HaskellStrict f where
     thunkSequence :: (Monad m) => f (TermT m g) -> m (f (TermT m g))
     thunkSequenceInject :: (Monad m, f :<: g) => f (TermT m g) -> TermT m g
-    thunkSequenceInject t = thunk $ liftM inject $ thunkSequence t
+    thunkSequenceInject t = thunk $ liftM (inject_ (Inr . inj)) $ thunkSequence t
     thunkSequenceInject' :: (Monad m, f :<: g) => f (TermT m g) -> TermT m g
     thunkSequenceInject' = thunkSequenceInject
 
diff --git a/src/Data/Comp/Derive/Injections.hs b/src/Data/Comp/Derive/Injections.hs
deleted file mode 100644
--- a/src/Data/Comp/Derive/Injections.hs
+++ /dev/null
@@ -1,82 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Data.Comp.Derive.Injections
--- Copyright   :  (c) 2011 Patrick Bahr, Tom Hvitved
--- License     :  BSD3
--- Maintainer  :  Tom Hvitved <hvitved@diku.dk>
--- Stability   :  experimental
--- Portability :  non-portable (GHC Extensions)
---
--- Derive functions for signature injections.
---
---------------------------------------------------------------------------------
-
-module Data.Comp.Derive.Injections
-    (
-     injn,
-     injectn,
-     deepInjectn
-    ) where
-
-import Language.Haskell.TH hiding (Cxt)
-import Data.Comp.Term
-import Data.Comp.Algebra (CxtFun, appSigFun)
-import Data.Comp.Ops ((:+:)(..), (:<:)(..))
-
-injn :: Int -> Q [Dec]
-injn n = do
-  let i = mkName $ "inj" ++ show n
-  let fvars = map (\n -> mkName $ 'f' : show n) [1..n]
-  let gvar = mkName "g"
-  let avar = mkName "a"
-  let xvar = mkName "x"
-  let d = [funD i [clause [varP xvar] (normalB $ genDecl xvar n) []]]
-  sequence $ sigD i (genSig fvars gvar avar) : d
-    where genSig fvars gvar avar = do
-            let cxt = map (\f -> classP ''(:<:) [varT f, varT gvar]) fvars
-            let tp = foldl1 (\a f -> conT ''(:+:) `appT` f `appT` a)
-                            (map varT fvars)
-            let tp' = arrowT `appT` (tp `appT` varT avar)
-                             `appT` (varT gvar `appT` varT avar)
-            forallT (map PlainTV $ gvar : avar : fvars)
-                    (sequence cxt) tp'
-          genDecl x n = [| case $(varE x) of
-                             Inl x -> $(varE $ mkName "inj") x
-                             Inr x -> $(varE $ mkName $ "inj" ++
-                                        if n > 2 then show (n - 1) else "") x |]
-injectn :: Int -> Q [Dec]
-injectn n = do
-  let i = mkName ("inject" ++ show n)
-  let fvars = map (\n -> mkName $ 'f' : show n) [1..n]
-  let gvar = mkName "g"
-  let avar = mkName "a"
-  let d = [funD i [clause [] (normalB $ genDecl n) []]]
-  sequence $ sigD i (genSig fvars gvar avar) : d
-    where genSig fvars gvar avar = do
-            let hvar = mkName "h"
-            let cxt = map (\f -> classP ''(:<:) [varT f, varT gvar]) fvars
-            let tp = foldl1 (\a f -> conT ''(:+:) `appT` f `appT` a)
-                            (map varT fvars)
-            let tp' = conT ''Cxt `appT` varT hvar `appT` varT gvar
-                                 `appT` varT avar
-            let tp'' = arrowT `appT` (tp `appT` tp') `appT` tp'
-            forallT (map PlainTV $ hvar : gvar : avar : fvars)
-                    (sequence cxt) tp''
-          genDecl n = [| Term . $(varE $ mkName $ "inj" ++ show n) |]
-
-deepInjectn :: Int -> Q [Dec]
-deepInjectn n = do
-  let i = mkName ("deepInject" ++ show n)
-  let fvars = map (\n -> mkName $ 'f' : show n) [1..n]
-  let gvar = mkName "g"
-  let d = [funD i [clause [] (normalB $ genDecl n) []]]
-  sequence $ sigD i (genSig fvars gvar) : d
-    where genSig fvars gvar = do
-            let cxt = map (\f -> classP ''(:<:) [varT f, varT gvar]) fvars
-            let tp = foldl1 (\a f -> conT ''(:+:) `appT` f `appT` a)
-                            (map varT fvars)
-            let cxt' = classP ''Functor [tp]
-            let tp' = conT ''CxtFun `appT` tp `appT` varT gvar
-            forallT (map PlainTV $ gvar : fvars) (sequence $ cxt' : cxt) tp'
-          genDecl n = [| appSigFun $(varE $ mkName $ "inj" ++ show n) |]
diff --git a/src/Data/Comp/Derive/Projections.hs b/src/Data/Comp/Derive/Projections.hs
--- a/src/Data/Comp/Derive/Projections.hs
+++ b/src/Data/Comp/Derive/Projections.hs
@@ -24,7 +24,7 @@
 import Data.Traversable (Traversable)
 import Data.Comp.Term
 import Data.Comp.Algebra (CxtFunM, appSigFunM')
-import Data.Comp.Ops ((:+:)(..), (:<:)(..))
+import Data.Comp.Ops ((:+:)(..), (:<:), proj, inj)
 
 projn :: Int -> Q [Dec]
 projn n = do
diff --git a/src/Data/Comp/Derive/Show.hs b/src/Data/Comp/Derive/Show.hs
--- a/src/Data/Comp/Derive/Show.hs
+++ b/src/Data/Comp/Derive/Show.hs
@@ -15,7 +15,9 @@
 module Data.Comp.Derive.Show
     (
      ShowF(..),
-     makeShowF
+     makeShowF,
+     ShowConstr(..),
+     makeShowConstr
     ) where
 
 import Data.Comp.Derive.Utils
@@ -25,11 +27,11 @@
   @Show (Term f)@. -}
 class ShowF f where
     showF :: f String -> String
-             
-showConstr :: String -> [String] -> String
-showConstr con [] = con
-showConstr con args = "(" ++ con ++ " " ++ unwords args ++ ")"
 
+showCon :: String -> [String] -> String
+showCon con [] = con
+showCon con args = "(" ++ con ++ " " ++ unwords args ++ ")"
+
 {-| Derive an instance of 'ShowF' for a type constructor of any first-order kind
   taking at least one argument. -}
 makeShowF :: Name -> Q [Dec]
@@ -49,12 +51,48 @@
             mkShow (isFArg, var)
                 | isFArg = var
                 | otherwise = [| show $var |]
-            genShowFClause fArg (constr, args) = do 
+            genShowFClause fArg (constr, args) = do
               let n = length args
               varNs <- newNames n "x"
               let pat = ConP constr $ map VarP varNs
                   allVars = zipWith (filterFarg fArg) args varNs
                   shows = listE $ map mkShow allVars
                   conName = nameBase constr
-              body <- [|showConstr conName $shows|]
+              body <- [|showCon conName $shows|]
+              return $ Clause [pat] (NormalB body) []
+
+{-| Constructor printing. -}
+class ShowConstr f where
+    showConstr :: f a -> String
+
+showCon' :: String -> [String] -> String
+showCon' con args = unwords $ con : filter (not.null) args
+
+{-| Derive an instance of 'showConstr' for a type constructor of any first-order kind
+  taking at least one argument. -}
+makeShowConstr :: Name -> Q [Dec]
+makeShowConstr fname = do
+  TyConI (DataD _cxt name args constrs _deriving) <- abstractNewtypeQ $ reify fname
+  let fArg = VarT . tyVarBndrName $ last args
+      argNames = map (VarT . tyVarBndrName) (init args)
+      complType = foldl AppT (ConT name) argNames
+      preCond = map (ClassP ''Show . (: [])) argNames
+      classType = AppT (ConT ''ShowConstr) complType
+  constrs' <- mapM normalConExp constrs
+  showConstrDecl <- funD 'showConstr (showConstrClauses fArg constrs')
+  return [InstanceD preCond classType [showConstrDecl]]
+      where showConstrClauses fArg = map (genShowConstrClause fArg)
+            filterFarg fArg ty x = (fArg == ty, varE x)
+            mkShow :: (Bool, ExpQ) -> ExpQ
+            mkShow (isFArg, var)
+                | isFArg = [| "" |]
+                | otherwise = [| show $var |]
+            genShowConstrClause fArg (constr, args) = do
+              let n = length args
+              varNs <- newNames n "x"
+              let pat = ConP constr $ map VarP varNs
+                  allVars = zipWith (filterFarg fArg) args varNs
+                  shows = listE $ map mkShow allVars
+                  conName = nameBase constr
+              body <- [|showCon' conName $shows|]
               return $ Clause [pat] (NormalB body) []
diff --git a/src/Data/Comp/Derive/SmartAConstructors.hs b/src/Data/Comp/Derive/SmartAConstructors.hs
--- a/src/Data/Comp/Derive/SmartAConstructors.hs
+++ b/src/Data/Comp/Derive/SmartAConstructors.hs
@@ -30,13 +30,13 @@
   inserted. -}
 smartAConstructors :: Name -> Q [Dec]
 smartAConstructors fname = do
-    TyConI (DataD _cxt tname targs constrs _deriving) <- abstractNewtypeQ $ reify fname
+    TyConI (DataD _cxt _tname _targs constrs _deriving) <- abstractNewtypeQ $ reify fname
     let cons = map abstractConType constrs
-    liftM concat $ mapM (genSmartConstr (map tyVarBndrName targs) tname) cons
-        where genSmartConstr targs tname (name, args) = do
+    liftM concat $ mapM genSmartConstr cons
+        where genSmartConstr   (name, args) = do
                 let bname = nameBase name
-                genSmartConstr' targs tname (mkName $ "iA" ++ bname) name args
-              genSmartConstr' targs tname sname name args = do
+                genSmartConstr'  (mkName $ "iA" ++ bname) name args
+              genSmartConstr'  sname name args = do
                 varNs <- newNames args "x"
                 varPr <- newName "_p"
                 let pats = map varP (varPr : varNs)
diff --git a/src/Data/Comp/Derive/Traversable.hs b/src/Data/Comp/Derive/Traversable.hs
--- a/src/Data/Comp/Derive/Traversable.hs
+++ b/src/Data/Comp/Derive/Traversable.hs
@@ -63,14 +63,14 @@
                    return (conE constr, mkCPat constr varNs,
                            \f g -> filterVars args varNs (\ d x -> f d (varE x)) (g . varE),
                            any (not . null) args, map varE varNs, catMaybes $ filterVars args varNs (curry Just) (const Nothing))
-            traverseClause (con, pat,vars',hasFargs,_,_) =
+            traverseClause (con, pat,vars',hasFargs,_allVars,_fVars) =
                 do fn <- newName "f"
                    let f = varE fn
                        fp = if hasFargs then VarP fn else WildP
                        vars = vars' (\d x -> iter d [|traverse|] f `appE` x) (\x -> [|pure $x|])
                    body <- P.foldl (\ x y -> [|$x <*> $y|]) [|pure $con|] vars
                    return $ Clause [fp, pat] (NormalB body) []
-            sequenceAClause (con, pat,vars',hasFargs,_,_) =
+            sequenceAClause (con, pat,vars',_hasFargs,_,_) =
                 do let vars = vars' (\d x -> iter' d [|sequenceA|] x) (\x -> [|pure $x|])
                    body <- P.foldl (\ x y -> [|$x <*> $y|]) [|pure $con|] vars
                    return $ Clause [pat] (NormalB body) []
@@ -85,7 +85,7 @@
                        conBind (d,x) y = [| $(iter d [|mapM|] f) $(varE x)  >>= $(lamE [varP x] y)|]
                    body <- P.foldr conBind [|return $conAp|] fvars
                    return $ Clause [fp, pat] (NormalB body) []
-            sequenceClause (con, pat,_,hasFargs,allVars, fvars) =
+            sequenceClause (con, pat,_vars',_hasFargs,allVars, fvars) =
                 do let conAp = P.foldl appE con allVars
                        conBind (d, x) y = [| $(iter' d [|sequence|] (varE x))  >>= $(lamE [varP x] y)|]
                    body <- P.foldr conBind [|return $conAp|] fvars
diff --git a/src/Data/Comp/Desugar.hs b/src/Data/Comp/Desugar.hs
--- a/src/Data/Comp/Desugar.hs
+++ b/src/Data/Comp/Desugar.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances,
-  UndecidableInstances, OverlappingInstances, TypeOperators #-}
+  UndecidableInstances, OverlappingInstances, TypeOperators, ConstraintKinds #-}
 --------------------------------------------------------------------------------
 -- |
 -- Module      :  Data.Comp.Desugar
diff --git a/src/Data/Comp/Generic.hs b/src/Data/Comp/Generic.hs
--- a/src/Data/Comp/Generic.hs
+++ b/src/Data/Comp/Generic.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE GADTs, ScopedTypeVariables, TypeOperators #-}
+{-# LANGUAGE GADTs, ScopedTypeVariables, TypeOperators, ConstraintKinds, FlexibleContexts #-}
 
 --------------------------------------------------------------------------------
 -- |
diff --git a/src/Data/Comp/MultiParam.hs b/src/Data/Comp/MultiParam.hs
deleted file mode 100644
--- a/src/Data/Comp/MultiParam.hs
+++ /dev/null
@@ -1,34 +0,0 @@
---------------------------------------------------------------------------------
--- |
--- Module      :  Data.Comp.MultiParam
--- Copyright   :  (c) 2011 Patrick Bahr, Tom Hvitved
--- License     :  BSD3
--- Maintainer  :  Patrick Bahr <paba@diku.dk>, Tom Hvitved <hvitved@diku.dk>
--- Stability   :  experimental
--- Portability :  non-portable (GHC Extensions)
---
--- This module defines the infrastructure necessary to use
--- /Generalised Parametric Compositional Data Types/. Generalised Parametric
--- Compositional Data Types is an extension of Compositional Data Types with
--- parametric higher-order abstract syntax (PHOAS) for usage with binders, and
--- GADTs. Generalised Parametric Compositional Data Types combines Generalised
--- Compositional Data Types ("Data.Comp.Multi") and Parametric Compositional
--- Data Types ("Data.Comp.Param"). Examples of usage are bundled with the
--- package in the library @examples\/Examples\/MultiParam@.
---
---------------------------------------------------------------------------------
-module Data.Comp.MultiParam (
-    module Data.Comp.MultiParam.Term
-  , module Data.Comp.MultiParam.Algebra
-  , module Data.Comp.MultiParam.HDifunctor
-  , module Data.Comp.MultiParam.Sum
-  , module Data.Comp.MultiParam.Annotation
-  , module Data.Comp.MultiParam.Equality
-    ) where
-
-import Data.Comp.MultiParam.Term
-import Data.Comp.MultiParam.Algebra
-import Data.Comp.MultiParam.HDifunctor
-import Data.Comp.MultiParam.Sum
-import Data.Comp.MultiParam.Annotation
-import Data.Comp.MultiParam.Equality
diff --git a/src/Data/Comp/MultiParam/Algebra.hs b/src/Data/Comp/MultiParam/Algebra.hs
deleted file mode 100644
--- a/src/Data/Comp/MultiParam/Algebra.hs
+++ /dev/null
@@ -1,346 +0,0 @@
-{-# LANGUAGE GADTs, Rank2Types, ScopedTypeVariables, TypeOperators,
-  FlexibleContexts, CPP, KindSignatures #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Data.Comp.MultiParam.Algebra
--- Copyright   :  (c) 2011 Patrick Bahr, Tom Hvitved
--- License     :  BSD3
--- Maintainer  :  Tom Hvitved <hvitved@diku.dk>
--- Stability   :  experimental
--- Portability :  non-portable (GHC Extensions)
---
--- This module defines the notion of algebras and catamorphisms, and their
--- generalizations to e.g. monadic versions and other (co)recursion schemes.
---
---------------------------------------------------------------------------------
-
-module Data.Comp.MultiParam.Algebra (
-      -- * Algebras & Catamorphisms
-      Alg,
-      free,
-      cata,
-      cata',
-      appCxt,
-      
-      -- * Monadic Algebras & Catamorphisms
-      AlgM,
---      algM,
-      freeM,
-      cataM,
-      AlgM',
-      Compose(..),
-      freeM',
-      cataM',
-
-      -- * Term Homomorphisms
-      CxtFun,
-      SigFun,
-      Hom,
-      appHom,
-      appHom',
-      compHom,
-      appSigFun,
-      appSigFun',
-      compSigFun,
-      hom,
-      compAlg,
-
-      -- * Monadic Term Homomorphisms
-      CxtFunM,
-      SigFunM,
-      HomM,
-      sigFunM,
-      hom',
-      appHomM,
-      appTHomM,
-      appHomM',
-      appTHomM',
-      homM,
-      appSigFunM,
-      appTSigFunM,
-      appSigFunM',
-      appTSigFunM',
-      compHomM,
-      compSigFunM,
-      compAlgM,
-      compAlgM'
-    ) where
-
-import Prelude hiding (sequence, mapM)
-import Control.Monad hiding (sequence, mapM)
-import Data.Functor.Compose -- Functor composition
-import Data.Comp.MultiParam.Term
-import Data.Comp.MultiParam.HDifunctor
-import Data.Comp.MultiParam.HDitraversable
-
-{-| This type represents an algebra over a difunctor @f@ and carrier @a@. -}
-type Alg f a = f a a :-> a
-
-{-| Construct a catamorphism for contexts over @f@ with holes of type @b@, from
-  the given algebra. -}
-free :: forall h f a b. HDifunctor f
-        => Alg f a -> (b :-> a) -> Cxt h f a b :-> a
-free f g = run
-    where run :: Cxt h f a b :-> a
-          run (In t) = f (hfmap run t)
-          run (Hole x) = g x
-          run (Var p) = p
-
-{-| Construct a catamorphism from the given algebra. -}
-cata :: forall f a. HDifunctor f => Alg f a -> Term f :-> a 
-{-# NOINLINE [1] cata #-}
-cata f (Term t) = run t
-    where run :: Trm f a :-> a
-          run (In t) = f (hfmap run t)
-          run (Var x) = x
-
-{-| A generalisation of 'cata' from terms over @f@ to contexts over @f@, where
-  the holes have the type of the algebra carrier. -}
-cata' :: HDifunctor f => Alg f a -> Cxt h f a a :-> a
-{-# INLINE cata' #-}
-cata' f = free f id
-
-{-| This function applies a whole context into another context. -}
-appCxt :: HDifunctor f => Cxt Hole f a (Cxt h f a b) :-> Cxt h f a b
-appCxt (In t) = In (hfmap appCxt t)
-appCxt (Hole x) = x
-appCxt (Var p) = Var p
-
-{-| This type represents a monadic algebra. It is similar to 'Alg' but
-  the return type is monadic. -}
-type AlgM m f a = NatM m (f a a) a
-
-{-| Construct a monadic catamorphism for contexts over @f@ with holes of type
-  @b@, from the given monadic algebra. -}
-freeM :: forall m h f a b. (HDitraversable f, Monad m)
-         => AlgM m f a -> NatM m b a -> NatM m (Cxt h f a b) a
-freeM f g = run
-    where run :: NatM m (Cxt h f a b) a
-          run (In t) = f =<< hdimapM run t
-          run (Hole x) = g x
-          run (Var p) = return p
-
-{-| Construct a monadic catamorphism from the given monadic algebra. -}
-cataM :: forall m f a. (HDitraversable f, Monad m)
-         => AlgM m f a -> NatM m (Term f) a
-{-# NOINLINE [1] cataM #-}
-cataM algm (Term t) = run t
-    where run :: NatM m (Trm f a) a
-          run (In t) = algm =<< hdimapM run t
-          run (Var x) = return x
-
-{-| This type represents a monadic algebra, but where the covariant argument is
-  also a monadic computation. -}
-type AlgM' m f a = NatM m (f a (Compose m a)) a
-
-{-| Construct a monadic catamorphism for contexts over @f@ with holes of type
-  @b@, from the given monadic algebra. -}
-freeM' :: forall m h f a b. (HDifunctor f, Monad m)
-          => AlgM' m f a -> NatM m b a -> NatM m (Cxt h f a b) a
-freeM' f g = run
-    where run :: NatM m (Cxt h f a b) a
-          run (In t) = f $ hfmap (Compose . run) t
-          run (Hole x) = g x
-          run (Var p) = return p
-
-{-| Construct a monadic catamorphism from the given monadic algebra. -}
-cataM' :: forall m f a. (HDifunctor f, Monad m)
-          => AlgM' m f a -> NatM m (Term f) a
-{-# NOINLINE [1] cataM' #-}
-cataM' algm (Term t) = run t
-    where run :: NatM m (Trm f a) a
-          run (In t) = algm $ hfmap (Compose . run) t
-          run (Var x) = return x
-
-{-| This type represents a signature function. -}
-type SigFun f g = forall (a :: * -> *) (b :: * -> *) . f a b :-> g a b
-
-{-| This type represents a context function. -}
-type CxtFun f g = forall h. SigFun (Cxt h f) (Cxt h g)
-
-{-| This type represents a term homomorphism. -}
-type Hom f g = SigFun f (Context g)
-
-{-| Apply a term homomorphism recursively to a term/context. -}
-appHom :: forall f g. (HDifunctor f, HDifunctor g) => Hom f g -> CxtFun f g
-{-# INLINE [1] appHom #-}
-appHom f = run where
-    run :: CxtFun f g
-    run (In t) = appCxt (f (hfmap run t))
-    run (Hole x) = Hole x
-    run (Var p) = Var p
-
--- | Apply a term homomorphism recursively to a term/context. This is
--- a top-down variant of 'appHom'.
-appHom' :: forall f g. (HDifunctor g)
-              => Hom f g -> CxtFun f g
-{-# INLINE [1] appHom' #-}
-appHom' f = run where
-    run :: CxtFun f g
-    run (In t) = appCxt (hfmapCxt run (f t))
-    run (Hole x) = Hole x
-    run (Var p) = Var p
-
-{-| Compose two term homomorphisms. -}
-compHom :: (HDifunctor g, HDifunctor h)
-               => Hom g h -> Hom f g -> Hom f h
-compHom f g = appHom f . g
-
-{-| Compose an algebra with a term homomorphism to get a new algebra. -}
-compAlg :: (HDifunctor f, HDifunctor g) => Alg g a -> Hom f g -> Alg f a
-compAlg alg talg = cata' alg . talg
-
-{-| This function applies a signature function to the given context. -}
-appSigFun :: forall f g. (HDifunctor f) => SigFun f g -> CxtFun f g
-appSigFun f = run where
-    run :: CxtFun f g
-    run (In t) = In (f (hfmap run t))
-    run (Hole x) = Hole x
-    run (Var p) = Var p
-
-{-| This function applies a signature function to the given context. -}
-appSigFun' :: forall f g. (HDifunctor g) => SigFun f g -> CxtFun f g
-appSigFun' f = run where
-    run :: CxtFun f g
-    run (In t) = In (hfmap run (f t))
-    run (Hole x) = Hole x
-    run (Var p) = Var p
-
-{-| This function composes two signature functions. -}
-compSigFun :: SigFun g h -> SigFun f g -> SigFun f h
-compSigFun f g = f . g
-
-{-| Lifts the given signature function to the canonical term homomorphism. -}
-hom :: HDifunctor g => SigFun f g -> Hom f g
-hom f = simpCxt . f
-
-{-| This type represents a monadic signature function. -}
-type SigFunM m f g = forall (a :: * -> *) (b :: * -> *) . NatM m (f a b) (g a b)
-
-{-| This type represents a monadic context function. -}
-type CxtFunM m f g = forall h . SigFunM m (Cxt h f) (Cxt h g)
-
-{-| This type represents a monadic term homomorphism. -}
-type HomM m f g = SigFunM m f (Cxt Hole g)
-
-
-{-| Lift the given signature function to a monadic signature function. Note that
-  term homomorphisms are instances of signature functions. Hence this function
-  also applies to term homomorphisms. -}
-sigFunM :: Monad m => SigFun f g -> SigFunM m f g
-sigFunM f = return . f
-
-{-| Lift the give monadic signature function to a monadic term homomorphism. -}
-hom' :: (HDifunctor f, HDifunctor g, Monad m)
-            => SigFunM m f g -> HomM m f g
-hom' f = liftM  (In . hfmap Hole) . f
-
-{-| Lift the given signature function to a monadic term homomorphism. -}
-homM :: (HDifunctor g, Monad m) => SigFun f g -> HomM m f g
-homM f = sigFunM $ hom f
-
-{-| Apply a monadic term homomorphism recursively to a term/context. -}
-appHomM :: forall f g m. (HDitraversable f, Monad m, HDifunctor g)
-               => HomM m f g -> CxtFunM m f g
-{-# NOINLINE [1] appHomM #-}
-appHomM f = run
-    where run :: CxtFunM m f g
-          run (In t) = liftM appCxt (f =<< hdimapM run t)
-          run (Hole x) = return (Hole x)
-          run (Var p) = return (Var p)
-
-{-| A restricted form of |appHomM| which only works for terms. -}
-appTHomM :: (HDitraversable f, Monad m, ParamFunctor m, HDifunctor g)
-            => HomM m f g -> Term f i -> m (Term g i)
-appTHomM f (Term t) = termM (appHomM f t)
-
--- | Apply a monadic term homomorphism recursively to a
--- term/context. This is a top-down variant of 'appHomM'.
-appHomM' :: forall f g m. (HDitraversable g, Monad m)
-            => HomM m f g -> CxtFunM m f g
-{-# NOINLINE [1] appHomM' #-}
-appHomM' f = run
-    where run :: CxtFunM m f g
-          run (In t) = liftM appCxt (hdimapMCxt run =<<  f t)
-          run (Hole x) = return (Hole x)
-          run (Var p) = return (Var p)
-
-{-| A restricted form of |appHomM'| which only works for terms. -}
-appTHomM' :: (HDitraversable g, Monad m, ParamFunctor m, HDifunctor g)
-             => HomM m f g -> Term f i -> m (Term g i)
-appTHomM' f (Term t) = termM (appHomM' f t)
-
-{-| This function applies a monadic signature function to the given context. -}
-appSigFunM :: forall m f g. (HDitraversable f, Monad m)
-              => SigFunM m f g -> CxtFunM m f g
-appSigFunM f = run
-    where run :: CxtFunM m f g
-          run (In t)   = liftM In (f =<< hdimapM run t)
-          run (Hole x) = return (Hole x)
-          run (Var p)  = return (Var p)
-
-{-| A restricted form of |appSigFunM| which only works for terms. -}
-appTSigFunM :: (HDitraversable f, Monad m, ParamFunctor m, HDifunctor g)
-               => SigFunM m f g -> Term f i -> m (Term g i)
-appTSigFunM f (Term t) = termM (appSigFunM f t)
-
--- | This function applies a monadic signature function to the given
--- context. This is a top-down variant of 'appSigFunM'.
-appSigFunM' :: forall m f g. (HDitraversable g, Monad m)
-               => SigFunM m f g -> CxtFunM m f g
-appSigFunM' f = run
-    where run :: CxtFunM m f g
-          run (In t)   = liftM In (hdimapM run =<< f t)
-          run (Hole x) = return (Hole x)
-          run (Var p)  = return (Var p)
-
-{-| A restricted form of |appSigFunM'| which only works for terms. -}
-appTSigFunM' :: (HDitraversable g, Monad m, ParamFunctor m, HDifunctor g)
-                => SigFunM m f g -> Term f i -> m (Term g i)
-appTSigFunM' f (Term t) = termM (appSigFunM' f t)
-
-{-| Compose two monadic term homomorphisms. -}
-compHomM :: (HDitraversable g, HDifunctor h, Monad m)
-                => HomM m g h -> HomM m f g -> HomM m f h
-compHomM f g = appHomM f <=< g
-
-{-| Compose a monadic algebra with a monadic term homomorphism to get a new
-  monadic algebra. -}
-compAlgM :: (HDitraversable g, Monad m) => AlgM m g a -> HomM m f g -> AlgM m f a
-compAlgM alg talg = freeM alg return <=< talg
-
-{-| Compose a monadic algebra with a term homomorphism to get a new monadic
-  algebra. -}
-compAlgM' :: (HDitraversable g, Monad m) => AlgM m g a -> Hom f g -> AlgM m f a
-compAlgM' alg talg = freeM alg return . talg
-
-{-| This function composes two monadic signature functions. -}
-compSigFunM :: Monad m => SigFunM m g h -> SigFunM m f g -> SigFunM m f h
-compSigFunM f g a = g a >>= f
-
-{-
-#ifndef NO_RULES
-{-# RULES
-  "cata/appHom" forall (a :: Alg g d) (h :: Hom f g) x.
-    cata a (appHom h x) = cata (compAlg a h) x;
-
-  "appHom/appHom" forall (a :: Hom g h) (h :: Hom f g) x.
-    appHom a (appHom h x) = appHom (compHom a h) x; #-}
-
-{-
-{-# RULES 
-  "cataM/appHomM" forall (a :: AlgM m g d) (h :: HomM m f g d) x.
-     appHomM h x >>= cataM a = cataM (compAlgM a h) x;
-
-  "cataM/appHom" forall (a :: AlgM m g d) (h :: Hom f g) x.
-     cataM a (appHom h x) = cataM (compAlgM' a h) x;
-
-  "appHomM/appHomM" forall (a :: HomM m g h b) (h :: HomM m f g b) x.
-    appHomM h x >>= appHomM a = appHomM (compHomM a h) x; #-}
-
-{-# RULES
-  "cata/build"  forall alg (g :: forall a . Alg f a -> a) .
-                cata alg (build g) = g alg #-}
--}
-#endif
--}
diff --git a/src/Data/Comp/MultiParam/Annotation.hs b/src/Data/Comp/MultiParam/Annotation.hs
deleted file mode 100644
--- a/src/Data/Comp/MultiParam/Annotation.hs
+++ /dev/null
@@ -1,81 +0,0 @@
-{-# LANGUAGE TypeOperators, MultiParamTypeClasses, FlexibleInstances,
-  UndecidableInstances, Rank2Types, GADTs, ScopedTypeVariables #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Data.Comp.MultiParam.Annotation
--- Copyright   :  (c) 2010-2011 Patrick Bahr, Tom Hvitved
--- License     :  BSD3
--- Maintainer  :  Tom Hvitved <hvitved@diku.dk>
--- Stability   :  experimental
--- Portability :  non-portable (GHC Extensions)
---
--- This module defines annotations on signatures.
---
---------------------------------------------------------------------------------
-
-module Data.Comp.MultiParam.Annotation
-    (
-     (:&:) (..),
-     (:*:) (..),
-     DistAnn (..),
-     RemA (..),
-     liftA,
-     liftA',
-     stripA,
-     propAnn,
-     propAnnM,
-     ann,
-     project'
-    ) where
-
-import qualified Data.Comp.Ops as O
-import Data.Comp.MultiParam.HDifunctor
-import Data.Comp.MultiParam.Term
-import Data.Comp.MultiParam.Sum
-import Data.Comp.MultiParam.Ops
-import Data.Comp.MultiParam.Algebra
-
-import Control.Monad
-
-{-| Transform a function with a domain constructed from a higher-order difunctor
-  to a function with a domain constructed with the same higher-order difunctor,
-  but with an additional annotation. -}
-liftA :: (RemA s s') => (s' a b :-> t) -> s a b :-> t
-liftA f v = f (remA v)
-
-{-| Transform a function with a domain constructed from a higher-order difunctor
-  to a function with a domain constructed with the same higher-order difunctor,
-  but with an additional annotation. -}
-liftA' :: (DistAnn s' p s, HDifunctor s')
-          => (s' a b :-> Cxt h s' c d) -> s a b :-> Cxt h s c d
-liftA' f v = let v' O.:&: p = projectA v
-             in ann p (f v')
-
-{-| Strip the annotations from a term over a higher-order difunctor with
-  annotations. -}
-stripA :: (RemA g f, HDifunctor g) => CxtFun g f
-stripA = appSigFun remA
-
-{-| Lift a term homomorphism over signatures @f@ and @g@ to a term homomorphism
- over the same signatures, but extended with annotations. -}
-propAnn :: (DistAnn f p f', DistAnn g p g', HDifunctor g) 
-           => Hom f g -> Hom f' g'
-propAnn hom f' = ann p (hom f)
-    where f O.:&: p = projectA f'
-
-{-| Lift a monadic term homomorphism over signatures @f@ and @g@ to a monadic
-  term homomorphism over the same signatures, but extended with annotations. -}
-propAnnM :: (DistAnn f p f', DistAnn g p g', HDifunctor g, Monad m)
-         => HomM m f g -> HomM m f' g'
-propAnnM hom f' = liftM (ann p) (hom f)
-    where f O.:&: p = projectA f'
-
-{-| Annotate each node of a term with a constant value. -}
-ann :: (DistAnn f p g, HDifunctor f) => p -> CxtFun f g
-ann c = appSigFun (injectA c)
-
-{-| This function is similar to 'project' but applies to signatures
-  with an annotation which is then ignored. -}
-project' :: (RemA f f', s :<: f') => Cxt h f a b i -> Maybe (s a (Cxt h f a b) i)
-project' (In x) = proj $ remA x
-project' _ = Nothing
diff --git a/src/Data/Comp/MultiParam/Derive.hs b/src/Data/Comp/MultiParam/Derive.hs
deleted file mode 100644
--- a/src/Data/Comp/MultiParam/Derive.hs
+++ /dev/null
@@ -1,55 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Data.Comp.MultiParam.Derive
--- Copyright   :  (c) 2011 Patrick Bahr, Tom Hvitved
--- License     :  BSD3
--- Maintainer  :  Tom Hvitved <hvitved@diku.dk>
--- Stability   :  experimental
--- Portability :  non-portable (GHC Extensions)
---
--- This module contains functionality for automatically deriving boilerplate
--- code using Template Haskell. Examples include instances of 'HDifunctor',
--- 'ShowHD', and 'EqHD'.
---
---------------------------------------------------------------------------------
-
-module Data.Comp.MultiParam.Derive
-    (
-     derive,
-     -- |Derive boilerplate instances for parametric signatures, i.e.
-     -- signatures for parametric compositional data types.
-
-     -- ** EqHD
-     module Data.Comp.MultiParam.Derive.Equality,
-     -- ** OrdHD
-     module Data.Comp.MultiParam.Derive.Ordering,
-     -- ** ShowHD
-     module Data.Comp.MultiParam.Derive.Show,
-     -- ** HDifunctor
-     module Data.Comp.MultiParam.Derive.HDifunctor,
-     -- ** Smart Constructors
-     module Data.Comp.MultiParam.Derive.SmartConstructors,
-     -- ** Smart Constructors w/ Annotations
-     module Data.Comp.MultiParam.Derive.SmartAConstructors,
-     -- ** Lifting to Sums
-     liftSum
-    ) where
-
-import Data.Comp.Derive.Utils (derive, liftSumGen)
-import Data.Comp.MultiParam.Derive.Equality
-import Data.Comp.MultiParam.Derive.Ordering
-import Data.Comp.MultiParam.Derive.Show
-import Data.Comp.MultiParam.Derive.HDifunctor
-import Data.Comp.MultiParam.Derive.SmartConstructors
-import Data.Comp.MultiParam.Derive.SmartAConstructors
-import Data.Comp.MultiParam.Ops ((:+:), caseHD)
-
-import Language.Haskell.TH
-
-{-| Given the name of a type class, where the first parameter is a higher-order
-  difunctor, lift it to sums of higher-order difunctors. Example:
-  @class ShowHD f where ...@ is lifted as
-  @instance (ShowHD f, ShowHD g) => ShowHD (f :+: g) where ... @. -}
-liftSum :: Name -> Q [Dec]
-liftSum = liftSumGen 'caseHD ''(:+:)
diff --git a/src/Data/Comp/MultiParam/Derive/Equality.hs b/src/Data/Comp/MultiParam/Derive/Equality.hs
deleted file mode 100644
--- a/src/Data/Comp/MultiParam/Derive/Equality.hs
+++ /dev/null
@@ -1,78 +0,0 @@
-{-# LANGUAGE TemplateHaskell, FlexibleInstances, IncoherentInstances,
-  ScopedTypeVariables #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Data.Comp.MultiParam.Derive.Equality
--- Copyright   :  (c) 2011 Patrick Bahr, Tom Hvitved
--- License     :  BSD3
--- Maintainer  :  Tom Hvitved <hvitved@diku.dk>
--- Stability   :  experimental
--- Portability :  non-portable (GHC Extensions)
---
--- Automatically derive instances of @EqHD@.
---
---------------------------------------------------------------------------------
-module Data.Comp.MultiParam.Derive.Equality
-    (
-     EqHD(..),
-     makeEqHD
-    ) where
-
-import Data.Comp.Derive.Utils
-import Data.Comp.MultiParam.FreshM hiding (Name)
-import Data.Comp.MultiParam.Equality
-import Control.Monad
-import Language.Haskell.TH hiding (Cxt, match)
-
-{-| Derive an instance of 'EqHD' for a type constructor of any parametric
-  kind taking at least three arguments. -}
-makeEqHD :: Name -> Q [Dec]
-makeEqHD fname = do
-  TyConI (DataD _ name args constrs _) <- abstractNewtypeQ $ reify fname
-  let args' = init args
-  -- covariant argument
-  let coArg :: Name = tyVarBndrName $ last args'
-  -- contravariant argument
-  let conArg :: Name = tyVarBndrName $ last $ init args'
-  let argNames = map (VarT . tyVarBndrName) (init $ init args')
-  let complType = foldl AppT (ConT name) argNames
-  let classType = AppT (ConT ''EqHD) complType
-  constrs' :: [(Name,[Type])] <- mapM normalConExp constrs
-  let defC = if length constrs < 2 then
-                 []
-             else
-                 [clause [wildP,wildP] (normalB [|return False|]) []]
-  eqHDDecl <- funD 'eqHD (map (eqHDClause conArg coArg) constrs' ++ defC)
-  let context = map (\arg -> ClassP ''Eq [arg]) argNames
-  return [InstanceD context classType [eqHDDecl]]
-      where eqHDClause :: Name -> Name -> (Name,[Type]) -> ClauseQ
-            eqHDClause conArg coArg (constr, args) = do
-              varXs <- newNames (length args) "x"
-              varYs <- newNames (length args) "y"
-              -- Patterns for the constructors
-              let patx = ConP constr $ map VarP varXs
-              let paty = ConP constr $ map VarP varYs
-              body <- eqHDBody conArg coArg (zip3 varXs varYs args)
-              return $ Clause [patx,paty] (NormalB body) []
-            eqHDBody :: Name -> Name -> [(Name, Name, Type)] -> ExpQ
-            eqHDBody conArg coArg x =
-                [|liftM and (sequence $(listE $ map (eqHDB conArg coArg) x))|]
-            eqHDB :: Name -> Name -> (Name, Name, Type) -> ExpQ
-            eqHDB conArg coArg (x, y, tp)
-                | not (containsType tp (VarT conArg)) &&
-                  not (containsType tp (VarT coArg)) =
-                    [| return $ $(varE x) == $(varE y) |]
-                | otherwise =
-                    case tp of
-                      AppT (VarT a) _ 
-                          | a == coArg -> [| peq $(varE x) $(varE y) |]
-                      AppT (AppT ArrowT (AppT (VarT a) _)) _
-                          | a == conArg ->
-                              [| withName (\v -> peq ($(varE x) $ nameCoerce v)                                                      ($(varE y) $ nameCoerce v)) |]
-                      SigT tp' _ ->
-                          eqHDB conArg coArg (x, y, tp')
-                      _ ->
-                          if containsType tp (VarT conArg) then
-                              [| eqHD $(varE x) $(varE y) |]
-                          else
-                              [| peq $(varE x) $(varE y) |]
diff --git a/src/Data/Comp/MultiParam/Derive/HDifunctor.hs b/src/Data/Comp/MultiParam/Derive/HDifunctor.hs
deleted file mode 100644
--- a/src/Data/Comp/MultiParam/Derive/HDifunctor.hs
+++ /dev/null
@@ -1,85 +0,0 @@
-{-# LANGUAGE TemplateHaskell, ScopedTypeVariables #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Data.Comp.MultiParam.Derive.HDifunctor
--- Copyright   :  (c) 2011 Patrick Bahr, Tom Hvitved
--- License     :  BSD3
--- Maintainer  :  Tom Hvitved <hvitved@diku.dk>
--- Stability   :  experimental
--- Portability :  non-portable (GHC Extensions)
---
--- Automatically derive instances of @HDifunctor@.
---
---------------------------------------------------------------------------------
-
-module Data.Comp.MultiParam.Derive.HDifunctor
-    (
-     HDifunctor,
-     makeHDifunctor
-    ) where
-
-import Data.Comp.Derive.Utils
-import Data.Comp.MultiParam.HDifunctor
-import Language.Haskell.TH
-
-{-| Derive an instance of 'HDifunctor' for a type constructor of any parametric
-  kind taking at least three arguments. -}
-makeHDifunctor :: Name -> Q [Dec]
-makeHDifunctor fname = do
-  TyConI (DataD _ name args constrs _) <- abstractNewtypeQ $ reify fname
-  let args' = init args
-  -- covariant argument
-  let coArg :: Name = tyVarBndrName $ last args'
-  -- contravariant argument
-  let conArg :: Name = tyVarBndrName $ last $ init args'
-  let argNames = map (VarT . tyVarBndrName) (init $ init args')
-  let complType = foldl AppT (ConT name) argNames
-  let classType = AppT (ConT ''HDifunctor) complType
-  constrs' :: [(Name,[Type])] <- mapM normalConExp constrs
-  hdimapDecl <- funD 'hdimap (map (hdimapClause conArg coArg) constrs')
-  return [InstanceD [] classType [hdimapDecl]]
-      where hdimapClause :: Name -> Name -> (Name,[Type]) -> ClauseQ
-            hdimapClause conArg coArg (constr, args) = do
-              fn <- newName "_f"
-              gn <- newName "_g"
-              varNs <- newNames (length args) "x"
-              let f = varE fn
-              let g = varE gn
-              let fp = VarP fn
-              let gp = VarP gn
-              -- Pattern for the constructor
-              let pat = ConP constr $ map VarP varNs
-              body <- hdimapArgs conArg coArg f g (zip varNs args) (conE constr)
-              return $ Clause [fp, gp, pat] (NormalB body) []
-            hdimapArgs :: Name -> Name -> ExpQ -> ExpQ
-                      -> [(Name, Type)] -> ExpQ -> ExpQ
-            hdimapArgs _ _ _ _ [] acc =
-                acc
-            hdimapArgs conArg coArg f g ((x,tp):tps) acc =
-                hdimapArgs conArg coArg f g tps
-                          (acc `appE` (hdimapArg conArg coArg tp f g `appE` varE x))
-            hdimapArg :: Name -> Name -> Type -> ExpQ -> ExpQ -> ExpQ
-            hdimapArg conArg coArg tp f g
-                | not (containsType tp (VarT conArg)) &&
-                  not (containsType tp (VarT coArg)) = [| id |]
-                | otherwise =
-                    case tp of
-                      AppT (VarT a) _ | a == conArg -> f
-                                      | a == coArg -> g
-                      AppT (AppT ArrowT tp1) tp2 -> do
-                          xn <- newName "x"
-                          let ftp1 = hdimapArg conArg coArg tp1 f g
-                          let ftp2 = hdimapArg conArg coArg tp2 f g
-                          lamE [varP xn]
-                               (infixE (Just ftp2)
-                                       [|(.)|]
-                                       (Just $ infixE (Just $ varE xn)
-                                                      [|(.)|]
-                                                      (Just ftp1)))
-                      SigT tp' _ ->
-                          hdimapArg conArg coArg tp' f g
-                      _ ->
-                          if containsType tp (VarT conArg) then
-                              [| hdimap $f $g |]
-                          else
-                              [| fmap $g |]
diff --git a/src/Data/Comp/MultiParam/Derive/Injections.hs b/src/Data/Comp/MultiParam/Derive/Injections.hs
deleted file mode 100644
--- a/src/Data/Comp/MultiParam/Derive/Injections.hs
+++ /dev/null
@@ -1,91 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Data.Comp.MultiParam.Derive.Injections
--- Copyright   :  (c) 2011 Patrick Bahr, Tom Hvitved
--- License     :  BSD3
--- Maintainer  :  Tom Hvitved <hvitved@diku.dk>
--- Stability   :  experimental
--- Portability :  non-portable (GHC Extensions)
---
--- Derive functions for signature injections.
---
---------------------------------------------------------------------------------
-
-module Data.Comp.MultiParam.Derive.Injections
-    (
-     injn,
-     injectn,
-     deepInjectn
-    ) where
-
-import Language.Haskell.TH hiding (Cxt)
-import Data.Comp.MultiParam.HDifunctor
-import Data.Comp.MultiParam.Term
-import Data.Comp.MultiParam.Algebra (CxtFun, appSigFun)
-import Data.Comp.MultiParam.Ops ((:+:)(..), (:<:)(..))
-
-injn :: Int -> Q [Dec]
-injn n = do
-  let i = mkName $ "inj" ++ show n
-  let fvars = map (\n -> mkName $ 'f' : show n) [1..n]
-  let gvar = mkName "g"
-  let avar = mkName "a"
-  let bvar = mkName "b"
-  let ivar = mkName "i"
-  let xvar = mkName "x"
-  let d = [funD i [clause [varP xvar] (normalB $ genDecl xvar n) []]]
-  sequence $ sigD i (genSig fvars gvar avar bvar ivar) : d
-    where genSig fvars gvar avar bvar ivar = do
-            let cxt = map (\f -> classP ''(:<:) [varT f, varT gvar]) fvars
-            let tp = foldl1 (\a f -> conT ''(:+:) `appT` f `appT` a)
-                            (map varT fvars)
-            let tp' = arrowT `appT` (tp `appT` varT avar `appT`
-                                     varT bvar `appT` varT ivar)
-                             `appT` (varT gvar `appT` varT avar `appT`
-                                     varT bvar `appT` varT ivar)
-            forallT (map PlainTV $ gvar : avar : bvar : ivar : fvars)
-                    (sequence cxt) tp'
-          genDecl x n = [| case $(varE x) of
-                             Inl x -> $(varE $ mkName "inj") x
-                             Inr x -> $(varE $ mkName $ "inj" ++
-                                        if n > 2 then show (n - 1) else "") x |]
-injectn :: Int -> Q [Dec]
-injectn n = do
-  let i = mkName ("inject" ++ show n)
-  let fvars = map (\n -> mkName $ 'f' : show n) [1..n]
-  let gvar = mkName "g"
-  let avar = mkName "a"
-  let bvar = mkName "b"
-  let ivar = mkName "i"
-  let d = [funD i [clause [] (normalB $ genDecl n) []]]
-  sequence $ sigD i (genSig fvars gvar avar bvar ivar) : d
-    where genSig fvars gvar avar bvar ivar = do
-            let hvar = mkName "h"
-            let cxt = map (\f -> classP ''(:<:) [varT f, varT gvar]) fvars
-            let tp = foldl1 (\a f -> conT ''(:+:) `appT` f `appT` a)
-                            (map varT fvars)
-            let tp' = conT ''Cxt `appT` varT hvar `appT` varT gvar
-                                 `appT` varT avar `appT` varT bvar
-            let tp'' = arrowT `appT` (tp `appT` varT avar `appT`
-                                      tp' `appT` varT ivar)
-                              `appT` (tp' `appT` varT ivar)
-            forallT (map PlainTV $ hvar : gvar : avar : bvar : ivar : fvars)
-                    (sequence cxt) tp''
-          genDecl n = [| In . $(varE $ mkName $ "inj" ++ show n) |]
-
-deepInjectn :: Int -> Q [Dec]
-deepInjectn n = do
-  let i = mkName ("deepInject" ++ show n)
-  let fvars = map (\n -> mkName $ 'f' : show n) [1..n]
-  let gvar = mkName "g"
-  let d = [funD i [clause [] (normalB $ genDecl n) []]]
-  sequence $ sigD i (genSig fvars gvar) : d
-    where genSig fvars gvar = do
-            let cxt = map (\f -> classP ''(:<:) [varT f, varT gvar]) fvars
-            let tp = foldl1 (\a f -> conT ''(:+:) `appT` f `appT` a)
-                            (map varT fvars)
-            let cxt' = classP ''HDifunctor [tp]
-            let tp' = conT ''CxtFun `appT` tp `appT` varT gvar
-            forallT (map PlainTV $ gvar : fvars) (sequence $ cxt' : cxt) tp'
-          genDecl n = [| appSigFun $(varE $ mkName $ "inj" ++ show n) |]
diff --git a/src/Data/Comp/MultiParam/Derive/Ordering.hs b/src/Data/Comp/MultiParam/Derive/Ordering.hs
deleted file mode 100644
--- a/src/Data/Comp/MultiParam/Derive/Ordering.hs
+++ /dev/null
@@ -1,93 +0,0 @@
-{-# LANGUAGE TemplateHaskell, FlexibleInstances, IncoherentInstances,
-  ScopedTypeVariables #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Data.Comp.MultiParam.Derive.Ordering
--- Copyright   :  (c) 2011 Patrick Bahr, Tom Hvitved
--- License     :  BSD3
--- Maintainer  :  Tom Hvitved <hvitved@diku.dk>
--- Stability   :  experimental
--- Portability :  non-portable (GHC Extensions)
---
--- Automatically derive instances of @OrdHD@.
---
---------------------------------------------------------------------------------
-module Data.Comp.MultiParam.Derive.Ordering
-    (
-     OrdHD(..),
-     makeOrdHD
-    ) where
-
-import Data.Comp.MultiParam.FreshM hiding (Name)
-import Data.Comp.MultiParam.Ordering
-import Data.Comp.Derive.Utils
-import Data.Maybe
-import Data.List
-import Language.Haskell.TH hiding (Cxt)
-import Control.Monad (liftM)
-
-compList :: [Ordering] -> Ordering
-compList = fromMaybe EQ . find (/= EQ)
-
-{-| Derive an instance of 'OrdHD' for a type constructor of any parametric
-  kind taking at least three arguments. -}
-makeOrdHD :: Name -> Q [Dec]
-makeOrdHD fname = do
-  TyConI (DataD _ name args constrs _) <- abstractNewtypeQ $ reify fname
-  let args' = init args
-  -- covariant argument
-  let coArg :: Name = tyVarBndrName $ last args'
-  -- contravariant argument
-  let conArg :: Name = tyVarBndrName $ last $ init args'
-  let argNames = map (VarT . tyVarBndrName) (init $ init args')
-  let complType = foldl AppT (ConT name) argNames
-  let classType = AppT (ConT ''OrdHD) complType
-  constrs' :: [(Name,[Type])] <- mapM normalConExp constrs
-  compareHDDecl <- funD 'compareHD (compareHDClauses conArg coArg constrs')
-  let context = map (\arg -> ClassP ''Ord [arg]) argNames
-  return [InstanceD context classType [compareHDDecl]]
-      where compareHDClauses :: Name -> Name -> [(Name,[Type])] -> [ClauseQ]
-            compareHDClauses _ _ [] = []
-            compareHDClauses conArg coArg constrs = 
-                let constrs' = constrs `zip` [1..]
-                    constPairs = [(x,y)| x<-constrs', y <- constrs']
-                in map (genClause conArg coArg) constPairs
-            genClause conArg coArg ((c,n),(d,m))
-                | n == m = genEqClause conArg coArg c
-                | n < m = genLtClause c d
-                | otherwise = genGtClause c d
-            genEqClause :: Name -> Name -> (Name,[Type]) -> ClauseQ
-            genEqClause conArg coArg (constr, args) = do 
-              varXs <- newNames (length args) "x"
-              varYs <- newNames (length args) "y"
-              let patX = ConP constr $ map VarP varXs
-              let patY = ConP constr $ map VarP varYs
-              body <- eqDBody conArg coArg (zip3 varXs varYs args)
-              return $ Clause [patX, patY] (NormalB body) []
-            eqDBody :: Name -> Name -> [(Name, Name, Type)] -> ExpQ
-            eqDBody conArg coArg x =
-                [|liftM compList (sequence $(listE $ map (eqDB conArg coArg) x))|]
-            eqDB :: Name -> Name -> (Name, Name, Type) -> ExpQ
-            eqDB conArg coArg (x, y, tp)
-                | not (containsType tp (VarT conArg)) &&
-                  not (containsType tp (VarT coArg)) =
-                    [| return $ compare $(varE x) $(varE y) |]
-                | otherwise =
-                    case tp of
-                      AppT (VarT a) _ 
-                          | a == coArg -> [| pcompare $(varE x) $(varE y) |]
-                      AppT (AppT ArrowT (AppT (VarT a) _)) _
-                          | a == conArg ->
-                              [| withName (\v -> pcompare ($(varE x) $ nameCoerce v)
-                                                          ($(varE y) $ nameCoerce v)) |]
-                      SigT tp' _ ->
-                          eqDB conArg coArg (x, y, tp')
-                      _ ->
-                          if containsType tp (VarT conArg) then
-                              [| compareHD $(varE x) $(varE y) |]
-                          else
-                              [| pcompare $(varE x) $(varE y) |]
-            genLtClause (c, _) (d, _) =
-                clause [recP c [], recP d []] (normalB [| return LT |]) []
-            genGtClause (c, _) (d, _) =
-                clause [recP c [], recP d []] (normalB [| return GT |]) []
diff --git a/src/Data/Comp/MultiParam/Derive/Projections.hs b/src/Data/Comp/MultiParam/Derive/Projections.hs
deleted file mode 100644
--- a/src/Data/Comp/MultiParam/Derive/Projections.hs
+++ /dev/null
@@ -1,108 +0,0 @@
-{-# LANGUAGE TemplateHaskell, GADTs #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Data.Comp.MultiParam.Derive.Projections
--- Copyright   :  (c) 2011 Patrick Bahr, Tom Hvitved
--- License     :  BSD3
--- Maintainer  :  Tom Hvitved <hvitved@diku.dk>
--- Stability   :  experimental
--- Portability :  non-portable (GHC Extensions)
---
--- Derive functions for signature projections.
---
---------------------------------------------------------------------------------
-
-module Data.Comp.MultiParam.Derive.Projections
-    (
-     projn,
-     projectn,
-     deepProjectn
-    ) where
-
-import Language.Haskell.TH hiding (Cxt)
-import Control.Monad (liftM)
-import Data.Comp.MultiParam.HDitraversable (HDitraversable)
-import Data.Comp.MultiParam.Term
-import Data.Comp.MultiParam.Algebra (appTSigFunM')
-import Data.Comp.MultiParam.Ops ((:+:)(..), (:<:)(..))
-
-projn :: Int -> Q [Dec]
-projn n = do
-  let p = mkName $ "proj" ++ show n
-  let gvars = map (\n -> mkName $ 'g' : show n) [1..n]
-  let avar = mkName "a"
-  let bvar = mkName "b"
-  let ivar = mkName "i"
-  let xvar = mkName "x"
-  let d = [funD p [clause [varP xvar] (normalB $ genDecl xvar gvars avar bvar ivar) []]]
-  sequence $ (sigD p $ genSig gvars avar bvar ivar) : d
-    where genSig gvars avar bvar ivar = do
-            let fvar = mkName "f"
-            let cxt = map (\g -> classP ''(:<:) [varT g, varT fvar]) gvars
-            let tp = foldl1 (\a g -> conT ''(:+:) `appT` g `appT` a)
-                            (map varT gvars)
-            let tp' = arrowT `appT` (varT fvar `appT` varT avar `appT`
-                                     varT bvar `appT` varT ivar)
-                             `appT` (conT ''Maybe `appT`
-                                     (tp `appT` varT avar `appT`
-                                      varT bvar `appT` varT ivar))
-            forallT (map PlainTV $ fvar : avar : bvar : ivar : gvars)
-                    (sequence cxt) tp'
-          genDecl x [g] a b i =
-            [| liftM inj (proj $(varE x)
-                          :: Maybe ($(varT g `appT` varT a `appT`
-                                      varT b `appT` varT i))) |]
-          genDecl x (g:gs) a b i =
-            [| case (proj $(varE x)
-                         :: Maybe ($(varT g `appT` varT a `appT`
-                                     varT b `appT` varT i))) of
-                 Just y -> Just $ inj y
-                 _ -> $(genDecl x gs a b i) |]
-          genDecl _ _ _ _ _ = error "genDecl called with empty list"
-
-projectn :: Int -> Q [Dec]
-projectn n = do
-  let p = mkName ("project" ++ show n)
-  let gvars = map (\n -> mkName $ 'g' : show n) [1..n]
-  let avar = mkName "a"
-  let bvar = mkName "b"
-  let ivar = mkName "i"
-  let xvar = mkName "x"
-  let d = [funD p [clause [varP xvar] (normalB $ genDecl xvar n) []]]
-  sequence $ (sigD p $ genSig gvars avar bvar ivar) : d
-    where genSig gvars avar bvar ivar = do
-            let fvar = mkName "f"
-            let hvar = mkName "h"
-            let cxt = map (\g -> classP ''(:<:) [varT g, varT fvar]) gvars
-            let tp = foldl1 (\a g -> conT ''(:+:) `appT` g `appT` a)
-                            (map varT gvars)
-            let tp' = conT ''Cxt `appT` varT hvar `appT` varT fvar
-                                 `appT` varT avar `appT` varT bvar
-            let tp'' = arrowT `appT` (tp' `appT` varT ivar)
-                              `appT` (conT ''Maybe `appT`
-                                      (tp `appT` varT avar `appT` tp' `appT`
-                                       varT ivar))
-            forallT (map PlainTV $ hvar : fvar : avar : bvar : ivar : gvars)
-                    (sequence cxt) tp''
-          genDecl x n = [| case $(varE x) of
-                             Hole _ -> Nothing
-                             Var _ -> Nothing
-                             In t -> $(varE $ mkName $ "proj" ++ show n) t |]
-
-deepProjectn :: Int -> Q [Dec]
-deepProjectn n = do
-  let p = mkName ("deepProject" ++ show n)
-  let gvars = map (\n -> mkName $ 'g' : show n) [1..n]
-  let d = [funD p [clause [] (normalB $ genDecl n) []]]
-  sequence $ (sigD p $ genSig gvars) : d
-    where genSig gvars = do
-            let fvar = mkName "f"
-            let ivar = mkName "i"
-            let cxt = map (\g -> classP ''(:<:) [varT g, varT fvar]) gvars
-            let tp = foldl1 (\a g -> conT ''(:+:) `appT` g `appT` a)
-                            (map varT gvars)
-            let cxt' = classP ''HDitraversable [tp]
-            let tp' = arrowT `appT` (conT ''Term `appT` varT fvar `appT` varT ivar)
-                             `appT` (conT ''Maybe `appT` (conT ''Term `appT` tp `appT` varT ivar))
-            forallT (map PlainTV $ fvar : ivar : gvars) (sequence $ cxt' : cxt) tp'
-          genDecl n = [| appTSigFunM' $(varE $ mkName $ "proj" ++ show n) |]
diff --git a/src/Data/Comp/MultiParam/Derive/Show.hs b/src/Data/Comp/MultiParam/Derive/Show.hs
deleted file mode 100644
--- a/src/Data/Comp/MultiParam/Derive/Show.hs
+++ /dev/null
@@ -1,87 +0,0 @@
-{-# LANGUAGE TemplateHaskell, FlexibleInstances, IncoherentInstances,
-  ScopedTypeVariables, UndecidableInstances, KindSignatures #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Data.Comp.MultiParam.Derive.Show
--- Copyright   :  (c) 2011 Patrick Bahr, Tom Hvitved
--- License     :  BSD3
--- Maintainer  :  Tom Hvitved <hvitved@diku.dk>
--- Stability   :  experimental
--- Portability :  non-portable (GHC Extensions)
---
--- Automatically derive instances of @ShowHD@.
---
---------------------------------------------------------------------------------
-module Data.Comp.MultiParam.Derive.Show
-    (
-     ShowHD(..),
-     makeShowHD
-    ) where
-
-import Data.Comp.Derive.Utils
-import Data.Comp.MultiParam.FreshM hiding (Name)
-import qualified Data.Comp.MultiParam.FreshM as FreshM
-import Data.Comp.MultiParam.HDifunctor
-import Control.Monad
-import Language.Haskell.TH hiding (Cxt, match)
-import qualified Data.Traversable as T
-
-{-| Signature printing. An instance @ShowHD f@ gives rise to an instance
-  @Show (Term f i)@. -}
-class ShowHD f where
-    showHD :: f FreshM.Name (K (FreshM String)) i -> FreshM String
-
-newtype Dummy = Dummy String
-
-instance Show Dummy where
-  show (Dummy s) = s
-
-{-| Derive an instance of 'ShowHD' for a type constructor of any parametric
-  kind taking at least three arguments. -}
-makeShowHD :: Name -> Q [Dec]
-makeShowHD fname = do
-  TyConI (DataD _ name args constrs _) <- abstractNewtypeQ $ reify fname
-  let args' = init args
-  -- covariant argument
-  let coArg :: Name = tyVarBndrName $ last args'
-  -- contravariant argument
-  let conArg :: Name = tyVarBndrName $ last $ init args'
-  let argNames = map (VarT . tyVarBndrName) (init $ init args')
-  let complType = foldl AppT (ConT name) argNames
-  let classType = AppT (ConT ''ShowHD) complType
-  constrs' :: [(Name,[Type])] <- mapM normalConExp constrs
-  showHDDecl <- funD 'showHD (map (showHDClause conArg coArg) constrs')
-  let context = map (\arg -> ClassP ''Show [arg]) argNames
-  return [InstanceD context classType [showHDDecl]]
-      where showHDClause :: Name -> Name -> (Name,[Type]) -> ClauseQ
-            showHDClause conArg coArg (constr, args) = do
-              varXs <- newNames (length args) "x"
-              -- Pattern for the constructor
-              let patx = ConP constr $ map VarP varXs
-              body <- showHDBody (nameBase constr) conArg coArg (zip varXs args)
-              return $ Clause [patx] (NormalB body) []
-            showHDBody :: String -> Name -> Name -> [(Name, Type)] -> ExpQ
-            showHDBody constr conArg coArg x =
-                [|liftM (unwords . (constr :) .
-                         map (\x -> if elem ' ' x then "(" ++ x ++ ")" else x))
-                        (sequence $(listE $ map (showHDB conArg coArg) x))|]
-            showHDB :: Name -> Name -> (Name, Type) -> ExpQ
-            showHDB conArg coArg (x, tp)
-                | not (containsType tp (VarT conArg)) &&
-                  not (containsType tp (VarT coArg)) =
-                    [| return $ show $(varE x) |]
-                | otherwise =
-                    case tp of
-                      AppT (VarT a) _ 
-                          | a == coArg -> [| unK $(varE x) |]
-                      AppT (AppT ArrowT (AppT (VarT a) _)) _
-                          | a == conArg ->
-                              [| withName (\v -> do body <- (unK . $(varE x)) v
-                                                    return $ "\\" ++ show v ++ " -> " ++ body) |]
-                      SigT tp' _ ->
-                          showHDB conArg coArg (x, tp')
-                      _ ->
-                          if containsType tp (VarT conArg) then
-                              [| showHD $(varE x) |]
-                          else
-                              [| liftM show $ T.mapM (liftM Dummy . unK) $(varE x) |]
diff --git a/src/Data/Comp/MultiParam/Derive/SmartAConstructors.hs b/src/Data/Comp/MultiParam/Derive/SmartAConstructors.hs
deleted file mode 100644
--- a/src/Data/Comp/MultiParam/Derive/SmartAConstructors.hs
+++ /dev/null
@@ -1,48 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Data.Comp.MultiParam.Derive.SmartAConstructors
--- Copyright   :  (c) 2011 Patrick Bahr, Tom Hvitved
--- License     :  BSD3
--- Maintainer  :  Tom Hvitved <hvitved@diku.dk>
--- Stability   :  experimental
--- Portability :  non-portable (GHC Extensions)
---
--- Automatically derive smart constructors with annotations for higher-order
--- difunctors.
---
---------------------------------------------------------------------------------
-
-module Data.Comp.MultiParam.Derive.SmartAConstructors 
-    (
-     smartAConstructors
-    ) where
-
-import Language.Haskell.TH hiding (Cxt)
-import Data.Comp.Derive.Utils
-import Data.Comp.MultiParam.Ops
-import Data.Comp.MultiParam.Term
-import Data.Comp.MultiParam.HDifunctor
-
-import Control.Monad
-
-{-| Derive smart constructors with annotations for a higher-order difunctor. The
- smart constructors are similar to the ordinary constructors, but a
- 'injectA . hdimap Var id' is automatically inserted. -}
-smartAConstructors :: Name -> Q [Dec]
-smartAConstructors fname = do
-    TyConI (DataD _cxt tname targs constrs _deriving) <- abstractNewtypeQ $ reify fname
-    let cons = map abstractConType constrs
-    liftM concat $ mapM (genSmartConstr (map tyVarBndrName targs) tname) cons
-        where genSmartConstr targs tname (name, args) = do
-                let bname = nameBase name
-                genSmartConstr' targs tname (mkName $ "iA" ++ bname) name args
-              genSmartConstr' targs tname sname name args = do
-                varNs <- newNames args "x"
-                varPr <- newName "_p"
-                let pats = map varP (varPr : varNs)
-                    vars = map varE varNs
-                    val = appE [|injectA $(varE varPr)|] $
-                          appE [|inj . hdimap Var id|] $ foldl appE (conE name) vars
-                    function = [funD sname [clause pats (normalB [|In $val|]) []]]
-                sequence function
diff --git a/src/Data/Comp/MultiParam/Derive/SmartConstructors.hs b/src/Data/Comp/MultiParam/Derive/SmartConstructors.hs
deleted file mode 100644
--- a/src/Data/Comp/MultiParam/Derive/SmartConstructors.hs
+++ /dev/null
@@ -1,72 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Data.Comp.MultiParam.Derive.SmartConstructors
--- Copyright   :  (c) 2011 Patrick Bahr, Tom Hvitved
--- License     :  BSD3
--- Maintainer  :  Tom Hvitved <hvitved@diku.dk>
--- Stability   :  experimental
--- Portability :  non-portable (GHC Extensions)
---
--- Automatically derive smart constructors for higher-order difunctors.
---
---------------------------------------------------------------------------------
-
-module Data.Comp.MultiParam.Derive.SmartConstructors 
-    (
-     smartConstructors
-    ) where
-
-import Language.Haskell.TH hiding (Cxt)
-import Data.Comp.Derive.Utils
-import Data.Comp.MultiParam.Sum
-import Data.Comp.MultiParam.Term
-import Data.Comp.MultiParam.HDifunctor
-import Control.Arrow ((&&&))
-import Control.Monad
-
-{-| Derive smart constructors for a higher-order difunctor. The smart
- constructors are similar to the ordinary constructors, but a
- 'inject . hdimap Var id' is automatically inserted. -}
-smartConstructors :: Name -> Q [Dec]
-smartConstructors fname = do
-    TyConI (DataD _cxt tname targs constrs _deriving) <- abstractNewtypeQ $ reify fname
-    let iVar = tyVarBndrName $ last targs
-    let cons = map (abstractConType &&& iTp iVar) constrs
-    liftM concat $ mapM (genSmartConstr (map tyVarBndrName targs) tname) cons
-        where iTp iVar (ForallC _ cxt _) =
-                  -- Check if the GADT phantom type is constrained
-                  case [y | EqualP x y <- cxt, x == VarT iVar] of
-                    [] -> Nothing
-                    tp:_ -> Just tp
-              iTp _ _ = Nothing
-              genSmartConstr targs tname ((name, args), miTp) = do
-                let bname = nameBase name
-                genSmartConstr' targs tname (mkName $ 'i' : bname) name args miTp
-              genSmartConstr' targs tname sname name args miTp = do
-                varNs <- newNames args "x"
-                let pats = map varP varNs
-                    vars = map varE varNs
-                    val = foldl appE (conE name) vars
-                    sig = genSig targs tname sname args miTp
-                    function = [funD sname [clause pats (normalB [|inject (hdimap Var id $val)|]) []]]
-                sequence $ sig ++ function
-              genSig targs tname sname 0 miTp = (:[]) $ do
-                hvar <- newName "h"
-                fvar <- newName "f"
-                avar <- newName "a"
-                bvar <- newName "b"
-                ivar <- newName "i"
-                let targs' = init $ init $ init targs
-                    vars = hvar:fvar:avar:bvar:maybe [ivar] (const []) miTp++targs'
-                    h = varT hvar
-                    f = varT fvar
-                    a = varT avar
-                    b = varT bvar
-                    i = varT ivar
-                    ftype = foldl appT (conT tname) (map varT targs')
-                    constr = classP ''(:<:) [ftype, f]
-                    typ = foldl appT (conT ''Cxt) [h, f, a, b,maybe i return miTp]
-                    typeSig = forallT (map PlainTV vars) (sequence [constr]) typ
-                sigD sname typeSig
-              genSig _ _ _ _ _ = []
diff --git a/src/Data/Comp/MultiParam/Desugar.hs b/src/Data/Comp/MultiParam/Desugar.hs
deleted file mode 100644
--- a/src/Data/Comp/MultiParam/Desugar.hs
+++ /dev/null
@@ -1,44 +0,0 @@
-{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances,
-  UndecidableInstances, OverlappingInstances, TypeOperators, Rank2Types #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Data.Comp.MultiParam.Desugar
--- Copyright   :  (c) 2011 Patrick Bahr, Tom Hvitved
--- License     :  BSD3
--- Maintainer  :  Tom Hvitved <hvitved@diku.dk>
--- Stability   :  experimental
--- Portability :  non-portable (GHC Extensions)
---
--- This modules defines the 'Desugar' type class for desugaring of terms.
---
---------------------------------------------------------------------------------
-
-module Data.Comp.MultiParam.Desugar where
-
-import Data.Comp.MultiParam
-
--- |The desugaring term homomorphism.
-class (HDifunctor f, HDifunctor g) => Desugar f g where
-    desugHom :: Hom f g
-    desugHom = desugHom' . hfmap Hole
-    desugHom' :: f a (Cxt h g a b) :-> Cxt h g a b
-    desugHom' x = appCxt (desugHom x)
-
--- We make the lifting to sums explicit in order to make the Desugar
--- class work with the default instance declaration further below.
-instance (Desugar f h, Desugar g h) => Desugar (f :+: g) h where
-    desugHom = caseHD desugHom desugHom
-
-
--- |Desugar a term.
-desugar :: Desugar f g => Term f :-> Term g
-desugar (Term t) = Term (appHom desugHom t)
-
--- |Lift desugaring to annotated terms.
-desugarA :: (HDifunctor f', HDifunctor g', DistAnn f p f', DistAnn g p g',
-             Desugar f g) => Term f' :-> Term g'
-desugarA (Term t) = Term (appHom (propAnn desugHom) t)
-
--- |Default desugaring instance.
-instance (HDifunctor f, HDifunctor g, f :<: g) => Desugar f g where
-    desugHom = simpCxt . inj
diff --git a/src/Data/Comp/MultiParam/Equality.hs b/src/Data/Comp/MultiParam/Equality.hs
deleted file mode 100644
--- a/src/Data/Comp/MultiParam/Equality.hs
+++ /dev/null
@@ -1,64 +0,0 @@
-{-# LANGUAGE TypeOperators, TypeSynonymInstances, FlexibleInstances,
-  UndecidableInstances, IncoherentInstances, GADTs #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Data.Comp.MultiParam.Equality
--- Copyright   :  (c) 2011 Patrick Bahr, Tom Hvitved
--- License     :  BSD3
--- Maintainer  :  Tom Hvitved <hvitved@diku.dk>
--- Stability   :  experimental
--- Portability :  non-portable (GHC Extensions)
---
--- This module defines equality for signatures, which lifts to equality for
--- terms.
---
---------------------------------------------------------------------------------
-module Data.Comp.MultiParam.Equality
-    (
-     PEq(..),
-     EqHD(..)
-    ) where
-
-import Data.Comp.MultiParam.Term
-import Data.Comp.MultiParam.Sum
-import Data.Comp.MultiParam.Ops
-import Data.Comp.MultiParam.HDifunctor
-import Data.Comp.MultiParam.FreshM
-
--- |Equality on parametric values. The equality test is performed inside the
--- 'FreshM' monad for generating fresh identifiers.
-class PEq a where
-    peq :: a i -> a j -> FreshM Bool
-
-instance Eq a => PEq (K a) where
-    peq (K x) (K y) = return $ x == y
-
-{-| Signature equality. An instance @EqHD f@ gives rise to an instance
-  @Eq (Term f i)@. The equality test is performed inside the 'FreshM' monad for
-  generating fresh identifiers. -}
-class EqHD f where
-    eqHD :: PEq a => f Name a i -> f Name a j -> FreshM Bool
-
-{-| 'EqHD' is propagated through sums. -}
-instance (EqHD f, EqHD g) => EqHD (f :+: g) where
-    eqHD (Inl x) (Inl y) = eqHD x y
-    eqHD (Inr x) (Inr y) = eqHD x y
-    eqHD _ _ = return False
-
-instance PEq Name where
-   peq x y = return $ nameCoerce x == y
-
-{-| From an 'EqHD' difunctor an 'Eq' instance of the corresponding term type can
-  be derived. -}
-instance EqHD f => EqHD (Cxt h f) where
-    eqHD (In e1) (In e2) = eqHD e1 e2
-    eqHD (Hole h1) (Hole h2) = peq h1 h2
-    eqHD (Var p1) (Var p2) = peq p1 p2
-    eqHD _ _ = return False
-
-instance (EqHD f, PEq a) => PEq (Cxt h f Name a) where
-    peq = eqHD
-
-{-| Equality on terms. -}
-instance (HDifunctor f, EqHD f) => Eq (Term f i) where
-    (==) (Term x) (Term y) = evalFreshM $ eqHD x y
diff --git a/src/Data/Comp/MultiParam/FreshM.hs b/src/Data/Comp/MultiParam/FreshM.hs
deleted file mode 100644
--- a/src/Data/Comp/MultiParam/FreshM.hs
+++ /dev/null
@@ -1,54 +0,0 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Data.Comp.MultiParam.FreshM
--- Copyright   :  (c) 2011 Patrick Bahr, Tom Hvitved
--- License     :  BSD3
--- Maintainer  :  Tom Hvitved <hvitved@diku.dk>
--- Stability   :  experimental
--- Portability :  non-portable (GHC Extensions)
---
--- This module defines a monad for generating fresh, abstract names, useful
--- e.g. for defining equality on terms.
---
---------------------------------------------------------------------------------
-module Data.Comp.MultiParam.FreshM
-    (
-     FreshM,
-     Name,
-     withName,
-     nameCoerce,
-     evalFreshM
-    ) where
-
-import Control.Monad.Reader
-
--- |Monad for generating fresh (abstract) names.
-newtype FreshM a = FreshM{unFreshM :: Reader Int a}
-    deriving Monad
-
--- |Abstract notion of a name (the constructor is hidden).
-newtype Name i = Name Int
-    deriving Eq
-
-instance Show (Name i) where
-    show (Name x) = names !! x
-        where baseNames = ['a'..'z']
-              names = map (:[]) baseNames ++ names' 1
-              names' n = map (: show n) baseNames ++ names' (n + 1)
-
-instance Ord (Name i) where
-    compare (Name x) (Name y) = compare x y
-
--- |Change the type tag of a name.
-nameCoerce :: Name i -> Name j
-nameCoerce (Name x) = Name x
-
--- |Run the given computation with the next available name.
-withName :: (Name i -> FreshM a) -> FreshM a
-withName m = do name <- FreshM (asks Name)
-                FreshM $ local ((+) 1) $ unFreshM $ m name
-
--- |Evaluate a computation that uses fresh names.
-evalFreshM :: FreshM a -> a
-evalFreshM (FreshM m) = runReader m 0
diff --git a/src/Data/Comp/MultiParam/HDifunctor.hs b/src/Data/Comp/MultiParam/HDifunctor.hs
deleted file mode 100644
--- a/src/Data/Comp/MultiParam/HDifunctor.hs
+++ /dev/null
@@ -1,40 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, Rank2Types,
-  TypeOperators, GADTs #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Data.Comp.MultiParam.HDifunctor
--- Copyright   :  (c) 2011 Patrick Bahr, Tom Hvitved
--- License     :  BSD3
--- Maintainer  :  Tom Hvitved <hvitved@diku.dk>
--- Stability   :  experimental
--- Portability :  non-portable (GHC Extensions)
---
--- This module defines higher-order difunctors, a hybrid between higher-order
--- functors (Johann, Ghani, POPL '08), and difunctors (Meijer, Hutton, FPCA
--- '95). Higher-order difunctors are used to define signatures for
--- compositional parametric generalised data types.
---
---------------------------------------------------------------------------------
-
-module Data.Comp.MultiParam.HDifunctor
-    (
-     HDifunctor (..),
-     HFunctor (..),
-     I (..),
-     K (..),
-     E (..),
-     A (..),
-     (:->),
-     NatM
-    ) where
-
-import Data.Comp.Multi.HFunctor
-
--- | This class represents higher-order difunctors.
-class HDifunctor f where
-    hdimap :: (a :-> b) -> (c :-> d) -> f b c :-> f a d
-
--- |A higher-order difunctor gives rise to a higher-order functor when
--- restricted to a particular contravariant argument.
-instance HDifunctor f => HFunctor (f a) where
-    hfmap = hdimap id
diff --git a/src/Data/Comp/MultiParam/HDitraversable.hs b/src/Data/Comp/MultiParam/HDitraversable.hs
deleted file mode 100644
--- a/src/Data/Comp/MultiParam/HDitraversable.hs
+++ /dev/null
@@ -1,29 +0,0 @@
-{-# LANGUAGE Rank2Types, FlexibleInstances, MultiParamTypeClasses,
-  FlexibleContexts, OverlappingInstances, TypeOperators, GADTs #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Data.Comp.MultiParam.HDitraversable
--- Copyright   :  (c) 2011 Patrick Bahr, Tom Hvitved
--- License     :  BSD3
--- Maintainer  :  Tom Hvitved <hvitved@diku.dk>
--- Stability   :  experimental
--- Portability :  non-portable (GHC Extensions)
---
--- This module defines traversable higher-order difunctors.
---
---------------------------------------------------------------------------------
-
-module Data.Comp.MultiParam.HDitraversable
-    (
-     HDitraversable (..),
-     HTraversable (..)
-    ) where
-
-import Prelude hiding (mapM, sequence, foldr)
-import Data.Comp.Multi.HTraversable
-import Data.Comp.MultiParam.HDifunctor
-
-{-| HDifunctors representing data structures that can be traversed from left to
-  right. -}
-class HDifunctor f => HDitraversable f where
-    hdimapM :: Monad m => NatM m b c -> NatM m (f a b) (f a c)
diff --git a/src/Data/Comp/MultiParam/Ops.hs b/src/Data/Comp/MultiParam/Ops.hs
deleted file mode 100644
--- a/src/Data/Comp/MultiParam/Ops.hs
+++ /dev/null
@@ -1,126 +0,0 @@
-{-# LANGUAGE TypeOperators, MultiParamTypeClasses, FunctionalDependencies,
-  FlexibleInstances, UndecidableInstances, IncoherentInstances,
-  KindSignatures, RankNTypes #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Data.Comp.MultiParam.Ops
--- Copyright   :  (c) 2011 Patrick Bahr, Tom Hvitved
--- License     :  BSD3
--- Maintainer  :  Tom Hvitved <hvitved@diku.dk>
--- Stability   :  experimental
--- Portability :  non-portable (GHC Extensions)
---
--- This module provides operators on higher-order difunctors.
---
---------------------------------------------------------------------------------
-
-module Data.Comp.MultiParam.Ops where
-
-import Data.Comp.MultiParam.HDifunctor
-import Data.Comp.MultiParam.HDitraversable
-import qualified Data.Comp.Ops as O
-import Control.Monad (liftM)
-
-
--- Sums
-infixr 6 :+:
-
--- |Formal sum of signatures (difunctors).
-data (f :+: g) (a :: * -> *) (b :: * -> *) i = Inl (f a b i)
-                                             | Inr (g a b i)
-
-{-| Utility function to case on a higher-order difunctor sum, without exposing
-  the internal representation of sums. -}
-caseHD :: (f a b i -> c) -> (g a b i -> c) -> (f :+: g) a b i -> c
-caseHD f g x = case x of
-                 Inl x -> f x
-                 Inr x -> g x
-
-instance (HDifunctor f, HDifunctor g) => HDifunctor (f :+: g) where
-    hdimap f g (Inl e) = Inl (hdimap f g e)
-    hdimap f g (Inr e) = Inr (hdimap f g e)
-
-instance (HDitraversable f, HDitraversable g) => HDitraversable (f :+: g) where
-    hdimapM f (Inl e) = Inl `liftM` hdimapM f e
-    hdimapM f (Inr e) = Inr `liftM` hdimapM f e
-
--- | Signature containment relation for automatic injections. The left-hand must
--- be an atomic signature, where as the right-hand side must have a list-like
--- structure. Examples include @f :<: f :+: g@ and @g :<: f :+: (g :+: h)@,
--- non-examples include @f :+: g :<: f :+: (g :+: h)@ and
--- @f :<: (f :+: g) :+: h@.
-class (sub :: (* -> *) -> (* -> *) -> * -> *) :<: sup where
-    inj :: sub a b :-> sup a b
-    proj :: NatM Maybe (sup a b) (sub a b)
-
-instance (:<:) f f where
-    inj = id
-    proj = Just
-
-instance (:<:) f (f :+: g) where
-    inj = Inl
-    proj (Inl x) = Just x
-    proj (Inr _) = Nothing
-
-instance (f :<: g) => (:<:) f (h :+: g) where
-    inj = Inr . inj
-    proj (Inr x) = proj x
-    proj (Inl _) = Nothing
-
-
--- Products
-infixr 8 :*:
-
--- |Formal product of signatures (higher-order difunctors).
-data (f :*: g) a b = f a b :*: g a b
-
-ffst :: (f :*: g) a b -> f a b
-ffst (x :*: _) = x
-
-fsnd :: (f :*: g) a b -> g a b 
-fsnd (_ :*: x) = x
-
-
--- Constant Products
-infixr 7 :&:
-
-{-| This data type adds a constant product to a signature. -}
-data (f :&: p) (a :: * -> *) (b :: * -> *) i = f a b i :&: p
-
-instance HDifunctor f => HDifunctor (f :&: p) where
-    hdimap f g (v :&: c) = hdimap f g v :&: c
-
-instance HDitraversable f => HDitraversable (f :&: p) where
-    hdimapM f (v :&: c) = liftM (:&: c) (hdimapM f v)
-
-{-| This class defines how to distribute an annotation over a sum of
-  signatures. -}
-class DistAnn (s :: (* -> *) -> (* -> *) -> * -> *) p s' | s' -> s, s' -> p where
-    {-| Inject an annotation over a signature. -}
-    injectA :: p -> s a b :-> s' a b
-    {-| Project an annotation from a signature. -}
-    projectA :: s' a b :-> (s a b O.:&: p)
-
-class RemA (s :: (* -> *) -> (* -> *) -> * -> *) s' | s -> s' where
-    {-| Remove annotations from a signature. -}
-    remA :: s a b :-> s' a b
-
-instance (RemA s s') => RemA (f :&: p :+: s) (f :+: s') where
-    remA (Inl (v :&: _)) = Inl v
-    remA (Inr v) = Inr $ remA v
-
-instance RemA (f :&: p) f where
-    remA (v :&: _) = v
-
-instance DistAnn f p (f :&: p) where
-    injectA c v = v :&: c
-
-    projectA (v :&: p) = v O.:&: p
-
-instance (DistAnn s p s') => DistAnn (f :+: s) p ((f :&: p) :+: s') where
-    injectA c (Inl v) = Inl (v :&: c)
-    injectA c (Inr v) = Inr $ injectA c v
-
-    projectA (Inl (v :&: p)) = Inl v O.:&: p
-    projectA (Inr v) = let (v' O.:&: p) = projectA v
-                       in Inr v' O.:&: p
diff --git a/src/Data/Comp/MultiParam/Ordering.hs b/src/Data/Comp/MultiParam/Ordering.hs
deleted file mode 100644
--- a/src/Data/Comp/MultiParam/Ordering.hs
+++ /dev/null
@@ -1,67 +0,0 @@
-{-# LANGUAGE TypeOperators, TypeSynonymInstances, FlexibleInstances,
-  UndecidableInstances, IncoherentInstances, GADTs #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Data.Comp.MultiParam.Ordering
--- Copyright   :  (c) 2011 Patrick Bahr, Tom Hvitved
--- License     :  BSD3
--- Maintainer  :  Tom Hvitved <hvitved@diku.dk>
--- Stability   :  experimental
--- Portability :  non-portable (GHC Extensions)
---
--- This module defines ordering of signatures, which lifts to ordering of
--- terms and contexts.
---
---------------------------------------------------------------------------------
-module Data.Comp.MultiParam.Ordering
-    (
-     POrd(..),
-     OrdHD(..)
-    ) where
-
-import Data.Comp.MultiParam.Term
-import Data.Comp.MultiParam.Sum
-import Data.Comp.MultiParam.Ops
-import Data.Comp.MultiParam.HDifunctor
-import Data.Comp.MultiParam.FreshM
-import Data.Comp.MultiParam.Equality
-
--- |Ordering of parametric values.
-class PEq a => POrd a where
-    pcompare :: a i -> a j -> FreshM Ordering
-
-instance Ord a => POrd (K a) where
-    pcompare (K x) (K y) = return $ compare x y
-
-{-| Signature ordering. An instance @OrdHD f@ gives rise to an instance
-  @Ord (Term f)@. -}
-class EqHD f => OrdHD f where
-    compareHD :: POrd a => f Name a i -> f Name a j -> FreshM Ordering
-
-{-| 'OrdHD' is propagated through sums. -}
-instance (OrdHD f, OrdHD g) => OrdHD (f :+: g) where
-    compareHD (Inl x) (Inl y) = compareHD x y
-    compareHD (Inl _) (Inr _) = return LT
-    compareHD (Inr x) (Inr y) = compareHD x y
-    compareHD (Inr _) (Inl _) = return GT
-
-{-| From an 'OrdHD' difunctor an 'Ord' instance of the corresponding term type
-  can be derived. -}
-instance OrdHD f => OrdHD (Cxt h f) where
-    compareHD (In e1) (In e2) = compareHD e1 e2
-    compareHD (Hole h1) (Hole h2) = pcompare h1 h2
-    compareHD (Var p1) (Var p2) = pcompare p1 p2
-    compareHD (In _) _ = return LT
-    compareHD (Hole _) (In _) = return GT
-    compareHD (Hole _) (Var _) = return LT
-    compareHD (Var _) _ = return GT
-
-instance POrd Name where
-    pcompare x y = return $ compare (nameCoerce x) y
-
-instance (OrdHD f, POrd a) => POrd (Cxt h f Name a) where
-    pcompare = compareHD
-
-{-| Ordering of terms. -}
-instance (HDifunctor f, OrdHD f) => Ord (Term f i) where
-    compare (Term x) (Term y) = evalFreshM $ compareHD x y
diff --git a/src/Data/Comp/MultiParam/Show.hs b/src/Data/Comp/MultiParam/Show.hs
deleted file mode 100644
--- a/src/Data/Comp/MultiParam/Show.hs
+++ /dev/null
@@ -1,42 +0,0 @@
-{-# LANGUAGE TypeOperators, FlexibleInstances, TypeSynonymInstances,
-  IncoherentInstances, UndecidableInstances, TemplateHaskell, GADTs #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Data.Comp.MultiParam.Show
--- Copyright   :  (c) 2011 Patrick Bahr, Tom Hvitved
--- License     :  BSD3
--- Maintainer  :  Tom Hvitved <hvitved@diku.dk>
--- Stability   :  experimental
--- Portability :  non-portable (GHC Extensions)
---
--- This module defines showing of signatures, which lifts to showing of terms.
---
---------------------------------------------------------------------------------
-module Data.Comp.MultiParam.Show
-    (
-     ShowHD(..)
-    ) where
-
-import Data.Comp.MultiParam.Term
-import Data.Comp.MultiParam.HDifunctor
-import Data.Comp.MultiParam.Ops
-import Data.Comp.MultiParam.Derive
-import Data.Comp.MultiParam.FreshM
-
--- Lift ShowHD to sums
-$(derive [liftSum] [''ShowHD])
-
-{-| From an 'ShowHD' higher-order difunctor an 'ShowHD' instance of the
-  corresponding term type can be derived. -}
-instance (HDifunctor f, ShowHD f) => ShowHD (Cxt h f) where
-    showHD (In t) = showHD $ hfmap (K . showHD) t
-    showHD (Hole h) = unK h
-    showHD (Var p) = return $ show p
-
-{-| Printing of terms. -}
-instance (HDifunctor f, ShowHD f) => Show (Term f i) where
-    show = evalFreshM . showHD . toCxt . unTerm
-
-instance (ShowHD f, Show p) => ShowHD (f :&: p) where
-    showHD (x :&: p) = do sx <- showHD x
-                          return $ sx ++ " :&: " ++ show p
diff --git a/src/Data/Comp/MultiParam/Sum.hs b/src/Data/Comp/MultiParam/Sum.hs
deleted file mode 100644
--- a/src/Data/Comp/MultiParam/Sum.hs
+++ /dev/null
@@ -1,180 +0,0 @@
-{-# LANGUAGE TypeOperators, MultiParamTypeClasses, IncoherentInstances,
-  FlexibleInstances, FlexibleContexts, GADTs, TypeSynonymInstances,
-  ScopedTypeVariables, TemplateHaskell #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Data.Comp.MultiParam.Sum
--- Copyright   :  (c) 2011 Patrick Bahr, Tom Hvitved
--- License     :  BSD3
--- Maintainer  :  Tom Hvitved <hvitved@diku.dk>
--- Stability   :  experimental
--- Portability :  non-portable (GHC Extensions)
---
--- This module provides the infrastructure to extend signatures.
---
---------------------------------------------------------------------------------
-
-module Data.Comp.MultiParam.Sum
-    (
-     (:<:),
-     (:+:),
-     caseHD,
-
-     -- * Projections for Signatures and Terms
-     proj,
-     proj2,
-     proj3,
-     proj4,
-     proj5,
-     proj6,
-     proj7,
-     proj8,
-     proj9,
-     proj10,
-     project,
-     project2,
-     project3,
-     project4,
-     project5,
-     project6,
-     project7,
-     project8,
-     project9,
-     project10,
-     deepProject,
-     deepProject2,
-     deepProject3,
-     deepProject4,
-     deepProject5,
-     deepProject6,
-     deepProject7,
-     deepProject8,
-     deepProject9,
-     deepProject10,
-
-     -- * Injections for Signatures and Terms
-     inj,
-     inj2,
-     inj3,
-     inj4,
-     inj5,
-     inj6,
-     inj7,
-     inj8,
-     inj9,
-     inj10,
-     inject,
-     inject2,
-     inject3,
-     inject4,
-     inject5,
-     inject6,
-     inject7,
-     inject8,
-     inject9,
-     inject10,
-     deepInject,
-     deepInject2,
-     deepInject3,
-     deepInject4,
-     deepInject5,
-     deepInject6,
-     deepInject7,
-     deepInject8,
-     deepInject9,
-     deepInject10,
-
-     injectCxt,
-     liftCxt
-    ) where
-
-import Prelude hiding (sequence)
-import Control.Monad hiding (sequence)
-import Data.Comp.MultiParam.Term
-import Data.Comp.MultiParam.Algebra
-import Data.Comp.MultiParam.Ops
-import Data.Comp.MultiParam.Derive.Projections
-import Data.Comp.MultiParam.Derive.Injections
-import Data.Comp.MultiParam.HDifunctor
-import Data.Comp.MultiParam.HDitraversable
-
-$(liftM concat $ mapM projn [2..10])
-
--- |Project the outermost layer of a term to a sub signature. If the signature
--- @g@ is compound of /n/ atomic signatures, use @project@/n/ instead.
-project :: (g :<: f) => NatM Maybe (Cxt h f a b) (g a (Cxt h f a b))
-project (In t)   = proj t
-project (Hole _) = Nothing
-project (Var _)  = Nothing
-
-$(liftM concat $ mapM projectn [2..10])
-
--- | Tries to coerce a term/context to a term/context over a sub-signature. If
--- the signature @g@ is compound of /n/ atomic signatures, use
--- @deepProject@/n/ instead.
-deepProject :: (HDitraversable g, g :<: f) => Term f i -> Maybe (Term g i)
-{-# INLINE deepProject #-}
-deepProject = appTSigFunM' proj
-
-$(liftM concat $ mapM deepProjectn [2..10])
-{-# INLINE deepProject2 #-}
-{-# INLINE deepProject3 #-}
-{-# INLINE deepProject4 #-}
-{-# INLINE deepProject5 #-}
-{-# INLINE deepProject6 #-}
-{-# INLINE deepProject7 #-}
-{-# INLINE deepProject8 #-}
-{-# INLINE deepProject9 #-}
-{-# INLINE deepProject10 #-}
-
-$(liftM concat $ mapM injn [2..10])
-
--- |Inject a term where the outermost layer is a sub signature. If the signature
--- @g@ is compound of /n/ atomic signatures, use @inject@/n/ instead.
-inject :: (g :<: f) => g a (Cxt h f a b) :-> Cxt h f a b
-inject = In . inj
-
-$(liftM concat $ mapM injectn [2..10])
-
--- |Inject a term over a sub signature to a term over larger signature. If the
--- signature @g@ is compound of /n/ atomic signatures, use @deepInject@/n/
--- instead.
-deepInject :: (HDifunctor g, g :<: f) => CxtFun g f
-{-# INLINE deepInject #-}
-deepInject = appSigFun inj
-
-$(liftM concat $ mapM deepInjectn [2..10])
-{-# INLINE deepInject2 #-}
-{-# INLINE deepInject3 #-}
-{-# INLINE deepInject4 #-}
-{-# INLINE deepInject5 #-}
-{-# INLINE deepInject6 #-}
-{-# INLINE deepInject7 #-}
-{-# INLINE deepInject8 #-}
-{-# INLINE deepInject9 #-}
-{-# INLINE deepInject10 #-}
-
-{-| This function injects a whole context into another context. -}
-injectCxt :: (HDifunctor g, g :<: f) => Cxt h g a (Cxt h f a b) :-> Cxt h f a b
-injectCxt (In t) = inject $ hfmap injectCxt t
-injectCxt (Hole x) = x
-injectCxt (Var p) = Var p
-
-{-| This function lifts the given functor to a context. -}
-liftCxt :: (HDifunctor f, g :<: f) => g a b :-> Cxt Hole f a b
-liftCxt g = simpCxt $ inj g
-
-instance (Show (f a b i), Show (g a b i)) => Show ((f :+: g) a b i) where
-    show (Inl v) = show v
-    show (Inr v) = show v
-
-instance (Ord (f a b i), Ord (g a b i)) => Ord ((f :+: g) a b i) where
-    compare (Inl _) (Inr _) = LT
-    compare (Inr _) (Inl _) = GT
-    compare (Inl x) (Inl y) = compare x y
-    compare (Inr x) (Inr y) = compare x y
-
-instance (Eq (f a b i), Eq (g a b i)) => Eq ((f :+: g) a b i) where
-    (Inl x) == (Inl y) = x == y
-    (Inr x) == (Inr y) = x == y                   
-    _ == _ = False
diff --git a/src/Data/Comp/MultiParam/Term.hs b/src/Data/Comp/MultiParam/Term.hs
deleted file mode 100644
--- a/src/Data/Comp/MultiParam/Term.hs
+++ /dev/null
@@ -1,123 +0,0 @@
-{-# LANGUAGE EmptyDataDecls, GADTs, KindSignatures, Rank2Types,
-  MultiParamTypeClasses, TypeOperators, ScopedTypeVariables #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Data.Comp.MultiParam.Term
--- Copyright   :  (c) 2011 Patrick Bahr, Tom Hvitved
--- License     :  BSD3
--- Maintainer  :  Tom Hvitved <hvitved@diku.dk>
--- Stability   :  experimental
--- Portability :  non-portable (GHC Extensions)
---
--- This module defines the central notion of /generalised parametrised terms/
--- and their generalisation to generalised parametrised contexts.
---
---------------------------------------------------------------------------------
-
-module Data.Comp.MultiParam.Term
-    (
-     Cxt(..),
-     Hole,
-     NoHole,
-     Term(..),
-     Trm,
-     Context,
-     simpCxt,
-     toCxt,
-     hfmapCxt,
-     hdimapMCxt,
-     ParamFunctor (..)
-    ) where
-
-import Prelude hiding (mapM, sequence, foldl, foldl1, foldr, foldr1)
-import Data.Comp.MultiParam.HDifunctor
-import Data.Comp.MultiParam.HDitraversable
-import Control.Monad 
-import Unsafe.Coerce
-import Data.Maybe (fromJust)
-
-{-| This data type represents contexts over a signature. Contexts are terms
-  containing zero or more holes, and zero or more parameters. The first
-  parameter is a phantom type indicating whether the context has holes. The
-  second paramater is the signature of the context, in the form of a
-  "Data.Comp.MultiParam.HDifunctor". The third parameter is the type of
-  parameters, the fourth parameter is the type of holes, and the fifth
-  parameter is the GADT type. -}
-data Cxt :: * -> ((* -> *) -> (* -> *) -> * -> *) -> (* -> *) -> (* -> *) -> * -> * where
-            In :: f a (Cxt h f a b) i -> Cxt h f a b i
-            Hole :: b i -> Cxt Hole f a b i
-            Var :: a i -> Cxt h f a b i
-
-{-| Phantom type used to define 'Context'. -}
-data Hole
-
-{-| Phantom type used to define 'Term'. -}
-data NoHole
-
-{-| A context may contain holes. -}
-type Context = Cxt Hole
-
-{-| \"Preterms\" |-}
-type Trm f a = Cxt NoHole f a (K ())
-
-{-| A term is a context with no holes, where all occurrences of the
-  contravariant parameter is fully parametric. -}
-newtype Term f i = Term{unTerm :: forall a. Trm f a i}
-
-{-| Convert a difunctorial value into a context. -}
-simpCxt :: HDifunctor f => f a b :-> Cxt Hole f a b
-{-# INLINE simpCxt #-}
-simpCxt = In . hfmap Hole
-
-toCxt :: HDifunctor f => Trm f a :-> Cxt h f a b
-{-# INLINE toCxt #-}
-toCxt = unsafeCoerce
-
--- | This is an instance of 'hfmap' for 'Cxt'.
-hfmapCxt :: forall h f a b b'. HDifunctor f
-         => (b :-> b') -> Cxt h f a b :-> Cxt h f a b'
-hfmapCxt f = run
-    where run :: Cxt h f a b :-> Cxt h f a b'
-          run (In t)   = In $ hfmap run t
-          run (Var a)  = Var a
-          run (Hole b) = Hole $ f b
-
--- | This is an instance of 'hdimapM' for 'Cxt'.
-hdimapMCxt :: forall h f a b b' m . (HDitraversable f, Monad m)
-          => NatM m b b' -> NatM m (Cxt h f a b) (Cxt h f a b')
-hdimapMCxt f = run
-    where run :: NatM m (Cxt h f a b) (Cxt h f a b')
-          run (In t)   = liftM In $ hdimapM run t
-          run (Var a)  = return $ Var a
-          run (Hole b) = liftM Hole (f b)
-          
-          
-          
-{-| Monads for which embedded @Trm@ values, which are parametric at top level,
-  can be made into monadic @Term@ values, i.e. \"pushing the parametricity
-  inwards\". -}
-class ParamFunctor m where
-    termM :: (forall a. m (Trm f a i)) -> m (Term f i)
-
-coerceTermM :: ParamFunctor m => (forall a. m (Trm f a i)) -> m (Term f i)
-{-# INLINE coerceTermM #-}
-coerceTermM t = unsafeCoerce t
-
-{-# RULES
-    "termM/coerce'" termM = coerceTermM
- #-}
-
-instance ParamFunctor Maybe where
-    termM Nothing = Nothing
-    termM x       = Just (Term $ fromJust x)
-
-instance ParamFunctor (Either a) where
-    termM (Left x) = Left x
-    termM x        = Right (Term $ fromRight x)
-                             where fromRight :: Either a b -> b
-                                   fromRight (Right x) = x
-                                   fromRight _ = error "fromRight: Left"
-
-instance ParamFunctor [] where
-    termM [] = []
-    termM l  = Term (head l) : termM (tail l)
diff --git a/src/Data/Comp/Ops.hs b/src/Data/Comp/Ops.hs
--- a/src/Data/Comp/Ops.hs
+++ b/src/Data/Comp/Ops.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE TypeOperators, MultiParamTypeClasses, IncoherentInstances,
              FlexibleInstances, FlexibleContexts, GADTs, TypeSynonymInstances,
-             ScopedTypeVariables, FunctionalDependencies, UndecidableInstances #-}
+             ScopedTypeVariables, FunctionalDependencies, UndecidableInstances,
+             TypeFamilies, DataKinds, ConstraintKinds #-}
 
 --------------------------------------------------------------------------------
 -- |
@@ -35,6 +36,12 @@
 data (f :+: g) e = Inl (f e)
                  | Inr (g e)
 
+fromInl :: (f :+: g) e -> Maybe (f e)
+fromInl = caseF Just (const Nothing)
+
+fromInr :: (f :+: g) e -> Maybe (g e)
+fromInr = caseF (const Nothing) Just 
+
 {-| Utility function to case on a functor sum, without exposing the internal
   representation of sums. -}
 caseF :: (f a -> b) -> (g a -> b) -> (f :+: g) a -> b
@@ -71,28 +78,159 @@
     sequence (Inl e) = Inl `liftM` sequence e
     sequence (Inr e) = Inr `liftM` sequence e
 
--- | Signature containment relation for automatic injections. The left-hand must
--- be an atomic signature, where as the right-hand side must have a list-like
--- structure. Examples include @f :<: f :+: g@ and @g :<: f :+: (g :+: h)@,
--- non-examples include @f :+: g :<: f :+: (g :+: h)@ and
--- @f :<: (f :+: g) :+: h@.
-class sub :<: sup where
-  inj :: sub a -> sup a
-  proj :: sup a -> Maybe (sub a)
+infixl 5 :<:
+infixl 5 :=:
 
-instance (:<:) f f where
-    inj = id
-    proj = Just
+data Pos = Here | GoLeft Pos | GoRight Pos | Sum Pos Pos
+data Emb = NotFound | Ambiguous | Found Pos
 
-instance (:<:) f (f :+: g) where
-    inj = Inl
-    proj (Inl x) = Just x
-    proj (Inr _) = Nothing
 
-instance (f :<: g) => (:<:) f (h :+: g) where
-    inj = Inr . inj
-    proj (Inr x) = proj x
-    proj (Inl _) = Nothing
+type family GetEmb (f :: * -> *) (g :: * -> *) :: Emb where
+    GetEmb f f = Found Here
+    GetEmb f (g1 :+: g2) = Pick f (g1 :+: g2) (GetEmb f g1) (GetEmb f g2)
+    GetEmb f g = NotFound
+
+
+type family Pick f g (e1 :: Emb) (r :: Emb) :: Emb where
+    Pick f g (Found x) (Found y) = Ambiguous
+    Pick f g Ambiguous y = Ambiguous
+    Pick f g x Ambiguous = Ambiguous
+    Pick f g (Found x) y = Found (GoLeft x)
+    Pick f g x (Found y) = Found (GoRight y)
+    Pick f g x y = Split f g
+
+type family Split (f :: * -> *) (g :: * -> *) :: Emb where
+    Split (f1 :+: f2) g = Pick2 (GetEmb f1 g) (GetEmb f2 g) 
+    Split f g = NotFound
+
+type family Pick2 (e1 :: Emb) (r :: Emb) :: Emb where
+    Pick2 (Found x) (Found y) = Found (Sum x y)
+    Pick2 Ambiguous y = Ambiguous
+    Pick2 x Ambiguous = Ambiguous
+    Pick2 NotFound y = NotFound
+    Pick2 x NotFound = NotFound
+
+data EmbD (e :: Emb) (f :: * -> *) (g :: * -> *) where
+    HereD :: EmbD (Found Here) f f
+    GoLeftD :: EmbD (Found p) f g -> EmbD (Found (GoLeft p)) f (g :+: g')
+    GoRightD :: EmbD (Found p) f g -> EmbD (Found (GoRight p)) f (g' :+: g)
+    SumD :: EmbD (Found p1) f1 g -> EmbD (Found p2) f2 g -> EmbD (Found (Sum p1 p2)) (f1 :+: f2) g
+
+class GetEmbD (e :: Emb) (f :: * -> *) (g :: * -> *) where
+    getEmbD :: EmbD e f g
+
+instance GetEmbD (Found Here) f f where
+    getEmbD = HereD
+
+instance GetEmbD (Found p) f g => GetEmbD (Found (GoLeft p)) f (g :+: g') where
+    getEmbD = GoLeftD getEmbD
+
+instance GetEmbD (Found p) f g => GetEmbD (Found (GoRight p)) f (g' :+: g) where
+    getEmbD = GoRightD getEmbD
+
+instance (GetEmbD (Found p1) f1 g, GetEmbD (Found p2) f2 g) 
+    => GetEmbD (Found (Sum p1 p2)) (f1 :+: f2) g where
+    getEmbD = SumD getEmbD getEmbD
+
+
+-- The following definitions are used to reject instances of :<: such
+-- as @F :+: F :<: F@ or @F :+: (F :+: G) :<: F :+: G@.
+
+data SimpPos = SimpHere | SimpLeft SimpPos | SimpRight SimpPos
+
+data Res = CompPos SimpPos Pos | SingPos SimpPos
+
+
+type family DestrPos (e :: Pos) :: Res where
+    DestrPos (GoLeft e) = ResLeft (DestrPos e)
+    DestrPos (GoRight e) = ResRight (DestrPos e)
+    DestrPos (Sum e1 e2) = ResSum (DestrPos e1) e2
+    DestrPos Here = SingPos SimpHere
+
+type family ResLeft (r :: Res) :: Res where
+    ResLeft (CompPos p e) = CompPos (SimpLeft p) (GoLeft e)
+    ResLeft (SingPos p) = SingPos (SimpLeft p)
+
+type family ResRight (r :: Res) :: Res where
+    ResRight (CompPos p e) = CompPos (SimpRight p) (GoRight e)
+    ResRight (SingPos p) = SingPos (SimpRight p)
+
+type family ResSum (r :: Res) (e :: Pos) :: Res where
+    ResSum (CompPos p e1) e2 = CompPos p (Sum e1 e2)
+    ResSum (SingPos p) e = CompPos p e
+
+type family Or x y where
+    Or x False = x
+    Or False y = y
+    Or x y  = True
+
+type family In (p :: SimpPos) (e :: Pos) :: Bool where
+    In SimpHere e = True
+    In p Here = True
+    In (SimpLeft p) (GoLeft e) = In p e
+    In (SimpRight p) (GoRight e) = In p e
+    In p (Sum e1 e2) = Or (In p e1)  (In p e2)
+    In p e = False
+
+type family Duplicates' (r :: Res) :: Bool where
+    Duplicates' (SingPos p) = False
+    Duplicates' (CompPos p e) = Or (In p e) (Duplicates' (DestrPos e))
+
+type family Duplicates (e :: Emb) where
+    Duplicates (Found p) = Duplicates' (DestrPos p)
+
+-- This class is used to produce more informative error messages
+class NoDup (b :: Bool) (f :: * -> *) (g :: * -> *)
+instance NoDup False f g
+
+inj_ :: EmbD e f g -> f a -> g a
+inj_ HereD x = x
+inj_ (GoLeftD e) x = Inl (inj_ e x)
+inj_ (GoRightD e) x = Inr (inj_ e x)
+inj_ (SumD e1 e2) x = case x of
+                        Inl y -> inj_ e1 y
+                        Inr y -> inj_ e2 y
+
+-- | The :<: constraint is a conjunction of two constraints. The first
+-- one is used to construct the evidence that is used to implement the
+-- injection and projection functions. The first constraint alone
+-- would allow instances such as @F :+: F :<: F@ or @F :+: (F :+: G)
+-- :<: F :+: G@ which have multiple occurrences of the same
+-- sub-signature on the left-hand side. Such instances are usually
+-- unintended and yield injection functions that are not
+-- injective. The second constraint excludes such instances.
+type f :<: g = (GetEmbD (GetEmb f g) f g, NoDup (Duplicates (GetEmb f g)) f g)
+
+inj :: forall f g a . (f :<: g) => f a -> g a
+inj = inj_ (getEmbD :: EmbD (GetEmb f g) f g)
+
+type f :=: g = (f :<: g, g :<: f) 
+
+
+proj_ :: EmbD e f g -> g a -> Maybe (f a)
+proj_ HereD x = Just x
+proj_ (GoLeftD p) x = case x of 
+                        Inl y -> proj_ p y
+                        _ -> Nothing
+proj_ (GoRightD p) x = case x of 
+                          Inr x -> proj_ p x
+                          _ -> Nothing
+proj_ (SumD p1 p2) x = case proj_ p1 x of
+                         Just y -> Just (Inl y)
+                         _ -> case proj_ p2 x of
+                                Just y -> Just (Inr y)
+                                _ -> Nothing
+
+
+proj :: forall f g a . (f :<: g) => g a -> Maybe (f a)
+proj = proj_ (getEmbD :: EmbD (GetEmb f g) f g)
+
+spl :: (f :<: f1 :+: f2) => (f1 a -> b) -> (f2 a -> b) -> f a -> b
+spl f1 f2 x = case inj x of 
+            Inl y -> f1 y
+            Inr y -> f2 y
+
+
 
 -- Products
 
diff --git a/src/Data/Comp/Param.hs b/src/Data/Comp/Param.hs
deleted file mode 100644
--- a/src/Data/Comp/Param.hs
+++ /dev/null
@@ -1,32 +0,0 @@
---------------------------------------------------------------------------------
--- |
--- Module      :  Data.Comp.Param
--- Copyright   :  (c) 2011 Patrick Bahr, Tom Hvitved
--- License     :  BSD3
--- Maintainer  :  Patrick Bahr <paba@diku.dk>, Tom Hvitved <hvitved@diku.dk>
--- Stability   :  experimental
--- Portability :  non-portable (GHC Extensions)
---
--- This module defines the infrastructure necessary to use
--- /Parametric Compositional Data Types/. Parametric Compositional Data Types 
--- is an extension of Compositional Data Types with parametric
--- higher-order abstract syntax (PHOAS) for usage with binders. Examples of
--- usage are bundled with the package in the library
--- @examples\/Examples\/Param@.
---
---------------------------------------------------------------------------------
-module Data.Comp.Param (
-    module Data.Comp.Param.Term
-  , module Data.Comp.Param.Algebra
-  , module Data.Comp.Param.Difunctor
-  , module Data.Comp.Param.Sum
-  , module Data.Comp.Param.Annotation
-  , module Data.Comp.Param.Equality
-    ) where
-
-import Data.Comp.Param.Term
-import Data.Comp.Param.Algebra
-import Data.Comp.Param.Difunctor
-import Data.Comp.Param.Sum
-import Data.Comp.Param.Annotation
-import Data.Comp.Param.Equality
diff --git a/src/Data/Comp/Param/Algebra.hs b/src/Data/Comp/Param/Algebra.hs
deleted file mode 100644
--- a/src/Data/Comp/Param/Algebra.hs
+++ /dev/null
@@ -1,962 +0,0 @@
-{-# LANGUAGE GADTs, Rank2Types, ScopedTypeVariables, TypeOperators,
-  FlexibleContexts, CPP #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Data.Comp.Param.Algebra
--- Copyright   :  (c) 2011 Patrick Bahr, Tom Hvitved
--- License     :  BSD3
--- Maintainer  :  Tom Hvitved <hvitved@diku.dk>
--- Stability   :  experimental
--- Portability :  non-portable (GHC Extensions)
---
--- This module defines the notion of algebras and catamorphisms, and their
--- generalizations to e.g. monadic versions and other (co)recursion schemes.
---
---------------------------------------------------------------------------------
-
-module Data.Comp.Param.Algebra (
-      -- * Algebras & Catamorphisms
-      Alg,
-      free,
-      cata,
-      cata',
-      appCxt,
-      
-      -- * Monadic Algebras & Catamorphisms
-      AlgM,
-      algM,
-      freeM,
-      cataM,
-      cataM',
-
-      -- * Term Homomorphisms
-      CxtFun,
-      SigFun,
-      Hom,
-      appHom,
-      appHom',
-      compHom,
-      appSigFun,
-      appSigFun',
-      compSigFun,
-      compHomSigFun,
-      compSigFunHom,
-      hom,
-      compAlg,
-      compAlgSigFun,
-
-      -- * Monadic Term Homomorphisms
-      CxtFunM,
-      SigFunM,
-      HomM,
-      SigFunMD,
-      HomMD,
-      sigFunM,
-      appHomM,
-      appTHomM,
-      appHomM',
-      appTHomM',
-      homM,
-      homMD,
-      appSigFunM,
-      appTSigFunM,
-      appSigFunM',
-      appTSigFunM',
-      appSigFunMD,
-      appTSigFunMD,
-      compHomM,
-      compHomM',
-      compSigFunM,
-      compSigFunHomM,
-      compSigFunHomM',
-      compAlgSigFunM,
-      compAlgSigFunM',
-      compAlgM,
-      compAlgM',
-
-      -- * Coalgebras & Anamorphisms
-      Coalg,
-      ana,
-      CoalgM,
-      anaM,
-
-      -- * R-Algebras & Paramorphisms
-      RAlg,
-      para,
-      RAlgM,
-      paraM,
-
-      -- * R-Coalgebras & Apomorphisms
-      RCoalg,
-      apo,
-      RCoalgM,
-      apoM,
-
-      -- * CV-Algebras & Histomorphisms
-      CVAlg,
-      histo,
-      CVAlgM,
-      histoM,
-
-      -- * CV-Coalgebras & Futumorphisms
-      CVCoalg,
-      futu,
-      CVCoalg',
-      futu',
-      CVCoalgM,
-      futuM
-    ) where
-
-import Prelude hiding (sequence, mapM)
-import Control.Monad hiding (sequence, mapM)
-import Data.Comp.Param.Term
-import Data.Comp.Param.Ops
-import Data.Comp.Param.Difunctor
-import Data.Comp.Param.Ditraversable
-
-{-| This type represents an algebra over a difunctor @f@ and carrier @a@. -}
-type Alg f a = f a a -> a
-
-
-{-| Construct a catamorphism for contexts over @f@ with holes of type @b@, from
-  the given algebra. -}
-free :: forall h f a b. Difunctor f
-        => Alg f a -> (b -> a) -> Cxt h f a b -> a
-free f g = run
-    where run :: Cxt h f a b -> a
-          run (In t) = f (difmap run t)
-          run (Hole x) = g x
-          run (Var p) = p
-
-{-| Construct a catamorphism from the given algebra. -}
-cata :: forall f a. Difunctor f => Alg f a -> Term f -> a 
-{-# NOINLINE [1] cata #-}
-cata f (Term t) = run t
-    where run :: Trm f a -> a
-          run (In t) = f (difmap run t)
-          run (Var x) = x
-
-{-| A generalisation of 'cata' from terms over @f@ to contexts over @f@, where
-  the holes have the type of the algebra carrier. -}
-cata' :: Difunctor f => Alg f a -> Cxt h f a a -> a
-{-# INLINE cata' #-}
-cata' f = free f id
-
-{-| This function applies a whole context into another context. -}
-appCxt :: Difunctor f => Context f a (Cxt h f a b) -> Cxt h f a b
-appCxt (In t) = In (difmap appCxt t)
-appCxt (Hole x) = x
-appCxt (Var p) = Var p
-
-{-| This type represents a monadic algebra. It is similar to 'Alg' but
-  the return type is monadic. -}
-type AlgM m f a = f a a -> m a
-
-{-| Convert a monadic algebra into an ordinary algebra with a monadic
-  carrier. -}
-algM :: (Ditraversable f, Monad m) => AlgM m f a -> Alg f (m a)
-algM f x = disequence (dimap return id x) >>= f
-
-{-| Construct a monadic catamorphism for contexts over @f@ with holes of type
-  @b@, from the given monadic algebra. -}
-freeM :: forall m h f a b. (Ditraversable f, Monad m)
-         => AlgM m f a -> (b -> m a) -> Cxt h f a b -> m a
-freeM f g = run
-    where run :: Cxt h f a b -> m a
-          run (In t) = f =<< dimapM run t
-          run (Hole x) = g x
-          run (Var p) = return p
-
-{-| Construct a monadic catamorphism from the given monadic algebra. -}
-cataM :: forall m f a. (Ditraversable f, Monad m) => AlgM m f a -> Term f -> m a
-{-# NOINLINE [1] cataM #-}
-cataM algm (Term t) = run t
-    where run :: Trm f a  -> m a
-          run (In t) = algm =<< dimapM run t
-          run (Var x) = return x
-
-{-| A generalisation of 'cataM' from terms over @f@ to contexts over @f@, where
-  the holes have the type of the monadic algebra carrier. -}
-cataM' :: forall m h f a. (Ditraversable f, Monad m)
-          => AlgM m f a -> Cxt h f a (m a) -> m a
-{-# NOINLINE [1] cataM' #-}
-cataM' f = freeM f id
-
-{-| This type represents a context function. -}
-type CxtFun f g = forall h a b. Cxt h f a b -> Cxt h g a b
-
-
-{-| This type represents a signature function. -}
-type SigFun f g = forall a b. f a b -> g a b
-
-{-| This type represents a term homomorphism. -}
-type Hom f g = SigFun f (Context g)
-
-{-| Apply a term homomorphism recursively to a term/context. -}
-appHom :: forall f g. (Difunctor f, Difunctor g) => Hom f g -> CxtFun f g
-{-# NOINLINE [1] appHom #-}
-appHom f = run where
-    run :: CxtFun f g
-    run (In t) = appCxt (f (difmap run t))
-    run (Hole x) = Hole x
-    run (Var p) = Var p
-
-{-| Apply a term homomorphism recursively to a term/context. -}
-appHom' :: forall f g. (Difunctor g) => Hom f g -> CxtFun f g
-{-# NOINLINE [1] appHom' #-}
-appHom' f = run where
-    run :: CxtFun f g
-    run (In t) = appCxt (fmapCxt run (f t))
-    run (Hole x) = Hole x
-    run (Var p) = Var p
-
-fmapCxt :: Difunctor f => (b -> b') -> Cxt h f a b -> Cxt h f a b'
-fmapCxt f = run
-    where run (In t) = In $ difmap run t
-          run (Var a) = Var a
-          run (Hole b)  = Hole $ f b
-
-{-| Compose two term homomorphisms. -}
-compHom :: (Difunctor g, Difunctor h)
-               => Hom g h -> Hom f g -> Hom f h
-compHom f g = appHom f . g
-
-
-{-| Compose an algebra with a term homomorphism to get a new algebra. -}
-compAlg :: (Difunctor f, Difunctor g) => Alg g a -> Hom f g -> Alg f a
-compAlg alg talg = cata' alg . talg
-
-compAlgSigFun  :: Alg g a -> SigFun f g -> Alg f a
-compAlgSigFun alg sig = alg . sig
-
-
-{-| This function applies a signature function to the given context. -}
-appSigFun :: forall f g. (Difunctor f) => SigFun f g -> CxtFun f g
-{-# NOINLINE [1] appSigFun #-}
-appSigFun f = run
-    where run (In t) = In $ f $ difmap run t
-          run (Var x) = Var x
-          run (Hole x) = Hole x
--- implementation via term homomorphisms
---  appSigFun f = appHom $ hom f
-
-
--- | This function applies a signature function to the given
--- context. This is a top-bottom variant of 'appSigFun'.
-appSigFun' :: forall f g. (Difunctor g) => SigFun f g -> CxtFun f g
-{-# NOINLINE [1] appSigFun' #-}
-appSigFun' f = run
-    where run (In t) = In $ difmap run $ f t
-          run (Var x) = Var x
-          run (Hole x) = Hole x
-
-{-| This function composes two signature functions. -}
-compSigFun :: SigFun g h -> SigFun f g -> SigFun f h
-compSigFun f g = f . g
-
-{-| This function composes a term homomorphism and a signature function. -}
-compHomSigFun :: Hom g h -> SigFun f g -> Hom f h
-compHomSigFun f g = f . g
-
-{-| This function composes a term homomorphism and a signature function. -}
-compSigFunHom :: (Difunctor g) => SigFun g h -> Hom f g -> Hom f h
-compSigFunHom f g = appSigFun f . g
-
-
-{-| Lifts the given signature function to the canonical term homomorphism. -}
-hom :: Difunctor g => SigFun f g -> Hom f g
-hom f = simpCxt . f
-
-{-| This type represents a monadic signature function. -}
-type SigFunM m f g = forall a b. f a b -> m (g a b)
-
-{-| This type represents a monadic context function. -}
-type CxtFunM m f g = forall h . SigFunM m (Cxt h f) (Cxt h g)
-
-{-| This type represents a monadic signature function. It is similar to
-  'SigFunM' but has monadic values also in the domain. -}
-type SigFunMD m f g = forall a b. f a (m b) -> m (g a b)
-
-{-| This type represents a monadic term homomorphism. -}
-type HomM m f g = SigFunM m f (Context g)
-
-{-| This type represents a monadic term homomorphism. It is similar to
-  'HomM' but has monadic values also in the domain. -}
-type HomMD m f g = SigFunMD m f (Context g)
-
-{-| Lift the given signature function to a monadic signature function. Note that
-  term homomorphisms are instances of signature functions. Hence this function
-  also applies to term homomorphisms. -}
-sigFunM :: Monad m => SigFun f g -> SigFunM m f g
-sigFunM f = return . f
-
-{-| Lift the given signature function to a monadic term homomorphism. -}
-homM :: (Difunctor g, Monad m) => SigFunM m f g -> HomM m f g
-homM f = liftM simpCxt . f
-
--- | Apply a monadic term homomorphism recursively to a
--- term/context. The monad is sequenced bottom-up.
-appHomM :: forall f g m. (Ditraversable f, Difunctor g, Monad m)
-           => HomM m f g -> CxtFunM m f g
-{-# NOINLINE [1] appHomM #-}
-appHomM f = run
-    where run :: CxtFunM m f g
-          run (In t) = liftM appCxt . f =<< dimapM run t
-          run (Hole x) = return (Hole x)
-          run (Var p) = return (Var p)
-
-{-| A restricted form of |appHomM| which only works for terms. -}
-appTHomM :: (Ditraversable f, ParamFunctor m, Monad m, Difunctor g)
-            => HomM m f g -> Term f -> m (Term g)
-appTHomM f (Term t) = termM (appHomM f t)
-
-
--- | Apply a monadic term homomorphism recursively to a
--- term/context. The monad is sequence top-down.
-appHomM' :: forall f g m. (Ditraversable g, Monad m)
-            => HomM m f g -> CxtFunM m f g
-appHomM' f = run
-    where run :: CxtFunM m f g
-          run (In t)  = liftM appCxt . dimapMCxt run =<< f t
-          run (Var p) = return (Var p)
-          run (Hole x) = return (Hole x)
-
-dimapMCxt :: (Ditraversable f, Monad m)
-             => (b -> m b') -> Cxt h f a b -> m (Cxt h f a b')
-dimapMCxt f = run
-              where run (In t) = liftM In $ dimapM run t
-                    run (Var a)  = return $ Var a
-                    run (Hole b) = liftM Hole (f b)
-
-{-| A restricted form of |appHomM'| which only works for terms. -}
-appTHomM' :: (Ditraversable g, ParamFunctor m, Monad m, Difunctor g)
-             => HomM m f g -> Term f -> m (Term g)
-appTHomM' f (Term t) = termM (appHomM' f t)
-            
-
-{-| This function constructs the unique monadic homomorphism from the
-  initial term algebra to the given term algebra. -}
-homMD :: forall f g m. (Difunctor f, Difunctor g, Monad m)
-         => HomMD m f g -> CxtFunM m f g
-homMD f = run 
-    where run :: CxtFunM m f g
-          run (In t) = liftM appCxt (f (difmap run t))
-          run (Hole x) = return (Hole x)
-          run (Var p) = return (Var p)
-
-{-| This function applies a monadic signature function to the given context. -}
-appSigFunM :: forall m f g. (Ditraversable f, Monad m)
-              => SigFunM m f g -> CxtFunM m f g
-appSigFunM f = run
-    where run :: CxtFunM m f g
-          run (In t) = liftM In . f =<< dimapM run t
-          run (Var x) = return $ Var x
-          run (Hole x) = return $ Hole x
--- implementation via term homomorphisms
---  appSigFunM f = appHomM $ hom' f
-
-{-| A restricted form of |appSigFunM| which only works for terms. -}
-appTSigFunM :: (Ditraversable f, ParamFunctor m, Monad m, Difunctor g)
-               => SigFunM m f g -> Term f -> m (Term g)
-appTSigFunM f (Term t) = termM (appSigFunM f t)
-
--- | This function applies a monadic signature function to the given
--- context. This is a 'top-down variant of 'appSigFunM'.
-appSigFunM' :: forall m f g. (Ditraversable g, Monad m)
-               => SigFunM m f g -> CxtFunM m f g
-appSigFunM' f = run
-    where run :: CxtFunM m f g
-          run (In t) = liftM In . dimapM run =<< f t
-          run (Var x) = return $ Var x
-          run (Hole x) = return $ Hole x
-
-{-| A restricted form of |appSigFunM'| which only works for terms. -}
-appTSigFunM' :: (Ditraversable g, ParamFunctor m, Monad m, Difunctor g)
-                => SigFunM m f g -> Term f -> m (Term g)
-appTSigFunM' f (Term t) = termM (appSigFunM' f t)
-
-{-| This function applies a signature function to the given context. -}
-appSigFunMD :: forall f g m. (Ditraversable f, Difunctor g, Monad m)
-               => SigFunMD m f g -> CxtFunM m f g
-appSigFunMD f = run 
-    where run :: CxtFunM m f g
-          run (In t) = liftM In (f (difmap run t))
-          run (Hole x) = return (Hole x)
-          run (Var p) = return (Var p)
-
-{-| A restricted form of |appSigFunMD| which only works for terms. -}
-appTSigFunMD :: (Ditraversable f, ParamFunctor m, Monad m, Difunctor g)
-                => SigFunMD m f g -> Term f -> m (Term g)
-appTSigFunMD f (Term t) = termM (appSigFunMD f t)
-
-{-| Compose two monadic term homomorphisms. -}
-compHomM :: (Ditraversable g, Difunctor h, Monad m)
-            => HomM m g h -> HomM m f g -> HomM m f h
-compHomM f g = appHomM f <=< g
-
-{-| Compose two monadic term homomorphisms. -}
-compHomM' :: (Ditraversable h, Monad m) => HomM m g h -> HomM m f g -> HomM m f h
-compHomM' f g = appHomM' f <=< g
-
-{-{-| Compose two monadic term homomorphisms. -}
-compHomM_ :: (Difunctor h, Difunctor g, Monad m)
-                => Hom g h -> HomM m f g -> HomM m f h
-compHomM_ f g = liftM (appHom f) . g
-
-{-| Compose two monadic term homomorphisms. -}
-compHomSigFunM :: Monad m => HomM m g h -> SigFunM m f g -> HomM m f h
-compHomSigFunM f g = f <=< g-}
-
-{-| Compose two monadic term homomorphisms. -}
-compSigFunHomM :: (Ditraversable g, Monad m)
-                  => SigFunM m g h -> HomM m f g -> HomM m f h
-compSigFunHomM f g = appSigFunM f <=< g
-
-{-| Compose two monadic term homomorphisms. -}
-compSigFunHomM' :: (Ditraversable h, Monad m)
-                   => SigFunM m g h -> HomM m f g -> HomM m f h
-compSigFunHomM' f g = appSigFunM' f <=< g
-
-{-| Compose a monadic algebra with a monadic term homomorphism to get a new
-  monadic algebra. -}
-compAlgM :: (Ditraversable g, Monad m) => AlgM m g a -> HomM m f g -> AlgM m f a
-compAlgM alg talg = freeM alg return <=< talg
-
-
-{-| Compose a monadic algebra with a term homomorphism to get a new monadic
-  algebra. -}
-compAlgM' :: (Ditraversable g, Monad m) => AlgM m g a -> Hom f g -> AlgM m f a
-compAlgM' alg talg = freeM alg return . talg
-
-{-| Compose a monadic algebra with a monadic signature function to get a new
-  monadic algebra. -}
-compAlgSigFunM :: Monad m => AlgM m g a -> SigFunM m f g -> AlgM m f a
-compAlgSigFunM alg talg = alg <=< talg
-
-
-{-| Compose a monadic algebra with a signature function to get a new monadic
-  algebra. -}
-compAlgSigFunM' :: AlgM m g a -> SigFun f g -> AlgM m f a
-compAlgSigFunM' alg talg = alg . talg
-
-{-| This function composes two monadic signature functions. -}
-compSigFunM :: Monad m => SigFunM m g h -> SigFunM m f g -> SigFunM m f h
-compSigFunM f g = f <=< g
-
-
-----------------
--- Coalgebras --
-----------------
-
-{-| This type represents a coalgebra over a difunctor @f@ and carrier @a@. The
-  list of @(a,b)@s represent the parameters that may occur in the constructed
-  value. The first component represents the seed of the parameter,
-  and the second component is the (polymorphic) parameter itself. If @f@ is
-  itself a binder, then the parameters bound by @f@ can be passed to the
-  covariant argument, thereby making them available to sub terms. -}
-type Coalg f a = forall b. a -> [(a,b)] -> Either b (f b (a,[(a,b)]))
-
-{-| Construct an anamorphism from the given coalgebra. -}
-ana :: Difunctor f => Coalg f a -> a -> Term f
-ana f x = Term $ anaAux f x
-    where anaAux :: Difunctor f => Coalg f a -> a -> (forall a. Trm f a)
-          anaAux f x = run (x,[])
-              where run (a,bs) = case f a bs of
-                                   Left p -> Var p
-                                   Right t -> In $ difmap run t
-
-{-| This type represents a monadic coalgebra over a difunctor @f@ and carrier
-  @a@. -}
-type CoalgM m f a = forall b. a -> [(a,b)] -> m (Either b (f b (a,[(a,b)])))
-
-{-| Construct a monadic anamorphism from the given monadic coalgebra. -}
-anaM :: forall a m f. (Ditraversable f, Monad m)
-     => CoalgM m f a -> a -> forall a. m (Trm f a)
-anaM f x = run (x,[])
-    where run (a,bs) = do c <- f a bs
-                          case c of
-                            Left p -> return $ Var p
-                            Right t -> liftM In $ dimapM run t
-
-
---------------------------------
--- R-Algebras & Paramorphisms --
---------------------------------
-
-{-| This type represents an r-algebra over a difunctor @f@ and carrier @a@. -}
-type RAlg f a = f a (Trm f a, a) -> a
-
-{-| Construct a paramorphism from the given r-algebra. -}
-para :: forall f a. Difunctor f => RAlg f a -> Term f -> a
-para f (Term t) = run t
-    where run :: Trm f a -> a
-          run (In t) = f $ difmap (\x -> (x, run x)) t
-          run (Var x) = x
-
-{-| This type represents a monadic r-algebra over a difunctor @f@ and carrier
-  @a@. -}
-type RAlgM m f a = f a (Trm f a, a) -> m a
-{-| Construct a monadic paramorphism from the given monadic r-algebra. -}
-paraM :: forall m f a. (Ditraversable f, Monad m) => RAlgM m f a -> Term f -> m a
-paraM f (Term t) = run t
-    where run :: Trm f a -> m a
-          run (In t) = f =<< dimapM (\x -> run x >>= \y -> return (x, y)) t
-          run (Var x) = return x
-
-
---------------------------------
--- R-Coalgebras & Apomorphisms --
---------------------------------
-
-{-| This type represents an r-coalgebra over a difunctor @f@ and carrier @a@. -}
-type RCoalg f a = forall b. a -> [(a,b)] -> Either b (f b (Either (Trm f b) (a,[(a,b)])))
-
-{-| Construct an apomorphism from the given r-coalgebra. -}
-apo :: Difunctor f => RCoalg f a -> a -> Term f
-apo f x = Term (apoAux f x)
-    where apoAux :: Difunctor f => RCoalg f a -> a -> (forall a. Trm f a)
-          apoAux coa x = run (x,[])
-              where -- run :: (a,[(a,b)]) -> Trm f b
-                run (a,bs) = case coa a bs of
-                               Left x -> Var x
-                               Right t -> In $ difmap run' t
-                -- run' :: Either (Trm f b) (a,[(a,b)]) -> Trm f b
-                run' (Left t) = t
-                run' (Right x) = run x
-
-
-
-{-| This type represents a monadic r-coalgebra over a functor @f@ and carrier
-  @a@. -}
-type RCoalgM m f a = forall b. a -> [(a,b)] -> m (Either b (f b (Either (Trm f b) (a,[(a,b)]))))
-
-{-| Construct a monadic apomorphism from the given monadic r-coalgebra. -}
-apoM :: forall f m a. (Ditraversable f, Monad m)
-        => RCoalgM m f a -> a -> forall a. m (Trm f a)
-apoM coa x = run (x,[]) 
-    where run (a,bs) = do
-            res <- coa a bs
-            case res of
-              Left x -> return $ Var x
-              Right t -> liftM In $ dimapM run' t
-          run' (Left t) = return t
-          run' (Right x) = run x
-
-
-----------------------------------
--- CV-Algebras & Histomorphisms --
-----------------------------------
-
-{-| This type represents a cv-algebra over a difunctor @f@ and carrier @a@. -}
-type CVAlg f a f' = f a (Trm f' a) -> a
-
--- | This function applies 'projectA' at the tip of the term.
-projectTip  :: DistAnn f a f' => Trm f' a -> a
-projectTip (In v) = snd $ projectA v
-projectTip (Var p) = p
-
-{-| Construct a histomorphism from the given cv-algebra. -}
-histo :: forall f f' a. (Difunctor f, DistAnn f a f')
-         => CVAlg f a f' -> Term f -> a
-histo alg = projectTip . cata run
-    where run :: Alg f (Trm f' a)
-          run v = In $ injectA (alg v') v'
-              where v' = dimap Var id v
-
-{-| This type represents a monadic cv-algebra over a functor @f@ and carrier
-  @a@. -}
-type CVAlgM m f a f' = f a (Trm f' a) -> m a
-
-{-| Construct a monadic histomorphism from the given monadic cv-algebra. -}
-histoM :: forall f f' m a. (Ditraversable f, Monad m, DistAnn f a f')
-          => CVAlgM m f a f' -> Term f -> m a
-histoM alg (Term t) = liftM projectTip (run t)
-    where run :: Trm f a -> m (Trm f' a)
-          run (In t) = do t' <- dimapM run t
-                          r <- alg t'
-                          return $ In $ injectA r t'
-          run (Var p) = return $ Var p
-
-
------------------------------------
--- CV-Coalgebras & Futumorphisms --
------------------------------------
-
-{-| This type represents a cv-coalgebra over a difunctor @f@ and carrier @a@.
-  The list of @(a,b)@s represent the parameters that may occur in the
-  constructed value. The first component represents the seed of the parameter,
-  and the second component is the (polymorphic) parameter itself. If @f@ is
-  itself a binder, then the parameters bound by @f@ can be passed to the
-  covariant argument, thereby making them available to sub terms. -}
-type CVCoalg f a = forall b. a -> [(a,b)]
-                 -> Either b (f b (Context f b (a,[(a,b)])))
-
-{-| Construct a futumorphism from the given cv-coalgebra. -}
-futu :: Difunctor f => CVCoalg f a -> a -> Term f
-futu f x = Term (futuAux f x)
-    where futuAux :: Difunctor f => CVCoalg f a -> a -> (forall a. Trm f a)
-          futuAux coa x = run (x,[])
-              where run (a,bs) = case coa a bs of
-                                   Left p -> Var p
-                                   Right t -> In $ difmap run' t
-                    run' (In t) = In $ difmap run' t
-                    run' (Hole x) = run x
-                    run' (Var p) = Var p
-
-{-| This type represents a monadic cv-coalgebra over a difunctor @f@ and carrier
-  @a@. -}
-type CVCoalgM m f a = forall b. a -> [(a,b)]
-                    -> m (Either b (f b (Context f b (a,[(a,b)]))))
-
-{-| Construct a monadic futumorphism from the given monadic cv-coalgebra. -}
-futuM :: forall f a m. (Ditraversable f, Monad m) =>
-         CVCoalgM m f a -> a -> forall a. m (Trm f a)
-futuM coa x = run (x,[])
-    where run (a,bs) = do c <- coa a bs
-                          case c of 
-                            Left p -> return $ Var p
-                            Right t -> liftM In $ dimapM run' t
-          run' (In t) = liftM In $ dimapM run' t
-          run' (Hole x) = run x
-          run' (Var p) = return $ Var p
-
-{-| This type represents a generalised cv-coalgebra over a difunctor @f@ and
-  carrier @a@. -}
-type CVCoalg' f a = forall b. a -> [(a,b)] -> Context f b (a,[(a,b)])
-
-{-| Construct a futumorphism from the given generalised cv-coalgebra. -}
-futu' :: Difunctor f => CVCoalg' f a -> a -> Term f
-futu' f x = Term (futuAux' f x)
-    where futuAux' :: Difunctor f => CVCoalg' f a -> a -> (forall a. Trm f a)
-          futuAux' coa x = run (x,[])
-              where run (a,bs) = run' $ coa a bs
-                    run' (In t) = In $ difmap run' t
-                    run' (Hole x) = run x
-                    run' (Var p) = Var p
-
-{--------------------------------------------
--- functions only used for rewrite rules --
--------------------------------------------
-
-appAlgHom :: forall f g d. Difunctor g => Alg g d -> Hom f g -> Term f -> d
-{-# NOINLINE [1] appAlgHom #-}
-appAlgHom alg hom (Term t) = run t where
-    run :: Trm f d -> d
-    run (In t) = run' $ hom t
-    run (Var a) = a
-    run' :: Context g d (Trm f d) -> d
-    run' (In t) = alg $ fmap run' t
-    run' (Var a) = a
-    run' (Hole x) = run x
-
-
--- | This function applies a signature function after a term homomorphism.
-appSigFunHom :: forall f g h. (Difunctor g)
-                => SigFun g h -> Hom f g -> CxtFun f h
-{-# NOINLINE [1] appSigFunHom #-}
-appSigFunHom f g = run where
-    run :: CxtFun f h
-    run (In t) = run' $ g t
-    run (Var a) = Var a
-    run (Hole h) = Hole h
-    run' :: Context g a (Cxt h' f a b) -> Cxt h' h a b
-    run' (In t) = In $ f $ fmap run' t
-    run' (Var a) = Var a
-    run' (Hole h) = run h
-
-appAlgHomM :: forall m g f d. Ditraversable g
-              => AlgM m g d -> HomM m f g -> Term f -> m d
-appAlgHomM alg hom (Term t) = run t where
-    run :: Trm f d -> m d
-    run (In t) = run' =<< hom t
-    run (Var a) = return a
-    run' :: Context g d (Trm f d) -> m d
-    run' (In t) = alg =<< dimapM run' t
-    run' (Var a) = return a
-    run' (Hole x) = run x
-
-appHomHomM :: forall m f g h. (Ditraversable g, Difunctor h)
-              => HomM m g h -> HomM m f g -> CxtFunM m f h
-appHomHomM f g = run where
---    run :: CxtFunM m f h
-    run (In t) = run' =<< g t
-    run (Var a) = return $ Var a
-    run (Hole h) = return $ Hole h
---    run' :: Context g Any (Cxt h' f Any b) -> m (Cxt h' h Any b)
-    run' (In t) = liftM appCxt $ f =<< dimapM run' t
-    run' (Var a) = return $ Var a
-    run' (Hole h) = run h
-
-appSigFunHomM :: forall m f g h. Ditraversable g
-                 => SigFunM m g h -> HomM m f g -> CxtFunM m f h
-appSigFunHomM f g = run where
---    run :: CxtFunM m f h
-    run (In t) = run' =<< g t
-    run (Var a) = return $ Var a
-    run (Hole h) = return $ Hole h
---    run' :: Context g Any (Cxt h' f Any b) -> m (Cxt h' h Any b)
-    run' (In t) = liftM In $ f =<< dimapM run' t
-    run' (Var a) = return $ Var a
-    run' (Hole h) = run h
-
-
--------------------
--- rewrite rules --
--------------------
-
-#ifndef NO_RULES
-{-# RULES
-  "cata/appHom" forall (a :: Alg g d) (h :: Hom f g) x.
-    cata a (appHom h x) = cata (compAlg a h) x;
-
-  "cata/appHom'" forall (a :: Alg g d) (h :: Hom f g) x.
-    cata a (appHom' h x) = appAlgHom a h x;
-
-  "cata/appSigFun" forall (a :: Alg g d) (h :: SigFun f g) x.
-    cata a (appSigFun h x) = cata (compAlgSigFun a h) x;
-
-  "cata/appSigFun'" forall (a :: Alg g d) (h :: SigFun f g) x.
-    cata a (appSigFun' h x) = appAlgHom a (hom h) x;
-
-  "cata/appSigFunHom" forall (f :: Alg f3 d) (g :: SigFun f2 f3)
-                                      (h :: Hom f1 f2) x.
-    cata f (appSigFunHom g h x) = appAlgHom (compAlgSigFun f g) h x;
-
-  "appAlgHom/appHom" forall (a :: Alg h d) (f :: Hom f g) (h :: Hom g h) x.
-    appAlgHom a h (appHom f x) = cata (compAlg a (compHom h f)) x;
-
-  "appAlgHom/appHom'" forall (a :: Alg h d) (f :: Hom f g) (h :: Hom g h) x.
-    appAlgHom a h (appHom' f x) = appAlgHom a (compHom h f) x;
-
-  "appAlgHom/appSigFun" forall (a :: Alg h d) (f :: SigFun f g) (h :: Hom g h) x.
-    appAlgHom a h (appSigFun f x) = cata (compAlg a (compHomSigFun h f)) x;
-
-  "appAlgHom/appSigFun'" forall (a :: Alg h d) (f :: SigFun f g) (h :: Hom g h) x.
-    appAlgHom a h (appSigFun' f x) = appAlgHom a (compHomSigFun h f) x;
-
-  "appAlgHom/appSigFunHom" forall (a :: Alg i d) (f :: Hom f g) (g :: SigFun g h)
-                                          (h :: Hom h i) x.
-    appAlgHom a h (appSigFunHom g f x)
-      = appAlgHom a (compHom (compHomSigFun h g) f) x;
-
-  "appHom/appHom" forall (a :: Hom g h) (h :: Hom f g) x.
-    appHom a (appHom h x) = appHom (compHom a h) x;
-
-  "appHom'/appHom'" forall (a :: Hom g h) (h :: Hom f g) x.
-    appHom' a (appHom' h x) = appHom' (compHom a h) x;
-
-  "appHom'/appHom" forall (a :: Hom g h) (h :: Hom f g) x.
-    appHom' a (appHom h x) = appHom (compHom a h) x;
-
-  "appHom/appHom'" forall (a :: Hom g h) (h :: Hom f g) x.
-    appHom a (appHom' h x) = appHom' (compHom a h) x;
-    
-  "appSigFun/appSigFun" forall (f :: SigFun g h) (g :: SigFun f g) x.
-    appSigFun f (appSigFun g x) = appSigFun (compSigFun f g) x;
-
-  "appSigFun'/appSigFun'" forall (f :: SigFun g h) (g :: SigFun f g) x.
-    appSigFun' f (appSigFun' g x) = appSigFun' (compSigFun f g) x;
-
-  "appSigFun/appSigFun'" forall (f :: SigFun g h) (g :: SigFun f g) x.
-    appSigFun f (appSigFun' g x) = appSigFunHom f (hom g) x;
-
-  "appSigFun'/appSigFun" forall (f :: SigFun g h) (g :: SigFun f g) x.
-    appSigFun' f (appSigFun g x) = appSigFun (compSigFun f g) x;
-
-  "appHom/appSigFun" forall (f :: Hom g h) (g :: SigFun f g) x.
-    appHom f (appSigFun g x) = appHom (compHomSigFun f g) x;
-
-  "appHom/appSigFun'" forall (f :: Hom g h) (g :: SigFun f g) x.
-    appHom f (appSigFun' g x) =  appHom' (compHomSigFun f g) x;
-
-  "appHom'/appSigFun'" forall (f :: Hom g h) (g :: SigFun f g) x.
-    appHom' f (appSigFun' g x) =  appHom' (compHomSigFun f g) x;
-
-  "appHom'/appSigFun" forall (f :: Hom g h) (g :: SigFun f g) x.
-    appHom' f (appSigFun g x) = appHom (compHomSigFun f g) x;
-    
-  "appSigFun/appHom" forall (f :: SigFun g h) (g :: Hom f g) x.
-    appSigFun f (appHom g x) = appSigFunHom f g x;
-
-  "appSigFun'/appHom'" forall (f :: SigFun g h) (g :: Hom f g) x.
-    appSigFun' f (appHom' g x) = appHom' (compSigFunHom f g) x;
-
-  "appSigFun/appHom'" forall (f :: SigFun g h) (g :: Hom f g) x.
-    appSigFun f (appHom' g x) = appSigFunHom f g x;
-
-  "appSigFun'/appHom" forall (f :: SigFun g h) (g :: Hom f g) x.
-    appSigFun' f (appHom g x) = appHom (compSigFunHom f g) x;
-    
-  "appSigFunHom/appSigFun" forall (f :: SigFun f3 f4) (g :: Hom f2 f3)
-                                      (h :: SigFun f1 f2) x.
-    appSigFunHom f g (appSigFun h x)
-    = appSigFunHom f (compHomSigFun g h) x;
-
-  "appSigFunHom/appSigFun'" forall (f :: SigFun f3 f4) (g :: Hom f2 f3)
-                                      (h :: SigFun f1 f2) x.
-    appSigFunHom f g (appSigFun' h x)
-    = appSigFunHom f (compHomSigFun g h) x;
-
-  "appSigFunHom/appHom" forall (f :: SigFun f3 f4) (g :: Hom f2 f3)
-                                      (h :: Hom f1 f2) x.
-    appSigFunHom f g (appHom h x)
-    = appSigFunHom f (compHom g h) x;
-
-  "appSigFunHom/appHom'" forall (f :: SigFun f3 f4) (g :: Hom f2 f3)
-                                      (h :: Hom f1 f2) x.
-    appSigFunHom f g (appHom' h x)
-    = appSigFunHom f (compHom g h) x;
-
-  "appSigFun/appSigFunHom" forall (f :: SigFun f3 f4) (g :: SigFun f2 f3)
-                                      (h :: Hom f1 f2) x.
-    appSigFun f (appSigFunHom g h x) = appSigFunHom (compSigFun f g) h x;
-
-  "appSigFun'/appSigFunHom" forall (f :: SigFun f3 f4) (g :: SigFun f2 f3)
-                                      (h :: Hom f1 f2) x.
-    appSigFun' f (appSigFunHom g h x) = appSigFunHom (compSigFun f g) h x;
-
-  "appHom/appSigFunHom" forall (f :: Hom f3 f4) (g :: SigFun f2 f3)
-                                      (h :: Hom f1 f2) x.
-    appHom f (appSigFunHom g h x) = appHom' (compHom (compHomSigFun f g) h) x;
-
-  "appHom'/appSigFunHom" forall (f :: Hom f3 f4) (g :: SigFun f2 f3)
-                                      (h :: Hom f1 f2) x.
-    appHom' f (appSigFunHom g h x) = appHom' (compHom (compHomSigFun f g) h) x;
-
-  "appSigFunHom/appSigFunHom" forall (f1 :: SigFun f4 f5) (f2 :: Hom f3 f4)
-                                             (f3 :: SigFun f2 f3) (f4 :: Hom f1 f2) x.
-    appSigFunHom f1 f2 (appSigFunHom f3 f4 x)
-      = appSigFunHom f1 (compHom (compHomSigFun f2 f3) f4) x; #-}
-
-{-# RULES 
-  "cataM/appHomM" forall (a :: AlgM Maybe g d) (h :: HomM Maybe f g) x.
-     appHomM h x >>= cataM a =  appAlgHomM a h x;
-
-  "cataM/appHomM'" forall (a :: AlgM Maybe g d) (h :: HomM Maybe f g) x.
-     appHomM' h x >>= cataM a = appAlgHomM a h x;
-
-  "cataM/appSigFunM" forall (a :: AlgM Maybe g d) (h :: SigFunM Maybe f g) x.
-     appSigFunM h x >>= cataM a = appAlgHomM a (homM h) x;
-
-  "cataM/appSigFunM'" forall (a :: AlgM Maybe g d) (h :: SigFunM Maybe f g) x.
-     appSigFunM' h x >>= cataM a = appAlgHomM a (homM h) x;
-
-  "cataM/appHom" forall (a :: AlgM m g d) (h :: Hom f g) x.
-     cataM a (appHom h x) = appAlgHomM a (sigFunM h) x;
-
-  "cataM/appHom'" forall (a :: AlgM m g d) (h :: Hom f g) x.
-     cataM a (appHom' h x) = appAlgHomM a (sigFunM h) x;
-
-  "cataM/appSigFun" forall (a :: AlgM m g d) (h :: SigFun f g) x.
-     cataM a (appSigFun h x) = appAlgHomM a (sigFunM $ hom h) x;
-
-  "cataM/appSigFun'" forall (a :: AlgM m g d) (h :: SigFun f g) x.
-     cataM a (appSigFun' h x) = appAlgHomM a (sigFunM $ hom h) x;
-
-  "cataM/appSigFun" forall (a :: AlgM m g d) (h :: SigFun f g) x.
-     cataM a (appSigFun h x) = appAlgHomM a (sigFunM $ hom h) x;
-
-  "cataM/appSigFunHom" forall (a :: AlgM m h d) (g :: SigFun g h) (f :: Hom f g) x.
-     cataM a (appSigFunHom g f x) = appAlgHomM a (sigFunM $ compSigFunHom g f) x;
-
-  "appHomM/appHomM" forall (a :: HomM Maybe g h) (h :: HomM Maybe f g) x.
-     appHomM h x >>= appHomM a = appHomM (compHomM a h) x;
-
-  "appHomM/appSigFunM" forall (a :: HomM Maybe g h) (h :: SigFunM Maybe f g) x.
-     appSigFunM h x >>= appHomM a = appHomM (compHomSigFunM a h) x;
-
-  "appHomM/appHomM'" forall (a :: HomM Maybe g h) (h :: HomM Maybe f g) x.
-     appHomM' h x >>= appHomM a = appHomHomM a h x;
-
-  "appHomM/appSigFunM'" forall (a :: HomM Maybe g h) (h :: SigFunM Maybe f g) x.
-     appSigFunM' h x >>= appHomM a = appHomHomM a (homM h) x;
-
-  "appHomM'/appHomM" forall (a :: HomM Maybe g h) (h :: HomM Maybe f g) x.
-     appHomM h x >>= appHomM' a = appHomM' (compHomM' a h) x;
-
-  "appHomM'/appSigFunM" forall (a :: HomM Maybe g h) (h :: SigFunM Maybe f g) x.
-     appSigFunM h x >>= appHomM' a = appHomM' (compHomSigFunM a h) x;
-
-  "appHomM'/appHomM'" forall (a :: HomM Maybe g h) (h :: HomM Maybe f g) x.
-     appHomM' h x >>= appHomM' a = appHomM' (compHomM' a h) x;
-
-  "appHomM'/appSigFunM'" forall (a :: HomM Maybe g h) (h :: SigFunM Maybe f g) x.
-     appSigFunM' h x >>= appHomM' a = appHomM' (compHomSigFunM a h) x;
-
-  "appHomM/appHom" forall (a :: HomM m g h) (h :: Hom f g) x.
-     appHomM a (appHom h x) = appHomHomM a (sigFunM h) x;
-
-  "appHomM/appSigFun" forall (a :: HomM m g h) (h :: SigFun f g) x.
-     appHomM a (appSigFun h x) = appHomHomM a (sigFunM $ hom h) x;
-
-  "appHomM'/appHom" forall (a :: HomM m g h) (h :: Hom f g) x.
-     appHomM' a (appHom h x) = appHomM' (compHomM' a (sigFunM h)) x;
-
-  "appHomM'/appSigFun" forall (a :: HomM m g h) (h :: SigFun f g) x.
-     appHomM' a (appSigFun h x) = appHomM' (compHomSigFunM a (sigFunM h)) x;
-
-  "appHomM/appHom'" forall (a :: HomM m g h) (h :: Hom f g) x.
-     appHomM a (appHom' h x) = appHomHomM a (sigFunM h) x;
-
-  "appHomM/appSigFun'" forall (a :: HomM m g h) (h :: SigFun f g) x.
-     appHomM a (appSigFun' h x) = appHomHomM a (sigFunM $ hom h) x;
-
-  "appHomM'/appHom'" forall (a :: HomM m g h) (h :: Hom f g) x.
-     appHomM' a (appHom' h x) = appHomM' (compHomM' a (sigFunM h)) x;
-
-  "appHomM'/appSigFun'" forall (a :: HomM m g h) (h :: SigFun f g) x.
-     appHomM' a (appSigFun' h x) = appHomM' (compHomSigFunM a (sigFunM h)) x;
-
-  "appSigFunM/appHomM" forall (a :: SigFunM Maybe g h) (h :: HomM Maybe f g) x.
-     appHomM h x >>= appSigFunM a = appSigFunHomM a h x;
-
-  "appSigFunHomM/appSigFunM" forall (a :: SigFunM Maybe g h) (h :: SigFunM Maybe f g) x.
-     appSigFunM h x >>= appSigFunM a = appSigFunM (compSigFunM a h) x;
-
-  "appSigFunM/appHomM'" forall (a :: SigFunM Maybe g h) (h :: HomM Maybe f g) x.
-     appHomM' h x >>= appSigFunM a = appSigFunHomM a h x;
-
-  "appSigFunM/appSigFunM'" forall (a :: SigFunM Maybe g h) (h :: SigFunM Maybe f g) x.
-     appSigFunM' h x >>= appSigFunM a = appSigFunHomM a (homM h) x;
-
-  "appSigFunM'/appHomM" forall (a :: SigFunM Maybe g h) (h :: HomM Maybe f g) x.
-     appHomM h x >>= appSigFunM' a = appHomM' (compSigFunHomM' a h) x;
-
-  "appSigFunM'/appSigFunM" forall (a :: SigFunM Maybe g h) (h :: SigFunM Maybe f g) x.
-     appSigFunM h x >>= appSigFunM' a = appSigFunM' (compSigFunM a h) x;
-
-  "appSigFunM'/appHomM'" forall (a :: SigFunM Maybe g h) (h :: HomM Maybe f g) x.
-     appHomM' h x >>= appSigFunM' a = appHomM' (compSigFunHomM' a h) x;
-
-  "appSigFunM'/appSigFunM'" forall (a :: SigFunM Maybe g h) (h :: SigFunM Maybe f g) x.
-     appSigFunM' h x >>= appSigFunM' a = appSigFunM' (compSigFunM a h) x;
-
-  "appSigFunM/appHom" forall (a :: SigFunM m g h) (h :: Hom f g) x.
-     appSigFunM a (appHom h x) = appSigFunHomM a (sigFunM h) x;
-
-  "appSigFunM/appSigFun" forall (a :: SigFunM m g h) (h :: SigFun f g) x.
-     appSigFunM a (appSigFun h x) = appSigFunHomM a (sigFunM $ hom h) x;
-
-  "appSigFunM'/appHom" forall (a :: SigFunM m g h) (h :: Hom f g) x.
-     appSigFunM' a (appHom h x) = appHomM' (compSigFunHomM' a (sigFunM h)) x;
-
-  "appSigFunM'/appSigFun" forall (a :: SigFunM m g h) (h :: SigFun f g) x.
-     appSigFunM' a (appSigFun h x) = appSigFunM' (compSigFunM a (sigFunM h)) x;
-
-  "appSigFunM/appHom'" forall (a :: SigFunM m g h) (h :: Hom f g) x.
-     appSigFunM a (appHom' h x) = appSigFunHomM a (sigFunM h) x;
-
-  "appSigFunM/appSigFun'" forall (a :: SigFunM m g h) (h :: SigFun f g) x.
-     appSigFunM a (appSigFun' h x) = appSigFunHomM a (sigFunM $ hom h) x;
-
-  "appSigFunM'/appHom'" forall (a :: SigFunM m g h) (h :: Hom f g) x.
-     appSigFunM' a (appHom' h x) = appHomM' (compSigFunHomM' a (sigFunM h)) x;
-
-  "appSigFunM'/appSigFun'" forall (a :: SigFunM m g h) (h :: SigFun f g) x.
-     appSigFunM' a (appSigFun' h x) = appSigFunM' (compSigFunM a (sigFunM h)) x;
-
-
-  "appHom/appHomM" forall (a :: Hom g h) (h :: HomM m f g) x.
-     appHomM h x >>= (return . appHom a) = appHomM (compHomM_ a h) x; #-}
-#endif
--}
diff --git a/src/Data/Comp/Param/Annotation.hs b/src/Data/Comp/Param/Annotation.hs
deleted file mode 100644
--- a/src/Data/Comp/Param/Annotation.hs
+++ /dev/null
@@ -1,79 +0,0 @@
-{-# LANGUAGE TypeOperators, MultiParamTypeClasses, FlexibleInstances,
-  UndecidableInstances, Rank2Types, GADTs, ScopedTypeVariables #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Data.Comp.Param.Annotation
--- Copyright   :  (c) 2010-2011 Patrick Bahr, Tom Hvitved
--- License     :  BSD3
--- Maintainer  :  Tom Hvitved <hvitved@diku.dk>
--- Stability   :  experimental
--- Portability :  non-portable (GHC Extensions)
---
--- This module defines annotations on signatures.
---
---------------------------------------------------------------------------------
-
-module Data.Comp.Param.Annotation
-    (
-     (:&:) (..),
-     (:*:) (..),
-     DistAnn (..),
-     RemA (..),
-     liftA,
-     liftA',
-     stripA,
-     propAnn,
-     propAnnM,
-     ann,
-     project'
-    ) where
-
-import Data.Comp.Param.Difunctor
-import Data.Comp.Param.Term
-import Data.Comp.Param.Sum
-import Data.Comp.Param.Ops
-import Data.Comp.Param.Algebra
-
-import Control.Monad
-
-{-| Transform a function with a domain constructed from a functor to a function
- with a domain constructed with the same functor, but with an additional
- annotation. -}
-liftA :: (RemA s s') => (s' a b -> t) -> s a b -> t
-liftA f v = f (remA v)
-
-{-| Transform a function with a domain constructed from a functor to a function
-  with a domain constructed with the same functor, but with an additional
-  annotation. -}
-liftA' :: (DistAnn s' p s, Difunctor s')
-          => (s' a b -> Cxt h s' c d) -> s a b -> Cxt h s c d
-liftA' f v = let (v',p) = projectA v
-             in ann p (f v')
-
-{-| Strip the annotations from a term over a functor with annotations. -}
-stripA :: (RemA g f, Difunctor g) => CxtFun g f
-stripA = appSigFun remA
-
-{-| Lift a term homomorphism over signatures @f@ and @g@ to a term homomorphism
- over the same signatures, but extended with annotations. -}
-propAnn :: (DistAnn f p f', DistAnn g p g', Difunctor g) 
-        => Hom f g -> Hom f' g'
-propAnn hom f' = ann p (hom f)
-    where (f,p) = projectA f'
-
-{-| Lift a monadic term homomorphism over signatures @f@ and @g@ to a monadic
-  term homomorphism over the same signatures, but extended with annotations. -}
-propAnnM :: (DistAnn f p f', DistAnn g p g', Difunctor g, Monad m) 
-         => HomM m f g -> HomM m f' g'
-propAnnM hom f' = liftM (ann p) (hom f)
-    where (f,p) = projectA f'
-
-{-| Annotate each node of a term with a constant value. -}
-ann :: (DistAnn f p g, Difunctor f)  => p -> CxtFun f g
-ann c = appSigFun (injectA c)
-
-{-| This function is similar to 'project' but applies to signatures
-with an annotation which is then ignored. -}
-project' :: (RemA f f', s :<: f') => Cxt h f a b -> Maybe (s a (Cxt h f a b))
-project' (In x) = proj $ remA x
-project' _ = Nothing
diff --git a/src/Data/Comp/Param/Derive.hs b/src/Data/Comp/Param/Derive.hs
deleted file mode 100644
--- a/src/Data/Comp/Param/Derive.hs
+++ /dev/null
@@ -1,57 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Data.Comp.Param.Derive
--- Copyright   :  (c) 2011 Patrick Bahr, Tom Hvitved
--- License     :  BSD3
--- Maintainer  :  Tom Hvitved <hvitved@diku.dk>
--- Stability   :  experimental
--- Portability :  non-portable (GHC Extensions)
---
--- This module contains functionality for automatically deriving boilerplate
--- code using Template Haskell. Examples include instances of 'Difunctor',
--- 'Difoldable', and 'Ditraversable'.
---
---------------------------------------------------------------------------------
-
-module Data.Comp.Param.Derive
-    (
-     derive,
-     -- |Derive boilerplate instances for parametric signatures, i.e.
-     -- signatures for parametric compositional data types.
-
-     -- ** EqD
-     module Data.Comp.Param.Derive.Equality,
-     -- ** OrdD
-     module Data.Comp.Param.Derive.Ordering,
-     -- ** ShowD
-     module Data.Comp.Param.Derive.Show,
-     -- ** Difunctor
-     module Data.Comp.Param.Derive.Difunctor,
-     -- ** Ditraversable
-     module Data.Comp.Param.Derive.Ditraversable,
-     -- ** Smart Constructors
-     module Data.Comp.Param.Derive.SmartConstructors,
-     -- ** Smart Constructors w/ Annotations
-     module Data.Comp.Param.Derive.SmartAConstructors,
-     -- ** Lifting to Sums
-     liftSum
-    ) where
-
-import Data.Comp.Derive.Utils (derive, liftSumGen)
-import Data.Comp.Param.Derive.Equality
-import Data.Comp.Param.Derive.Ordering
-import Data.Comp.Param.Derive.Show
-import Data.Comp.Param.Derive.Difunctor
-import Data.Comp.Param.Derive.Ditraversable
-import Data.Comp.Param.Derive.SmartConstructors
-import Data.Comp.Param.Derive.SmartAConstructors
-import Data.Comp.Param.Ops ((:+:), caseD)
-
-import Language.Haskell.TH
-
-{-| Given the name of a type class, where the first parameter is a difunctor,
-  lift it to sums of difunctors. Example: @class ShowD f where ...@ is lifted
-  as @instance (ShowD f, ShowD g) => ShowD (f :+: g) where ... @. -}
-liftSum :: Name -> Q [Dec]
-liftSum = liftSumGen 'caseD ''(:+:)
diff --git a/src/Data/Comp/Param/Derive/Difunctor.hs b/src/Data/Comp/Param/Derive/Difunctor.hs
deleted file mode 100644
--- a/src/Data/Comp/Param/Derive/Difunctor.hs
+++ /dev/null
@@ -1,96 +0,0 @@
-{-# LANGUAGE TemplateHaskell, ScopedTypeVariables #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Data.Comp.Param.Derive.Functor
--- Copyright   :  (c) 2011 Patrick Bahr, Tom Hvitved
--- License     :  BSD3
--- Maintainer  :  Tom Hvitved <hvitved@diku.dk>
--- Stability   :  experimental
--- Portability :  non-portable (GHC Extensions)
---
--- Automatically derive instances of @Difunctor@.
---
---------------------------------------------------------------------------------
-
-module Data.Comp.Param.Derive.Difunctor
-    (
-     Difunctor,
-     makeDifunctor
-    ) where
-
-import Data.Comp.Derive.Utils
-import Data.Comp.Param.Difunctor
-import Language.Haskell.TH
-
-{-| Derive an instance of 'Difunctor' for a type constructor of any parametric
-  kind taking at least two arguments. -}
-makeDifunctor :: Name -> Q [Dec]
-makeDifunctor fname = do
-  -- Comments below apply to the example where name = T, args = [a,b,c], and
-  -- constrs = [(X,[c]), (Y,[a,c]), (Z,[b -> c])], i.e. the data type
-  -- declaration: T a b c = X c | Y a c | Z (b -> c)
-  TyConI (DataD _ name args constrs _) <- abstractNewtypeQ $ reify fname
-  -- coArg = c (covariant difunctor argument)
-  let coArg :: Name = tyVarBndrName $ last args
-  -- conArg = b (contravariant difunctor argument)
-  let conArg :: Name = tyVarBndrName $ last $ init args
-  -- argNames = [a]
-  let argNames = map (VarT . tyVarBndrName) (init $ init args)
-  -- compType = T a
-  let complType = foldl AppT (ConT name) argNames
-  -- classType = Difunctor (T a)
-  let classType = AppT (ConT ''Difunctor) complType
-  -- constrs' = [(X,[c]), (Y,[a,c]), (Z,[b -> c])]
-  constrs' :: [(Name,[Type])] <- mapM normalConExp constrs
-  dimapDecl <- funD 'dimap (map (dimapClause conArg coArg) constrs')
-  return [InstanceD [] classType [dimapDecl]]
-      where dimapClause :: Name -> Name -> (Name,[Type]) -> ClauseQ
-            dimapClause conArg coArg (constr, args) = do
-              fn <- newName "_f"
-              gn <- newName "_g"
-              varNs <- newNames (length args) "x"
-              let f = varE fn
-              let g = varE gn
-              let fp = VarP fn
-              let gp = VarP gn
-              -- Pattern for the constructor
-              let pat = ConP constr $ map VarP varNs
-              body <- dimapArgs conArg coArg f g (zip varNs args) (conE constr)
-              return $ Clause [fp, gp, pat] (NormalB body) []
-            dimapArgs :: Name -> Name -> ExpQ -> ExpQ
-                      -> [(Name, Type)] -> ExpQ -> ExpQ
-            dimapArgs _ _ _ _ [] acc =
-                acc
-            dimapArgs conArg coArg f g ((x,tp):tps) acc =
-                dimapArgs conArg coArg f g tps
-                          (acc `appE` (dimapArg conArg coArg tp f g `appE` varE x))
-            -- Given the name of the difunctor variables, a type, and the two
-            -- arguments to dimap, return the expression that should be applied
-            -- to the parameter of the given type.
-            -- Example: dimapArg a b (a -> b) f g yields the expression
-            -- [|\x -> g . x . f|]
-            dimapArg :: Name -> Name -> Type -> ExpQ -> ExpQ -> ExpQ
-            dimapArg conArg coArg tp f g
-                | not (containsType tp (VarT conArg)) &&
-                  not (containsType tp (VarT coArg)) = [| id |]
-                | otherwise =
-                    case tp of
-                      VarT a | a == conArg -> f
-                             | a == coArg -> g
-                      AppT (AppT ArrowT tp1) tp2 -> do
-                          xn <- newName "x"
-                          let ftp1 = dimapArg conArg coArg tp1 f g
-                          let ftp2 = dimapArg conArg coArg tp2 f g
-                          lamE [varP xn]
-                               (infixE (Just ftp2)
-                                       [|(.)|]
-                                       (Just $ infixE (Just $ varE xn)
-                                                      [|(.)|]
-                                                      (Just ftp1)))
-                      SigT tp' _ ->
-                          dimapArg conArg coArg tp' f g
-                      _ ->
-                          if containsType tp (VarT conArg) then
-                              [| dimap $f $g |]
-                          else
-                              [| fmap $g |]
diff --git a/src/Data/Comp/Param/Derive/Ditraversable.hs b/src/Data/Comp/Param/Derive/Ditraversable.hs
deleted file mode 100644
--- a/src/Data/Comp/Param/Derive/Ditraversable.hs
+++ /dev/null
@@ -1,88 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Data.Comp.Param.Derive.Ditraversable
--- Copyright   :  (c) 2010-2011 Patrick Bahr
--- License     :  BSD3
--- Maintainer  :  Patrick Bahr <paba@diku.dk>
--- Stability   :  experimental
--- Portability :  non-portable (GHC Extensions)
---
--- Automatically derive instances of @Ditraversable@.
---
---------------------------------------------------------------------------------
-
-module Data.Comp.Param.Derive.Ditraversable
-    (
-     Ditraversable,
-     makeDitraversable
-    ) where
-
-import Data.Comp.Derive.Utils
-import Data.Comp.Param.Ditraversable
-import Data.Traversable (mapM)
-import Language.Haskell.TH
-import Data.Maybe
-import Control.Monad hiding (mapM)
-import Prelude hiding (mapM)
-
-iter 0 _ e = e
-iter n f e = iter (n-1) f (f `appE` e)
-
-iter' n f e = run n f e
-    where run 0 _ e = e
-          run m f e = let f' = iter (m-1) [|fmap|] f
-                        in run (m-1) f (f' `appE` e)
-
-{-| Derive an instance of 'Traversable' for a type constructor of any
-  first-order kind taking at least one argument. -}
-makeDitraversable :: Name -> Q [Dec]
-makeDitraversable fname = do
-  TyConI (DataD _cxt name args constrs _deriving) <- abstractNewtypeQ $ reify fname
-  let fArg = VarT . tyVarBndrName $ last args
-      aArg = VarT . tyVarBndrName $ last (init args)
-      funTy = foldl AppT ArrowT [aArg,fArg]
-      argNames = map (VarT . tyVarBndrName) (init $ init args)
-      complType = foldl AppT (ConT name) argNames
-      classType = foldl1 AppT [ConT ''Ditraversable, complType]
-  normConstrs <- mapM normalConExp constrs
-  constrs' <- mapM (mkPatAndVars . isFarg fArg funTy) normConstrs
-  mapMDecl <- funD 'dimapM (map mapMClause constrs')
-  sequenceDecl <- funD 'disequence (map sequenceClause constrs')
-  return [InstanceD [] classType [mapMDecl,sequenceDecl]]
-      where isFarg fArg funTy (constr, args) =
-                (constr, map (\t -> (t `containsType'` fArg, t `containsType'` funTy)) args)
-            checksAarg aArg (_,args) = any (`containsType` aArg) args
-            filterVar _ _ nonFarg ([],[]) x  = nonFarg x
-            filterVar farg _ _ ([depth],[]) x = farg depth x
-            filterVar _ aarg _ ([_],[depth]) x = aarg depth x
-            filterVar _ _ _ _ _ = error "functor variable occurring twice in argument type"
-            filterVars args varNs farg aarg nonFarg = zipWith (filterVar farg aarg nonFarg) args varNs
-            mkCPat constr varNs = ConP constr $ map mkPat varNs
-            mkPat = VarP
-            mkPatAndVars (constr, args) =
-                do varNs <- newNames (length args) "x"
-                   return (conE constr, mkCPat constr varNs,
-                           any (not . null . fst) args || any (not . null . snd) args, map varE varNs,
-                           catMaybes $ filterVars args varNs (\x y -> Just (False,x,y)) (\x y -> Just (True, x, y)) (const Nothing))
-
-            -- Note: the monadic versions are not defined
-            -- applicatively, as this results in a considerable
-            -- performance penalty (by factor 2)!
-            mapMClause (con, pat,hasFargs,allVars, fvars) =
-                do fn <- newName "f"
-                   let f = varE fn
-                       fp = if hasFargs then VarP fn else WildP
-                       conAp = foldl appE con allVars
-                       addDi False _ x = x
-                       addDi True d x = [|dimapM $(f)|]
-                       conBind (fun,d,x) y = [| $(iter d [|mapM|] (addDi fun d f)) $(varE x)  >>= $(lamE [varP x] y)|]
-                   body <- foldr conBind [|return $conAp|] fvars
-                   return $ Clause [fp, pat] (NormalB body) []
-            sequenceClause (con, pat,hasFargs,allVars, fvars) =
-                do let conAp = foldl appE con allVars
-                       varE' False _ x = varE x
-                       varE' True d x = appE (iter d [|fmap|] [|disequence|]) (varE x)
-                       conBind (fun,d, x) y = [| $(iter' d [|sequence|] (varE' fun d x))  >>= $(lamE [varP x] y)|]
-                   body <- foldr conBind [|return $conAp|] fvars
-                   return $ Clause [pat] (NormalB body) []
diff --git a/src/Data/Comp/Param/Derive/Equality.hs b/src/Data/Comp/Param/Derive/Equality.hs
deleted file mode 100644
--- a/src/Data/Comp/Param/Derive/Equality.hs
+++ /dev/null
@@ -1,84 +0,0 @@
-{-# LANGUAGE TemplateHaskell, FlexibleInstances, IncoherentInstances,
-  ScopedTypeVariables #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Data.Comp.Param.Derive.Equality
--- Copyright   :  (c) 2011 Patrick Bahr, Tom Hvitved
--- License     :  BSD3
--- Maintainer  :  Tom Hvitved <hvitved@diku.dk>
--- Stability   :  experimental
--- Portability :  non-portable (GHC Extensions)
---
--- Automatically derive instances of @EqD@.
---
---------------------------------------------------------------------------------
-module Data.Comp.Param.Derive.Equality
-    (
-     EqD(..),
-     makeEqD
-    ) where
-
-import Data.Comp.Derive.Utils
-import Data.Comp.Param.FreshM hiding (Name)
-import Data.Comp.Param.Equality
-import Control.Monad
-import Language.Haskell.TH hiding (Cxt, match)
-
-{-| Derive an instance of 'EqD' for a type constructor of any parametric
-  kind taking at least two arguments. -}
-makeEqD :: Name -> Q [Dec]
-makeEqD fname = do
-  -- Comments below apply to the example where name = T, args = [a,b,c], and
-  -- constrs = [(X,[c]), (Y,[a,c]), (Z,[b -> c])], i.e. the data type
-  -- declaration: T a b c = X c | Y a c | Z (b -> c)
-  TyConI (DataD _ name args constrs _) <- abstractNewtypeQ $ reify fname
-  -- coArg = c (covariant difunctor argument)
-  let coArg :: Name = tyVarBndrName $ last args
-  -- conArg = b (contravariant difunctor argument)
-  let conArg :: Name = tyVarBndrName $ last $ init args
-  -- argNames = [a]
-  let argNames = map (VarT . tyVarBndrName) (init $ init args)
-  -- compType = T a
-  let complType = foldl AppT (ConT name) argNames
-  -- classType = Difunctor (T a)
-  let classType = AppT (ConT ''EqD) complType
-  -- constrs' = [(X,[c]), (Y,[a,c]), (Z,[b -> c])]
-  constrs' :: [(Name,[Type])] <- mapM normalConExp constrs
-  let defC = if length constrs < 2 then
-                 []
-             else
-                 [clause [wildP,wildP] (normalB [|return False|]) []]
-  eqDDecl <- funD 'eqD (map (eqDClause conArg coArg) constrs' ++ defC)
-  let context = map (\arg -> ClassP ''Eq [arg]) argNames
-  return [InstanceD context classType [eqDDecl]]
-      where eqDClause :: Name -> Name -> (Name,[Type]) -> ClauseQ
-            eqDClause conArg coArg (constr, args) = do
-              varXs <- newNames (length args) "x"
-              varYs <- newNames (length args) "y"
-              -- Patterns for the constructors
-              let patx = ConP constr $ map VarP varXs
-              let paty = ConP constr $ map VarP varYs
-              body <- eqDBody conArg coArg (zip3 varXs varYs args)
-              return $ Clause [patx,paty] (NormalB body) []
-            eqDBody :: Name -> Name -> [(Name, Name, Type)] -> ExpQ
-            eqDBody conArg coArg x =
-                [|liftM and (sequence $(listE $ map (eqDB conArg coArg) x))|]
-            eqDB :: Name -> Name -> (Name, Name, Type) -> ExpQ
-            eqDB conArg coArg (x, y, tp)
-                | not (containsType tp (VarT conArg)) &&
-                  not (containsType tp (VarT coArg)) =
-                    [| return $ $(varE x) == $(varE y) |]
-                | otherwise =
-                    case tp of
-                      VarT a
-                          | a == coArg -> [| peq $(varE x) $(varE y) |]
-                      AppT (AppT ArrowT (VarT a)) _
-                          | a == conArg ->
-                              [| withName (\v -> peq ($(varE x) v) ($(varE y) v)) |]
-                      SigT tp' _ ->
-                          eqDB conArg coArg (x, y, tp')
-                      _ ->
-                          if containsType tp (VarT conArg) then
-                              [| eqD $(varE x) $(varE y) |]
-                          else
-                              [| peq $(varE x) $(varE y) |]
diff --git a/src/Data/Comp/Param/Derive/Injections.hs b/src/Data/Comp/Param/Derive/Injections.hs
deleted file mode 100644
--- a/src/Data/Comp/Param/Derive/Injections.hs
+++ /dev/null
@@ -1,86 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Data.Comp.Param.Derive.Injections
--- Copyright   :  (c) 2011 Patrick Bahr, Tom Hvitved
--- License     :  BSD3
--- Maintainer  :  Tom Hvitved <hvitved@diku.dk>
--- Stability   :  experimental
--- Portability :  non-portable (GHC Extensions)
---
--- Derive functions for signature injections.
---
---------------------------------------------------------------------------------
-
-module Data.Comp.Param.Derive.Injections
-    (
-     injn,
-     injectn,
-     deepInjectn
-    ) where
-
-import Language.Haskell.TH hiding (Cxt)
-import Data.Comp.Param.Difunctor
-import Data.Comp.Param.Term
-import Data.Comp.Param.Algebra (CxtFun, appSigFun)
-import Data.Comp.Param.Ops ((:+:)(..), (:<:)(..))
-
-injn :: Int -> Q [Dec]
-injn n = do
-  let i = mkName $ "inj" ++ show n
-  let fvars = map (\n -> mkName $ 'f' : show n) [1..n]
-  let gvar = mkName "g"
-  let avar = mkName "a"
-  let bvar = mkName "b"
-  let xvar = mkName "x"
-  let d = [funD i [clause [varP xvar] (normalB $ genDecl xvar n) []]]
-  sequence $ sigD i (genSig fvars gvar avar bvar) : d
-    where genSig fvars gvar avar bvar = do
-            let cxt = map (\f -> classP ''(:<:) [varT f, varT gvar]) fvars
-            let tp = foldl1 (\a f -> conT ''(:+:) `appT` f `appT` a)
-                            (map varT fvars)
-            let tp' = arrowT `appT` (tp `appT` varT avar `appT` varT bvar)
-                             `appT` (varT gvar `appT` varT avar `appT`
-                                     varT bvar)
-            forallT (map PlainTV $ gvar : avar : bvar : fvars)
-                    (sequence cxt) tp'
-          genDecl x n = [| case $(varE x) of
-                             Inl x -> $(varE $ mkName "inj") x
-                             Inr x -> $(varE $ mkName $ "inj" ++
-                                        if n > 2 then show (n - 1) else "") x |]
-injectn :: Int -> Q [Dec]
-injectn n = do
-  let i = mkName ("inject" ++ show n)
-  let fvars = map (\n -> mkName $ 'f' : show n) [1..n]
-  let gvar = mkName "g"
-  let avar = mkName "a"
-  let bvar = mkName "b"
-  let d = [funD i [clause [] (normalB $ genDecl n) []]]
-  sequence $ sigD i (genSig fvars gvar avar bvar) : d
-    where genSig fvars gvar avar bvar = do
-            let hvar = mkName "h"
-            let cxt = map (\f -> classP ''(:<:) [varT f, varT gvar]) fvars
-            let tp = foldl1 (\a f -> conT ''(:+:) `appT` f `appT` a)
-                            (map varT fvars)
-            let tp' = conT ''Cxt `appT` varT hvar `appT` varT gvar
-                                 `appT` varT avar `appT` varT bvar
-            let tp'' = arrowT `appT` (tp `appT` varT avar `appT` tp') `appT` tp'
-            forallT (map PlainTV $ hvar : gvar : avar : bvar : fvars)
-                    (sequence cxt) tp''
-          genDecl n = [| In . $(varE $ mkName $ "inj" ++ show n) |]
-
-deepInjectn :: Int -> Q [Dec]
-deepInjectn n = do
-  let i = mkName ("deepInject" ++ show n)
-  let fvars = map (\n -> mkName $ 'f' : show n) [1..n]
-  let gvar = mkName "g"
-  let d = [funD i [clause [] (normalB $ genDecl n) []]]
-  sequence $ sigD i (genSig fvars gvar) : d
-    where genSig fvars gvar = do
-            let cxt = map (\f -> classP ''(:<:) [varT f, varT gvar]) fvars
-            let tp = foldl1 (\a f -> conT ''(:+:) `appT` f `appT` a)
-                            (map varT fvars)
-            let cxt' = classP ''Difunctor [tp]
-            let tp' = conT ''CxtFun `appT` tp `appT` varT gvar
-            forallT (map PlainTV $ gvar : fvars) (sequence $ cxt' : cxt) tp'
-          genDecl n = [| appSigFun $(varE $ mkName $ "inj" ++ show n) |]
diff --git a/src/Data/Comp/Param/Derive/Ordering.hs b/src/Data/Comp/Param/Derive/Ordering.hs
deleted file mode 100644
--- a/src/Data/Comp/Param/Derive/Ordering.hs
+++ /dev/null
@@ -1,93 +0,0 @@
-{-# LANGUAGE TemplateHaskell, FlexibleInstances, IncoherentInstances,
-  ScopedTypeVariables #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Data.Comp.Param.Derive.Ordering
--- Copyright   :  (c) 2011 Patrick Bahr, Tom Hvitved
--- License     :  BSD3
--- Maintainer  :  Tom Hvitved <hvitved@diku.dk>
--- Stability   :  experimental
--- Portability :  non-portable (GHC Extensions)
---
--- Automatically derive instances of @OrdD@.
---
---------------------------------------------------------------------------------
-module Data.Comp.Param.Derive.Ordering
-    (
-     OrdD(..),
-     makeOrdD
-    ) where
-
-import Data.Comp.Param.FreshM hiding (Name)
-import Data.Comp.Param.Ordering
-import Data.Comp.Derive.Utils
-import Language.Haskell.TH hiding (Cxt)
-import Control.Monad (liftM)
-
-{-| Derive an instance of 'OrdD' for a type constructor of any parametric
-  kind taking at least two arguments. -}
-makeOrdD :: Name -> Q [Dec]
-makeOrdD fname = do
-  -- Comments below apply to the example where name = T, args = [a,b,c], and
-  -- constrs = [(X,[c]), (Y,[a,c]), (Z,[b -> c])], i.e. the data type
-  -- declaration: T a b c = X c | Y a c | Z (b -> c)
-  TyConI (DataD _ name args constrs _) <- abstractNewtypeQ $ reify fname
-  -- coArg = c (covariant difunctor argument)
-  let coArg :: Name = tyVarBndrName $ last args
-  -- conArg = b (contravariant difunctor argument)
-  let conArg :: Name = tyVarBndrName $ last $ init args
-  -- argNames = [a]
-  let argNames = map (VarT . tyVarBndrName) (init $ init args)
-  -- compType = T a
-  let complType = foldl AppT (ConT name) argNames
-  -- classType = Difunctor (T a)
-  let classType = AppT (ConT ''OrdD) complType
-  -- constrs' = [(X,[c]), (Y,[a,c]), (Z,[b -> c])]
-  constrs' :: [(Name,[Type])] <- mapM normalConExp constrs
-  compareDDecl <- funD 'compareD (compareDClauses conArg coArg constrs')
-  let context = map (\arg -> ClassP ''Ord [arg]) argNames
-  return [InstanceD context classType [compareDDecl]]
-      where compareDClauses :: Name -> Name -> [(Name,[Type])] -> [ClauseQ]
-            compareDClauses _ _ [] = []
-            compareDClauses conArg coArg constrs = 
-                let constrs' = constrs `zip` [1..]
-                    constPairs = [(x,y)| x<-constrs', y <- constrs']
-                in map (genClause conArg coArg) constPairs
-            genClause conArg coArg ((c,n),(d,m))
-                | n == m = genEqClause conArg coArg c
-                | n < m = genLtClause c d
-                | otherwise = genGtClause c d
-            genEqClause :: Name -> Name -> (Name,[Type]) -> ClauseQ
-            genEqClause conArg coArg (constr, args) = do 
-              varXs <- newNames (length args) "x"
-              varYs <- newNames (length args) "y"
-              let patX = ConP constr $ map VarP varXs
-              let patY = ConP constr $ map VarP varYs
-              body <- eqDBody conArg coArg (zip3 varXs varYs args)
-              return $ Clause [patX, patY] (NormalB body) []
-            eqDBody :: Name -> Name -> [(Name, Name, Type)] -> ExpQ
-            eqDBody conArg coArg x =
-                [|liftM compList (sequence $(listE $ map (eqDB conArg coArg) x))|]
-            eqDB :: Name -> Name -> (Name, Name, Type) -> ExpQ
-            eqDB conArg coArg (x, y, tp)
-                | not (containsType tp (VarT conArg)) &&
-                  not (containsType tp (VarT coArg)) =
-                    [| return $ compare $(varE x) $(varE y) |]
-                | otherwise =
-                    case tp of
-                      VarT a
-                          | a == coArg -> [| pcompare $(varE x) $(varE y) |]
-                      AppT (AppT ArrowT (VarT a)) _
-                          | a == conArg ->
-                              [| withName (\v -> pcompare ($(varE x) v) ($(varE y) v)) |]
-                      SigT tp' _ ->
-                          eqDB conArg coArg (x, y, tp')
-                      _ ->
-                          if containsType tp (VarT conArg) then
-                              [| compareD $(varE x) $(varE y) |]
-                          else
-                              [| pcompare $(varE x) $(varE y) |]
-            genLtClause (c, _) (d, _) =
-                clause [recP c [], recP d []] (normalB [| return LT |]) []
-            genGtClause (c, _) (d, _) =
-                clause [recP c [], recP d []] (normalB [| return GT |]) []
diff --git a/src/Data/Comp/Param/Derive/Projections.hs b/src/Data/Comp/Param/Derive/Projections.hs
deleted file mode 100644
--- a/src/Data/Comp/Param/Derive/Projections.hs
+++ /dev/null
@@ -1,101 +0,0 @@
-{-# LANGUAGE TemplateHaskell, GADTs #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Data.Comp.Param.Derive.Projections
--- Copyright   :  (c) 2011 Patrick Bahr, Tom Hvitved
--- License     :  BSD3
--- Maintainer  :  Tom Hvitved <hvitved@diku.dk>
--- Stability   :  experimental
--- Portability :  non-portable (GHC Extensions)
---
--- Derive functions for signature projections.
---
---------------------------------------------------------------------------------
-
-module Data.Comp.Param.Derive.Projections
-    (
-     projn,
-     projectn,
-     deepProjectn
-    ) where
-
-import Language.Haskell.TH hiding (Cxt)
-import Control.Monad (liftM)
-import Data.Comp.Param.Ditraversable (Ditraversable)
-import Data.Comp.Param.Term
-import Data.Comp.Param.Algebra (appTSigFunM')
-import Data.Comp.Param.Ops ((:+:)(..), (:<:)(..))
-
-projn :: Int -> Q [Dec]
-projn n = do
-  let p = mkName $ "proj" ++ show n
-  let gvars = map (\n -> mkName $ 'g' : show n) [1..n]
-  let avar = mkName "a"
-  let bvar = mkName "b"
-  let xvar = mkName "x"
-  let d = [funD p [clause [varP xvar] (normalB $ genDecl xvar gvars avar bvar) []]]
-  sequence $ (sigD p $ genSig gvars avar bvar) : d
-    where genSig gvars avar bvar = do
-            let fvar = mkName "f"
-            let cxt = map (\g -> classP ''(:<:) [varT g, varT fvar]) gvars
-            let tp = foldl1 (\a g -> conT ''(:+:) `appT` g `appT` a)
-                            (map varT gvars)
-            let tp' = arrowT `appT` (varT fvar `appT` varT avar `appT`
-                                     varT bvar)
-                             `appT` (conT ''Maybe `appT`
-                                     (tp `appT` varT avar `appT` varT bvar))
-            forallT (map PlainTV $ fvar : avar : bvar : gvars)
-                    (sequence cxt) tp'
-          genDecl x [g] a b =
-            [| liftM inj (proj $(varE x)
-                          :: Maybe ($(varT g `appT` varT a `appT` varT b))) |]
-          genDecl x (g:gs) a b =
-            [| case (proj $(varE x)
-                         :: Maybe ($(varT g `appT` varT a `appT` varT b))) of
-                 Just y -> Just $ inj y
-                 _ -> $(genDecl x gs a b) |]
-          genDecl _ _ _ _ = error "genDecl called with empty list"
-
-projectn :: Int -> Q [Dec]
-projectn n = do
-  let p = mkName ("project" ++ show n)
-  let gvars = map (\n -> mkName $ 'g' : show n) [1..n]
-  let avar = mkName "a"
-  let bvar = mkName "b"
-  let xvar = mkName "x"
-  let d = [funD p [clause [varP xvar] (normalB $ genDecl xvar n) []]]
-  sequence $ (sigD p $ genSig gvars avar bvar) : d
-    where genSig gvars avar bvar = do
-            let fvar = mkName "f"
-            let hvar = mkName "h"
-            let cxt = map (\g -> classP ''(:<:) [varT g, varT fvar]) gvars
-            let tp = foldl1 (\a g -> conT ''(:+:) `appT` g `appT` a)
-                            (map varT gvars)
-            let tp' = conT ''Cxt `appT` varT hvar `appT` varT fvar
-                                 `appT` varT avar `appT` varT bvar
-            let tp'' = arrowT `appT` tp'
-                              `appT` (conT ''Maybe `appT`
-                                      (tp `appT` varT avar `appT` tp'))
-            forallT (map PlainTV $ hvar : fvar : avar : bvar : gvars)
-                    (sequence cxt) tp''
-          genDecl x n = [| case $(varE x) of
-                             Hole _ -> Nothing
-                             Var _ -> Nothing
-                             In t -> $(varE $ mkName $ "proj" ++ show n) t |]
-
-deepProjectn :: Int -> Q [Dec]
-deepProjectn n = do
-  let p = mkName ("deepProject" ++ show n)
-  let gvars = map (\n -> mkName $ 'g' : show n) [1..n]
-  let d = [funD p [clause [] (normalB $ genDecl n) []]]
-  sequence $ (sigD p $ genSig gvars) : d
-    where genSig gvars = do
-            let fvar = mkName "f"
-            let cxt = map (\g -> classP ''(:<:) [varT g, varT fvar]) gvars
-            let tp = foldl1 (\a g -> conT ''(:+:) `appT` g `appT` a)
-                            (map varT gvars)
-            let cxt' = classP ''Ditraversable [tp]
-            let tp' = arrowT `appT` (conT ''Term `appT` varT fvar)
-                             `appT` (conT ''Maybe `appT` (conT ''Term `appT` tp))
-            forallT (map PlainTV $ fvar : gvars) (sequence $ cxt' : cxt) tp'
-          genDecl n = [| appTSigFunM' $(varE $ mkName $ "proj" ++ show n) |]
diff --git a/src/Data/Comp/Param/Derive/Show.hs b/src/Data/Comp/Param/Derive/Show.hs
deleted file mode 100644
--- a/src/Data/Comp/Param/Derive/Show.hs
+++ /dev/null
@@ -1,92 +0,0 @@
-{-# LANGUAGE TemplateHaskell, FlexibleInstances, IncoherentInstances,
-  ScopedTypeVariables, UndecidableInstances #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Data.Comp.Param.Derive.Show
--- Copyright   :  (c) 2011 Patrick Bahr, Tom Hvitved
--- License     :  BSD3
--- Maintainer  :  Tom Hvitved <hvitved@diku.dk>
--- Stability   :  experimental
--- Portability :  non-portable (GHC Extensions)
---
--- Automatically derive instances of @ShowD@.
---
---------------------------------------------------------------------------------
-module Data.Comp.Param.Derive.Show
-    (
-     ShowD(..),
-     makeShowD
-    ) where
-
-import Data.Comp.Derive.Utils
-import Data.Comp.Param.FreshM hiding (Name)
-import qualified Data.Comp.Param.FreshM as FreshM
-import Control.Monad
-import Language.Haskell.TH hiding (Cxt, match)
-import qualified Data.Traversable as T
-
-{-| Signature printing. An instance @ShowD f@ gives rise to an instance
-  @Show (Term f)@. -}
-class ShowD f where
-    showD :: f FreshM.Name (FreshM String) -> FreshM String
-
-newtype Dummy = Dummy String
-
-instance Show Dummy where
-  show (Dummy s) = s
-
-{-| Derive an instance of 'ShowD' for a type constructor of any parametric
-  kind taking at least two arguments. -}
-makeShowD :: Name -> Q [Dec]
-makeShowD fname = do
-  -- Comments below apply to the example where name = T, args = [a,b,c], and
-  -- constrs = [(X,[c]), (Y,[a,c]), (Z,[b -> c])], i.e. the data type
-  -- declaration: T a b c = X c | Y a c | Z (b -> c)
-  TyConI (DataD _ name args constrs _) <- abstractNewtypeQ $ reify fname
-  -- coArg = c (covariant difunctor argument)
-  let coArg :: Name = tyVarBndrName $ last args
-  -- conArg = b (contravariant difunctor argument)
-  let conArg :: Name = tyVarBndrName $ last $ init args
-  -- argNames = [a]
-  let argNames = map (VarT . tyVarBndrName) (init $ init args)
-  -- compType = T a
-  let complType = foldl AppT (ConT name) argNames
-  -- classType = Difunctor (T a)
-  let classType = AppT (ConT ''ShowD) complType
-  -- constrs' = [(X,[c]), (Y,[a,c]), (Z,[b -> c])]
-  constrs' :: [(Name,[Type])] <- mapM normalConExp constrs
-  showDDecl <- funD 'showD (map (showDClause conArg coArg) constrs')
-  let context = map (\arg -> ClassP ''Show [arg]) argNames
-  return [InstanceD context classType [showDDecl]]
-      where showDClause :: Name -> Name -> (Name,[Type]) -> ClauseQ
-            showDClause conArg coArg (constr, args) = do
-              varXs <- newNames (length args) "x"
-              -- Pattern for the constructor
-              let patx = ConP constr $ map VarP varXs
-              body <- showDBody (nameBase constr) conArg coArg (zip varXs args)
-              return $ Clause [patx] (NormalB body) []
-            showDBody :: String -> Name -> Name -> [(Name, Type)] -> ExpQ
-            showDBody constr conArg coArg x =
-                [|liftM (unwords . (constr :) .
-                         map (\x -> if elem ' ' x then "(" ++ x ++ ")" else x))
-                        (sequence $(listE $ map (showDB conArg coArg) x))|]
-            showDB :: Name -> Name -> (Name, Type) -> ExpQ
-            showDB conArg coArg (x, tp)
-                | not (containsType tp (VarT conArg)) &&
-                  not (containsType tp (VarT coArg)) =
-                    [| return $ show $(varE x) |]
-                | otherwise =
-                    case tp of
-                      VarT a
-                          | a == coArg -> [| $(varE x) |]
-                      AppT (AppT ArrowT (VarT a)) _
-                          | a == conArg ->
-                              [| withName (\v -> do body <- $(varE x) v;
-                                                    return $ "\\" ++ show v ++ " -> " ++ body) |]
-                      SigT tp' _ ->
-                          showDB conArg coArg (x, tp')
-                      _ ->
-                          if containsType tp (VarT conArg) then
-                              [| showD $(varE x) |]
-                          else
-                              [| liftM show $ T.mapM (liftM Dummy) $(varE x) |]
diff --git a/src/Data/Comp/Param/Derive/SmartAConstructors.hs b/src/Data/Comp/Param/Derive/SmartAConstructors.hs
deleted file mode 100644
--- a/src/Data/Comp/Param/Derive/SmartAConstructors.hs
+++ /dev/null
@@ -1,47 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Data.Comp.Param.Derive.SmartAConstructors
--- Copyright   :  (c) 2011 Patrick Bahr, Tom Hvitved
--- License     :  BSD3
--- Maintainer  :  Tom Hvitved <hvitved@diku.dk>
--- Stability   :  experimental
--- Portability :  non-portable (GHC Extensions)
---
--- Automatically derive smart constructors with annotations for difunctors.
---
---------------------------------------------------------------------------------
-
-module Data.Comp.Param.Derive.SmartAConstructors 
-    (
-     smartAConstructors
-    ) where
-
-import Language.Haskell.TH hiding (Cxt)
-import Data.Comp.Derive.Utils
-import Data.Comp.Param.Ops
-import Data.Comp.Param.Term
-import Data.Comp.Param.Difunctor
-
-import Control.Monad
-
-{-| Derive smart constructors with annotations for a difunctor. The smart
- constructors are similar to the ordinary constructors, but a
- 'injectA . dimap Var id' is automatically inserted. -}
-smartAConstructors :: Name -> Q [Dec]
-smartAConstructors fname = do
-    TyConI (DataD _cxt tname targs constrs _deriving) <- abstractNewtypeQ $ reify fname
-    let cons = map abstractConType constrs
-    liftM concat $ mapM (genSmartConstr (map tyVarBndrName targs) tname) cons
-        where genSmartConstr targs tname (name, args) = do
-                let bname = nameBase name
-                genSmartConstr' targs tname (mkName $ "iA" ++ bname) name args
-              genSmartConstr' targs tname sname name args = do
-                varNs <- newNames args "x"
-                varPr <- newName "_p"
-                let pats = map varP (varPr : varNs)
-                    vars = map varE varNs
-                    val = appE [|injectA $(varE varPr)|] $
-                          appE [|inj . dimap Var id|] $ foldl appE (conE name) vars
-                    function = [funD sname [clause pats (normalB [|In $val|]) []]]
-                sequence function
diff --git a/src/Data/Comp/Param/Derive/SmartConstructors.hs b/src/Data/Comp/Param/Derive/SmartConstructors.hs
deleted file mode 100644
--- a/src/Data/Comp/Param/Derive/SmartConstructors.hs
+++ /dev/null
@@ -1,62 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Data.Comp.Param.Derive.SmartConstructors
--- Copyright   :  (c) 2011 Patrick Bahr, Tom Hvitved
--- License     :  BSD3
--- Maintainer  :  Tom Hvitved <hvitved@diku.dk>
--- Stability   :  experimental
--- Portability :  non-portable (GHC Extensions)
---
--- Automatically derive smart constructors for difunctors.
---
---------------------------------------------------------------------------------
-
-module Data.Comp.Param.Derive.SmartConstructors 
-    (
-     smartConstructors
-    ) where
-
-import Language.Haskell.TH hiding (Cxt)
-import Data.Comp.Derive.Utils
-import Data.Comp.Param.Sum
-import Data.Comp.Param.Term
-import Data.Comp.Param.Difunctor
-import Control.Monad
-
-{-| Derive smart constructors for a difunctor. The smart constructors are
- similar to the ordinary constructors, but a 'inject . dimap Var id' is
- automatically inserted. -}
-smartConstructors :: Name -> Q [Dec]
-smartConstructors fname = do
-    TyConI (DataD _cxt tname targs constrs _deriving) <- abstractNewtypeQ $ reify fname
-    let cons = map abstractConType constrs
-    liftM concat $ mapM (genSmartConstr (map tyVarBndrName targs) tname) cons
-        where genSmartConstr targs tname (name, args) = do
-                let bname = nameBase name
-                genSmartConstr' targs tname (mkName $ 'i' : bname) name args
-              genSmartConstr' targs tname sname name args = do
-                varNs <- newNames args "x"
-                let pats = map varP varNs
-                    vars = map varE varNs
-                    val = foldl appE (conE name) vars
-                    sig = genSig targs tname sname args
-                    function = [funD sname [clause pats (normalB [|inject (dimap Var id $val)|]) []]]
-                sequence $ sig ++ function
-              genSig targs tname sname 0 = (:[]) $ do
-                hvar <- newName "h"
-                fvar <- newName "f"
-                avar <- newName "a"
-                bvar <- newName "b"
-                let targs' = init $ init targs
-                    vars = hvar:fvar:avar:bvar:targs'
-                    h = varT hvar
-                    f = varT fvar
-                    a = varT avar
-                    b = varT bvar
-                    ftype = foldl appT (conT tname) (map varT targs')
-                    constr = classP ''(:<:) [ftype, f]
-                    typ = foldl appT (conT ''Cxt) [h, f, a, b]
-                    typeSig = forallT (map PlainTV vars) (sequence [constr]) typ
-                sigD sname typeSig
-              genSig _ _ _ _ = []
diff --git a/src/Data/Comp/Param/Desugar.hs b/src/Data/Comp/Param/Desugar.hs
deleted file mode 100644
--- a/src/Data/Comp/Param/Desugar.hs
+++ /dev/null
@@ -1,45 +0,0 @@
-{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances,
-  UndecidableInstances, OverlappingInstances, Rank2Types, TypeOperators #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Data.Comp.Param.Desugar
--- Copyright   :  (c) 2011 Patrick Bahr, Tom Hvitved
--- License     :  BSD3
--- Maintainer  :  Tom Hvitved <hvitved@diku.dk>
--- Stability   :  experimental
--- Portability :  non-portable (GHC Extensions)
---
--- This modules defines the 'Desugar' type class for desugaring of terms.
---
---------------------------------------------------------------------------------
-
-module Data.Comp.Param.Desugar where
-
-import Data.Comp.Param
-
-
--- |The desugaring term homomorphism.
-class (Difunctor f, Difunctor g) => Desugar f g where
-    desugHom :: Hom f g
-    desugHom = desugHom' . fmap Hole
-    desugHom' :: f a (Cxt h g a b) -> Cxt h g a b
-    desugHom' x = appCxt (desugHom x)
-
--- We make the lifting to sums explicit in order to make the Desugar
--- class work with the default instance declaration further below.
-instance (Desugar f h, Desugar g h) => Desugar (f :+: g) h where
-    desugHom = caseD desugHom desugHom
-
--- |Desugar a term.
-desugar :: Desugar f g => Term f -> Term g
-{-# INLINE desugar #-}
-desugar (Term t) = Term (appHom desugHom t)
-
--- |Lift desugaring to annotated terms.
-desugarA :: (Difunctor f', Difunctor g', DistAnn f p f', DistAnn g p g',
-             Desugar f g) => Term f' -> Term g'
-desugarA (Term t) = Term (appHom (propAnn desugHom) t)
-
--- |Default desugaring instance.
-instance (Difunctor f, Difunctor g, f :<: g) => Desugar f g where
-    desugHom = simpCxt . inj
diff --git a/src/Data/Comp/Param/Difunctor.hs b/src/Data/Comp/Param/Difunctor.hs
deleted file mode 100644
--- a/src/Data/Comp/Param/Difunctor.hs
+++ /dev/null
@@ -1,36 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Data.Comp.Param.Difunctor
--- Copyright   :  (c) 2011 Patrick Bahr, Tom Hvitved
--- License     :  BSD3
--- Maintainer  :  Tom Hvitved <hvitved@diku.dk>
--- Stability   :  experimental
--- Portability :  non-portable (GHC Extensions)
---
--- This module defines difunctors (Meijer, Hutton, FPCA '95), i.e. binary type
--- constructors that are contravariant in the first argument and covariant in
--- the second argument.
---
---------------------------------------------------------------------------------
-
-module Data.Comp.Param.Difunctor
-    (
-      difmap,
-     Difunctor(..)
-    ) where
-
--- | This class represents difunctors, i.e. binary type constructors that are
--- contravariant in the first argument and covariant in the second argument.
-class Difunctor f where
-    dimap :: (a -> b) -> (c -> d) -> f b c -> f a d
-
-{-| The canonical example of a difunctor. -}
-instance Difunctor (->) where
-    dimap f g h = g . h . f
-
-difmap :: Difunctor f => (a -> b) -> f c a -> f c b
-difmap = dimap id
-
-instance Difunctor f => Functor (f a) where
-    fmap = difmap
diff --git a/src/Data/Comp/Param/Ditraversable.hs b/src/Data/Comp/Param/Ditraversable.hs
deleted file mode 100644
--- a/src/Data/Comp/Param/Ditraversable.hs
+++ /dev/null
@@ -1,28 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Data.Comp.Param.Ditraversable
--- Copyright   :  (c) 2011 Patrick Bahr, Tom Hvitved
--- License     :  BSD3
--- Maintainer  :  Tom Hvitved <hvitved@diku.dk>
--- Stability   :  experimental
--- Portability :  non-portable (GHC Extensions)
---
--- This module defines traversable difunctors.
---
---------------------------------------------------------------------------------
-
-module Data.Comp.Param.Ditraversable
-    (
-     Ditraversable(..)
-    ) where
-
-import Data.Comp.Param.Difunctor
-
-{-| Difunctors representing data structures that can be traversed from left to
-  right. -}
-class Difunctor f => Ditraversable f where
-    dimapM :: Monad m => (b -> m c) -> f a b -> m (f a c)
-    dimapM f = disequence . fmap f
-    disequence :: Monad m => f a (m b) -> m (f a b)
-    disequence = dimapM id
diff --git a/src/Data/Comp/Param/Equality.hs b/src/Data/Comp/Param/Equality.hs
deleted file mode 100644
--- a/src/Data/Comp/Param/Equality.hs
+++ /dev/null
@@ -1,67 +0,0 @@
-{-# LANGUAGE TypeOperators, TypeSynonymInstances, FlexibleInstances,
-  UndecidableInstances, IncoherentInstances, GADTs #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Data.Comp.Param.Equality
--- Copyright   :  (c) 2011 Patrick Bahr, Tom Hvitved
--- License     :  BSD3
--- Maintainer  :  Tom Hvitved <hvitved@diku.dk>
--- Stability   :  experimental
--- Portability :  non-portable (GHC Extensions)
---
--- This module defines equality for signatures, which lifts to equality for
--- terms.
---
---------------------------------------------------------------------------------
-module Data.Comp.Param.Equality
-    (
-     PEq(..),
-     EqD(..)
-    ) where
-
-import Data.Comp.Param.Term
-import Data.Comp.Param.Sum
-import Data.Comp.Param.Ops
-import Data.Comp.Param.Difunctor
-import Data.Comp.Param.FreshM
-import Control.Monad (liftM)
-
--- |Equality on parametric values. The equality test is performed inside the
--- 'FreshM' monad for generating fresh identifiers.
-class PEq a where
-    peq :: a -> a -> FreshM Bool
-
-instance PEq a => PEq [a] where
-    peq l1 l2
-        | length l1 /= length l2 = return False
-        | otherwise = liftM or $ mapM (uncurry peq) $ zip l1 l2
-
-instance Eq a => PEq a where
-    peq x y = return $ x == y
-
-{-| Signature equality. An instance @EqD f@ gives rise to an instance
-  @Eq (Term f)@. The equality test is performed inside the 'FreshM' monad for
-  generating fresh identifiers. -}
-class EqD f where
-    eqD :: PEq a => f Name a -> f Name a -> FreshM Bool
-
-{-| 'EqD' is propagated through sums. -}
-instance (EqD f, EqD g) => EqD (f :+: g) where
-    eqD (Inl x) (Inl y) = eqD x y
-    eqD (Inr x) (Inr y) = eqD x y
-    eqD _ _ = return False
-
-{-| From an 'EqD' difunctor an 'Eq' instance of the corresponding term type can
-  be derived. -}
-instance EqD f => EqD (Cxt h f) where
-    eqD (In e1) (In e2) = eqD e1 e2
-    eqD (Hole h1) (Hole h2) = peq h1 h2
-    eqD (Var p1) (Var p2) = peq p1 p2
-    eqD _ _ = return False
-
-instance (EqD f, PEq a) => PEq (Cxt h f Name a) where
-    peq = eqD
-
-{-| Equality on terms. -}
-instance (Difunctor f, EqD f) => Eq (Term f) where
-    (==) (Term x) (Term y) = evalFreshM $ eqD x y
diff --git a/src/Data/Comp/Param/FreshM.hs b/src/Data/Comp/Param/FreshM.hs
deleted file mode 100644
--- a/src/Data/Comp/Param/FreshM.hs
+++ /dev/null
@@ -1,49 +0,0 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Data.Comp.Param.FreshM
--- Copyright   :  (c) 2011 Patrick Bahr, Tom Hvitved
--- License     :  BSD3
--- Maintainer  :  Tom Hvitved <hvitved@diku.dk>
--- Stability   :  experimental
--- Portability :  non-portable (GHC Extensions)
---
--- This module defines a monad for generating fresh, abstract names, useful
--- e.g. for defining equality on terms.
---
---------------------------------------------------------------------------------
-module Data.Comp.Param.FreshM
-    (
-     FreshM,
-     Name,
-     withName,
-     evalFreshM
-    ) where
-
-import Control.Monad.Reader
-
--- |Monad for generating fresh (abstract) names.
-newtype FreshM a = FreshM{unFreshM :: Reader Int a}
-    deriving Monad
-
--- |Abstract notion of a name (the constructor is hidden).
-newtype Name = Name Int
-    deriving Eq
-
-instance Show Name where
-    show (Name x) = names !! x
-        where baseNames = ['a'..'z']
-              names = map (:[]) baseNames ++ names' 1
-              names' n = map (: show n) baseNames ++ names' (n + 1)
-
-instance Ord Name where
-    compare (Name x) (Name y) = compare x y
-
--- |Run the given computation with the next available name.
-withName :: (Name -> FreshM a) -> FreshM a
-withName m = do name <- FreshM (asks Name)
-                FreshM $ local ((+) 1) $ unFreshM $ m name
-
--- |Evaluate a computation that uses fresh names.
-evalFreshM :: FreshM a -> a
-evalFreshM (FreshM m) = runReader m 0
diff --git a/src/Data/Comp/Param/Ops.hs b/src/Data/Comp/Param/Ops.hs
deleted file mode 100644
--- a/src/Data/Comp/Param/Ops.hs
+++ /dev/null
@@ -1,127 +0,0 @@
-{-# LANGUAGE TypeOperators, MultiParamTypeClasses, FunctionalDependencies,
-  FlexibleInstances, UndecidableInstances, IncoherentInstances #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Data.Comp.Param.Ops
--- Copyright   :  (c) 2011 Patrick Bahr, Tom Hvitved
--- License     :  BSD3
--- Maintainer  :  Tom Hvitved <hvitved@diku.dk>
--- Stability   :  experimental
--- Portability :  non-portable (GHC Extensions)
---
--- This module provides operators on difunctors.
---
---------------------------------------------------------------------------------
-
-module Data.Comp.Param.Ops where
-
-import Data.Comp.Param.Difunctor
-import Data.Comp.Param.Ditraversable
-import Control.Monad (liftM)
-
-
--- Sums
-infixr 6 :+:
-
--- |Formal sum of signatures (difunctors).
-data (f :+: g) a b = Inl (f a b)
-                   | Inr (g a b)
-
-{-| Utility function to case on a difunctor sum, without exposing the internal
-  representation of sums. -}
-caseD :: (f a b -> c) -> (g a b -> c) -> (f :+: g) a b -> c
-caseD f g x = case x of
-                Inl x -> f x
-                Inr x -> g x
-
-instance (Difunctor f, Difunctor g) => Difunctor (f :+: g) where
-    dimap f g (Inl e) = Inl (dimap f g e)
-    dimap f g (Inr e) = Inr (dimap f g e)
-
-instance (Ditraversable f, Ditraversable g) => Ditraversable (f :+: g) where
-    dimapM f (Inl e) = Inl `liftM` dimapM f e
-    dimapM f (Inr e) = Inr `liftM` dimapM f e
-    disequence (Inl e) = Inl `liftM` disequence e
-    disequence (Inr e) = Inr `liftM` disequence e
-
--- | Signature containment relation for automatic injections. The left-hand must
--- be an atomic signature, where as the right-hand side must have a list-like
--- structure. Examples include @f :<: f :+: g@ and @g :<: f :+: (g :+: h)@,
--- non-examples include @f :+: g :<: f :+: (g :+: h)@ and
--- @f :<: (f :+: g) :+: h@.
-class sub :<: sup where
-  inj :: sub a b -> sup a b
-  proj :: sup a b -> Maybe (sub a b)
-
-instance (:<:) f f where
-    inj = id
-    proj = Just
-
-instance (:<:) f (f :+: g) where
-    inj = Inl
-    proj (Inl x) = Just x
-    proj (Inr _) = Nothing
-
-instance (f :<: g) => (:<:) f (h :+: g) where
-    inj = Inr . inj
-    proj (Inr x) = proj x
-    proj (Inl _) = Nothing
-
-
--- Products
-infixr 8 :*:
-
--- |Formal product of signatures (difunctors).
-data (f :*: g) a b = f a b :*: g a b
-
-ffst :: (f :*: g) a b -> f a b
-ffst (x :*: _) = x
-
-fsnd :: (f :*: g) a b -> g a b
-fsnd (_ :*: x) = x
-
-
--- Constant Products
-infixr 7 :&:
-
-{-| This data type adds a constant product to a signature. -}
-data (f :&: p) a b = f a b :&: p
-
-instance Difunctor f => Difunctor (f :&: p) where
-    dimap f g (v :&: c) = dimap f g v :&: c
-
-instance Ditraversable f => Ditraversable (f :&: p) where
-    dimapM f (v :&: c) = liftM (:&: c) (dimapM f v)
-    disequence (v :&: c) = liftM (:&: c) (disequence v)
-
-{-| This class defines how to distribute an annotation over a sum of
-  signatures. -}
-class DistAnn s p s' | s' -> s, s' -> p where
-    {-| Inject an annotation over a signature. -}
-    injectA :: p -> s a b -> s' a b
-    {-| Project an annotation from a signature. -}
-    projectA :: s' a b -> (s a b, p)
-
-class RemA s s' | s -> s'  where
-    {-| Remove annotations from a signature. -}
-    remA :: s a b -> s' a b
-
-instance (RemA s s') => RemA (f :&: p :+: s) (f :+: s') where
-    remA (Inl (v :&: _)) = Inl v
-    remA (Inr v) = Inr $ remA v
-
-instance RemA (f :&: p) f where
-    remA (v :&: _) = v
-
-instance DistAnn f p (f :&: p) where
-    injectA c v = v :&: c
-
-    projectA (v :&: p) = (v,p)
-
-instance (DistAnn s p s') => DistAnn (f :+: s) p ((f :&: p) :+: s') where
-    injectA c (Inl v) = Inl (v :&: c)
-    injectA c (Inr v) = Inr $ injectA c v
-
-    projectA (Inl (v :&: p)) = (Inl v,p)
-    projectA (Inr v) = let (v',p) = projectA v
-                       in  (Inr v',p)
diff --git a/src/Data/Comp/Param/Ordering.hs b/src/Data/Comp/Param/Ordering.hs
deleted file mode 100644
--- a/src/Data/Comp/Param/Ordering.hs
+++ /dev/null
@@ -1,77 +0,0 @@
-{-# LANGUAGE TypeOperators, TypeSynonymInstances, FlexibleInstances,
-  UndecidableInstances, IncoherentInstances, GADTs #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Data.Comp.Param.Ordering
--- Copyright   :  (c) 2011 Patrick Bahr, Tom Hvitved
--- License     :  BSD3
--- Maintainer  :  Tom Hvitved <hvitved@diku.dk>
--- Stability   :  experimental
--- Portability :  non-portable (GHC Extensions)
---
--- This module defines ordering of signatures, which lifts to ordering of
--- terms and contexts.
---
---------------------------------------------------------------------------------
-module Data.Comp.Param.Ordering
-    (
-     POrd(..),
-     OrdD(..),
-     compList
-    ) where
-
-import Data.Comp.Param.Term
-import Data.Comp.Param.Sum
-import Data.Comp.Param.Ops
-import Data.Comp.Param.Difunctor
-import Data.Comp.Param.FreshM
-import Data.Comp.Param.Equality
-import Data.Maybe (fromMaybe)
-import Data.List (find)
-import Control.Monad (liftM)
-
--- |Ordering of parametric values.
-class PEq a => POrd a where
-    pcompare :: a -> a -> FreshM Ordering
-
-instance POrd a => POrd [a] where
-    pcompare l1 l2
-        | length l1 < length l2 = return LT
-        | length l1 > length l2 = return GT
-        | otherwise = liftM compList $ mapM (uncurry pcompare) $ zip l1 l2
-
-compList :: [Ordering] -> Ordering
-compList = fromMaybe EQ . find (/= EQ)
-
-instance Ord a => POrd a where
-    pcompare x y = return $ compare x y
-
-{-| Signature ordering. An instance @OrdD f@ gives rise to an instance
-  @Ord (Term f)@. -}
-class EqD f => OrdD f where
-    compareD :: POrd a => f Name a -> f Name a -> FreshM Ordering
-
-{-| 'OrdD' is propagated through sums. -}
-instance (OrdD f, OrdD g) => OrdD (f :+: g) where
-    compareD (Inl x) (Inl y) = compareD x y
-    compareD (Inl _) (Inr _) = return LT
-    compareD (Inr x) (Inr y) = compareD x y
-    compareD (Inr _) (Inl _) = return GT
-
-{-| From an 'OrdD' difunctor an 'Ord' instance of the corresponding term type
-  can be derived. -}
-instance OrdD f => OrdD (Cxt h f) where
-    compareD (In e1) (In e2) = compareD e1 e2
-    compareD (Hole h1) (Hole h2) = pcompare h1 h2
-    compareD (Var p1) (Var p2) = pcompare p1 p2
-    compareD (In _) _ = return LT
-    compareD (Hole _) (In _) = return GT
-    compareD (Hole _) (Var _) = return LT
-    compareD (Var _) _ = return GT
-
-instance (OrdD f, POrd a) => POrd (Cxt h f Name a) where
-    pcompare = compareD
-
-{-| Ordering of terms. -}
-instance (Difunctor f, OrdD f) => Ord (Term f) where
-    compare (Term x) (Term y) = evalFreshM $ compareD x y
diff --git a/src/Data/Comp/Param/Show.hs b/src/Data/Comp/Param/Show.hs
deleted file mode 100644
--- a/src/Data/Comp/Param/Show.hs
+++ /dev/null
@@ -1,41 +0,0 @@
-{-# LANGUAGE TypeOperators, FlexibleInstances, TypeSynonymInstances,
-  IncoherentInstances, UndecidableInstances, TemplateHaskell, GADTs #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Data.Comp.Param.Show
--- Copyright   :  (c) 2011 Patrick Bahr, Tom Hvitved
--- License     :  BSD3
--- Maintainer  :  Tom Hvitved <hvitved@diku.dk>
--- Stability   :  experimental
--- Portability :  non-portable (GHC Extensions)
---
--- This module defines showing of signatures, which lifts to showing of terms.
---
---------------------------------------------------------------------------------
-module Data.Comp.Param.Show
-    (
-     ShowD(..)
-    ) where
-
-import Data.Comp.Param.Term
-import Data.Comp.Param.Ops
-import Data.Comp.Param.Derive
-import Data.Comp.Param.FreshM
-
--- Lift ShowD to sums
-$(derive [liftSum] [''ShowD])
-
-{-| From an 'ShowD' difunctor an 'ShowD' instance of the corresponding term type
-  can be derived. -}
-instance (Difunctor f, ShowD f) => ShowD (Cxt h f) where
-    showD (In t) = showD $ fmap showD t
-    showD (Hole h) = h
-    showD (Var p) = return $ show p
-
-{-| Printing of terms. -}
-instance (Difunctor f, ShowD f) => Show (Term f) where
-    show = evalFreshM . showD . toCxt . unTerm
-
-instance (ShowD f, Show p) => ShowD (f :&: p) where
-    showD (x :&: p) = do sx <- showD x
-                         return $ sx ++ " :&: " ++ show p
diff --git a/src/Data/Comp/Param/Sum.hs b/src/Data/Comp/Param/Sum.hs
deleted file mode 100644
--- a/src/Data/Comp/Param/Sum.hs
+++ /dev/null
@@ -1,186 +0,0 @@
-{-# LANGUAGE TypeOperators, MultiParamTypeClasses, IncoherentInstances,
-  FlexibleInstances, FlexibleContexts, GADTs, TypeSynonymInstances,
-  ScopedTypeVariables, TemplateHaskell, Rank2Types #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Data.Comp.Param.Sum
--- Copyright   :  (c) 2011 Patrick Bahr, Tom Hvitved
--- License     :  BSD3
--- Maintainer  :  Tom Hvitved <hvitved@diku.dk>
--- Stability   :  experimental
--- Portability :  non-portable (GHC Extensions)
---
--- This module provides the infrastructure to extend signatures.
---
---------------------------------------------------------------------------------
-
-module Data.Comp.Param.Sum
-    (
-     (:<:),
-     (:+:),
-     caseD,
-
-     -- * Projections for Signatures and Terms
-     proj,
-     proj2,
-     proj3,
-     proj4,
-     proj5,
-     proj6,
-     proj7,
-     proj8,
-     proj9,
-     proj10,
-     project,
-     project2,
-     project3,
-     project4,
-     project5,
-     project6,
-     project7,
-     project8,
-     project9,
-     project10,
-     deepProject,
-     deepProject2,
-     deepProject3,
-     deepProject4,
-     deepProject5,
-     deepProject6,
-     deepProject7,
-     deepProject8,
-     deepProject9,
-     deepProject10,
-
-     -- * Injections for Signatures and Terms
-     inj,
-     inj2,
-     inj3,
-     inj4,
-     inj5,
-     inj6,
-     inj7,
-     inj8,
-     inj9,
-     inj10,
-     inject,
-     inject',
-     inject2,
-     inject3,
-     inject4,
-     inject5,
-     inject6,
-     inject7,
-     inject8,
-     inject9,
-     inject10,
-     deepInject,
-     deepInject2,
-     deepInject3,
-     deepInject4,
-     deepInject5,
-     deepInject6,
-     deepInject7,
-     deepInject8,
-     deepInject9,
-     deepInject10,
-
-     injectCxt,
-     liftCxt
-    ) where
-
-import Prelude hiding (sequence)
-import Control.Monad hiding (sequence)
-import Data.Comp.Param.Term
-import Data.Comp.Param.Algebra
-import Data.Comp.Param.Ops
-import Data.Comp.Param.Derive.Projections
-import Data.Comp.Param.Derive.Injections
-import Data.Comp.Param.Difunctor
-import Data.Comp.Param.Ditraversable
-
-$(liftM concat $ mapM projn [2..10])
-
--- |Project the outermost layer of a term to a sub signature. If the signature
--- @g@ is compound of /n/ atomic signatures, use @project@/n/ instead.
-project :: (g :<: f) => Cxt h f a b -> Maybe (g a (Cxt h f a b))
-project (In t) = proj t
-project (Hole _) = Nothing
-project (Var _) = Nothing
-
-$(liftM concat $ mapM projectn [2..10])
-
--- | Tries to coerce a term/context to a term/context over a sub-signature. If
--- the signature @g@ is compound of /n/ atomic signatures, use
--- @deepProject@/n/ instead.
-deepProject :: (Ditraversable g, g :<: f) => Term f -> Maybe (Term g)
-{-# INLINE deepProject #-}
-deepProject = appTSigFunM' proj
-
-$(liftM concat $ mapM deepProjectn [2..10])
-{-# INLINE deepProject2 #-}
-{-# INLINE deepProject3 #-}
-{-# INLINE deepProject4 #-}
-{-# INLINE deepProject5 #-}
-{-# INLINE deepProject6 #-}
-{-# INLINE deepProject7 #-}
-{-# INLINE deepProject8 #-}
-{-# INLINE deepProject9 #-}
-{-# INLINE deepProject10 #-}
-
-$(liftM concat $ mapM injn [2..10])
-
--- |Inject a term where the outermost layer is a sub signature. If the signature
--- @g@ is compound of /n/ atomic signatures, use @inject@/n/ instead.
-inject :: (g :<: f) => g a (Cxt h f a b) -> Cxt h f a b
-inject = In . inj
-
--- |Inject a term where the outermost layer is a sub signature. If the signature
--- @g@ is compound of /n/ atomic signatures, use @inject@/n/ instead.
-inject' :: (Difunctor g, g :<: f) => g (Cxt h f a b) (Cxt h f a b) -> Cxt h f a b
-inject' = inject . dimap Var id
-
-$(liftM concat $ mapM injectn [2..10])
-
--- |Inject a term over a sub signature to a term over larger signature. If the
--- signature @g@ is compound of /n/ atomic signatures, use @deepInject@/n/
--- instead.
-deepInject :: (Difunctor g, g :<: f) => Term g -> Term f
-{-# INLINE deepInject #-}
-deepInject (Term t) = Term (appSigFun inj t)
-
-$(liftM concat $ mapM deepInjectn [2..10])
-{-# INLINE deepInject2 #-}
-{-# INLINE deepInject3 #-}
-{-# INLINE deepInject4 #-}
-{-# INLINE deepInject5 #-}
-{-# INLINE deepInject6 #-}
-{-# INLINE deepInject7 #-}
-{-# INLINE deepInject8 #-}
-{-# INLINE deepInject9 #-}
-{-# INLINE deepInject10 #-}
-
-{-| This function injects a whole context into another context. -}
-injectCxt :: (Difunctor g, g :<: f) => Cxt h g a (Cxt h f a b) -> Cxt h f a b
-injectCxt (In t) = inject $ difmap injectCxt t
-injectCxt (Hole x) = x
-injectCxt (Var p) = Var p
-
-{-| This function lifts the given functor to a context. -}
-liftCxt :: (Difunctor f, g :<: f) => g a b -> Cxt Hole f a b
-liftCxt g = simpCxt $ inj g
-
-instance (Show (f a b), Show (g a b)) => Show ((f :+: g) a b) where
-    show (Inl v) = show v
-    show (Inr v) = show v
-
-instance (Ord (f a b), Ord (g a b)) => Ord ((f :+: g) a b) where
-    compare (Inl _) (Inr _) = LT
-    compare (Inr _) (Inl _) = GT
-    compare (Inl x) (Inl y) = compare x y
-    compare (Inr x) (Inr y) = compare x y
-
-instance (Eq (f a b), Eq (g a b)) => Eq ((f :+: g) a b) where
-    (Inl x) == (Inl y) = x == y
-    (Inr x) == (Inr y) = x == y                   
-    _ == _ = False
diff --git a/src/Data/Comp/Param/Term.hs b/src/Data/Comp/Param/Term.hs
deleted file mode 100644
--- a/src/Data/Comp/Param/Term.hs
+++ /dev/null
@@ -1,109 +0,0 @@
-{-# LANGUAGE EmptyDataDecls, GADTs, KindSignatures, Rank2Types,
-  MultiParamTypeClasses, TypeSynonymInstances, FlexibleInstances #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Data.Comp.Param.Term
--- Copyright   :  (c) 2011 Patrick Bahr, Tom Hvitved
--- License     :  BSD3
--- Maintainer  :  Tom Hvitved <hvitved@diku.dk>
--- Stability   :  experimental
--- Portability :  non-portable (GHC Extensions)
---
--- This module defines the central notion of /parametrised terms/ and their
--- generalisation to parametrised contexts.
---
---------------------------------------------------------------------------------
-
-module Data.Comp.Param.Term
-    (
-     Cxt(..),
-     Hole,
-     NoHole,
-     Term(..),
-     Trm,
-     Context,
-     simpCxt,
-     toCxt,
-     cxtMap,
-     ParamFunctor(..)
-    ) where
-
-import Prelude hiding (mapM, sequence, foldl, foldl1, foldr, foldr1)
-import Data.Comp.Param.Difunctor
-import Unsafe.Coerce (unsafeCoerce)
-
-import Data.Maybe (fromJust)
-
-{-| This data type represents contexts over a signature. Contexts are terms
-  containing zero or more holes, and zero or more parameters. The first
-  parameter is a phantom type indicating whether the context has holes. The
-  second paramater is the signature of the context, in the form of a
-  "Data.Comp.Param.Difunctor". The third parameter is the type of parameters,
-  and the fourth parameter is the type of holes. -}
-data Cxt :: * -> (* -> * -> *) -> * -> * -> * where
-            In :: f a (Cxt h f a b) -> Cxt h f a b
-            Hole :: b -> Cxt Hole f a b
-            Var :: a -> Cxt h f a b
-
-{-| Phantom type used to define 'Context'. -}
-data Hole
-
-{-| Phantom type used to define 'Term'. -}
-data NoHole
-
-{-| A context may contain holes. -}
-type Context = Cxt Hole
-
-{-| \"Preterms\" -}
-type Trm f a = Cxt NoHole f a ()
-
-{-| A term is a context with no holes, where all occurrences of the
-  contravariant parameter is fully parametric. -}
-newtype Term f = Term{unTerm :: forall a. Trm f a}
-
-{-| Convert a difunctorial value into a context. -}
-simpCxt :: Difunctor f => f a b -> Cxt Hole f a b
-{-# INLINE simpCxt #-}
-simpCxt = In . difmap Hole
-
-toCxt :: Difunctor f => Trm f a -> Cxt h f a b
-{-# INLINE toCxt #-}
-toCxt = unsafeCoerce
-
--- | This combinator maps a function over a context by applying the
--- function to each hole.
-cxtMap :: Difunctor f => (b -> c) -> Context f a b -> Context f a c
-cxtMap f (Hole x) = Hole (f x)
-cxtMap _ (Var x)  = Var x
-cxtMap f (In t)   = In (dimap id (cxtMap f) t)
-
--- Param Functor
-
-{-| Monads for which embedded @Trm@ values, which are parametric at top level,
-  can be made into monadic @Term@ values, i.e. \"pushing the parametricity
-  inwards\". -}
-class ParamFunctor m where
-    termM :: (forall a. m (Trm f a)) -> m (Term f)
-
-coerceTermM :: ParamFunctor m => (forall a. m (Trm f a)) -> m (Term f)
-{-# INLINE coerceTermM #-}
-coerceTermM t = unsafeCoerce t
-
-{-# RULES
-    "termM/coerce" termM = coerceTermM
- #-}
-
-instance ParamFunctor Maybe where
-    termM Nothing = Nothing
-    termM x       = Just (Term $ fromJust x)
-
-instance ParamFunctor (Either a) where
-    termM (Left x) = Left x
-    termM x        = Right (Term $ fromRight x)
-                             where fromRight :: Either a b -> b
-                                   fromRight (Right x) = x
-                                   fromRight _ = error "fromRight: Left"
-
-instance ParamFunctor [] where
-    termM [] = []
-    termM l  = Term (head l) : termM (tail l)
diff --git a/src/Data/Comp/Param/Thunk.hs b/src/Data/Comp/Param/Thunk.hs
deleted file mode 100644
--- a/src/Data/Comp/Param/Thunk.hs
+++ /dev/null
@@ -1,127 +0,0 @@
-{-# LANGUAGE TypeOperators, FlexibleContexts, Rank2Types, GADTs #-}
-
---------------------------------------------------------------------------------
--- |
--- Module      :  Data.Comp.Param.Thunk
--- Copyright   :  (c) 2011 Patrick Bahr
--- License     :  BSD3
--- Maintainer  :  Patrick Bahr <paba@diku.dk>
--- Stability   :  experimental
--- Portability :  non-portable (GHC Extensions)
---
--- This modules defines terms & contexts with thunks, with deferred
--- monadic computations.
---
---------------------------------------------------------------------------------
-
-module Data.Comp.Param.Thunk
-    (TermT
-    ,TrmT
-    ,CxtT
-    ,Thunk
-    ,thunk
-    ,whnf
-    ,whnf'
-    ,whnfPr
-    ,nf
-    ,nfT
-    ,nfPr
-    ,nfTPr
-    ,evalStrict
-    ,AlgT
-    ,strict
-    ,strict')
- where
-
-import Data.Comp.Param.Term
-import Data.Comp.Param.Sum
-import Data.Comp.Param.Ops
-import Data.Comp.Param.Algebra
-import Data.Comp.Param.Ditraversable
-import Data.Comp.Param.Difunctor
-
-import Control.Monad
-
--- | This type represents terms with thunks.
-type TermT m f = Term (Thunk m :+: f)
-
--- | This type represents terms with thunks.
-type TrmT m f a = Trm  (Thunk m :+: f) a
-
--- | This type represents contexts with thunks.
-type CxtT h  m f a = Cxt h (Thunk m :+: f) a
-
-newtype Thunk m a b = Thunk (m b)
-
--- | This function turns a monadic computation into a thunk.
-thunk :: (Thunk m :<: f) => m (Cxt h f a b) -> Cxt h f a b
-thunk = inject . Thunk
-
--- | This function evaluates all thunks until a non-thunk node is
--- found.
-whnf :: Monad m => TrmT m f a -> m (Either a (f a (TrmT m f a)))
-whnf (In (Inl (Thunk m))) = m >>= whnf
-whnf (In (Inr t)) = return $ Right t
-whnf (Var x) = return $ Left x
-
-whnf' :: Monad m => TrmT m f a -> m (TrmT m f a)
-whnf' =  liftM (either Var inject) . whnf
-
--- | This function first evaluates the argument term into whnf via
--- 'whnf' and then projects the top-level signature to the desired
--- subsignature. Failure to do the projection is signalled as a
--- failure in the monad.
-whnfPr :: (Monad m, g :<: f) => TrmT m f a -> m (g a (TrmT m f a))
-whnfPr t = do res <- whnf t
-              case res of
-                Left _  -> fail "cannot project variable"
-                Right t ->
-                    case proj t of
-                      Just res' -> return res'
-                      Nothing -> fail "projection failed"
-
-
--- | This function evaluates all thunks.
-nfT :: (ParamFunctor m, Monad m, Ditraversable f) => TermT m f -> m (Term f)
-nfT t = termM $ nf $ unTerm  t
-
--- | This function evaluates all thunks.
-nf :: (Monad m, Ditraversable f) => TrmT m f a -> m (Trm f a)
-nf = either (return . Var) (liftM In . dimapM nf) <=< whnf
-
--- | This function evaluates all thunks while simultaneously
--- projecting the term to a smaller signature. Failure to do the
--- projection is signalled as a failure in the monad as in 'whnfPr'.
-nfTPr :: (ParamFunctor m, Monad m, Ditraversable g, g :<: f) => TermT m f -> m (Term g)
-nfTPr t = termM $ nfPr $ unTerm t
-
--- | This function evaluates all thunks while simultaneously
--- projecting the term to a smaller signature. Failure to do the
--- projection is signalled as a failure in the monad as in 'whnfPr'.
-nfPr :: (Monad m, Ditraversable g, g :<: f) => TrmT m f a -> m (Trm g a)
-nfPr = liftM In . dimapM nfPr <=< whnfPr
-
-
-evalStrict :: (Ditraversable g, Monad m, g :<: f) => 
-              (g (TrmT m f a) (f a (TrmT m f a)) -> TrmT m f a)
-           -> g (TrmT m f a) (TrmT m f a) -> TrmT m f a
-evalStrict cont t = thunk $ do 
-                      t' <- dimapM (liftM (either (const Nothing) Just) . whnf) t
-                      case disequence t' of
-                        Nothing -> return $ inject' t
-                        Just s -> return $ cont s
-                      
-
--- | This type represents algebras which have terms with thunks as
--- carrier.
-type AlgT m f g = Alg f (TermT m g)
-
--- | This combinator makes the evaluation of the given functor
--- application strict by evaluating all thunks of immediate subterms.
-strict :: (f :<: g, Ditraversable f, Monad m) => f a (TrmT m g a) -> TrmT m g a
-strict x = thunk $ liftM inject $ dimapM whnf' x
-
--- | This combinator makes the evaluation of the given functor
--- application strict by evaluating all thunks of immediate subterms.
-strict' :: (f :<: g, Ditraversable f, Monad m) => f (TrmT m g a) (TrmT m g a) -> TrmT m g a
-strict'  = strict . dimap Var id
diff --git a/src/Data/Comp/Render.hs b/src/Data/Comp/Render.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Comp/Render.hs
@@ -0,0 +1,33 @@
+{-# LANGUAGE TemplateHaskell, TypeSynonymInstances #-}
+module Data.Comp.Render where
+
+import Data.Foldable (toList)
+import Data.Tree (Tree (..))
+import Data.Tree.View
+import Data.Comp
+import Data.Comp.Derive
+import Data.Comp.Show ()
+
+-- | The 'stringTree' algebra of a functor. The default instance creates a tree
+-- with the same structure as the term.
+class (Functor f, Foldable f, ShowConstr f) => Render f where
+    stringTreeAlg :: Alg f (Tree String)
+    stringTreeAlg f = Node (showConstr f) $ toList f
+
+-- | Convert a term to a 'Tree'
+stringTree :: Render f => Term f -> Tree String
+stringTree = cata stringTreeAlg
+
+-- | Show a term using ASCII art
+showTerm :: Render f => Term f -> String
+showTerm = showTree . stringTree
+
+-- | Print a term using ASCII art
+drawTerm :: Render f => Term f -> IO ()
+drawTerm = putStrLn . showTerm
+
+-- | Write a term to an HTML file with foldable nodes
+writeHtmlTerm :: Render f => FilePath -> Term f -> IO ()
+writeHtmlTerm file = writeHtmlTree file . fmap (\n -> NodeInfo n "") . stringTree
+
+$(derive [liftSum] [''Render])
diff --git a/src/Data/Comp/Show.hs b/src/Data/Comp/Show.hs
--- a/src/Data/Comp/Show.hs
+++ b/src/Data/Comp/Show.hs
@@ -36,3 +36,8 @@
 
 $(derive [liftSum] [''ShowF])
 $(derive [makeShowF] [''Maybe, ''[], ''(,)])
+
+instance (ShowConstr f, Show p) => ShowConstr (f :&: p) where
+    showConstr (v :&: p) = showConstr v ++ " :&: " ++ show p
+
+$(derive [liftSum] [''ShowConstr])
diff --git a/src/Data/Comp/Sum.hs b/src/Data/Comp/Sum.hs
--- a/src/Data/Comp/Sum.hs
+++ b/src/Data/Comp/Sum.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE TypeOperators, MultiParamTypeClasses, IncoherentInstances,
   FlexibleInstances, FlexibleContexts, GADTs, TypeSynonymInstances,
-  ScopedTypeVariables, TemplateHaskell #-}
+  ScopedTypeVariables, TemplateHaskell, ConstraintKinds, Rank2Types #-}
 --------------------------------------------------------------------------------
 -- |
 -- Module      :  Data.Comp.Sum
@@ -17,77 +17,28 @@
 module Data.Comp.Sum
     (
      (:<:),
+     (:=:),
      (:+:),
      caseF,
 
      -- * Projections for Signatures and Terms
      proj,
-     proj2,
-     proj3,
-     proj4,
-     proj5,
-     proj6,
-     proj7,
-     proj8,
-     proj9,
-     proj10,
      project,
-     project2,
-     project3,
-     project4,
-     project5,
-     project6,
-     project7,
-     project8,
-     project9,
-     project10,
      deepProject,
-     deepProject2,
-     deepProject3,
-     deepProject4,
-     deepProject5,
-     deepProject6,
-     deepProject7,
-     deepProject8,
-     deepProject9,
-     deepProject10,
+     project_,
+     deepProject_,
 
      -- * Injections for Signatures and Terms
      inj,
-     inj2,
-     inj3,
-     inj4,
-     inj5,
-     inj6,
-     inj7,
-     inj8,
-     inj9,
-     inj10,
      inject,
-     inject2,
-     inject3,
-     inject4,
-     inject5,
-     inject6,
-     inject7,
-     inject8,
-     inject9,
-     inject10,
      deepInject,
-     deepInject2,
-     deepInject3,
-     deepInject4,
-     deepInject5,
-     deepInject6,
-     deepInject7,
-     deepInject8,
-     deepInject9,
-     deepInject10,
+     inject_,
+     deepInject_,
 
+     split,
+
      -- * Injections and Projections for Constants
      injectConst,
-     injectConst2,
-     injectConst3,
      projectConst,
      injectCxt,
      liftCxt,
@@ -98,10 +49,9 @@
 import Data.Comp.Term
 import Data.Comp.Algebra
 import Data.Comp.Ops
-import Data.Comp.Derive.Projections
-import Data.Comp.Derive.Injections
 
 import Control.Monad hiding (mapM,sequence)
+import Control.Applicative (Applicative (..))
 import Prelude hiding (mapM,sequence)
 
 import Data.Maybe
@@ -110,16 +60,18 @@
 import qualified Data.Map as Map
 
 
-$(liftM concat $ mapM projn [2..10])
-
 -- |Project the outermost layer of a term to a sub signature. If the signature
 -- @g@ is compound of /n/ atomic signatures, use @project@/n/ instead.
 project :: (g :<: f) => Cxt h f a -> Maybe (g (Cxt h f a))
-project (Hole _) = Nothing
-project (Term t) = proj t
+project = project_ proj
 
-$(liftM concat $ mapM projectn [2..10])
+-- |Project the outermost layer of a term to a sub signature. If the signature
+-- @g@ is compound of /n/ atomic signatures, use @project@/n/ instead.
+project_ :: (SigFunM Maybe f g) -> Cxt h f a -> Maybe (g (Cxt h f a))
+project_ _ (Hole _) = Nothing
+project_ f (Term t) = f t
 
+
 -- | Tries to coerce a term/context to a term/context over a sub-signature. If
 -- the signature @g@ is compound of /n/ atomic signatures, use
 -- @deepProject@/n/ instead.
@@ -127,55 +79,47 @@
 {-# INLINE deepProject #-}
 deepProject = appSigFunM' proj
 
-$(liftM concat $ mapM deepProjectn [2..10])
-{-# INLINE deepProject2 #-}
-{-# INLINE deepProject3 #-}
-{-# INLINE deepProject4 #-}
-{-# INLINE deepProject5 #-}
-{-# INLINE deepProject6 #-}
-{-# INLINE deepProject7 #-}
-{-# INLINE deepProject8 #-}
-{-# INLINE deepProject9 #-}
-{-# INLINE deepProject10 #-}
+-- | Tries to coerce a term/context to a term/context over a sub-signature. If
+-- the signature @g@ is compound of /n/ atomic signatures, use
+-- @deepProject@/n/ instead.
+deepProject_ :: (Traversable g) => (SigFunM Maybe f g) -> CxtFunM Maybe f g
+{-# INLINE deepProject_ #-}
+deepProject_ f = appSigFunM' f
 
-$(liftM concat $ mapM injn [2..10])
 
 -- |Inject a term where the outermost layer is a sub signature. If the signature
 -- @g@ is compound of /n/ atomic signatures, use @inject@/n/ instead.
 inject :: (g :<: f) => g (Cxt h f a) -> Cxt h f a
-inject = Term . inj
+inject = inject_ inj
 
-$(liftM concat $ mapM injectn [2..10])
+-- |Inject a term where the outermost layer is a sub signature. If the signature
+-- @g@ is compound of /n/ atomic signatures, use @inject@/n/ instead.
+inject_ :: (SigFun g f) -> g (Cxt h f a) -> Cxt h f a
+inject_ f = Term . f
 
+
 -- |Inject a term over a sub signature to a term over larger signature. If the
 -- signature @g@ is compound of /n/ atomic signatures, use @deepInject@/n/
 -- instead.
 deepInject :: (Functor g, g :<: f) => CxtFun g f
 {-# INLINE deepInject #-}
-deepInject = appSigFun inj
+deepInject = deepInject_ inj
 
-$(liftM concat $ mapM deepInjectn [2..10])
-{-# INLINE deepInject2 #-}
-{-# INLINE deepInject3 #-}
-{-# INLINE deepInject4 #-}
-{-# INLINE deepInject5 #-}
-{-# INLINE deepInject6 #-}
-{-# INLINE deepInject7 #-}
-{-# INLINE deepInject8 #-}
-{-# INLINE deepInject9 #-}
-{-# INLINE deepInject10 #-}
+-- |Inject a term over a sub signature to a term over larger signature. If the
+-- signature @g@ is compound of /n/ atomic signatures, use @deepInject@/n/
+-- instead.
+deepInject_ :: (Functor g) => SigFun g f -> CxtFun g f
+{-# INLINE deepInject_ #-}
+deepInject_ f = appSigFun f
 
+
+split :: (f :<: f1 :+: f2) => (f1 (Term f) -> a) -> (f2 (Term f) -> a) -> Term f -> a
+split f1 f2 (Term t) = spl f1 f2 t
+
 injectConst :: (Functor g, g :<: f) => Const g -> Cxt h f a
 injectConst = inject . fmap (const undefined)
 
-injectConst2 :: (Functor f1, Functor f2, Functor g, f1 :<: g, f2 :<: g)
-             => Const (f1 :+: f2) -> Cxt h g a
-injectConst2 = inject2 . fmap (const undefined)
 
-injectConst3 :: (Functor f1, Functor f2, Functor f3, Functor g, f1 :<: g, f2 :<: g, f3 :<: g)
-             => Const (f1 :+: f2 :+: f3) -> Cxt h g a
-injectConst3 = inject3 . fmap (const undefined)
-
 projectConst :: (Functor g, g :<: f) => Cxt h f a -> Maybe (Const g)
 projectConst = fmap (fmap (const ())) . project
 
@@ -196,10 +140,6 @@
 
 substHoles' :: (Functor f, Functor g, f :<: g, Ord v) => Cxt h' f v -> Map v (Cxt h g a) -> Cxt h g a
 substHoles' c m = substHoles c (fromJust . (`Map.lookup`  m))
-
-instance (Functor f) => Monad (Context f) where
-    return = Hole
-    (>>=) = substHoles
 
 
 instance (Show (f a), Show (g a)) => Show ((f :+: g) a) where
diff --git a/src/Data/Comp/Term.hs b/src/Data/Comp/Term.hs
--- a/src/Data/Comp/Term.hs
+++ b/src/Data/Comp/Term.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE EmptyDataDecls, GADTs, KindSignatures, Rank2Types #-}
+{-# LANGUAGE EmptyDataDecls, GADTs, KindSignatures, Rank2Types, TypeSynonymInstances, FlexibleInstances #-}
 --------------------------------------------------------------------------------
 -- |
 -- Module      :  Data.Comp.Term
@@ -92,6 +92,16 @@
 instance Functor f => Functor (Cxt h f) where
     fmap f = run
         where run (Hole v) = Hole (f v)
+              run (Term t) = Term (fmap run t)
+
+instance Functor f => Applicative (Context f) where
+    pure = Hole
+    (<*>) = ap
+
+instance (Functor f) => Monad (Context f) where
+    return = Hole
+    m >>= f = run m
+        where run (Hole v) = f v
               run (Term t) = Term (fmap run t)
 
 instance (Foldable f) => Foldable (Cxt h f) where
diff --git a/src/Data/Comp/Thunk.hs b/src/Data/Comp/Thunk.hs
--- a/src/Data/Comp/Thunk.hs
+++ b/src/Data/Comp/Thunk.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE TypeOperators, FlexibleContexts, Rank2Types, ScopedTypeVariables #-}
+{-# LANGUAGE TypeOperators, FlexibleContexts, Rank2Types, ScopedTypeVariables, ConstraintKinds #-}
 
 --------------------------------------------------------------------------------
 -- |
@@ -18,6 +18,7 @@
     (TermT
     ,CxtT
     ,thunk
+    ,injectT
     ,whnf
     ,whnf'
     ,whnfPr
@@ -39,7 +40,7 @@
 import Data.Comp.Term
 import Data.Comp.Equality
 import Data.Comp.Algebra
-import Data.Comp.Ops
+import Data.Comp.Ops ((:+:)(..), fromInr)
 import Data.Comp.Sum
 import Data.Comp.Number
 import Data.Foldable hiding (and)
@@ -60,9 +61,13 @@
 
 
 -- | This function turns a monadic computation into a thunk.
-thunk :: (m :<: f) => m (Cxt h f a) -> Cxt h f a
-thunk = inject
+thunk :: m (CxtT m h f a) -> CxtT m h f a
+thunk = inject_ Inl
 
+-- | Variant of 'inject' for the typex 'CxtT' and 'TermT'.
+injectT :: (g :<: f) => g (CxtT m h f a) -> CxtT m h f a
+injectT = inject_ (Inr . inj)
+
 -- | This function evaluates all thunks until a non-thunk node is
 -- found.
 whnf :: Monad m => TermT m f -> m (f (TermT m f))
@@ -70,7 +75,7 @@
 whnf (Term (Inr t)) = return t
 
 whnf' :: Monad m => TermT m f -> m (TermT m f)
-whnf' = liftM inject . whnf
+whnf' = liftM (inject_ Inr) . whnf
 
 -- | This function first evaluates the argument term into whnf via
 -- 'whnf' and then projects the top-level signature to the desired
@@ -114,7 +119,7 @@
 -- given function.
 deepEval :: (Traversable f, Monad m) => 
             (Term f -> TermT m f) -> TermT m f -> TermT m f
-deepEval cont v = case deepProject v of 
+deepEval cont v = case deepProject_ fromInr v of 
                     Just v' -> cont v'
                     _ -> thunk $ liftM cont $ nf v 
 
@@ -150,7 +155,7 @@
 -- | This combinator makes the evaluation of the given functor
 -- application strict by evaluating all thunks of immediate subterms.
 strict :: (f :<: g, Traversable f, Monad m) => f (TermT m g) -> TermT m g
-strict x = thunk $ liftM inject $ mapM whnf' x
+strict x = thunk $ liftM (inject_ (Inr . inj)) $ mapM whnf' x
 
 -- | This type represents position representations for a functor
 -- @f@. It is a function that extracts a number of components (of
@@ -163,7 +168,7 @@
 -- argument of this combinator specifies which positions are supposed
 -- to be strict.
 strictAt :: (f :<: g, Traversable f, Monad m) => Pos f ->  f (TermT m g) -> TermT m g
-strictAt p s = thunk $ liftM inject $ mapM run s'
+strictAt p s = thunk $ liftM (inject_ (Inr . inj)) $ mapM run s'
     where s'  = number s
           isStrict e = Set.member e $ Set.fromList $ p s'
           run e | isStrict e = whnf' $ unNumbered e
diff --git a/testsuite/tests/Data/Comp/Examples/MultiParam.hs b/testsuite/tests/Data/Comp/Examples/MultiParam.hs
deleted file mode 100644
--- a/testsuite/tests/Data/Comp/Examples/MultiParam.hs
+++ /dev/null
@@ -1,34 +0,0 @@
-{-# LANGUAGE TypeOperators #-}
-module Data.Comp.Examples.MultiParam where
-
-import Examples.MultiParam.FOL as FOL
-
-import Data.Comp.MultiParam
-import Data.Comp.MultiParam.FreshM (Name)
-
-import Test.Framework
-import Test.Framework.Providers.HUnit
-import Test.HUnit
-import Test.Utils
-
-
-
-
-
---------------------------------------------------------------------------------
--- Test Suits
---------------------------------------------------------------------------------
-
-tests = testGroup "Parametric Compositional Data Types" [
-         testCase "FOL" folTest
-        ]
-
-
---------------------------------------------------------------------------------
--- Properties
---------------------------------------------------------------------------------
-
-folTest = show (foodFact7 :: INF Name TFormula) @=? "(Person(x1) and Food(x2)) -> (Food(Skol2(x1)) or Person(Skol6(x2)))\n" ++
-          "(Person(x1) and Food(x2)) -> (Food(Skol2(x1)) or Eats(Skol6(x2), x2))\n" ++
-                                                                                        "(Person(x1) and Eats(x1, Skol2(x1)) and Food(x2)) -> (Person(Skol6(x2)))\n" ++
-                                                                                        "(Person(x1) and Eats(x1, Skol2(x1)) and Food(x2)) -> (Eats(Skol6(x2), x2))"
diff --git a/testsuite/tests/Data/Comp/Examples/Param.hs b/testsuite/tests/Data/Comp/Examples/Param.hs
deleted file mode 100644
--- a/testsuite/tests/Data/Comp/Examples/Param.hs
+++ /dev/null
@@ -1,38 +0,0 @@
-{-# LANGUAGE TypeOperators #-}
-module Data.Comp.Examples.Param where
-
-import Examples.Param.Names as Names
-import Examples.Param.Graph as Graph
-
-import Data.Comp.Param
-
-import Test.Framework
-import Test.Framework.Providers.HUnit
-import Test.HUnit
-import Test.Utils
-
-
-
-
-
---------------------------------------------------------------------------------
--- Test Suits
---------------------------------------------------------------------------------
-
-tests = testGroup "Parametric Compositional Data Types" [
-         testCase "names" namesTest,
-         testCase "graph" graphTest
-        ]
-
-
---------------------------------------------------------------------------------
--- Properties
---------------------------------------------------------------------------------
-
-instance (EqD f, PEq p) => EqD (f :&: p) where
-    eqD (v1 :&: p1) (v2 :&: p2) = do b1 <- peq p1 p2
-                                     b2 <- eqD v1 v2
-                                     return $ b1 && b2
-
-namesTest = sequence_ [en @=? en', ep @=? ep']
-graphTest = sequence_ [n @=? 5, f @=? [0,2,1,2]]
diff --git a/testsuite/tests/Data/Comp/Examples_Test.hs b/testsuite/tests/Data/Comp/Examples_Test.hs
--- a/testsuite/tests/Data/Comp/Examples_Test.hs
+++ b/testsuite/tests/Data/Comp/Examples_Test.hs
@@ -3,8 +3,6 @@
 
 import qualified Data.Comp.Examples.Comp as C
 import qualified Data.Comp.Examples.Multi as M
-import qualified Data.Comp.Examples.Param as P
-import qualified Data.Comp.Examples.MultiParam as MP
 
 import Test.Framework
 import Test.Framework.Providers.QuickCheck2
@@ -13,7 +11,5 @@
 
 tests = testGroup "Examples" [
          C.tests,
-         M.tests,
-         P.tests,
-         MP.tests
+         M.tests
        ]
diff --git a/testsuite/tests/Data/Comp/Variables_Test.hs b/testsuite/tests/Data/Comp/Variables_Test.hs
--- a/testsuite/tests/Data/Comp/Variables_Test.hs
+++ b/testsuite/tests/Data/Comp/Variables_Test.hs
@@ -1,5 +1,5 @@
-{-# LANGUAGE TemplateHaskell, TypeSynonymInstances,
-FlexibleInstances, MultiParamTypeClasses, TypeOperators, FlexibleContexts#-}
+{-# LANGUAGE TemplateHaskell, TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses, 
+  TypeOperators, FlexibleContexts, ConstraintKinds #-}
 
 module Data.Comp.Variables_Test where
 
diff --git a/testsuite/tests/Test/Utils.hs b/testsuite/tests/Test/Utils.hs
--- a/testsuite/tests/Test/Utils.hs
+++ b/testsuite/tests/Test/Utils.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE TemplateHaskell, TypeOperators, FlexibleContexts, FlexibleInstances #-}
+{-# LANGUAGE TemplateHaskell, TypeOperators, FlexibleContexts, FlexibleInstances, ConstraintKinds #-}
 
 module Test.Utils where