diff --git a/ADP/Fusion.hs b/ADP/Fusion.hs
deleted file mode 100644
--- a/ADP/Fusion.hs
+++ /dev/null
@@ -1,12 +0,0 @@
-{-# LANGUAGE NoMonomorphismRestriction #-}
-
--- | Pure combinators along the lines of original ADP. We simply re-export the
--- monadic interface without the monadic function application combinator.
-
-module ADP.Fusion
-  ( module ADP.Fusion.Monadic
-  , module ADP.Fusion.Monadic.Internal
-  ) where
-
-import ADP.Fusion.Monadic hiding ((#<<))
-import ADP.Fusion.Monadic.Internal (Scalar(..))
diff --git a/ADP/Fusion/Core.hs b/ADP/Fusion/Core.hs
new file mode 100644
--- /dev/null
+++ b/ADP/Fusion/Core.hs
@@ -0,0 +1,152 @@
+
+{-# Language MagicHash #-}
+
+-- | Generalized fusion system for grammars.
+--
+-- This module re-exports only the core functionality.
+--
+-- NOTE Symbols typically do not check bound data for consistency. If you, say,
+-- bind a terminal symbol to an input of length 0 and then run your grammar,
+-- you probably get errors, garbled data or random crashes. Such checks are
+-- done via asserts in non-production code.
+
+module ADP.Fusion.Core
+  ( module ADP.Fusion.Core
+  , module ADP.Fusion.Core.Apply
+  , module ADP.Fusion.Core.Classes
+  , module ADP.Fusion.Core.Multi
+  , module ADP.Fusion.Core.SynVar.Array.Type
+  , module ADP.Fusion.Core.SynVar.Axiom
+  , module ADP.Fusion.Core.SynVar.Backtrack
+  , module ADP.Fusion.Core.SynVar.FillTyLvl
+  , module ADP.Fusion.Core.SynVar.Indices
+  , module ADP.Fusion.Core.SynVar.Recursive.Type
+  , module ADP.Fusion.Core.SynVar.Split.Type
+  , module ADP.Fusion.Core.SynVar.TableWrap
+  , module ADP.Fusion.Core.Term.Chr
+  , module ADP.Fusion.Core.Term.Deletion
+  , module ADP.Fusion.Core.Term.Edge
+  , module ADP.Fusion.Core.Term.Epsilon
+  , module ADP.Fusion.Core.Term.MultiChr
+  , module ADP.Fusion.Core.Term.PeekIndex
+  , module ADP.Fusion.Core.Term.Str
+  , module ADP.Fusion.Core.TH
+  , module ADP.Fusion.Core.TyLvlIx
+  , module Data.Vector.Fusion.Stream.Monadic
+  , module Data.Vector.Fusion.Util
+  ) where
+
+import           Data.Vector.Fusion.Stream.Monadic (Stream (..))
+import           Data.Strict.Tuple
+import           GHC.Exts (inline)
+import qualified Data.Vector.Fusion.Stream.Monadic as S
+import           Data.Vector.Fusion.Util (Id(..))
+
+import           Data.PrimitiveArray
+
+import           ADP.Fusion.Core.Apply
+import           ADP.Fusion.Core.Classes hiding (iIx)
+import           ADP.Fusion.Core.Multi hiding (iIx)
+import           ADP.Fusion.Core.SynVar.Array.Type
+import           ADP.Fusion.Core.SynVar.Axiom
+import           ADP.Fusion.Core.SynVar.Backtrack
+import           ADP.Fusion.Core.SynVar.FillTyLvl
+import           ADP.Fusion.Core.SynVar.Indices
+import           ADP.Fusion.Core.SynVar.Recursive.Type
+import           ADP.Fusion.Core.SynVar.Split.Type
+import           ADP.Fusion.Core.SynVar.TableWrap
+import           ADP.Fusion.Core.Term.Chr
+import           ADP.Fusion.Core.Term.Deletion
+import           ADP.Fusion.Core.Term.Edge
+import           ADP.Fusion.Core.Term.Epsilon
+import           ADP.Fusion.Core.Term.MultiChr
+import           ADP.Fusion.Core.Term.PeekIndex
+import           ADP.Fusion.Core.Term.Str
+import           ADP.Fusion.Core.TH
+import           ADP.Fusion.Core.TyLvlIx
+
+
+
+-- | Apply a function to symbols on the RHS of a production rule. Builds the
+-- stack of symbols from 'xs' using 'build', then hands this stack to
+-- 'mkStream' together with the initial 'iniT' telling 'mkStream' that we are
+-- in the "outer" position. Once the stream has been created, we 'S.map'
+-- 'getArg' to get just the arguments in the stack, and finally 'apply' the
+-- function 'f'.
+
+infixl 8 <<<
+(<<<)
+  ∷ forall k m initCtx symbols i b
+  . ( Monad m
+    , Build symbols
+    , Element (Stack symbols) i
+    , Apply (Arg (Stack symbols) → b)
+    , initCtx ~ InitialContext i
+    , MkStream m initCtx (Stack symbols) i
+    )
+  ⇒ (Fun (Arg (Stack symbols) → b))
+  → symbols
+  → (LimitType i → i → Stream m b)
+(<<<) f xs
+  = \lu ij
+  → S.map (apply (inline f) . getArg)
+  $ mkStream (Proxy ∷ Proxy initCtx) (build xs) 1# lu ij
+{-# INLINE (<<<) #-}
+
+--infixl 8 <<#
+--(<<#) f xs = \lu ij -> S.mapM (apply (inline f) . getArg) $ mkStream Proxy (build xs) 1# lu ij
+--{-# INLINE (<<#) #-}
+
+-- | Combine two RHSs to give a choice between parses.
+
+infixl 7 |||
+(|||) xs ys = \lu ij -> xs lu ij `streamappend` ys lu ij
+{-# INLINE (|||) #-}
+
+data StreamAppend a b = SAL a | SAR b
+
+streamappend :: Monad m => Stream m a -> Stream m a -> Stream m a
+{-# Inline streamappend #-}
+Stream stepa ta `streamappend` Stream stepb tb = Stream step (SAL ta)
+  where
+    {-# Inline [0] step #-}
+    step (SAL   sa) = do
+                        r <- stepa sa
+                        case r of
+                          S.Yield x sa' -> return $ S.Yield x (SAL sa')
+                          S.Skip    sa' -> return $ S.Skip    (SAL sa')
+                          S.Done        -> return $ S.Skip    (SAR tb)
+    step (SAR   sb) = do
+                        r <- stepb sb
+                        case r of
+                          S.Yield x sb' -> return $ S.Yield x (SAR sb')
+                          S.Skip    sb' -> return $ S.Skip    (SAR sb')
+                          S.Done        -> return $ S.Done
+
+
+-- | Applies the objective function 'h' to a stream 's'. The objective function
+-- reduces the stream to a single optimal value (or some vector of co-optimal
+-- things).
+
+infixl 5 ...
+(...) s h = \lu ij -> (inline h) $ s lu ij
+{-# INLINE (...) #-}
+
+-- -- | Additional outer check with user-given check function
+-- 
+-- infixl 6 `check`
+-- check xs f = \ij -> let chk = f ij in chk `seq` outerCheck chk (xs ij)
+-- {-# INLINE check #-}
+
+-- | Separator between RHS symbols.
+
+infixl 9 ~~
+(~~) = (:!:)
+{-# INLINE (~~) #-}
+
+-- | This separator looks much paper "on paper" and is not widely used otherwise.
+
+infixl 9 %
+(%) = (:!:)
+{-# INLINE (%) #-}
+
diff --git a/ADP/Fusion/Core/Apply.hs b/ADP/Fusion/Core/Apply.hs
new file mode 100644
--- /dev/null
+++ b/ADP/Fusion/Core/Apply.hs
@@ -0,0 +1,89 @@
+
+module ADP.Fusion.Core.Apply where
+
+--import Data.Array.Repa.Index
+import Data.PrimitiveArray.Index.Class (Z(..), (:.)(..))
+
+
+
+-- * Apply function 'f' in '(<<<)'
+
+class Apply x where
+  type Fun x :: *
+  apply :: Fun x -> x
+
+instance Apply (Z:.a -> res) where
+  type Fun (Z:.a -> res) = a -> res
+  apply fun (Z:.a) = fun a
+  {-# INLINE apply #-}
+
+instance Apply (Z:.a:.b -> res) where
+  type Fun (Z:.a:.b -> res) = a->b -> res
+  apply fun (Z:.a:.b) = fun a b
+  {-# INLINE apply #-}
+
+instance Apply (Z:.a:.b:.c -> res) where
+  type Fun (Z:.a:.b:.c -> res) = a->b->c -> res
+  apply fun (Z:.a:.b:.c) = fun a b c
+  {-# INLINE apply #-}
+
+instance Apply (Z:.a:.b:.c:.d -> res) where
+  type Fun (Z:.a:.b:.c:.d -> res) = a->b->c->d -> res
+  apply fun (Z:.a:.b:.c:.d) = fun a b c d
+  {-# INLINE apply #-}
+
+instance Apply (Z:.a:.b:.c:.d:.e -> res) where
+  type Fun (Z:.a:.b:.c:.d:.e -> res) = a->b->c->d->e -> res
+  apply fun (Z:.a:.b:.c:.d:.e) = fun a b c d e
+  {-# INLINE apply #-}
+
+instance Apply (Z:.a:.b:.c:.d:.e:.f -> res) where
+  type Fun (Z:.a:.b:.c:.d:.e:.f -> res) = a->b->c->d->e->f -> res
+  apply fun (Z:.a:.b:.c:.d:.e:.f) = fun a b c d e f
+  {-# INLINE apply #-}
+
+instance Apply (Z:.a:.b:.c:.d:.e:.f:.g -> res) where
+  type Fun (Z:.a:.b:.c:.d:.e:.f:.g -> res) = a->b->c->d->e->f->g -> res
+  apply fun (Z:.a:.b:.c:.d:.e:.f:.g) = fun a b c d e f g
+  {-# INLINE apply #-}
+
+instance Apply (Z:.a:.b:.c:.d:.e:.f:.g:.h -> res) where
+  type Fun (Z:.a:.b:.c:.d:.e:.f:.g:.h -> res) = a->b->c->d->e->f->g->h -> res
+  apply fun (Z:.a:.b:.c:.d:.e:.f:.g:.h) = fun a b c d e f g h
+  {-# INLINE apply #-}
+
+instance Apply (Z:.a:.b:.c:.d:.e:.f:.g:.h:.i -> res) where
+  type Fun (Z:.a:.b:.c:.d:.e:.f:.g:.h:.i -> res) = a->b->c->d->e->f->g->h->i -> res
+  apply fun (Z:.a:.b:.c:.d:.e:.f:.g:.h:.i) = fun a b c d e f g h i
+  {-# INLINE apply #-}
+
+instance Apply (Z:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j -> res) where
+  type Fun (Z:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j -> res) = a->b->c->d->e->f->g->h->i->j -> res
+  apply fun (Z:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j) = fun a b c d e f g h i j
+  {-# INLINE apply #-}
+
+instance Apply (Z:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j:.k -> res) where
+  type Fun (Z:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j:.k -> res) = a->b->c->d->e->f->g->h->i->j->k -> res
+  apply fun (Z:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j:.k) = fun a b c d e f g h i j k
+  {-# INLINE apply #-}
+
+instance Apply (Z:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j:.k:.l -> res) where
+  type Fun (Z:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j:.k:.l -> res) = a->b->c->d->e->f->g->h->i->j->k->l -> res
+  apply fun (Z:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j:.k:.l) = fun a b c d e f g h i j k l
+  {-# INLINE apply #-}
+
+instance Apply (Z:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j:.k:.l:.m -> res) where
+  type Fun (Z:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j:.k:.l:.m -> res) = a->b->c->d->e->f->g->h->i->j->k->l->m -> res
+  apply fun (Z:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j:.k:.l:.m) = fun a b c d e f g h i j k l m
+  {-# INLINE apply #-}
+
+instance Apply (Z:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j:.k:.l:.m:.n -> res) where
+  type Fun (Z:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j:.k:.l:.m:.n -> res) = a->b->c->d->e->f->g->h->i->j->k->l->m->n -> res
+  apply fun (Z:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j:.k:.l:.m:.n) = fun a b c d e f g h i j k l m n
+  {-# INLINE apply #-}
+
+instance Apply (Z:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j:.k:.l:.m:.n:.o -> res) where
+  type Fun (Z:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j:.k:.l:.m:.n:.o -> res) = a->b->c->d->e->f->g->h->i->j->k->l->m->n->o -> res
+  apply fun (Z:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j:.k:.l:.m:.n:.o) = fun a b c d e f g h i j k l m n o
+  {-# INLINE apply #-}
+
diff --git a/ADP/Fusion/Core/Classes.hs b/ADP/Fusion/Core/Classes.hs
new file mode 100644
--- /dev/null
+++ b/ADP/Fusion/Core/Classes.hs
@@ -0,0 +1,233 @@
+
+{-# Language MagicHash #-}
+
+module ADP.Fusion.Core.Classes where
+
+import           Control.DeepSeq
+import           Data.Proxy
+import           Data.Strict.Tuple
+import           GHC.Exts hiding (build)
+import           GHC.Generics (Generic, Generic1)
+import qualified Data.Vector.Fusion.Stream.Monadic as S
+
+import           Data.PrimitiveArray.Index.Class
+
+
+
+-- TODO Until I figure out how to use @InitialContext ∷ k@ instead of
+-- @InitialContext ∷ *@ we need to live in @*@. Unfortunately, @(<<<)@ does not
+-- like differently-kinded types.
+
+{-
+data OutsideContext s
+  = OStatic     s
+  | ORightOf    s
+  | OFirstLeft  s
+  | OLeftOf     s
+  deriving (Show)
+-}
+data OStatic    s
+data ORightOf   s
+data OFirstLeft s
+data OLeftOf    s
+
+{-
+data InsideContext s
+  = IStatic   {iGetContext :: s}
+  | IVariable {iGetContext :: s}
+  deriving (Show)
+-}
+data IStatic   s
+data IVariable s
+
+{-
+data ComplementContext
+  = Complemented
+  deriving (Show)
+-}
+data Complement
+
+-- | Needed for structures that have long-range interactions and "expand",
+-- like sets around edge boundaries: @set <edge> set@. requires the sets to
+-- be connected.
+
+data ExtComplementContext s
+  = CStatic s
+  | CVariable s
+
+-- | For each index type @ix@, @initialContext (Proxy ∷ ix)@ yields the initial
+-- context from which to start up rules.
+--
+-- TODO turn into type family and make 'initialContext' a global function.
+
+type family InitialContext ix ∷ *
+
+{-
+class RuleContext ix where
+  type InitialContext ix ∷ *
+  initialContext ∷ Proxy ix → Proxy (InitialContext ix)
+--  default initialContext ∷ Proxy ix → Proxy (InitialContext ix ∷ k)
+  initialContext Proxy = Proxy
+  {-# Inline initialContext #-}
+-}
+
+-- | While we ostensibly use an index of type @i@ we typically do not need
+-- every element of an @i@. For example, when looking at 'Subword's, we do
+-- not need both element of @j:.k@ but only @k@.
+-- Also, inside grammars do need fewer moving indices than outside
+-- grammars.
+
+data family RunningIndex i :: *
+
+data instance RunningIndex Z = RiZ
+  deriving (Generic, NFData, Show)
+
+data instance RunningIndex (is:.i) = !(RunningIndex is) :.: !(RunningIndex i)
+  deriving (Generic)
+
+deriving instance (NFData (RunningIndex is), NFData (RunningIndex i)) => NFData (RunningIndex (is:.i))
+
+-- | During construction of the stream, we need to extract individual elements
+-- from symbols in production rules. An element in a stream is fixed by both,
+-- the type @x@ of the actual argument we want to grab (say individual
+-- characters we parse from an input) and the type of indices @i@ we use.
+--
+-- @Elm@ data constructors are all eradicated during fusion and should never
+-- show up in CORE.
+
+class Element (x ∷ *) i where
+  data Elm    x i ∷ *
+  type RecElm x i ∷ *
+  type Arg    x   ∷ *
+  getArg ∷ Elm x i → Arg x
+  getIdx ∷ Elm x i → RunningIndex i
+  getElm ∷ Elm x i → RecElm x i
+
+-- | @mkStream@ creates the actual stream of elements (@Elm@) that will be fed
+-- to functions on the left of the @(<<<)@ operator. Streams work over all
+-- monads and are specialized for each combination of arguments @x@ and indices
+-- @i@.
+
+class (Monad m) ⇒ MkStream m pos sym ix where
+  mkStream
+    ∷ Proxy pos
+    -- ^ Fix static/variable/... depending on position in r.h.s. of rule.
+    → sym
+    -- ^ the symbol type (syntactic variable with or with memoization, terminal types like char, string, etc)
+    → Int#
+    -- ^ guard system for stopping execution of rule
+    → LimitType ix
+    -- ^ upper limit of index @i@, using the specialized 'LimitType' for type @i@.
+    → ix
+    -- ^ the current index @i@
+    → S.Stream m (Elm sym ix)
+    -- ^ resulting stream of elements
+
+-- | This type family yields for a given positional type @posty ∷ k@, the
+-- current symbol type @symty@ and index type @ix@ the next-left positional
+-- type within the same kind @k@ Keeping within the same kind should prevent
+-- accidental switching from Inside to Outside or similar bugs.
+
+type family LeftPosTy (pos ∷ *) sym ix ∷ *
+
+-- | Finally, we need to be able to correctly build together symbols on the
+-- right-hand side of the @(<<<)@ operator.
+--
+-- The default makes sure that the last (or only) argument left over is
+-- correctly assigned a @Z@ to terminate the symbol stack.
+
+class Build x where
+  type Stack x :: *
+  type Stack x = S :!: x
+  build :: x -> Stack x
+  default build :: (Stack x ~ (S :!: x)) => x -> Stack x
+  build x = S :!: x
+  {-# Inline build #-}
+
+instance Build x => Build (x:!:y) where
+  type Stack (x:!:y) = Stack x :!: y
+  build (x:!:y) = build x :!: y
+  {-# Inline build #-}
+
+-- | Similar to 'Z', but terminates an argument stack.
+
+data S = S
+  deriving (Eq,Show)
+
+instance
+  (
+  ) => Element S i where
+  newtype Elm S i = ElmS (RunningIndex i)
+  type Arg S   = Z
+  getArg (ElmS _) = Z
+  getIdx (ElmS i) = i
+  {-# Inline [0] getArg #-}
+  {-# Inline [0] getIdx #-}
+
+deriving instance (Show (RunningIndex ix)) => Show (Elm S ix)
+
+-- | 'staticCheck' acts as a static filter. If 'b' is true, we keep all stream
+-- elements. If 'b' is false, we discard all stream elements.
+
+staticCheck :: Monad m => Bool -> S.Stream m a -> S.Stream m a
+staticCheck !b (S.Stream step t) = S.Stream snew (CheckLeft b t) where
+  {-# Inline [0] snew #-}
+  snew (CheckLeft  False _) = return $ S.Done
+  snew (CheckLeft  True  s) = return $ S.Skip (CheckRight s)
+  snew (CheckRight s      ) = do r <- step s
+                                 case r of
+                                   S.Yield x s' -> return $ S.Yield x (CheckRight s')
+                                   S.Skip    s' -> return $ S.Skip    (CheckRight s')
+                                   S.Done       -> return $ S.Done
+{-# INLINE staticCheck #-}
+
+data StaticCheck a b = CheckLeft Bool a | CheckRight b
+
+staticCheck# :: Monad m => Int# -> S.Stream m a -> S.Stream m a
+staticCheck# b (S.Stream step t) = S.Stream snew (SL b t) where
+  {-# Inline [0] snew #-}
+  snew (SL q s)
+    | 1# <- q   = return $ S.Skip (SR s)
+    | otherwise = return $ S.Done
+  snew (SR s  ) = do r <- step s
+                     case r of
+                       S.Yield x s' -> return $ S.Yield x (SR s')
+                       S.Skip    s' -> return $ S.Skip    (SR s')
+                       S.Done       -> return $ S.Done
+{-# Inline staticCheck# #-}
+
+
+data SLR z = SL Int# z | SR z
+
+-- | Constrains the behaviour of the memoizing tables. They may be 'EmptyOk' if
+-- @i==j@ is allowed (empty subwords or similar); or they may need 'NonEmpty'
+-- indices, or finally they can be 'OnlyZero' (only @i==j@ allowed) which is
+-- useful in multi-dimensional casese.
+
+data EmptyOk = EmptyOk
+  deriving (Show)
+
+data NonEmpty = NonEmpty
+  deriving (Show)
+
+class MinSize c where
+  minSize :: c -> Int
+
+instance MinSize EmptyOk where
+  minSize EmptyOk = 0
+  {-# Inline minSize #-}
+
+instance MinSize NonEmpty where
+  minSize NonEmpty = 1
+  {-# Inline minSize #-}
+
+-- |
+--
+-- TODO Rewrite to generalize easily over multi-dim cases.
+
+class ModifyConstraint t where
+  type TNE t :: *
+  type TE  t :: *
+  toNonEmpty :: t -> TNE t
+  toEmpty    :: t -> TE  t
+
diff --git a/ADP/Fusion/Core/Multi.hs b/ADP/Fusion/Core/Multi.hs
new file mode 100644
--- /dev/null
+++ b/ADP/Fusion/Core/Multi.hs
@@ -0,0 +1,228 @@
+
+{-# Language MagicHash #-}
+
+module ADP.Fusion.Core.Multi where
+
+import qualified Data.Vector.Fusion.Stream.Monadic as S
+import           Data.Vector.Fusion.Stream.Monadic
+import           Data.Strict.Tuple
+import           Data.Proxy
+import           Prelude hiding (map)
+import           GHC.Exts
+import           Debug.Trace
+
+import           Data.PrimitiveArray.Index.Class hiding (map)
+
+import           ADP.Fusion.Core.Classes
+import           ADP.Fusion.Core.TyLvlIx
+
+
+
+-- * Multi-dimensional extension
+
+-- | Terminates a multi-dimensional terminal symbol stack.
+
+data M = M
+  deriving (Eq,Show)
+
+infixl 2 :|
+
+-- | Terminal symbols are stacked together with @a@ tails and @b@ head.
+
+data TermSymbol a b = a :| b
+  deriving (Eq,Show)
+
+instance Build (TermSymbol a b)
+
+-- | Extracts the type of a multi-dimensional terminal argument.
+
+type family   TermArg x :: *
+type instance TermArg M                = Z
+type instance TermArg (TermSymbol a b) = (TermArg a) :. (TermArg b)
+
+instance (Element ls i) => Element (ls :!: TermSymbol a b) i where
+  data Elm (ls :!: TermSymbol a b) i = ElmTS !(TermArg (TermSymbol a b)) !(RunningIndex i) !(Elm ls i)
+  type Arg (ls :!: TermSymbol a b)   = Arg ls :. TermArg (TermSymbol a b)
+  getArg (ElmTS a _ ls) = getArg ls :. a
+  getIdx (ElmTS _ i _ ) = i
+  {-# INLINE getArg #-}
+  {-# INLINE getIdx #-}
+
+deriving instance (Show i, Show (RunningIndex i), Show (TermArg (TermSymbol a b)), Show (Elm ls i)) => Show (Elm (ls :!: TermSymbol a b) i)
+
+type instance LeftPosTy (ps :. p) (TermSymbol a b) (is:.i) = (LeftPosTy ps a is) :. (LeftPosTy p b i)
+
+instance
+  ( Monad m
+  , MkStream m posLeft ls i
+  , Element ls i
+  , TermStaticVar pos (TermSymbol a b) i
+  , TermStream m pos (TermSymbol a b) (Elm ls i) i
+  , posLeft ~ LeftPosTy pos (TermSymbol a b) i
+  ) => MkStream m pos (ls :!: TermSymbol a b) i where
+  mkStream Proxy (ls :!: ts) grd lu i
+    = map (\(TState sS ii ee) -> ElmTS ee ii sS)
+    . termStream (Proxy ∷ Proxy pos) ts lu i
+    . map (\s -> TState s RiZ Z)
+    $ mkStream (Proxy ∷ Proxy posLeft)
+               ls
+               (termStaticCheck (Proxy ∷ Proxy pos) ts lu i grd)
+               lu (termStreamIndex (Proxy ∷ Proxy pos) ts i)
+  {-# Inline mkStream #-}
+
+-- | 
+
+type instance LeftPosTy Z M Z = Z
+
+instance Monad m => MkStream m Z S Z where
+  -- mkStream Proxy S grd ZZ Z = S.filter (const $ isTrue# grd) $ S.singleton $ ElmS RiZ
+  mkStream Proxy S grd ZZ Z = staticCheck# grd $ S.singleton $ ElmS RiZ
+  {-# Inline mkStream #-}
+
+-- | For multi-dimensional terminals we need to be able to calculate how the
+-- static/variable signal changes and if the index for the inner part needs to
+-- be modified.
+
+class TermStaticVar pos sym ix where
+--  termStaticVar   ∷ sym → Context i → i → Context i
+  termStreamIndex ∷ Proxy pos → sym → ix → ix
+  termStaticCheck ∷ Proxy pos → sym → LimitType ix → ix → Int# → Int#
+
+instance TermStaticVar pos M Z where
+  termStreamIndex Proxy M Z = Z
+  termStaticCheck Proxy M _ Z grd = grd
+  {-# INLINE [0] termStreamIndex #-}
+  {-# INLINE [0] termStaticCheck #-}
+
+instance
+  ( TermStaticVar ps ts is
+  , TermStaticVar p  t  i
+  ) => TermStaticVar (ps:.p) (TermSymbol ts t) (is:.i) where
+  termStreamIndex Proxy (ts:|t) (is:.i) = termStreamIndex (Proxy ∷ Proxy ps) ts is :. termStreamIndex (Proxy ∷ Proxy p) t i
+  termStaticCheck Proxy (ts:|t) (us:..u) (is:.i) grd = termStaticCheck (Proxy ∷ Proxy ps) ts us is (termStaticCheck (Proxy ∷ Proxy p) t u i grd)
+  {-# INLINE [0] termStreamIndex #-}
+  {-# INLINE [0] termStaticCheck #-}
+
+--instance RuleContext Z where
+type instance InitialContext Z = Z
+
+--instance (RuleContext is, RuleContext i) => RuleContext (is:.i) where
+type instance InitialContext (is:.i) = InitialContext is:.InitialContext i
+
+class TableStaticVar pos minSize tableIx ix where
+  tableStreamIndex
+    ∷ Proxy pos
+    -- ^ provide type-level information on if we are currently static/variable/
+    -- etc
+    → minSize
+    -- ^ Information on the minimal size of the corresponding table.
+    → LimitType tableIx
+    -- ^ provide type-level information on the index structure of the table we
+    -- are looking at. This index structure might well be different than the
+    -- @ix@ index we use in the grammar.
+    → ix
+    -- ^ current right-most index
+    → ix
+    -- ^ right-most index for symbol to the left of us
+
+-- | Index "0" for multi-dimensional syntactic variables.
+
+instance TableStaticVar pos Z tableIx Z where
+  tableStreamIndex Proxy Z _ Z = Z
+  {-# INLINE [0] tableStreamIndex #-}
+
+instance
+  ( TableStaticVar ps cs us is
+  , TableStaticVar p  c  u  i
+  )
+  ⇒ TableStaticVar (ps:.p) (cs:.c) (us:.u) (is:.i) where
+  tableStreamIndex Proxy (cs:.c) (us:..u) (is:.i)
+    =  tableStreamIndex (Proxy ∷ Proxy ps) cs us is
+    :. tableStreamIndex (Proxy ∷ Proxy p ) c  u  i
+  {-# INLINE [0] tableStreamIndex #-}
+
+
+data TermState s i e = TState
+  { tS  :: !s
+    -- ^ state coming in from the left
+  , iIx :: !(RunningIndex i)
+    -- ^ @I/C@ building up state to hand over to next symbol
+  , eTS :: !e
+    -- ^ element data
+  }
+
+class TermStream m pos t s i where
+  termStream
+    ∷ Proxy pos
+    → t
+    → LimitType i
+    → i
+    → Stream m (TermState s Z Z)
+    → Stream m (TermState s i (TermArg t))
+
+instance (Monad m) => TermStream m pos M s Z where
+  termStream Proxy M ZZ Z = id
+  {-# Inline termStream #-}
+
+-- |
+--
+-- TODO need @t -> ElmType t@ type function
+--
+-- TODO need to actually return an @ElmType t@ can do that instead of
+-- returning @u@ !!!
+
+addTermStream1
+  ∷ forall m pos t s i
+  . ( Monad m
+    , TermStream m (Z:.pos) (TermSymbol M t) (Elm (Term1 s) (Z:.i)) (Z:.i)
+    )
+  ⇒ Proxy pos
+  → t
+  → LimitType i
+  → i
+  → Stream m s
+  → Stream m (s,TermArg t,RunningIndex i)
+addTermStream1 Proxy t u i
+  = map (\(TState (ElmTerm1 sS) (RiZ:.:ii) (Z:.ee)) -> (sS,ee,ii))
+  . termStream (Proxy ∷ Proxy (Z:.pos)) (M:|t) (ZZ:..u) (Z:.i)
+  . map (\s -> TState (elmTerm1 s i) RiZ Z)
+{-# Inline addTermStream1 #-}
+
+newtype Term1 s = Term1 s
+
+elmTerm1 :: s -> i -> Elm (Term1 s) (Z:.i)
+elmTerm1 s _ = ElmTerm1 s
+{-# Inline elmTerm1 #-}
+
+instance (s ~ Elm x0 i, Element x0 i) => Element (Term1 s) (Z:.i) where
+  newtype Elm (Term1 s) (Z:.i) = ElmTerm1 s
+  getIdx (ElmTerm1 s) = RiZ :.: getIdx s
+  {-# Inline getIdx #-}
+
+-- | @Term MkStream@ context
+--
+-- TODO prepare for deletion
+
+--type TermMkStreamContext m (pos ∷ k) ls t i
+--  = ( Monad m
+--    , MkStream m pos ls i
+--    , TermStream m pos (TermSymbol M t) (Elm (Term1 (Elm ls i)) (Z:.i)) (Z:.i)
+--    , Element ls i
+--    , TermStaticVar pos t i
+--    )
+
+-- | @Term TermStream@ context
+
+type TermStreamContext m (pos ∷ k) ts s x0 sixty is i
+  = ( Monad m
+    , TermStream m pos ts s is
+    , GetIndex (RunningIndex sixty) (RunningIndex (is:.i))
+    , GetIx (RunningIndex sixty) (RunningIndex (is:.i)) ~ (RunningIndex i)
+    , Element x0 sixty
+    , s ~ Elm x0 sixty
+    )
+
+-- | Shorthand for proxifying @getIndex@
+
+type PRI is i = Proxy (RunningIndex (is:.i))
+
diff --git a/ADP/Fusion/Core/SynVar/Array.hs b/ADP/Fusion/Core/SynVar/Array.hs
new file mode 100644
--- /dev/null
+++ b/ADP/Fusion/Core/SynVar/Array.hs
@@ -0,0 +1,150 @@
+
+{-# Language MagicHash #-}
+
+module ADP.Fusion.Core.SynVar.Array
+  ( module ADP.Fusion.Core.SynVar.Array.Type
+  , module ADP.Fusion.Core.SynVar.Array
+  ) where
+
+
+import Data.Proxy
+import Data.Strict.Tuple hiding (snd)
+import Data.Vector.Fusion.Stream.Monadic
+import GHC.Exts
+import Prelude hiding (map,mapM)
+
+import Data.PrimitiveArray hiding (map)
+
+import ADP.Fusion.Core.Classes
+import ADP.Fusion.Core.Multi
+import ADP.Fusion.Core.SynVar.Array.Type
+import ADP.Fusion.Core.SynVar.Backtrack
+import ADP.Fusion.Core.SynVar.Indices
+import ADP.Fusion.Core.SynVar.TableWrap
+
+
+
+-- | Constraints needed to use @iTblStream@.
+
+type ITblCx m pos ls arr x u c i =
+  ( TableStaticVar pos c u i
+  , Element ls i
+  , AddIndexDense (Z:.pos) (Elm (SynVar1 (Elm ls i)) (Z:.i)) (Z:.c) (Z:.u) (Z:.i)
+  , PrimArrayOps arr u x
+  )
+
+-- | General function for @ITbl@s with skalar indices.
+
+iTblStream
+  ∷ forall b s m pos posLeft ls arr x u c i
+  . ( ITblCx m pos ls arr x u c i
+    , posLeft ~ LeftPosTy pos (TwITbl b s m arr c u x) i
+    , MkStream m posLeft ls i
+    )
+  ⇒ Proxy pos
+  → Pair ls (TwITbl b s m arr c u x)
+  → Int#
+  → LimitType i
+  → i
+  → Stream m (Elm (ls :!: TwITbl b s m arr c u x) i)
+iTblStream pos (ls :!: TW (ITbl c t) _) grd us is
+  = map (\(s,tt,ii') -> ElmITbl (t!tt) ii' s)
+  . addIndexDense1 pos c ub us is
+  $ mkStream (Proxy ∷ Proxy posLeft) ls grd us (tableStreamIndex (Proxy :: Proxy pos) c ub is)
+  where ub = upperBound t
+{-# Inline iTblStream #-}
+
+-- | General function for @Backtrack ITbl@s with skalar indices.
+
+btITblStream
+  ∷ forall b s mB mF pos posLeft ls arr x r u c i
+  . ( ITblCx mB pos ls arr x u c i
+    , posLeft ~ LeftPosTy pos (TwITblBt b s arr c u x mF mB r) i
+    , MkStream mB posLeft ls i
+    )
+  ⇒ Proxy pos
+  → Pair ls (TwITblBt b s arr c u x mF mB r)
+  → Int#
+  → LimitType i
+  → i
+  → Stream mB (Elm (ls :!: TwITblBt b s arr c u x mF mB r) i)
+btITblStream pos (ls :!: TW (BtITbl c t) bt) grd us is
+    = mapM (\(s,tt,ii') -> bt ub tt >>= \ ~bb -> return $ ElmBtITbl (t!tt) bb ii' s)
+    . addIndexDense1 pos c ub us is
+    $ mkStream (Proxy ∷ Proxy posLeft) ls grd us (tableStreamIndex (Proxy :: Proxy pos) c ub is)
+    where ub = upperBound t
+{-# Inline btITblStream #-}
+
+
+
+-- ** Instances
+
+instance
+  ( Monad m
+  , ITblCx m pos ls arr x u c (i I)
+  , MkStream m (LeftPosTy pos (TwITbl b s m arr c u x) (i I)) ls (i I)
+  ) => MkStream m pos (ls :!: TwITbl b s m arr c u x) (i I) where
+  mkStream = iTblStream
+  {-# Inline mkStream #-}
+
+instance
+  ( Monad mB
+  , ITblCx mB pos ls arr x u c (i I)
+  , MkStream mB (LeftPosTy pos (TwITblBt b s arr c u x mF mB r) (i I)) ls (i I)
+  )
+  ⇒ MkStream mB pos (ls :!: TwITblBt b s arr c u x mF mB r) (i I) where
+  mkStream = btITblStream
+  {-# Inline mkStream #-}
+
+instance
+  ( Monad m
+  , ITblCx m pos ls arr x u c (i O)
+  , MkStream m (LeftPosTy pos (TwITbl b s m arr c u x) (i O)) ls (i O)
+  ) => MkStream m pos (ls :!: TwITbl b s m arr c u x) (i O) where
+  mkStream = iTblStream
+  {-# Inline mkStream #-}
+
+instance
+  ( Monad mB
+  , ITblCx mB pos ls arr x u c (i O)
+  , MkStream mB (LeftPosTy pos (TwITblBt b s arr c u x mF mB r) (i O)) ls (i O)
+  )
+  ⇒ MkStream mB pos (ls :!: TwITblBt b s arr c u x mF mB r) (i O) where
+  mkStream = btITblStream
+  {-# Inline mkStream #-}
+
+{-
+instance
+  ( Monad m
+  , ITblCx m ls arr x u c (i C)
+  ) => MkStream m (ls :!: TwITbl m arr c u x) (i C) where
+  mkStream = iTblStream
+  {-# Inline mkStream #-}
+
+instance
+  ( Monad mB
+  , ITblCx mB ls arr x u c (i O)
+  ) => MkStream mB (ls :!: TwITblBt arr c u x mF mB r) (i O) where
+  mkStream = btITblStream
+  {-# Inline mkStream #-}
+
+instance
+  ( Monad mB
+  , ITblCx mB ls arr x u c (i C)
+  ) => MkStream mB (ls :!: TwITblBt arr c u x mF mB r) (i C) where
+  mkStream = btITblStream
+  {-# Inline mkStream #-}
+
+instance ModifyConstraint (TwITbl m arr EmptyOk i x) where
+  type TNE (TwITbl m arr EmptyOk i x) = TwITbl m arr NonEmpty i x
+  type TE  (TwITbl m arr EmptyOk i x) = TwITbl m arr EmptyOk  i x
+  toNonEmpty (TW (ITbl b l _ arr) f) = TW (ITbl b l NonEmpty arr) f
+  {-# Inline toNonEmpty #-}
+
+instance ModifyConstraint (TwITblBt arr EmptyOk i x mF mB r) where
+  type TNE (TwITblBt arr EmptyOk i x mF mB r) = TwITblBt arr NonEmpty i x mF mB r
+  type TE  (TwITblBt arr EmptyOk i x mF mB r) = TwITblBt arr EmptyOk  i x mF mB r
+  toNonEmpty (TW (BtITbl _ arr) bt) = TW (BtITbl NonEmpty arr) bt
+  {-# Inline toNonEmpty #-}
+-}
+
diff --git a/ADP/Fusion/Core/SynVar/Array/Type.hs b/ADP/Fusion/Core/SynVar/Array/Type.hs
new file mode 100644
--- /dev/null
+++ b/ADP/Fusion/Core/SynVar/Array/Type.hs
@@ -0,0 +1,177 @@
+
+{-# Language DataKinds #-}
+{-# Language TypeOperators #-}
+
+module ADP.Fusion.Core.SynVar.Array.Type where
+
+import Data.Proxy
+import Data.Strict.Tuple hiding (uncurry,snd)
+import Data.Vector.Fusion.Stream.Monadic (map,Stream,head,mapM,Step(..))
+import Debug.Trace
+import GHC.TypeNats
+import Prelude hiding (map,head,mapM)
+
+import Data.PrimitiveArray hiding (map)
+
+import ADP.Fusion.Core.Classes
+import ADP.Fusion.Core.Multi
+import ADP.Fusion.Core.SynVar.Axiom
+import ADP.Fusion.Core.SynVar.Backtrack
+import ADP.Fusion.Core.SynVar.Indices
+import ADP.Fusion.Core.SynVar.TableWrap
+
+
+
+-- | Immutable table.
+--
+-- NOTE / TODO We can *NOT* move the little order into the type-level until we
+-- have a fully working TH-based table filler.
+
+data ITbl (bigorder ∷ Nat) (smallOrder ∷ Nat) arr c i x where
+  ITbl ∷ { iTblConstraint  ∷ !c           -- TODO next to go?!
+         , iTblArray       ∷ !(arr i x)
+         } → ITbl bigOrder smallOrder arr c i x
+
+instance (Show c, Show (arr i x)) ⇒ Show (ITbl bo so arr c i x) where
+  show (ITbl c arr) = "ITbl " ++ " " ++ show c ++ " [" ++ show arr ++ "]"
+
+type TwITbl (b ∷ Nat) (s ∷ Nat) (m ∷ * → *) arr c i x = TW (ITbl b s arr c i x) (LimitType i → i → m x)
+
+type TwITblBt b s arr c i x mF mB r = TW (Backtrack (TwITbl b s mF arr c i x) mF mB) (LimitType i → i → mB [r])
+
+instance Build (TwITbl b s m arr c i x)
+
+instance Build (TwITblBt b s arr c i x mF mB r)
+
+type instance TermArg (TwITbl b s m arr c i x) = x
+
+type instance TermArg (TwITblBt b s arr c i x mF mB r) = (x,[r])
+
+instance GenBacktrackTable (TwITbl b s mF arr c i x) mF mB where
+  data Backtrack (TwITbl b s mF arr c i x) mF mB = BtITbl !c !(arr i x)
+  type BacktrackIndex (TwITbl b s mF arr c i x) = i
+  toBacktrack (TW (ITbl c arr) _) _ = BtITbl c arr
+  {-# Inline toBacktrack #-}
+
+
+
+-- * axiom stuff
+
+instance
+  ( Monad m
+  , PrimArrayOps arr i x
+  , IndexStream i
+  ) ⇒ Axiom (TwITbl b s m arr c i x) where
+  type AxiomStream (TwITbl b s m arr c i x) = m x
+  type AxiomIx     (TwITbl b s m arr c i x) = i
+  axiom (TW (ITbl c arr) _) = do
+    k ← head . streamDown zeroBound' $ upperBound arr
+    return $ arr ! k
+  {-# Inline axiom #-}
+  axiomAt (TW (ITbl c arr) _) k = 
+    return $ arr ! k
+  {-# Inline axiomAt #-}
+
+-- | We need this somewhat annoying instance construction (@i ~ j@ and @m
+-- ~ mB@) in order to force selection of this instance.
+
+instance
+  ( Monad mB
+  , PrimArrayOps arr i x
+  , IndexStream i
+  , j ~ i
+  , m ~ mB
+  ) ⇒ Axiom (TW (Backtrack (TwITbl b s mF arr c i x) mF mB) (LimitType j → j → m [r])) where
+  type AxiomStream (TW (Backtrack (TwITbl b s mF arr c i x) mF mB) (LimitType j → j → m [r])) = mB [r]
+  type AxiomIx     (TW (Backtrack (TwITbl b s mF arr c i x) mF mB) (LimitType j → j → m [r])) = i
+  axiom (TW (BtITbl c arr) bt) = do
+    h ← head . streamDown zeroBound' $ upperBound arr
+    bt (upperBound arr) h
+  {-# Inline axiom #-}
+  axiomAt (TW (BtITbl c arr) bt) k = do
+    bt (upperBound arr) k
+  {-# Inline axiomAt #-}
+
+
+
+-- * 'Element'
+
+instance Element ls i ⇒ Element (ls :!: TwITbl b s m arr c j x) i where
+  data Elm    (ls :!: TwITbl b s m arr c j x) i = ElmITbl !x !(RunningIndex i) !(Elm ls i)
+  type Arg    (ls :!: TwITbl b s m arr c j x)   = Arg ls :. x
+  type RecElm (ls :!: TwITbl b s m arr c j x) i = Elm ls i
+  getArg (ElmITbl x _ ls) = getArg ls :. x
+  getIdx (ElmITbl _ i _ ) = i
+  getElm (ElmITbl _ _ ls) = ls
+  {-# Inline getArg #-}
+  {-# Inline getIdx #-}
+  {-# Inline getElm #-}
+
+deriving instance (Show i, Show (RunningIndex i), Show (Elm ls i), Show x) => Show (Elm (ls :!: TwITbl b s m arr c j x) i)
+
+instance Element ls i => Element (ls :!: TwITblBt b s arr c j x mF mB r) i where
+  data Elm    (ls :!: TwITblBt b s arr c j x mF mB r) i = ElmBtITbl !x [r] !(RunningIndex i) !(Elm ls i)
+  type Arg    (ls :!: TwITblBt b s arr c j x mF mB r)   = Arg ls :. (x, [r])
+  type RecElm (ls :!: TwITblBt b s arr c j x mF mB r) i = Elm ls i
+  getArg (ElmBtITbl x s _ ls) = getArg ls :. (x,s)
+  getIdx (ElmBtITbl _ _ i _ ) = i
+  getElm (ElmBtITbl _ _ _ ls) = ls
+  {-# Inline getArg #-}
+  {-# Inline getIdx #-}
+  {-# Inline getElm #-}
+
+instance (Show x, Show i, Show (RunningIndex i), Show (Elm ls i)) => Show (Elm (ls :!: TwITblBt b s arr c i x mF mB r) i) where
+  show (ElmBtITbl x _ i s) = show (x,i) ++ " " ++ show s
+
+
+
+-- * Multi-dim extensions
+
+type instance LeftPosTy Z (TwITbl b s m arr EmptyOk Z x) Z = Z
+type instance LeftPosTy Z (TwITblBt b s arr EmptyOk Z x mF mB r) Z = Z
+
+type instance LeftPosTy (ps:.p) (TwITbl b s m arr (eos:.EmptyOk) (us:.u) x) (is:.i)
+  = (LeftPosTy ps (TwITbl b s m arr eos us x) is) :. (LeftPosTy p (TwITbl b s m arr EmptyOk u x) i)
+
+type instance LeftPosTy (ps:.p) (TwITblBt b s arr (eos:.EmptyOk) (us:.u) x mF mB r) (is:.i)
+  = (LeftPosTy ps (TwITblBt b s arr eos us x mF mB r) is) :. (LeftPosTy p (TwITblBt b s arr EmptyOk u x mF mB r) i)
+
+type instance LeftPosTy Z (TwITbl b s m arr Z Z x) Z = Z
+type instance LeftPosTy Z (TwITblBt b s arr Z Z x mF mB r) Z = Z
+
+
+instance
+  forall b s l m pos ps p posLeft arr cs c us u x is i ls
+  . ( Monad m
+  , pos ~ (ps:.p)
+  , posLeft ~ LeftPosTy pos (TwITbl b s m arr (cs:.c) (us:.u) x) (is:.i)
+  , Element ls (is:.i)
+  , TableStaticVar (ps:.p) (cs:.c) (us:.u) (is:.i)
+  , AddIndexDense pos (Elm ls (is:.i)) (cs:.c) (us:.u) (is:.i)
+  , MkStream m posLeft ls (is:.i)
+  , PrimArrayOps arr (us:.u) x
+  ) ⇒ MkStream m (ps:.p) (ls :!: TwITbl b s m arr (cs:.c) (us:.u) x) (is:.i) where
+  mkStream Proxy (ls :!: TW (ITbl csc t) _) grd usu isi
+    = map (\(s,tt,ii') -> ElmITbl (t!tt) ii' s)
+    . addIndexDense (Proxy ∷ Proxy pos) csc ub usu isi
+    $ mkStream (Proxy ∷ Proxy posLeft) ls grd usu (tableStreamIndex (Proxy ∷ Proxy pos) csc ub isi)
+    where ub = upperBound t
+  {-# Inline mkStream #-}
+
+instance
+  ( Monad mB
+  , pos ~ (ps:.p)
+  , posLeft ~ LeftPosTy pos (TwITblBt b s arr (cs:.c) (us:.u) x mF mB r) (is:.i)
+  , Element ls (is:.i)
+  , TableStaticVar (ps:.p) (cs:.c) (us:.u) (is:.i)
+  , AddIndexDense pos (Elm ls (is:.i)) (cs:.c) (us:.u) (is:.i)
+  , MkStream mB posLeft ls (is:.i)
+  , PrimArrayOps arr (us:.u) x
+  ) ⇒ MkStream mB (ps:.p) (ls :!: TwITblBt b s arr (cs:.c) (us:.u) x mF mB r) (is:.i) where
+  mkStream Proxy (ls :!: TW (BtITbl csc t) bt) grd usu isi
+    = mapM (\(s,tt,ii') -> bt ub tt >>= \ ~bb -> return $ ElmBtITbl (t!tt) bb ii' s)
+    . addIndexDense (Proxy ∷ Proxy pos) csc ub usu isi
+    $ mkStream (Proxy ∷ Proxy posLeft) ls grd usu (tableStreamIndex (Proxy :: Proxy pos) csc ub isi)
+    where ub = upperBound t
+  {-# Inline mkStream #-}
+
diff --git a/ADP/Fusion/Core/SynVar/Axiom.hs b/ADP/Fusion/Core/SynVar/Axiom.hs
new file mode 100644
--- /dev/null
+++ b/ADP/Fusion/Core/SynVar/Axiom.hs
@@ -0,0 +1,20 @@
+
+-- | The 'axiom' runs a backtracking algebra. The name comes from Robert
+-- Giegerichs @ADP@ where @axiom@ runs the fully formed algorithm.
+
+module ADP.Fusion.Core.SynVar.Axiom where
+
+-- | The Axiom type class
+
+class Axiom t where
+  -- | The corresponding stream being returned by 'axiom'
+  type AxiomStream t ∷ *
+  -- | Index type when running the axiom
+  type AxiomIx t ∷ *
+  -- | Given a table, run the axiom
+  axiom ∷ t → AxiomStream t
+  -- | Given a table and index, run the axiom from the index on. This is useful
+  -- for scanning type algorithms that need to return all locally optimal
+  -- structures, as a locally optimal may start at any given index.
+  axiomAt ∷ t → AxiomIx t → AxiomStream t
+
diff --git a/ADP/Fusion/Core/SynVar/Backtrack.hs b/ADP/Fusion/Core/SynVar/Backtrack.hs
new file mode 100644
--- /dev/null
+++ b/ADP/Fusion/Core/SynVar/Backtrack.hs
@@ -0,0 +1,28 @@
+
+-- | Wrap forward tables in such a way as to allow backtracking via
+-- algebras.
+
+module ADP.Fusion.Core.SynVar.Backtrack where
+
+import Data.Vector.Fusion.Stream.Monadic (Stream)
+
+import ADP.Fusion.Core.SynVar.TableWrap
+
+
+
+-- |
+--
+-- TODO this should go into @ADP.Fusion.Table.Backtrack@, more than just
+-- tabulated syntactic vars are going to use it.
+--
+-- NOTE You probably need to give the @monad morphism@ between @mF@ and
+-- @mB@ so as to be able to extract forward results in the backtracking
+-- phase.
+
+class GenBacktrackTable t (mF :: * -> *) (mB :: * -> *) where
+  data Backtrack t (mF :: * -> *) (mB :: * -> *) :: *
+  type BacktrackIndex t :: *
+  toBacktrack :: t -> (forall a . mF a -> mB a) {- -> (BacktrackIndex t -> BacktrackIndex t -> mB [r]) -} -> Backtrack t mF mB
+
+-- instance Build (TW (Backtrack t mF mB) f)
+
diff --git a/ADP/Fusion/Core/SynVar/Fill.hs b/ADP/Fusion/Core/SynVar/Fill.hs
new file mode 100644
--- /dev/null
+++ b/ADP/Fusion/Core/SynVar/Fill.hs
@@ -0,0 +1,442 @@
+
+module ADP.Fusion.Core.SynVar.Fill where
+
+import           Control.Monad
+import           Control.Monad.Morph (hoist, MFunctor (..))
+import           Control.Monad.Primitive
+import           Control.Monad.ST
+import           Control.Monad.Trans.Class (lift, MonadTrans (..))
+import           Control.Monad (when,forM_)
+import           Data.Dynamic
+import           Data.List (nub,sort,group)
+import           Data.Maybe (fromJust)
+import           Data.Proxy
+import           Data.Type.Equality
+import           Data.Vector.Fusion.Util (Id(..))
+import           Debug.Trace (traceShow)
+import           GHC.Exts (inline)
+import           GHC.TypeNats
+import qualified Data.Data as D
+import qualified Data.List as L
+import qualified Data.Typeable as T
+import qualified Data.Vector as V
+import qualified Data.Vector.Fusion.Stream.Monadic as SM
+import qualified Data.Vector.Mutable as VM
+import qualified Data.Vector.Unboxed as VU
+import qualified GHC.Generics as G
+import           System.IO.Unsafe
+import           System.CPUTime
+import           GHC.Conc (pseq)
+
+import           Data.PrimitiveArray
+
+import           ADP.Fusion.Core.SynVar.Array -- TODO we want to keep only classes in here, move instances to the corresponding modules
+import           ADP.Fusion.Core.SynVar.Recursive.Type
+import           ADP.Fusion.Core.SynVar.TableWrap
+
+import           Debug.Trace
+
+
+
+{-
+
+-- | A vanilla context-free grammar
+
+data CFG
+
+-- | This grammar is a multi-cfg in a monotone setting
+
+data MonotoneMCFG
+
+
+-- * Unsafely mutate 'ITbls' and similar tables in the forward phase.
+
+-- | Mutate a cell in a stack of syntactic variables.
+--
+-- TODO generalize to monad morphism via @mmorph@ package. This will allow
+-- more interesting @mrph@ functions that can, for example, track some
+-- state in the forward phase. (Note that this can be dangerous, we do
+-- /not/ want to have this state influence forward results, unless that can
+-- be made deterministic, or we'll break Bellman)
+
+class MutateCell (h ∷ *) (s ∷ *) (im ∷ * → *) i where
+  mutateCell
+    ∷ (Monad om, PrimMonad om)
+    ⇒ Proxy h
+    → Int
+    → Int
+    → (forall a . im a → om a)
+    → s
+    → LimitType i
+    → i
+    → om ()
+
+-- |
+
+class MutateTables (h :: *) (s :: *) (im :: * -> *) where
+  mutateTables :: (Monad om, PrimMonad om) => Proxy h -> (forall a . im a -> om a) -> s -> om s
+
+class TableOrder (s :: *) where
+  tableLittleOrder :: s -> [Int]
+  tableBigOrder :: s -> [Int]
+
+instance TableOrder Z where
+  tableLittleOrder Z = []
+  tableBigOrder Z = []
+  {-# Inline tableLittleOrder #-}
+  {-# Inline tableBigOrder #-}
+
+instance
+  ( TableOrder ts
+  , KnownNat bo
+--  , KnownNat lo
+  ) ⇒ TableOrder (ts:.TwITbl bo im arr c i x) where
+  tableLittleOrder (ts:.TW (ITbl tlo _ _) _) =
+    let -- tlo = fromIntegral $ natVal (Proxy ∷ Proxy lo)
+    in  tlo : tableLittleOrder ts
+  tableBigOrder    (ts:.TW (ITbl _ _ _) _) =
+    let tbo = fromIntegral $ natVal (Proxy ∷ Proxy bo)
+    in  tbo : tableBigOrder ts
+  {-# Inline tableLittleOrder #-}
+  {-# Inline tableBigOrder #-}
+
+-- | @IRec@s do not need an order, given that they do not memoize.
+
+instance (TableOrder ts) => TableOrder (ts:.TwIRec im c i x) where
+  tableLittleOrder (ts:._) = tableLittleOrder ts
+  tableBigOrder    (ts:._) = tableBigOrder ts
+  {-# Inline tableLittleOrder #-}
+  {-# Inline tableBigOrder #-}
+
+-- ** individual instances for filling a *single cell*
+
+instance
+  (
+  ) => MutateCell p Z im i where
+  mutateCell _ _ _ _ Z _ _ = return ()
+  {-# INLINE mutateCell #-}
+
+instance
+  ( MutateCell CFG ts im i
+  ) => MutateCell CFG (ts:.TwIRec im c i x) im i where
+  mutateCell h bo lo mrph (ts:._) lu i = do
+    mutateCell h bo lo mrph ts lu i
+  {-# Inline mutateCell #-}
+
+instance
+  ( PrimArrayOps  arr i x
+  , MPrimArrayOps arr i x
+  , MutateCell CFG ts im i
+  , KnownNat bo
+--  , KnownNat lo
+  ) => MutateCell CFG (ts:.TwITbl bo im arr c i x) im i where
+  mutateCell h bo lo mrph (ts:.TW (ITbl tlo c arr) f) lu i = do
+    let tbo = fromIntegral $ natVal (Proxy ∷ Proxy bo)
+--        tlo = fromIntegral $ natVal (Proxy ∷ Proxy lo)
+    mutateCell h bo lo mrph ts lu i
+    when (bo==tbo && lo==tlo) $ do
+      marr <- unsafeThaw arr
+      z <- (inline mrph) $ f lu i
+      writeM marr i z
+  {-# INLINE mutateCell #-}
+
+{-
+ - TODOThe following code goes into ADPfusionSubword!
+ -
+type ZS2 = Z:.Subword I:.Subword I
+
+instance
+  ( PrimArrayOps  arr ZS2 x
+  , MPrimArrayOps arr ZS2 x
+  , MutateCell MonotoneMCFG ts im ZS2
+  ) => MutateCell MonotoneMCFG (ts:.TwITbl im arr c ZS2 x) im ZS2 where
+  mutateCell h bo lo mrph (ts:.TW (ITbl tbo tlo c arr) f) lu iklj@(Z:.Subword (i:.k):.Subword(l:.j)) = do
+    mutateCell h bo lo mrph ts lu iklj
+    when (bo==tbo && lo==tlo && k<=l) $ do
+      marr <- unsafeThaw arr
+      z <- (inline mrph) $ f lu iklj
+      writeM marr iklj z
+  {-# INLINE mutateCell #-}
+
+instance
+  ( PrimArrayOps arr (Subword I) x
+  , MPrimArrayOps arr (Subword I) x
+  , MutateCell h ts im (Z:.Subword I:.Subword I)
+  ) => MutateCell h (ts:.TwITbl im arr c (Subword I) x) im (Z:.Subword I:.Subword I) where
+  mutateCell h bo lo mrph (ts:.TW (ITbl tbo tlo c arr) f) lu@(Z:.Subword (l:._):.Subword(_:.u)) ix@(Z:.Subword (i1:.j1):.Subword (i2:.j2)) = do
+    mutateCell h bo lo mrph ts lu ix
+    when (bo==tbo && lo==tlo && i1==i2 && j1==j2) $ do
+      let i = i1
+      let j = j1
+      marr <- unsafeThaw arr
+      z <- (inline mrph) $ f (subword l u) (subword i j)
+      writeM marr (subword i j) z
+  {-# Inline mutateCell #-}
+-}
+
+
+-- ** individual instances for filling a complete table and extracting the
+-- bounds
+
+instance
+  ( MutateCell h (ts:.TwITbl bo im arr c i x) im i
+  , PrimArrayOps arr i x
+  , Show i
+  , IndexStream i
+  , TableOrder (ts:.TwITbl bo im arr c i x)
+  ) => MutateTables h (ts:.TwITbl bo im arr c i x) im where
+  mutateTables h mrph tt@(_:.TW (ITbl lo _ arr) _) = do
+    let to = upperBound arr
+    -- TODO (1) find the set of orders for the synvars
+    let !tbos = VU.fromList . nub . sort $ tableBigOrder tt
+    let !tlos = VU.fromList . nub . sort $ tableLittleOrder tt
+    VU.forM_ tbos $ \bo ->
+      case (VU.length tlos) of
+        1 -> let lo = VU.head tlos
+             in  flip SM.mapM_ (streamUp zeroBound' to) $ \k ->
+                  mutateCell h bo lo (inline mrph) tt to k
+        -- TODO each big-order group should be allowed to have its own sets
+        -- of bounds. within a group, it doesn't make a lot of sense to
+        -- have different bounds? Is there a use case for that even?
+        _ -> flip SM.mapM_ (streamUp zeroBound' to) $ \k ->
+              VU.forM_ tlos $ \lo ->
+                mutateCell h bo lo (inline mrph) tt to k
+    return tt
+  {-# INLINE mutateTables #-}
+
+-- | Default table filling, assuming that the forward monad is just @IO@.
+--
+-- TODO generalize to @MonadIO@ or @MonadPrim@.
+
+mutateTablesDefault :: MutateTables CFG t Id => t -> t
+mutateTablesDefault t = unsafePerformIO $ mutateTables (Proxy :: Proxy CFG) (return . unId) t
+{-# INLINE mutateTablesDefault #-}
+
+-- | Mutate tables, but observe certain hints. We use this for monotone
+-- mcfgs for now.
+
+mutateTablesWithHints :: MutateTables h t Id => Proxy h -> t -> t
+mutateTablesWithHints h t = unsafePerformIO $ mutateTables h (return . unId) t
+
+
+
+
+
+
+mutateTablesST t = runST $ mutateTablesNew t
+{-# Inline mutateTablesST #-}
+
+class CountNumberOfCells t where
+  countNumberOfCells ∷ t → Integer
+
+instance CountNumberOfCells Z where
+  countNumberOfCells Z = 0
+
+instance
+  ( CountNumberOfCells ts
+  , Index i
+  , PrimArrayOps arr i x
+  ) ⇒ CountNumberOfCells (ts:.TwITbl bo Id arr c i x) where
+  countNumberOfCells (ts:.(TW (ITbl lo _ arr) fun)) =
+    countNumberOfCells ts + (product . totalSize $ upperBound arr)
+
+data PerfCounter = PerfCounter
+  { picoSeconds   :: !Integer
+  , seconds       :: !Double
+  , numberOfCells :: !Integer
+  }
+  deriving (Eq,Ord,Show)
+
+data Mutated ts = Mutated
+  { mutatedTables ∷ !ts
+  , perfCounter   ∷ !PerfCounter
+  , eachBigPerfCounter  ∷ [PerfCounter]
+  }
+
+-- | 
+--
+-- TODO new way how to do table filling. Because we now have heterogeneous
+-- tables (i) group tables by @big order@ into different bins; (ii) check
+-- that each bin has the same bounds (needed? -- could we have
+-- smaller-sized tables once in a while); (iii) run each bin one after the
+-- other
+--
+-- TODO measure performance penalty, if any. We might need liberal
+-- INLINEABLE, and specialization. On the other hand, we can do the
+-- freeze/unfreeze outside of table filling.
+
+mutateTablesNew
+  :: forall t m .
+     ( TableOrder t
+     , TSBO t
+     , Monad m
+     , PrimMonad m
+     , CountNumberOfCells t
+     )
+  => t
+  -> m (Mutated t)
+mutateTablesNew ts = do
+  -- sort the tables according to [bigorder,type,littleorder]. For each
+  -- @bigorder@, we should have only one @type@ and can therefor do the
+  -- following (i) get subset of the @ts@, (ii) use outermost of @ts@ to
+  -- get bounds, (iii) fill these tables
+  -- let !tbos = VU.fromList . nub . sort $ tableBigOrder ts
+  let justOrder = L.map (\d → (qBigOrder d, qLittleOrder d))
+  let ds = L.sort $ asDyn ts
+  let goM ∷ (Monad m, PrimMonad m) ⇒ [Q] → [PerfCounter] → m [PerfCounter]
+      goM [] ps = return $ reverse ps
+      goM xs ps = do
+        (ys,p) <- fillWithDyn xs ts
+        goM ys (p:ps)
+      {-# Inlinable goM #-}
+  startTime ← unsafeIOToPrim getCPUTime
+  ps ← goM ds []
+  stopTime  ← unsafeIOToPrim getCPUTime
+  let deltaTime = max 1 $ stopTime - startTime
+  return $! Mutated
+    { mutatedTables = ts
+    , perfCounter   = PerfCounter
+        { picoSeconds   = deltaTime
+        , seconds       = 1e-12 * fromIntegral deltaTime
+        , numberOfCells = countNumberOfCells ts
+        }
+    , eachBigPerfCounter = ps
+    }
+{-# Inline mutateTablesNew #-}
+
+data Q = Q
+  { qBigOrder     :: Int
+  , qLittleOrder  :: Int
+  , qTypeRep      :: T.TypeRep
+  , qObject       :: Dynamic
+  , qTable        :: Dynamic
+  , qFunction     :: Dynamic
+  }
+  deriving (Show)
+
+instance Eq Q where
+  Q bo1 lo1 tr1 _ _ _ == Q bo2 lo2 tr2 _ _ _ = (bo1,tr1,lo1) == (bo2,tr2,lo2)
+
+instance Ord Q where
+  Q bo1 lo1 tr1 _ _ _ `compare` Q bo2 lo2 tr2 _ _ _ = (bo1,lo1,tr1) `compare` (bo2,lo2,tr2)
+
+-- | Find the outermost table that has a certain big order and then fill
+-- from there.
+
+class TSBO t where
+  asDyn :: t -> [Q]
+  fillWithDyn :: (Monad m, PrimMonad m) => [Q] -> t -> m ([Q], PerfCounter)
+
+instance TSBO Z where
+  asDyn Z = []
+  fillWithDyn qs Z = return (qs, PerfCounter 0 0 0)
+  {-# Inlinable asDyn #-}
+  {-# Inline fillWithDyn #-}
+
+instance
+ ( TSBO ts
+ , Typeable arr
+ , Typeable c
+ , Typeable i
+ , Typeable x
+ , PrimArrayOps arr i x
+ , MPrimArrayOps arr i x
+ , IndexStream i
+ , KnownNat bo
+-- , KnownNat lo
+ ) => TSBO (ts:.TwITbl bo Id arr c i x) where
+  asDyn (ts:.t@(TW (ITbl lo _ arr) fun)) =
+    let bo = fromIntegral $ natVal (Proxy ∷ Proxy bo)
+--        lo = fromIntegral $ natVal (Proxy ∷ Proxy lo)
+    in  Q bo lo (T.typeOf t) (toDyn t) (toDyn arr) (seq fun $ toDyn fun) : asDyn ts
+  fillWithDyn qs (ts:.t@(TW (ITbl _ _ arrDirect) fDirect)) = do
+    let to = upperBound arrDirect
+        bo = fromIntegral $ natVal (Proxy ∷ Proxy bo)
+--        lo = fromIntegral $ natVal (Proxy ∷ Proxy lo)
+    -- @hs@ are all tables that can be filled here
+    -- @ns@ are all tables we can't fill and need to process further down
+    -- the line
+    -- TODO FIXME FIXME FIXME why are the typereps different???
+    let (hs,ns) = L.span (\Q{..} -> qBigOrder == bo) qs -- && qTypeRep == T.typeOf t) qs
+    if null hs
+      then fillWithDyn qs ts
+      else do
+        let ms = Prelude.map concreteTW hs
+            af = Prelude.map concreteAF hs
+            concreteTW  = (maybe (error "fromDynamic should not fail!")
+                           (\x -> x `asTypeOf` t)
+                          . fromDynamic . qObject)
+            concreteAF q  = ( (`asTypeOf` arrDirect) . fromJust . fromDynamic $ qTable    q
+                            , (`asTypeOf` fDirect)   . fromJust . fromDynamic $ qFunction q
+                            )
+        -- We have a single table and should short-circuit here
+        --
+        -- TODO we should specialize for tables of lengh @1..k@ for some
+        -- small k. For @1@ and Needleman-Wunsch, we have a very nice @1.8@
+        -- seconds down to @1.25@ seconds. :-)
+        --
+        -- TODO how about
+        -- case ms of
+        --   [a] -> bla
+        --   [a,b] -> bla
+        --   [a,b,c] -> bla
+        --   [a:b:c:d:ms'] -> bla >> go ms'
+        --   measure if this yields meaningful performance improvements
+        --
+        -- TODO also consider if we maybe just put marrfs into a vector
+        --
+        -- TODO we should use TH here.
+        --
+        -- (1) Have @Proxy @0@, say to set up big and small orders -- this
+        -- gives us the order on the type level. @data One = One, data Two
+        -- = Two, ...@ might be easier... maybe this is not too annoying to
+        -- write using type equality
+        -- 
+        -- (2) Then deconstruct the @ts:.t@ things with TH into the correct
+        -- pieces.
+        --
+        -- (3) Finally generate fill code. This should yield to performance
+        -- similar to what we have here with the @case of 1@ construction,
+        -- because @fDirect@ is partially floated out.
+        --
+        marrfs <- V.fromList <$> Prelude.mapM (\(TW (ITbl _ _ arr) f) -> unsafeThaw arr >>= \marr -> return (marr,f)) ms
+        startTime ← unsafeIOToPrim getCPUTime
+        case (V.length marrfs) of
+          1 -> do -- let (!marr,!f) = marrfs V.! 0   -- this takes 1.3 seconds for NeedlemanWunsch
+                  -- marr <- unsafeThaw arrDirect  -- this takes 0.8 seconds for NeedlemanWunsch
+                  marr <- unsafeThaw arrDirect -- (fst $ af!!0)  -- this takes 1.3 seconds for NeedlemanWunsch
+                  let !ffff = fDirect --snd $ af!!0
+                  flip SM.mapM_ (streamUp zeroBound' to) $ \k -> do
+                    -- TODO @inline mrph@ ...
+                    z <- (return . unId) $ fDirect to k
+                    writeM marr k z
+        -- We have more than one table in will work over the list of tables
+          _ -> do flip SM.mapM_ (streamUp zeroBound' to) $ \k ->
+                    V.forM_ marrfs $ \(marr,f) -> do
+                      z <- (return . unId) $ f to k
+                      writeM marr k z
+        -- traceShow (hs,length ms) $
+        stopTime ← unsafeIOToPrim getCPUTime
+        let deltaTime = stopTime - startTime
+        let perf = PerfCounter
+              { picoSeconds   = deltaTime
+              , seconds       = 1e-12 * fromIntegral deltaTime
+              , numberOfCells = sum $ Prelude.map (\(TW t _) → product . totalSize . upperBound $ iTblArray t) ms
+              }
+        return (ns, perf)
+  {-# Inline fillWithDyn #-}
+
+-- We don't need to capture @IRec@ tables as no table-filling takes place
+-- for those tables. @asDyn@ therefore just collects on the remaining @ts@,
+-- while @fillWithDyn@ hands of to the next possible table.
+
+instance
+  ( TSBO ts
+  ) => TSBO (ts:.TwIRec Id c i x) where
+  asDyn (ts:.t@(TW (IRec _ _) _)) = asDyn ts
+  fillWithDyn qs (ts:._) = fillWithDyn qs ts
+  {-# Inlinable asDyn #-}
+  {-# Inline fillWithDyn #-}
+
+-}
+
diff --git a/ADP/Fusion/Core/SynVar/FillTyLvl.hs b/ADP/Fusion/Core/SynVar/FillTyLvl.hs
new file mode 100644
--- /dev/null
+++ b/ADP/Fusion/Core/SynVar/FillTyLvl.hs
@@ -0,0 +1,324 @@
+
+-- |
+--
+-- TODO Need to add additional type family instances as required.
+--
+-- TODO Need to have little order nats as well.
+
+module ADP.Fusion.Core.SynVar.FillTyLvl where
+
+import           Control.DeepSeq
+import           Control.Monad.Primitive
+import           Control.Monad.ST
+import           Data.Proxy
+import           Data.Singletons.Prelude.Bool
+import           Data.Singletons.Prelude.Bool
+import           Data.Singletons.Prelude.List
+import           Data.Type.Equality
+import           Data.Vector.Fusion.Util (Id(..))
+import           GHC.Exts
+import           GHC.Generics
+import           GHC.TypeNats
+import qualified Data.Vector.Fusion.Stream.Monadic as SM
+import qualified Data.Vector.Unboxed as VU
+import           System.CPUTime
+import           Text.Printf
+
+import           Data.PrimitiveArray
+
+import           ADP.Fusion.Core.SynVar.TableWrap
+import           ADP.Fusion.Core.SynVar.Array
+
+
+
+--  -- | Fill/mutate tables using @ST@.
+--  
+--  fillTablesST
+--    ∷ forall bigOrder ts
+--    . ( bigOrder ~ BigOrderNats ts
+--      , EachBigOrder bigOrder ts
+--      )
+--    ⇒ ts
+--    → ts
+--  {-# Inline fillTablesST #-}
+--  fillTablesST ts = runST $ fillTables ts
+
+-- |
+
+fillTables
+--  ∷ Proxy (BigOrderNats ts)
+--  -- ^ Proxy that provides the set of @BigOrder@ naturals
+  ∷ forall bigOrder s ts
+  . ( bigOrder ~ BigOrderNats ts
+    , EachBigOrder bigOrder ts
+    , CountNumberOfCells 0 ts
+    )
+  ⇒ ts
+  -- ^ The tables
+  → ST s (Mutated ts)
+{-# Inline fillTables #-}
+fillTables ts = do
+  startTime ← unsafeIOToPrim getCPUTime
+  ps ← eachBigOrder (Proxy ∷ Proxy bigOrder) ts
+  stopTime  ← unsafeIOToPrim getCPUTime
+  let deltaTime = max 1 $ stopTime - startTime
+  return $! Mutated
+    { mutatedTables = ts
+    , perfCounter   = PerfCounter
+        { picoSeconds   = deltaTime
+        , seconds       = 1e-12 * fromIntegral deltaTime
+        , numberOfCells = countNumberOfCells (Nothing ∷ Maybe (Proxy 0)) ts
+        }
+    , eachBigPerfCounter = ps
+    }
+
+-- | This type class instanciates to the specialized machinery for each
+-- @BigOrder Natural@ number.
+
+class EachBigOrder (boNats ∷ [Nat]) ts where
+  eachBigOrder ∷ Proxy boNats → ts → ST s [PerfCounter]
+
+-- | No more big orders to handle.
+
+instance EachBigOrder '[] ts where
+  {-# Inline eachBigOrder #-}
+  eachBigOrder Proxy _ = return []
+
+-- | handle this big order.
+
+instance
+  ( EachBigOrder ns ts
+  , ThisBigOrder n (IsThisBigOrder n ts) ts
+  , CountNumberOfCells n ts
+  ) ⇒ EachBigOrder (n ': ns) ts where
+  {-# Inline eachBigOrder #-}
+  eachBigOrder Proxy ts = do
+    startTime ← unsafeIOToPrim getCPUTime
+    thisBigOrder (Proxy ∷ Proxy n) (Proxy ∷ Proxy (IsThisBigOrder n ts)) ts
+    stopTime  ← unsafeIOToPrim getCPUTime
+    let deltaTime = max 1 $ stopTime - startTime
+    ps ← eachBigOrder (Proxy ∷ Proxy ns) ts
+    let p = PerfCounter
+              { picoSeconds   = deltaTime
+              , seconds       = 1e-12 * fromIntegral deltaTime
+              , numberOfCells = countNumberOfCells (Just (Proxy ∷ Proxy n)) ts
+              }
+    return $ p:ps
+
+-- |
+
+class ThisBigOrder (boNat ∷ Nat) (thisOrder ∷ Bool) ts where
+  thisBigOrder ∷ Proxy boNat → Proxy thisOrder → ts → ST s ()
+  getAllBounds ∷ Proxy boNat → Proxy thisOrder → ts → [()]
+
+instance ThisBigOrder boNat anyOrder Z where
+  {-# Inline thisBigOrder #-}
+  thisBigOrder Proxy Proxy Z = return ()
+  {-# Inline getAllBounds #-}
+  getAllBounds Proxy Proxy Z = []
+
+-- | We have found the first table for our big order. Extract the bounds and
+-- hand over to small order. We do not need to check for another big order with
+-- this nat, since all tables are now being filled by the small order.
+
+instance
+  ( smallOrder ~ SmallOrderNats (ts:.TwITbl bo so m arr c i x)
+  , EachSmallOrder boNat smallOrder (ts:.TwITbl bo so m arr c i x) i
+  , PrimArrayOps arr i x
+  , IndexStream i
+  ) ⇒ ThisBigOrder boNat True (ts:.TwITbl bo so m arr c i x) where
+  {-# Inline thisBigOrder #-}
+  thisBigOrder Proxy Proxy tst@(_:.TW (ITbl _ arr) _) = do
+    let to = upperBound arr
+    let allBounds = getAllBounds (Proxy ∷ Proxy boNat) (Proxy ∷ Proxy True) tst
+    -- TODO check bounds
+    flip SM.mapM_ (streamUp zeroBound' to) $ \k ->
+      eachSmallOrder (Proxy ∷ Proxy boNat) (Proxy ∷ Proxy smallOrder) tst k
+  {-# Inline getAllBounds #-}
+  getAllBounds Proxy Proxy (ts:.t) = undefined
+
+-- | Go down the tables until we find the first table for our big order.
+
+instance
+  ( ThisBigOrder n (IsThisBigOrder n ts) ts
+  ) ⇒ ThisBigOrder n False (ts:.t) where
+  {-# Inline thisBigOrder #-}
+  thisBigOrder Proxy Proxy (ts:.t) =
+    thisBigOrder (Proxy ∷ Proxy n) (Proxy ∷ Proxy (IsThisBigOrder n ts)) ts
+
+-- |
+
+class EachSmallOrder (bigOrder ∷ Nat) (smallOrders ∷ [Nat]) ts i where
+  eachSmallOrder
+    ∷ Proxy bigOrder
+    -- ^ Only fill exactly this big order
+    → Proxy smallOrders
+    -- ^ These are all the small order to go through.
+    → ts
+    -- ^ set of tables.
+    → i
+    -- ^ index to update.
+    → ST s ()
+
+-- | Went through all tables, nothing more to do.
+
+instance EachSmallOrder bigOrder '[] ts i where
+  {-# Inline eachSmallOrder #-}
+  eachSmallOrder Proxy Proxy ts i = return ()
+
+-- | 
+
+instance
+  ( EachSmallOrder bigOrder so ts i
+  , isThisBigOrder ~ IsThisBigOrder bigOrder ts
+  , isThisSmallOrder ~ IsThisSmallOrder s ts
+  , isThisOrder ~ (isThisBigOrder && isThisSmallOrder)
+  , ThisSmallOrder bigOrder s isThisOrder ts i
+  ) ⇒ EachSmallOrder bigOrder (s ': so) ts i where
+  {-# Inline eachSmallOrder #-}
+  eachSmallOrder Proxy Proxy ts i = do
+    -- fill all tables that have the same big & small order
+    thisSmallOrder (Proxy ∷ Proxy bigOrder) (Proxy ∷ Proxy s) (Proxy ∷ Proxy isThisOrder) ts i
+    -- fill tables with the next small order
+    eachSmallOrder (Proxy ∷ Proxy bigOrder) (Proxy ∷ Proxy so) ts i
+
+-- |
+
+class ThisSmallOrder (bigNat ∷ Nat) (smallNat ∷ Nat) (thisOrder ∷ Bool) ts i where
+  thisSmallOrder ∷ Proxy bigNat → Proxy smallNat → Proxy thisOrder → ts → i → ST s ()
+
+instance ThisSmallOrder b s any Z i where
+  {-# Inline thisSmallOrder #-}
+  thisSmallOrder _ _ _ _ _ = return ()
+
+instance
+  ( isThisBigOrder ~ IsThisBigOrder bigOrder ts
+  , isThisSmallOrder ~ IsThisSmallOrder smallOrder ts
+  , isThisOrder ~ (isThisBigOrder && isThisSmallOrder)
+  , ThisSmallOrder bigOrder smallOrder isThisOrder ts i
+  ) ⇒ ThisSmallOrder bigOrder smallOrder 'False (ts:.t) i where
+  {-# Inline thisSmallOrder #-}
+  thisSmallOrder Proxy Proxy Proxy (ts:.t) i =
+    thisSmallOrder (Proxy ∷ Proxy bigOrder) (Proxy ∷ Proxy smallOrder) (Proxy ∷ Proxy isThisOrder) ts i
+
+-- |
+--
+-- TODO generalize from @Id@ to any monad in a stack with a primitive base
+
+instance
+  ( PrimArrayOps arr i x
+  , MPrimArrayOps arr i x
+  , isThisBigOrder ~ IsThisBigOrder bigOrder ts
+  , isThisSmallOrder ~ IsThisSmallOrder smallOrder ts
+  , isThisOrder ~ (isThisBigOrder && isThisSmallOrder)
+  , ThisSmallOrder bigOrder smallOrder isThisOrder ts i
+  ) ⇒ ThisSmallOrder bigOrder smallOrder 'True (ts:.TwITbl bo so Id arr c i x) i where
+  {-# Inline thisSmallOrder #-}
+  thisSmallOrder Proxy Proxy Proxy (ts:.TW (ITbl _ arr) f) i = do
+    let uB = upperBound arr
+    marr <- unsafeThaw arr
+    z ← return . unId $ (inline f) uB i
+    writeM marr i z
+    -- TODO need to write test case that checks that all tables are always filled
+    thisSmallOrder (Proxy ∷ Proxy bigOrder) (Proxy ∷ Proxy smallOrder) (Proxy ∷ Proxy isThisOrder) ts i
+
+-- | The set of arrays to fill is a tuple of the form @(Z:.a:.b:.c)@. Here, we
+-- extract the big order @Nat@s. The set of @Nat@s being returned is already
+-- ordered with the smallest @Nat@ up front.
+
+type BigOrderNats arr = Nub (Sort (BigOrderNats' arr))
+
+type family BigOrderNats' arr ∷ [Nat]
+
+type instance BigOrderNats' Z = '[]
+
+type instance BigOrderNats' (ts:.TwITbl bo so m arr c i x) = bo ': BigOrderNats' ts
+
+
+
+type family IsThisBigOrder (n ∷ Nat) arr ∷ Bool
+
+type instance IsThisBigOrder n Z = 'False
+
+type instance IsThisBigOrder n (ts:.TwITbl bo so m arr c i x) = n == bo
+
+
+
+type SmallOrderNats arr = Nub (Sort (SmallOrderNats' arr))
+
+type family SmallOrderNats' arr ∷ [Nat]
+
+type instance SmallOrderNats' Z = '[]
+
+-- TODO fix small order
+
+type instance SmallOrderNats' (ts:.TwITbl bo so m arr c i x) = so ': SmallOrderNats' ts
+
+
+
+type family IsThisSmallOrder (n ∷ Nat) arr ∷ Bool
+
+type instance IsThisSmallOrder n Z = 'False
+
+-- TODO fix small order comparision
+
+type instance IsThisSmallOrder n (ts:.TwITbl bo so m arr c i x) = n == so
+
+data Mutated ts = Mutated
+  { mutatedTables ∷ !ts
+  , perfCounter   ∷ !PerfCounter
+  , eachBigPerfCounter  ∷ [PerfCounter]
+  }
+  deriving (Eq,Ord,Show,Generic)
+
+instance NFData ts ⇒ NFData (Mutated ts)
+
+data PerfCounter = PerfCounter
+  { picoSeconds   :: !Integer
+  , seconds       :: !Double
+  , numberOfCells :: !Integer
+  }
+  deriving (Eq,Ord,Show,Generic)
+
+instance NFData PerfCounter
+
+showPerfCounter ∷ PerfCounter → String
+{-# NoInline showPerfCounter #-}
+showPerfCounter PerfCounter{..} =
+  let cellsSecond = round $ fromIntegral numberOfCells / seconds
+      m ∷ Integer = 1000000
+  in  printf "%.4f seconds, %d,%06d cells @ %d,%06d cells/second"
+             seconds
+             (numberOfCells `div` m) (numberOfCells `mod` m)
+             (cellsSecond `div` m) (cellsSecond `mod` m)
+
+-- | Adding two 'PerfCounter's yields the time they take together.
+
+instance Num PerfCounter where
+  PerfCounter p1 s1 n1 + PerfCounter p2 s2 n2 = PerfCounter (p1+p2) (s1+s2) (n1+n2)
+
+
+class CountNumberOfCells (n ∷ Nat) t where
+  countNumberOfCells ∷ Maybe (Proxy n) → t → Integer
+
+instance CountNumberOfCells n Z where
+  {-# NoInline countNumberOfCells #-}
+  countNumberOfCells p Z = 0
+
+instance
+  ( CountNumberOfCells n ts
+  , Index i
+  , PrimArrayOps arr i x
+  , KnownNat n
+  , KnownNat bo
+  ) ⇒ CountNumberOfCells n (ts:.TwITbl bo so Id arr c i x) where
+  {-# NoInline countNumberOfCells #-}
+  countNumberOfCells mayP (ts:.(TW (ITbl _ arr) fun)) =
+    let n  = natVal (Proxy ∷ Proxy n)
+        bo = natVal (Proxy ∷ Proxy bo)
+        cs = countNumberOfCells mayP ts
+        c  = product . totalSize $ upperBound arr
+    in  case mayP of
+      Nothing → cs + c
+      Just _  → cs + if n==bo then c else 0
+
diff --git a/ADP/Fusion/Core/SynVar/Indices.hs b/ADP/Fusion/Core/SynVar/Indices.hs
new file mode 100644
--- /dev/null
+++ b/ADP/Fusion/Core/SynVar/Indices.hs
@@ -0,0 +1,140 @@
+
+-- | Classes that enumerate the index structure necessary for actually
+-- performing the indexing.
+--
+-- TODO Currently, we only provide dense index generation.
+
+module ADP.Fusion.Core.SynVar.Indices where
+
+import Data.Proxy (Proxy(..))
+import Data.Vector.Fusion.Stream.Monadic (map,Stream,head,mapM,flatten,Step(..))
+import Prelude hiding (map,head,mapM)
+
+import Data.PrimitiveArray hiding (map)
+
+import ADP.Fusion.Core.Classes
+import ADP.Fusion.Core.Multi
+import ADP.Fusion.Core.TyLvlIx
+
+
+
+-- | This type classes enable enumeration both in single- and multi-dim
+-- cases. The type @a@ is the type of the /full stack/ of indices, i.e. the
+-- full multi-tape problem.
+--
+-- @pos@ is the positional information,
+-- @s@ is the element type over the index @ix@,
+-- @ minSize@ the minimal size or width to request from the syntactic variable,
+-- @tableIx@ the index type of the table to walk over,
+-- and @ix@ the actual index.
+
+class AddIndexDense pos elm minSize tableIx ix where
+  addIndexDenseGo
+    ∷ (Monad m)
+    ⇒ Proxy pos
+    -- ^ Positional information in the rule (static/variable/etc)
+    → minSize
+    -- ^ Minimal size of the structure under consideration. We might want to
+    -- constrain enumeration over syntactic variables to only consider at least
+    -- "size>=1" cases. Normally, a syntactic variable may be of size 0 as
+    -- well, but with rules like @X -> X X@, we don't want to have one of the
+    -- @X@'s on the r.h.s. be of size 0.
+    → LimitType tableIx
+    -- ^ The upper limit imposed by the structure to traverse over.
+    → LimitType ix
+    -- ^ The upper limit imposed by the rule that traverses.
+    → ix
+    -- ^ The current index for the full rule.
+    → Stream m (SvState elm Z Z)
+    -- ^ Initial stream state with @Z@ero indices.
+    → Stream m (SvState elm tableIx ix)
+    -- ^ The type of the full stream.
+
+instance AddIndexDense pos elm Z Z Z where
+  addIndexDenseGo _ _ _ _ _ = id
+  {-# Inline addIndexDenseGo #-}
+
+-- | @SvState@ holds the state that is currently being built up by
+-- @AddIndexDense@. We have both @tIx@ (and @tOx@) and @iIx@ (and @iOx@).
+-- For most index structures, the indices will co-incide; however for some,
+-- this will not be true -- herein for @Set@ index structures.
+
+data SvState elm tableIx ix = SvS
+  { sS  ∷ !elm
+  -- ^ state coming in from the left
+  , tx  ∷ !tableIx
+  -- ^ @I/C@ building up state to index the @table@.
+  , iIx ∷ !(RunningIndex ix)
+  -- ^ @I/C@ building up state to hand over to next symbol
+  }
+
+
+-- | Given an incoming stream with indices, this adds indices for the
+-- current syntactic variable / symbol.
+
+addIndexDense
+  ∷ ( Monad m
+    , AddIndexDense pos elm minSize tableIx ix
+    , elm ~ Elm x0 i0
+    , Element x0 i0
+    )
+  ⇒ Proxy pos
+  → minSize
+  → LimitType tableIx
+  → LimitType ix
+  → ix
+  → Stream m elm
+  → Stream m (elm,tableIx,RunningIndex ix)
+addIndexDense pos minSize tableBound upperBound ix
+  = map (\(SvS s z i') -> (s,z,i'))
+  . addIndexDenseGo pos minSize tableBound upperBound ix
+  . map (\s -> (SvS s Z RiZ))
+{-# Inline addIndexDense #-}
+
+-- | In case of 1-dim tables, we wrap the index creation in a multi-dim
+-- system and remove the @Z@ later on. This allows us to have to write only
+-- a single instance.
+
+addIndexDense1
+  ∷ forall m pos x0 a ix minSize tableIx elm
+  . ( Monad m
+    , AddIndexDense (Z:.pos) (Elm (SynVar1 (Elm x0 a)) (Z:.ix)) (Z:.minSize) (Z:.tableIx) (Z:.ix)
+    , GetIndex (Z:.a) (Z:.ix)
+    , elm ~ Elm x0 a
+    , Element x0 a
+    )
+  ⇒ Proxy pos
+  → minSize
+  → LimitType tableIx
+  → LimitType ix
+  → ix
+  → Stream m elm
+  → Stream m (elm,tableIx,RunningIndex ix)
+addIndexDense1 Proxy minSize tableBound upperBound ix
+  = map (\(SvS (ElmSynVar1 s) (Z:.z) (RiZ:.:i')) -> (s,z,i'))
+  . addIndexDenseGo (Proxy ∷ Proxy (Z:.pos)) (Z:.minSize) (ZZ:..tableBound) (ZZ:..upperBound) (Z:.ix)
+  . map (\s -> (SvS (elmSynVar1 s ix) Z RiZ))
+{-# Inline addIndexDense1 #-}
+
+newtype SynVar1 s = SynVar1 s
+
+elmSynVar1 :: s -> i -> Elm (SynVar1 s) (Z:.i)
+elmSynVar1 s _ = ElmSynVar1 s
+{-# Inline elmSynVar1 #-}
+
+instance (s ~ Elm x0 i, Element x0 i) => Element (SynVar1 s) (Z:.i) where
+  newtype Elm (SynVar1 s) (Z:.i) = ElmSynVar1 s
+  getIdx (ElmSynVar1 s) = RiZ :.: getIdx s
+  {-# Inline getIdx #-}
+
+
+-- | Instance headers, we typically need.
+
+type AddIndexDenseContext pos elm x0 i0 minSizes minSize tableIxs tableIx ixs ix =
+  ( AddIndexDense pos elm minSizes tableIxs ixs
+  , GetIndex (RunningIndex i0) (RunningIndex (ixs:.ix))
+  , GetIx (RunningIndex i0) (RunningIndex (ixs:.ix)) ~ (RunningIndex ix)
+  , Element x0 i0
+  , elm ~ Elm x0 i0
+  )
+
diff --git a/ADP/Fusion/Core/SynVar/Recursive/Type.hs b/ADP/Fusion/Core/SynVar/Recursive/Type.hs
new file mode 100644
--- /dev/null
+++ b/ADP/Fusion/Core/SynVar/Recursive/Type.hs
@@ -0,0 +1,131 @@
+
+module ADP.Fusion.Core.SynVar.Recursive.Type where
+
+import Control.Applicative (Applicative,(<$>),(<*>))
+import Control.Monad.Morph
+import Data.Proxy
+import Data.Strict.Tuple
+import Data.Vector.Fusion.Stream.Monadic (Stream,head,map,mapM)
+import Prelude hiding (head,map,mapM)
+
+import Data.PrimitiveArray hiding (map)
+
+import ADP.Fusion.Core.Classes
+import ADP.Fusion.Core.Multi
+import ADP.Fusion.Core.SynVar.Axiom
+import ADP.Fusion.Core.SynVar.Backtrack
+import ADP.Fusion.Core.SynVar.Indices
+import ADP.Fusion.Core.SynVar.TableWrap
+
+
+
+-- | A syntactic variable that does not memoize but simplify recurses. One
+-- needs to be somewhat careful when using this one. @ITbl@ performs
+-- memoization to perform DP in polynomial time (roughly speaking). If the
+-- rules for an @IRec@ are of a particular type, they will exponential
+-- running time. Things like @X -> X X@ are, for example, rather bad. Rules
+-- of the type @X -> Y, Y -> Z@ are ok, if @Y@ is an @IRec@ since we just
+-- continue on. The same holds for @Y -> a Y@. Basically, things are safe
+-- if there is only a (small) constant number of parses of an @IRec@
+-- synvar.
+
+data IRec c i x where
+  IRec ∷ { iRecConstraint ∷ !c
+         , iRecTo         ∷ !(LimitType i)
+         } → IRec c i x
+
+type TwIRec (m ∷ * → *) c i x = TW (IRec c i x) (LimitType i → i → m x)
+
+type TwIRecBt c i x mF mB r = TW (Backtrack (TwIRec mF c i x) mF mB) (LimitType i → i → mB [r])
+
+instance Build (TwIRec   m c i x)
+
+instance Build (TwIRecBt c i x mF mB r)
+
+type instance TermArg (TwIRec m c i x) = x
+
+instance GenBacktrackTable (TwIRec mF c i x) mF mB where
+  data Backtrack (TwIRec mF c i x) mF mB = BtIRec !c !(LimitType i) !(LimitType i → i → mB x)
+  type BacktrackIndex (TwIRec mF c i x) = i
+  toBacktrack (TW (IRec c iT) f) mrph = BtIRec c iT (\lu i -> mrph $ f lu i)
+  {-# Inline toBacktrack #-}
+
+
+
+instance
+  ( Monad m
+  , IndexStream i
+  ) ⇒ Axiom (TwIRec m c i x) where
+  type AxiomStream (TwIRec m c i x) = m x
+  axiom (TW (IRec _ h) fun) = do
+    k ← head $ streamDown zeroBound' h
+    fun h k
+  {-# Inline axiom #-}
+
+instance
+  ( Monad mB
+  , IndexStream i
+  , i ~ j
+  , m ~ mB
+  ) ⇒ Axiom (TW (Backtrack (TwIRec mF c i x) mF mB) (LimitType j → j → m [r])) where
+  type AxiomStream (TW (Backtrack (TwIRec mF c i x) mF mB) (LimitType j → j → m [r])) = mB [r]
+  axiom (TW (BtIRec c h fun) btfun) = do
+    k <- head $ streamDown zeroBound' h
+    btfun h k
+  {-# Inline axiom #-}
+
+
+
+instance Element ls i ⇒ Element (ls :!: TwIRec m c u x) i where
+  data Elm (ls :!: TwIRec m c u x) i = ElmIRec !x !(RunningIndex i) !(Elm ls i)
+  type Arg (ls :!: TwIRec m c u x)   = Arg ls :. x
+  getArg (ElmIRec x _ ls) = getArg ls :. x
+  getIdx (ElmIRec _ i _ ) = i
+  {-# Inline getArg #-}
+  {-# Inline getIdx #-}
+
+instance Element ls i ⇒ Element (ls :!: TwIRecBt c u x mF mB r) i where
+  data Elm (ls :!: (TwIRecBt c u x mF mB r)) i = ElmBtIRec !x [r] !(RunningIndex i) !(Elm ls i)
+  type Arg (ls :!: (TwIRecBt c u x mF mB r))   = Arg ls :. (x, [r])
+  getArg (ElmBtIRec x s _ ls) = getArg ls :. (x,s)
+  getIdx (ElmBtIRec _ _ i _ ) = i
+  {-# Inline getArg #-}
+  {-# Inline getIdx #-}
+
+instance
+  ( Functor m
+  , Monad m
+  , pos ~ (ps:.p)
+  , posLeft ~ LeftPosTy pos (TwIRec m (cs:.c) (us:.u) x) (is:.i)
+  , Element ls (is:.i)
+--  , TableStaticVar ps cs us is
+--  , TableStaticVar p  c  u  i
+  , TableStaticVar (ps:.p) (cs:.c) (us:.u) (is:.i)
+  , AddIndexDense pos (Elm ls (is:.i)) (cs:.c) (us:.u) (is:.i)
+  , MkStream m posLeft ls (is:.i)
+  ) ⇒ MkStream m ('(:.) ps p) (ls :!: TwIRec m (cs:.c) (us:.u) x) (is:.i) where
+  mkStream Proxy (ls :!: TW (IRec csc h) fun) grd usu isi
+    = mapM (\(s,tt,ii) -> (\res -> ElmIRec res ii s) <$> fun h tt)
+    . addIndexDense (Proxy ∷ Proxy pos) csc h usu isi
+    $ mkStream (Proxy ∷ Proxy posLeft) ls grd usu (tableStreamIndex (Proxy ∷ Proxy pos) csc h isi)
+  {-# Inline mkStream #-}
+
+instance
+  ( Applicative mB
+  , Monad mB
+  , pos ~ (ps :. p)
+  , posLeft ~ LeftPosTy pos (TwIRecBt (cs:.c) (us:.u) x mF mB r) (is:.i)
+  , Element ls (is:.i)
+--  , TableStaticVar (us:.u) (cs:.c) (is:.i)
+--  , TableStaticVar ps cs us is
+--  , TableStaticVar p  c  u  i
+  , TableStaticVar (ps:.p) (cs:.c) (us:.u) (is:.i)
+  , AddIndexDense pos (Elm ls (is:.i)) (cs:.c) (us:.u) (is:.i)
+  , MkStream mB posLeft ls (is:.i)
+  ) => MkStream mB  ('(:.) ps p) (ls :!: TwIRecBt (cs:.c) (us:.u) x mF mB r) (is:.i) where
+  mkStream Proxy (ls :!: TW (BtIRec csc h fun) bt) grd usu isi
+    = mapM (\(s,tt,ii) -> (\res bb -> ElmBtIRec res bb ii s) <$> fun h tt <*> bt h tt)
+    . addIndexDense (Proxy ∷ Proxy pos) csc h usu isi
+    $ mkStream (Proxy ∷ Proxy posLeft) ls grd usu (tableStreamIndex (Proxy :: Proxy pos) csc h isi)
+  {-# Inline mkStream #-}
+
diff --git a/ADP/Fusion/Core/SynVar/Split/Type.hs b/ADP/Fusion/Core/SynVar/Split/Type.hs
new file mode 100644
--- /dev/null
+++ b/ADP/Fusion/Core/SynVar/Split/Type.hs
@@ -0,0 +1,200 @@
+
+-- |
+--
+-- NOTE /highly experimental/
+
+module ADP.Fusion.Core.SynVar.Split.Type
+  ( module ADP.Fusion.Core.SynVar.Split.Type
+  , Proxy (..)
+  ) where
+
+import Data.Proxy
+import Data.Strict.Tuple
+import Data.Vector.Fusion.Stream.Monadic
+import Data.Vector.Fusion.Util (delay_inline)
+import Debug.Trace
+import GHC.TypeLits
+import Prelude hiding (map,mapM)
+import Data.Type.Equality
+
+import Data.PrimitiveArray hiding (map)
+
+import ADP.Fusion.Core.Classes
+import ADP.Fusion.Core.Multi
+import ADP.Fusion.Core.SynVar.Array.Type
+import ADP.Fusion.Core.SynVar.Backtrack
+import ADP.Fusion.Core.SynVar.TableWrap
+
+
+
+data SplitType = Fragment | Final
+
+-- | The @Arg synVar@ means that we probably need to rewrite the internal
+-- type resolution now!
+
+type family CalcSplitType splitType varTy where
+  CalcSplitType Fragment varTy = ()
+  CalcSplitType Final    varTy = varTy
+
+-- | Should never fail?
+
+type family ArgTy argTy where
+--  ArgTy Z = Z
+  ArgTy (z:.x) = x
+
+-- | Wraps a normal non-terminal and attaches a type-level unique identier
+-- and z-ordering (with the unused @Z@ at @0@).
+--
+-- TODO attach empty/non-empty stuff (or get from non-splitted synvar?)
+--
+-- TODO re-introduce z-ordering later (once we have a sort fun)
+
+newtype Split (uId :: Symbol) {- (zOrder :: Nat) -} (splitType :: SplitType) synVar = Split { getSplit :: synVar }
+
+-- |
+--
+-- TODO Here, we probably want to default to a @NonEmpty@ condition. Or at
+-- least have different versions of @split@.
+
+split :: Proxy (uId::Symbol) -> {- Proxy (zOrder::Nat) -> -} Proxy (splitType::SplitType) -> synVar -> Split uId splitType synVar
+split _ _ = Split
+{-# Inline split #-}
+
+--splitNE :: (ModifyConstraint synVar) => Proxy (uId::Symbol) -> {- Proxy (zOrder::Nat) -> -} Proxy (splitType::SplitType) -> synVar -> Split uId splitType synVar
+--splitNE _ _ = Split . toNonEmpty
+--{-# Inline splitNE #-}
+
+--type Spl uId zOrder splitType = forall synVar . Split uId zOrder splitType synVar
+
+instance Build (Split uId splitType synVar)
+
+instance
+  ( Element ls i
+  ) => Element (ls :!: Split uId splitType (TwITbl b s m arr c j x)) i where
+  -- | @ElmSplitITbl@ carry one additional element of type @i@. We need
+  -- those to be able to extract the full index via @collectIx@.
+  data Elm     (ls :!: Split uId splitType (TwITbl b s m arr c j x)) i = ElmSplitITbl !(Proxy uId) !(CalcSplitType splitType x) !(RunningIndex i) !(Elm ls i) !i
+  type Arg     (ls :!: Split uId splitType (TwITbl b s m arr c j x))   = Arg ls :. (CalcSplitType splitType x)
+  type RecElm  (ls :!: Split uId splitType (TwITbl b s m arr c j x)) i = Elm ls i
+  getArg (ElmSplitITbl _ x _ ls _) = getArg ls :. x
+  getIdx (ElmSplitITbl _ _ i _  _) = i
+  getElm (ElmSplitITbl _ _ _ ls _) = ls
+  {-# Inline getArg #-}
+  {-# Inline getIdx #-}
+  {-# Inline getElm #-}
+
+instance
+  ( Element ls i
+  ) => Element (ls :!: Split uId splitType (TwITblBt b s arr c j x mF mB r)) i where
+  data Elm     (ls :!: Split uId splitType (TwITblBt b s arr c j x mF mB r)) i = ElmSplitBtITbl !(Proxy uId) !(CalcSplitType splitType (x, [r])) !(RunningIndex i) !(Elm ls i) !i
+  type Arg     (ls :!: Split uId splitType (TwITblBt b s arr c j x mF mB r))   = Arg ls :. (CalcSplitType splitType (x,[r]))
+  type RecElm  (ls :!: Split uId splitType (TwITblBt b s arr c j x mF mB r)) i = Elm ls i
+  getArg (ElmSplitBtITbl _ xs _ ls _) = getArg ls :. xs
+  getIdx (ElmSplitBtITbl _ _  i _  _) = i
+  getElm (ElmSplitBtITbl _ _  _ ls _) = ls
+  {-# Inline getArg #-}
+  {-# Inline getIdx #-}
+  {-# Inline getElm #-}
+
+
+
+-- | 'collectIx' gobbles up indices that are tagged with the same symbolic
+-- identifier.
+
+collectIx
+  :: forall uId ls i .
+     ( SplitIxCol uId (SameSid uId (Elm ls i)) (Elm ls i)
+     )
+  => Proxy uId -> Elm ls i -> SplitIxTy uId (SameSid uId (Elm ls i)) (Elm ls i)
+collectIx p e = splitIxCol p (Proxy :: Proxy (SameSid uId (Elm ls i))) e
+
+-- | Closed type family that gives us a (type) function for type symbol
+-- equality.
+
+type family SameSid uId elm :: Bool where
+  SameSid uId (Elm (ls :!: Split sId splitType synVar) i) = uId == sId
+  SameSid uId (Elm (ls :!: TermSymbol a b            ) i) = SameSid uId (TermSymbol a b)
+  SameSid uId M                                           = False
+  SameSid uId (TermSymbol a (Split sId splitType synVar)) = OR (uId == sId) (SameSid uId a)
+  SameSid uId (Elm (ls :!: l                         ) i) = False
+
+-- | Type-level @(||)@
+
+type family OR a b where
+  OR False False = False
+  OR a     b     = True
+
+-- | @x ++ y@ but for inductive tuples.
+--
+-- TODO move to PrimitiveArray
+
+class Zconcat x y where
+  type Zpp x y :: *
+  zconcat :: x -> y -> Zpp x y
+
+instance Zconcat x Z where
+  type Zpp x Z = x
+  zconcat x Z = x
+  {-# Inline zconcat #-}
+
+instance 
+  ( Zconcat x z
+  ) => Zconcat x (z:.y) where
+  type Zpp x (z:.y) = Zpp x z :. y
+  zconcat x (z:.y) = zconcat x z :. y
+  {-# Inline zconcat #-}
+
+-- WORKS
+
+-- | Actually collect split indices based on if we managed to find the
+-- right @Split@ synvar (based on the right symbol).
+--
+-- TODO this is not completely right, or? Since we should consider
+-- inside/outside?
+--
+-- TODO 'splitIxCol' will need the index type @i@ to combine running index
+-- and index into the actual lookup part.
+
+class SplitIxCol (uId::Symbol) (b::Bool) e where
+  type SplitIxTy uId b e :: *
+  splitIxCol :: Proxy uId -> Proxy b -> e -> SplitIxTy uId b e
+
+
+
+instance SplitIxCol uId b (Elm S i) where
+  type SplitIxTy uId b (Elm S i) = Z
+  splitIxCol p b (ElmS _) = Z
+  {-# Inline splitIxCol #-}
+
+
+instance
+  ( SplitIxCol uId (SameSid uId (Elm ls i)) (Elm ls i)
+  , Element (ls :!: l) i
+  , RecElm (ls :!: l) i ~ Elm ls i
+  ) => SplitIxCol uId False (Elm (ls :!: l) i) where
+  type SplitIxTy uId False (Elm (ls :!: l) i) = SplitIxTy uId (SameSid uId (Elm ls i)) (Elm ls i)
+  splitIxCol p b e = collectIx p (getElm e)
+  {-# Inline splitIxCol #-}
+
+instance
+  ( SplitIxCol uId (SameSid uId (Elm ls i)) (Elm ls i)
+  ) => SplitIxCol   uId True (Elm (ls :!: Split sId splitType (TwITbl b s m arr c j x)) i) where
+  type SplitIxTy uId True (Elm (ls :!: Split sId splitType (TwITbl b s m arr c j x)) i) = SplitIxTy uId (SameSid uId (Elm ls i)) (Elm ls i) :. i
+  splitIxCol p b (ElmSplitITbl _ _ i e ix) = collectIx p e :. ix
+  {-# Inline splitIxCol #-}
+
+instance
+  ( SplitIxCol uId (SameSid uId (Elm ls i)) (Elm ls i)
+  ) => SplitIxCol   uId True (Elm (ls :!: Split sId splitType (TwITblBt b s arr c j x mF mB r)) i) where
+  type SplitIxTy uId True (Elm (ls :!: Split sId splitType (TwITblBt b s arr c j x mF mB r)) i) = SplitIxTy uId (SameSid uId (Elm ls i)) (Elm ls i) :. i
+  splitIxCol p b (ElmSplitBtITbl _ _ i e ix) = collectIx p e :. ix
+  {-# Inline splitIxCol #-}
+
+instance
+  ( SplitIxCol uId (SameSid uId (Elm ls i)) (Elm ls i)
+  , Zconcat (SplitIxTy uId (SameSid uId (Elm ls i)) (Elm ls i)) (SplitIxTy uId (SameSid uId (TermSymbol a b)) (TermSymbol a b))
+  ) => SplitIxCol uId True (Elm (ls :!: TermSymbol a b) i) where
+  type SplitIxTy uId True (Elm (ls :!: TermSymbol a b) i) = Zpp (SplitIxTy uId (SameSid uId (Elm ls i)) (Elm ls i)) (SplitIxTy uId (SameSid uId (TermSymbol a b)) (TermSymbol a b))
+  splitIxCol p b (ElmTS t i e) = collectIx p e `zconcat` ((error "ElmTS / splitIxCol") {- p t -} :: SplitIxTy uId (SameSid uId (TermSymbol a b)) (TermSymbol a b))
+  {-# Inline splitIxCol #-}
+
diff --git a/ADP/Fusion/Core/SynVar/TableWrap.hs b/ADP/Fusion/Core/SynVar/TableWrap.hs
new file mode 100644
--- /dev/null
+++ b/ADP/Fusion/Core/SynVar/TableWrap.hs
@@ -0,0 +1,15 @@
+
+-- | Wrap the underlying table and the rules. Isomorphic to @(,)@.
+
+module ADP.Fusion.Core.SynVar.TableWrap where
+
+
+
+-- | Wrap tables of type @t@. The tables are strict, the functions @f@ can
+-- not be strict, because we need to build grammars recursively.
+
+data TW t f = TW !t f
+
+instance Show t ⇒ Show (TW t f) where
+  show (TW t _) = "TW(" ++ show t ++ ")"
+
diff --git a/ADP/Fusion/Core/TH.hs b/ADP/Fusion/Core/TH.hs
new file mode 100644
--- /dev/null
+++ b/ADP/Fusion/Core/TH.hs
@@ -0,0 +1,77 @@
+
+-- | The functions in here auto-create suitable algebra product functions from
+-- a signature. Currently, functions @<**@ are supported which have scalar
+-- results in the first variable.
+--
+-- TODO If we want to support classified DP, we shall also need @**<@
+-- generating vector-results given a vector result, followed by a scalar
+-- result.
+--
+-- TODO Then we also need @***@ handling the case of vector-to-vector results.
+--
+-- TODO note the comments in @buildBacktrackingChoice@
+
+module ADP.Fusion.Core.TH
+  ( makeAlgebraProduct
+  , (<||)
+  , (**>)
+  ) where
+
+import           Data.List
+import           Data.Tuple.Select
+import           Language.Haskell.TH
+import           Language.Haskell.TH.Syntax
+import qualified Data.Vector.Fusion.Stream.Monadic as SM
+
+import           ADP.Fusion.Core.TH.Backtrack -- (makeBacktrackingProductInstance,(<||))
+import           ADP.Fusion.Core.TH.Common (getRuleResultType)
+
+
+
+makeAlgebraProduct = makeProductInstances
+
+{-
+-- | Create the algebra product function from a signature type constructor.
+--
+-- TODO make the resulting function INLINE
+--
+-- TODO compare @synTypes@ with the stream argument types of all @hs@ (via their
+-- @hns@ names). If there is a mismatch, then either not all non-terminal types
+-- have a corresponding choice function or vice versa.
+
+makeAlgebraProductH :: [Name] -> Name -> Q [Dec]
+makeAlgebraProductH hns nm = do
+  rnm <- reify nm
+  case rnm of
+    TyConI (DataD ctx tyConName args cs d) -> case cs of
+      -- we analyze the accessor functions and look for the objective function
+      -- accessor. It's stream parameter is the type of the non-terminal.
+      -- Everything else in accessors are terminal parameters.
+      [RecC dataConName fs'] -> do
+        -- split @fs@ into functions applied to rule RHSs and choice functions (@hs@)
+        let (fs,hs) = partition ((`notElem` hns) . sel1) fs'
+        -- the result types of the @fs@ are the types of the non-terminal symbols
+        let synTypes = nub . map getRuleResultType $ fs
+--        funStream <- funD (mkName "<**") [genClauseStream dataConName fs' fs hs]
+        funList   <- funD (mkName "<||") [genClauseBacktrack dataConName fs' fs hs]
+        return
+--          [ funStream
+          [ funList
+          , PragmaD $ InlineP (mkName "<||") Inline FunLike AllPhases
+          ]
+      _   -> fail "more than one data ctor"
+    _          -> fail "unsupported data type"
+
+-- | Creates a class for each type of product and instances for each
+-- signature.
+
+makeClassyProducts :: Name -> Q [Dec]
+makeClassyProducts conName = do
+  c <- lookupValueName "BacktrackingProduct"
+  case c of
+    Nothing -> error "need to create class now and add instance"
+    Just cl -> error "add instance"
+  return []
+-}
+
+
diff --git a/ADP/Fusion/Core/TH/Backtrack.hs b/ADP/Fusion/Core/TH/Backtrack.hs
new file mode 100644
--- /dev/null
+++ b/ADP/Fusion/Core/TH/Backtrack.hs
@@ -0,0 +1,498 @@
+
+-- | Backtracking which uses lists internally. The basic idea is to convert
+-- each @Stream@ into a list. The consumer consumes the stream lazily, but
+-- allows for fusion to happen. The hope is that this improves total
+-- performance in those cases, where backtracking has significant costs.
+
+module ADP.Fusion.Core.TH.Backtrack where
+
+import           Control.Applicative ( (<$>) )
+import           Control.Monad
+import           Control.Monad.Primitive (PrimState, PrimMonad)
+import           Data.List
+import           Data.Tuple.Select
+import           Data.Vector.Fusion.Stream.Monadic (Stream(..))
+import           Debug.Trace
+import           Language.Haskell.TH
+import           Language.Haskell.TH.Instances
+import           Language.Haskell.TH.Syntax
+import qualified Data.Map.Strict as M
+import qualified Data.Vector as V
+import qualified Data.Vector.Fusion.Stream.Monadic as SM
+import qualified Data.Vector.Generic as VG
+import qualified Data.Vector.Generic.Mutable as VGM
+import qualified Data.Vector.Mutable as VM
+import qualified Data.Set as S
+
+import           Data.PrimitiveArray.Index.Class ( (:.)(..) , Z(..) )
+
+import           ADP.Fusion.Core.TH.Common
+
+import Control.Monad.Reader
+
+
+
+-- | @Backtracking@ products of @f@ and @b@. Choice in @f@ needs to be
+-- reduced to a scalar value. It is then compared to the @fst@ values
+-- in @b@. From those, @choice b@ selects.
+
+class ProductBacktracking sigF sigB where
+  type SigBacktracking sigF sigB :: *
+  (<||) :: sigF -> sigB -> SigBacktracking sigF sigB
+
+-- | The ADP-established product operation. Returns a vector of results,
+-- along the lines of what the ADP @f *** b@ provides.
+--
+-- @f **> g@ assumes a vector-to-vector function @f@, and
+-- a vector-to-scalar function @g@.
+
+class ProductCombining sigF sigB where
+  type SigCombining sigF sigB :: *
+  (**>) :: sigF -> sigB -> SigCombining sigF sigB
+
+-- | Creates instances for all products given a signature data type.
+
+makeProductInstances :: Name -> Q [Dec]
+makeProductInstances tyconName = do
+  t <- reify tyconName
+  case t of
+#if MIN_VERSION_template_haskell(2,11,0)
+    TyConI (DataD ctx tyConName args maybeKind cs d) -> do
+#else
+    TyConI (DataD ctx tyConName args cs d) -> do
+#endif
+      let m = getMonadName args
+      case cs of
+        [RecC dataconName funs] -> do
+          let Just (h,m',x,r) = getObjectiveNames funs
+          mL <- newName "mL"
+          xL <- newName "xL"
+          rL <- newName "rL"
+          mR <- newName "mR"
+          xR <- newName "xR"
+          rR <- newName "rR"
+          let lType    = buildRightType tyconName (m', x, r) (mL, xL, rL)    args
+          let rType    = buildRightType tyconName (m', x, r) (mR, xR, rR)    args
+          let (fs,hs) = partition ((`notElem` [h]) . sel1) funs
+          sigBType <- buildSigBacktrackingType  tyconName (m', x, r) xL (mR, xR, rR) args
+          Clause psB (NormalB bB) dsB <- genAlgProdFunctions buildBacktrackingChoice dataconName funs fs hs
+          iB <- [d| instance (Monad $(varT mL), Monad $(varT mR), Eq $(varT xL), $(varT mL) ~ $(varT mR), $(varT xL) ~ $(varT rL))
+                      => ProductBacktracking $(return lType) $(return rType) where
+                          type SigBacktracking $(return lType) $(return rType) = $(return sigBType)
+                          (<||) = $(return $ LamE psB $ LetE dsB bB)
+                          {-# Inline (<||) #-}
+                |]
+          -- TODO might well be that this doesn't work because we re-use
+          -- type names ...
+          vG <- newName "vG"
+          sigPType <- buildSigCombiningType tyconName vG (m', x, r) (mL, xL, rL) (mR, xR, rR) args
+          Clause psC (NormalB bC) dsC <- genAlgProdFunctions buildCombiningChoice    dataconName funs fs hs
+          iC <- [d| instance (Monad $(varT mL), Monad $(varT mR), Eq $(varT xL), Ord $(varT xL), Ord $(varT xR), $(varT mL) ~ $(varT mR) ) -- , VG.Vector $(varT vG) ($(varT rL),$(varT rR)) )
+                      => ProductCombining $(return lType) $(return rType) where
+                          type SigCombining $(return lType) $(return rType) = $(return sigPType)
+                          (**>) = $(return $ LamE psC $ LetE dsC bC)
+                          {-# Inline (**>) #-}
+                |]
+          return $ iB ++ iC
+
+-- | Returns the 'Name' of the monad variable.
+
+getMonadName :: [TyVarBndr] -> Maybe Name
+getMonadName = go
+  where go [] = Nothing
+        go (KindedTV m (AppT (AppT ArrowT StarT) StarT) : _) = Just m
+        go (_ : xs) = go xs
+
+-- | Returns the 'Name's of the objective function variables, as well as
+-- the name of the objective function itself.
+
+getObjectiveNames :: [VarStrictType] -> Maybe (Name,Name,Name,Name)
+getObjectiveNames = go
+  where go [] = Nothing
+        go ( (hName , _ , (AppT (AppT ArrowT (AppT (AppT (ConT streamName) (VarT mS)) (VarT x))) (AppT (VarT mR) (VarT r)))) : xs)
+          | streamName == ''Stream && mS == mR = Just (hName,mS,x,r)
+          | otherwise             = go xs
+        go ( _ : xs) = go xs
+
+
+
+-- * Constructions for the different algebra types.
+
+-- | The left algebra type. Assumes that in @choice :: Stream m x -> m r@
+-- we have that @x ~ r@.
+
+buildLeftType :: Name -> (Name, Name, Name) -> (Name, Name) -> [TyVarBndr] -> Type
+buildLeftType tycon (m, x, r) (mL, xL) = foldl AppT (ConT tycon) . map (VarT . go)
+  where go (PlainTV z)
+          | z == m        = mL  -- correct monad name
+          | z == x        = xL  -- point to new x type
+          | z == r        = xL  -- stream and return type are the same
+          | otherwise     = z   -- everything else can stay as is
+        go (KindedTV z _) = go (PlainTV z)
+
+-- | Here, we do not set any restrictions on the types @m@ and @r@.
+
+buildRightType :: Name -> (Name, Name, Name) -> (Name, Name, Name) -> [TyVarBndr] -> Type
+buildRightType tycon (m, x, r) (mR, xR, rR) = foldl AppT (ConT tycon) . map (VarT . go)
+  where go (PlainTV z)
+          | z == m    = mR  -- have discovered a monadic type
+          | z == x    = xR  -- have discovered a type that is equal to the stream type (and hence we have a synvar type)
+          | z == r    = rR  -- have discovered a type that is equal to the result type (for @<||@) equal to the stream type, hence synvar
+          | otherwise = z   -- this is a terminal or a terminal stack (we don't care)
+        go (KindedTV z _) = go (PlainTV z)
+
+-- | Build up the type for backtracking. We want laziness in the right
+-- return type. Hence, we have @AppT ListT (VarT xR)@ ; i.e. we want to
+-- return results in a list.
+
+buildSigBacktrackingType :: Name -> (Name, Name, Name) -> (Name) -> (Name, Name, Name) -> [TyVarBndr] -> TypeQ
+buildSigBacktrackingType tycon (m, x, r) (xL) (mR, xR, rR) = foldl appT (conT tycon) . map go
+  where go (PlainTV z)
+          | z == m    = varT mR
+          | z == x    = [t| ($(varT xL) , [ $(varT xR) ] ) |]
+          | z == r    = varT rR
+          | otherwise = varT z
+        go (KindedTV z _) = go (PlainTV z)
+
+-- |
+--
+-- [1] we want a list for @[xR]@ because this will make it lazy here. At
+-- least that was the reason for backtracking. For forward mode, we may not
+-- want this. We will have to change the function combination then?
+
+buildSigCombiningType :: Name -> Name -> (Name, Name, Name) -> (Name, Name, Name) -> (Name, Name, Name) -> [TyVarBndr] -> TypeQ
+buildSigCombiningType tycon vG (m, x, r) (mL, xL, rL) (mR, xR, rR) = foldl appT (conT tycon) . map go
+  where go (PlainTV z)
+          | z == m    = varT mR
+          | z == x    = [t| ($(varT xL) , [ $(varT xR) ] ) |]   -- [1]
+          | z == r    = [t| V.Vector ($(varT rL) , $(varT rR)) |]
+          | otherwise = varT z
+        go (KindedTV z _) = go (PlainTV z)
+
+
+
+-- *
+
+-- | Build up attribute and choice function. Here, we actually bind the
+-- left and right algebra to @l@ and @r@.
+
+genAlgProdFunctions
+  :: Choice
+  -> Name
+  -> [VarStrictType]
+  -> [VarStrictType]
+  -> [VarStrictType]
+  -> Q Clause
+genAlgProdFunctions choice conName allFunNames evalFunNames choiceFunNames = do
+  let nonTermNames = nub . map getRuleResultType $ evalFunNames
+  -- bind the l'eft and r'ight variable of the two algebras we want to join,
+  -- also create unique names for the function names we shall bind later.
+  nameL <- newName "l"
+  varL  <- varP nameL
+  fnmsL <- sequence $ replicate (length allFunNames) (newName "fnamL")
+  nameR <- newName "r"
+  varR  <- varP nameR
+  fnmsR <- sequence $ replicate (length allFunNames) (newName "fnamR")
+  -- bind the individual variables in the where part
+  whereL <- valD (conP conName (map varP fnmsL)) (normalB $ varE nameL) []
+  whereR <- valD (conP conName (map varP fnmsR)) (normalB $ varE nameR) []
+  rce <- recConE conName
+          $  zipWith3 (genChoiceFunction choice) (drop (length evalFunNames) fnmsL) (drop (length evalFunNames) fnmsR) choiceFunNames
+          ++ zipWith3 (genAttributeFunction nonTermNames) fnmsL fnmsR evalFunNames
+  -- build the function pairs
+  -- to keep our sanity, lets print this stuff
+  let cls = Clause [varL, varR] (NormalB rce) [whereL,whereR]
+  return cls
+
+-- | Simple wrapper for creating the choice fun expression.
+
+genChoiceFunction
+  :: Choice
+  -> Name
+  -> Name
+  -> VarStrictType
+  -> Q (Name,Exp)
+genChoiceFunction choice hL hR (name,_,t) = do
+  exp <- choice hL hR
+  return (name,exp)
+
+
+-- | We take the left and right function name for one attribute and build
+-- up the combined attribute function. Mostly a wrapper around
+-- 'recBuildLampat' which does the main work.
+--
+-- TODO need fun names from @l@ and @r@
+
+genAttributeFunction
+  :: [Name]
+  -> Name
+  -> Name
+  -> VarStrictType
+  -> Q (Name,Exp)
+genAttributeFunction nts fL fR (name,_,t) = do
+  (lamPat,funL,funR) <-recBuildLamPat nts fL fR (init $ getRuleSynVarNames nts t) -- @init@ since we don't want the result as a parameter
+  let exp = LamE lamPat $ TupE [funL,funR]
+  return (name,exp)
+
+-- | Now things become trickly. We are given all non-terminal names (to
+-- differentiate between a terminal (stack) and a syntactic variable; the
+-- left and right function; and the arguments to this attribute function
+-- (except the result parameter). We are given the latter as a result to an
+-- earlier call to 'getRuleSynVarNames'.
+--
+-- We now look at each argument and determine wether it is a syntactic
+-- variable. If so, then we actually have a tuple arguments @(x,ys)@ where
+-- @x@ has to optimized value and @ys@ the backtracking list. The left
+-- function receives just @x@ in this case. For the right function, things
+-- are more complicated, since we have to flatten lists. See 'buildRns'.
+--
+-- Terminals are always given "as is" since we do not have a need for
+-- tupled-up information as we have for syntactic variables.
+
+recBuildLamPat
+  :: [Name]   -- ^ all non-terminal names
+  -> Name     -- ^ left attribute function
+  -> Name     -- ^ right attribute function
+  -> [ArgTy Name]  -- ^ all arguments to the attribute function
+  -> Q ([Pat], Exp, Exp)
+recBuildLamPat nts fL' fR' ts = do
+  -- here we just run through all arguments, either creating an @x@ and
+  -- a @ys@ for a non-term or a @t@ for a term.
+  ps <- mapM argTyArgs ts
+  lamPat <- buildLamPat ps
+  lfun <- buildLns (VarE fL') ps -- foldl buildLfun (varE fL') ps
+  rfun <- buildRns (VarE fR') ps
+  return (lamPat, lfun, rfun)
+
+buildLamPat :: [ArgTy Pat] -> Q [Pat]
+buildLamPat = mapM go where
+  go (SynVar      p ) = return p
+  go (Term        p ) = return p
+  go (StackedVars ps) = build ps
+  build :: [ArgTy Pat] -> Q Pat
+  build = foldl (\s v -> [p| $(s) :. $(return v) |]) [p|Z|] . map get
+  get :: ArgTy Pat -> Pat
+  get (SynVar p) = p
+  get (Term   p) = p
+
+-- | Look at the argument type and build the capturing variables. In
+-- particular captures synvar arguments with a 2-tuple @(x,ys)@.
+
+argTyArgs :: ArgTy Name -> Q (ArgTy Pat)
+argTyArgs (SynVar n) = SynVar <$> tupP [newName "x" >>= varP , newName "ys" >>= varP]
+argTyArgs (Term n)          = Term <$> (newName "t" >>= varP)
+argTyArgs (StackedTerms _)  = Term <$> (newName "t" >>= varP) -- !!!
+argTyArgs (StackedVars vs)  = StackedVars <$> mapM argTyArgs vs
+argTyArgs NilVar            = Term <$> (newName "t" >>= varP)
+argTyArgs (Result _)        = error "argTyArgs: should not receive @Result@"
+
+buildLns
+  :: Exp
+  -> [ArgTy Pat]
+  -> ExpQ
+buildLns f' ps = foldl go (return f') ps
+  where go :: ExpQ -> ArgTy Pat -> ExpQ
+        go f (SynVar      (TupP [VarP v,_])) = appE f (varE v)
+        go f (Term        (VarP v         )) = appE f (varE v)
+        go f (StackedVars vs               ) = appE f (build vs)
+        build :: [ArgTy Pat] -> ExpQ
+        build = foldl (\s v -> [| $(s) :. $(varE v) |]) [|Z|] . map get
+        get (SynVar (TupP [VarP v,_])) = v
+        get (Term   (VarP t)         ) = t
+
+-- | Build the right-hand side of a function combined in @f <|| g@. This
+-- splits the paired synvars @(x,xs)@ such that we calculate @f x@ and @g
+-- xs@.
+--
+-- NOTE If we want to write
+--
+-- @
+-- [ f x | x <- xs ]
+-- @
+--
+-- then in template haskell, this looks like this:
+--
+-- @
+-- CompE [BindS (VarP x) (VarE xs), NoBindS (AppE (VarE f) (VarE x))]
+-- @
+--
+-- The @NoBindS@ is the final binding of @f@ to the individual @x@'s, while
+-- the prior @x <- xs@ comes from @BindS (VarP x) (VarE xs)@.
+--
+-- TODO This is where we might be able to improve performance if we can
+-- optimize @[f x y | x <- xs, y <- ys]@ for @concatMap@ in @vector@.
+
+buildRns
+  :: Exp
+--  -> [Name]
+  -> [ArgTy Pat]
+  -> ExpQ
+buildRns f' ps = do
+  -- get all synvars, shallow or deep and create a new name to bind
+  -- individual parts to.
+  sy :: M.Map Pat Name <- M.fromList <$> (mapM (\s -> newName "y" >>= \y -> return (s,y)) $ concatMap flattenSynVars ps)
+  -- bind them for the right part of the list expression (even though they
+  -- are left in @CompE@. We don't use @sy@ directly to keep the order in
+  -- which the comprehensions run.
+  let rs = map (\k@(TupP [_,VarP v]) -> BindS (VarP $ sy M.! k) (VarE v)) $ concatMap flattenSynVars ps
+  let go :: ExpQ -> ArgTy Pat -> ExpQ
+      go f (SynVar      k       ) = appE f (varE $ sy M.! k) -- needed like this, because we need the @y@ in @y <- ys@
+      go f (Term        (VarP v)) = appE f (varE v)
+      go f (StackedVars vs      ) = appE f (foldl build [|Z|] vs)
+      build :: ExpQ -> ArgTy Pat -> ExpQ
+      build s (SynVar k       ) = [| $(s) :. $(varE $ sy M.! k) |]
+      build s (Term   (VarP v)) = [| $(s) :. $(varE v)          |]
+  funApp <- foldl go (return f') ps
+  return . CompE $ rs ++ [NoBindS funApp]
+
+
+-- | Type for backtracking functions.
+--
+-- Not too interesting, mostly to keep track of @choice@.
+
+type Choice = Name -> Name -> Q Exp
+
+-- | Build up the backtracking choice function. This choice function will
+-- backtrack based on the first result, then return only the second.
+--
+-- TODO it should be (only?) this function we will need to modify to build
+-- all algebra products.
+--
+-- @ysM@ can't be unboxed, as @snd@ of each element is a list, lazily
+-- consumed. We build up @ysM@ as this makes fusion happen. Of course, this
+-- is a boxed vector and not as efficient, but we gain the ability to have
+-- lazily created backtracking from this!
+--
+-- This means strict optimization AND lazy backtracking
+--
+-- TODO in principle, we do more work than necessary. The line
+-- @hFres <- ...@ evaluates the optimal choice from the @fst@ elements
+-- again. As long as the cost is small compared to the evaluation of @snd@
+-- (or the list-comprehension based creation of all parses), this won't
+-- matter much.
+
+buildBacktrackingChoice :: Choice
+buildBacktrackingChoice hL' hR' =
+  [| \xs -> do
+      -- turn the stream into a list
+      ysM <- SM.toList xs
+      -- based only on the @fst@ elements, select optimal value
+      hFres <- $(varE hL') $ SM.map fst $ SM.fromList ysM
+      -- filter accordingly
+      $(varE hR') $ SM.fromList $ concatMap snd $ filter ((hFres==) . fst) $ ysM
+  |]
+
+-- | We assume parses of type @(x,y)@ in a vector @<(x,y)>@. the function
+-- acting on @x@ will produce a subset @<x>@ (in vector form). the function
+-- acting on @y@ produces scalars @y@. We have @actFst :: <x> -> <x>@ and
+-- @actSnd :: <y> -> y@. This in total should yield @<(x,y)> -> <(x,y)>@.
+--
+-- TODO This should create @generic@ vectors, that are specialized by the
+-- table they are stored into.
+
+buildCombiningChoice :: Choice
+buildCombiningChoice hL' hR' =
+  [| \xs -> do
+      -- -- lets begin with the list of parses
+      -- ys <- SM.toList xs
+      -- -- but now, we actually get a list of co-optimals to keep. Yes,
+      -- -- a @[fst]@ list.
+      -- cooptFsts <- S.fromList <$> ( ( $(varE hL') $ SM.map fst $ SM.fromList ys ) >>= SM.toList )
+      -- -- now we create a map with all the coopts, where we collect in the
+      -- -- value parts the list of parses for each co-optimal @snd@ for
+      -- -- a @fst@.
+      -- let cooptMap = M.fromListWith (++) [ y | y <- ys, y `S.member` cooptFsts ]
+      -- -- We now need to map @actSnd@ over the resulting intermediates
+      -- actSnd <- mapM (\y -> $(varE hR') (SM.fromList y)) cooptMap
+      -- -- a vector with co-optimals, each one associated with its optimal
+      -- -- @snd@.
+      -- return . VG.fromList . M.toList $ actSnd
+      return undefined
+  |]
+
+-- | Turn a stream into a vector.
+--
+-- TODO need to be improved in terms of performance.
+
+streamToVectorM :: (Monad m, VG.Vector v a) => SM.Stream m a -> m (v a)
+streamToVectorM s = SM.toList s >>= return . VG.fromList
+{-# Inline streamToVectorM #-}
+
+-- | Gets the names used in the evaluation function. This returns one
+-- 'Name' for each variable.
+--
+-- In case of @TupleT 0@ the type is @()@ and there isn't a name to go with
+-- it. We just @mkName "()"@ a name, but this might be slightly dangerous?
+-- (Not really sure if it indeed is)
+--
+-- With @AppT _ _@ we have a multidim terminal and produce another hackish
+-- name to be consumed above.
+--
+-- @
+-- AppT (AppT ArrowT (AppT (AppT (ConT Data.Array.Repa.Index.:.) (AppT (AppT (ConT Data.Array.Repa.Index.:.) (ConT Data.Array.Repa.Index.Z)) (VarT c_1627675270))) (VarT c_1627675270))) (VarT x_1627675265)
+-- @
+
+getRuleSynVarNames :: [Name]-> Type -> [ArgTy Name] -- [Name]
+getRuleSynVarNames nts t' = go t' where
+  go t
+    | VarT x <- t                          = [Result x]
+    | AppT (AppT ArrowT (VarT x)  ) y <- t = (if x `elem` nts then SynVar x else Term x) : go y
+    | AppT (AppT ArrowT (TupleT 0)) y <- t = NilVar : go y
+    | AppT (AppT ArrowT s         ) y <- t = stacked s : go y
+    | otherwise                            = error $ "getRuleSynVarNames error: " ++ show t ++ "    in:    " ++ show t'
+  stacked s = if null [ () | SynVar _ <- xs ] then StackedTerms xs else StackedVars xs
+    where xs = reverse $ stckd s
+          stckd (ConT z) | z == ''Z = []
+          stckd (AppT a (TupleT 0)) = NilVar : stckd a
+          stckd (AppT a (VarT x)  ) = (if x `elem` nts then SynVar x else Term x) : stckd a
+          stckd (AppT (ConT c) a  ) | c == ''(:.) = stckd a
+          stckd err = error $ "stckd" ++ show err
+
+{-
+(AppT (AppT (ConT Data.PrimitiveArray.Index.Class.:.)
+            (AppT (AppT (ConT Data.PrimitiveArray.Index.Class.:.)
+                        (ConT Data.PrimitiveArray.Index.Class.Z)
+                  )
+                  (VarT x_1627774371)
+            )
+      )
+      (TupleT 0)
+)
+-}
+
+
+data ArgTy x
+  -- | This @SynVar@ spans the full column of tapes; i.e. it is a normal
+  -- syntactic variable.
+  = SynVar { synVarName :: x }
+  -- | We have just a single-tape grammar and as such just
+  -- a single-dimensional terminal. We call this term, because
+  -- @StackedTerms@ will be rewritten to just @Term@!
+  | Term { termName :: x }
+  -- | We have a multi-tape grammar with a stack of just terminals. We
+  -- normally can ignore the contents in the functions above, but keep them
+  -- anyway.
+  | StackedTerms { stackedTerms :: [ArgTy x] }
+  -- | We have a multi-tape grammar, but the stack contains a mixture of
+  -- @ArgTy@s.
+  | StackedVars { stackedVars :: [ArgTy x] }
+  -- | A single-dim @()@ case
+  | NilVar
+  -- | The result type name
+  | Result { result :: x }
+  deriving (Show,Eq)
+
+unpackArgTy :: Show x => ArgTy x -> x
+unpackArgTy = go
+  where go (SynVar x) = x
+        go (Term   x) = x
+        go (Result x) = x
+        go err        = error $ "unpackArgTy " ++ show err
+
+-- | Get all synvars, even if deep in a stack
+
+flattenSynVars :: ArgTy x -> [x]
+flattenSynVars (SynVar x)       = [x]
+flattenSynVars (StackedVars xs) = concatMap flattenSynVars xs
+flattenSynVars _                = []
+
diff --git a/ADP/Fusion/Core/TH/Common.hs b/ADP/Fusion/Core/TH/Common.hs
new file mode 100644
--- /dev/null
+++ b/ADP/Fusion/Core/TH/Common.hs
@@ -0,0 +1,19 @@
+
+module ADP.Fusion.Core.TH.Common where
+
+import           Data.Tuple.Select
+import           Language.Haskell.TH
+import           Language.Haskell.TH.Syntax
+
+
+
+-- | The last @Name@ of a rule is the name of the syntactic type of the
+-- result.
+
+getRuleResultType :: VarStrictType -> Name
+getRuleResultType vst = go $ sel3 vst where
+  go t
+    | AppT _ (VarT x) <- t = x
+    | AppT _ x        <- t = go x
+    | otherwise            = error $ "undetermined error:" ++ show vst
+
diff --git a/ADP/Fusion/Core/Term/Chr.hs b/ADP/Fusion/Core/Term/Chr.hs
new file mode 100644
--- /dev/null
+++ b/ADP/Fusion/Core/Term/Chr.hs
@@ -0,0 +1,62 @@
+
+-- |
+--
+-- TODO Rename @Chr@ to @Vtx@, a vertex parser is a generalization of
+-- a char parser. But this is only semantics, so not super important to do
+-- now.
+
+module ADP.Fusion.Core.Term.Chr where
+
+import           Data.Strict.Tuple
+import qualified Data.Vector.Generic as VG
+
+import           Data.PrimitiveArray
+
+import           ADP.Fusion.Core.Classes
+import           ADP.Fusion.Core.Multi
+
+
+
+-- | A generic Character parser that reads a single character but allows
+-- passing additional information.
+--
+--  'Chr' expects a function to retrieve @r@ at index position, followed by
+--  the actual generic vector with data.
+
+data Chr r x where
+  Chr :: VG.Vector v x
+      => (v x -> Int -> r)
+      -> !(v x)
+      -> Chr r x
+
+-- | smart constructor for regular 1-character parsers
+
+chr :: VG.Vector v x => v x -> Chr x x
+chr = Chr VG.unsafeIndex
+{-# Inline chr #-}
+
+-- | Smart constructor for Maybe Peeking, followed by a character.
+
+chrLeft xs = Chr f xs where
+  f xs k = ( xs VG.!? (k-1)
+           , VG.unsafeIndex xs k
+           )
+  {-# Inline [0] f #-}
+{-# Inline chrLeft #-}
+
+instance Build (Chr r x)
+
+instance
+  ( Element ls i
+  ) => Element (ls :!: Chr r x) i where
+    data Elm (ls :!: Chr r x) i = ElmChr !r !(RunningIndex i) !(Elm ls i)
+    type Arg (ls :!: Chr r x)   = Arg ls :. r
+    getArg (ElmChr x _ ls) = getArg ls :. x
+    getIdx (ElmChr _ i _ ) = i
+    {-# Inline getArg #-}
+    {-# Inline getIdx #-}
+
+deriving instance (Show i, Show (RunningIndex i), Show r, Show (Elm ls i)) => Show (Elm (ls :!: Chr r x) i)
+
+type instance TermArg (Chr r x) = r
+
diff --git a/ADP/Fusion/Core/Term/Deletion.hs b/ADP/Fusion/Core/Term/Deletion.hs
new file mode 100644
--- /dev/null
+++ b/ADP/Fusion/Core/Term/Deletion.hs
@@ -0,0 +1,26 @@
+
+module ADP.Fusion.Core.Term.Deletion where
+
+import Data.Strict.Tuple
+
+import Data.PrimitiveArray
+
+import ADP.Fusion.Core.Classes
+import ADP.Fusion.Core.Multi
+
+
+
+data Deletion = Deletion
+
+instance Build Deletion
+
+instance (Element ls i) => Element (ls :!: Deletion) i where
+  data Elm (ls :!: Deletion) i = ElmDeletion !(RunningIndex i) !(Elm ls i)
+  type Arg (ls :!: Deletion)   = Arg ls :. ()
+  getArg (ElmDeletion _ l) = getArg l :. ()
+  getIdx (ElmDeletion i _) = i
+  {-# Inline getArg #-}
+  {-# Inline getIdx #-}
+
+type instance TermArg Deletion = ()
+
diff --git a/ADP/Fusion/Core/Term/Edge.hs b/ADP/Fusion/Core/Term/Edge.hs
new file mode 100644
--- /dev/null
+++ b/ADP/Fusion/Core/Term/Edge.hs
@@ -0,0 +1,73 @@
+
+module ADP.Fusion.Core.Term.Edge where
+
+import Data.Strict.Tuple
+import Data.Proxy
+
+import Data.PrimitiveArray
+
+import ADP.Fusion.Core.Classes
+import ADP.Fusion.Core.Multi
+
+
+
+newtype From = From { getFrom :: Int }
+  deriving (Eq,Ord,Show)
+
+newtype To = To { getTo :: Int }
+  deriving (Eq,Ord,Show)
+
+-- | An edge in a graph. As a parsing symbol, it will provide (From:.To)
+-- pairs.
+
+data Edge = Edge
+
+instance Build Edge
+
+instance
+  ( Element ls i
+  ) => Element (ls :!: Edge) i where
+    data Elm (ls :!: Edge) i = ElmEdge !(From:.To) !(RunningIndex i) !(Elm ls i)
+    type Arg (ls :!: Edge)   = Arg ls :. (From:.To)
+    getArg (ElmEdge e _ ls) = getArg ls :. e
+    getIdx (ElmEdge _ i _ ) = i
+    {-# Inline getArg #-}
+    {-# Inline getIdx #-}
+
+deriving instance (Show i, Show (RunningIndex i), Show (Elm ls i)) => Show (Elm (ls :!: Edge) i)
+
+type instance TermArg Edge = (From:.To)
+
+-- | 'edgeFromTo' creates a @(From:.To)@ structure for edges. How this is
+-- filled depends on the @Proxy@. Possible are @Proxy First@ and @Proxy Last@.
+-- @First@ denotes that @To@ is the first node to be visited. I.e. @First(From)
+-- → Set(To)@. @Last@ on the other hand is @Set(From) → Last(To)@.
+
+class EdgeFromTo k where
+  edgeFromTo ∷ Proxy k → SetBoundary → NewBoundary → (From:.To)
+
+newtype SetBoundary = SetBoundary Int
+
+newtype NewBoundary = NewBoundary Int
+
+-- | In case our sets have a @First@ boundary, then we always point from
+-- the boundary "into" the set. Hence @SetNode == To@ and @NewNode ==
+-- From@.
+--
+-- @{1,2,(3)} <- (4)@ yields @From 4 :. To 3@. Note the arrow direction @INTO@
+-- the set.
+
+instance EdgeFromTo First where
+  edgeFromTo Proxy (SetBoundary to) (NewBoundary from) = From from :. To to
+  {-# Inline edgeFromTo #-}
+
+-- | And if the set has a @Last@ boundary, then we point from somewhere in
+-- the set @To@ the @NewNode@, which is @Last@.
+--
+-- @{1,2,(3)} -> (4)@ yields @From 3 :. To 4@. Note the arrow direction @OUT
+-- OF@ the set.
+
+instance EdgeFromTo Last where
+  edgeFromTo Proxy (SetBoundary from) (NewBoundary to) = From from :. To to
+  {-# Inline edgeFromTo #-}
+
diff --git a/ADP/Fusion/Core/Term/Epsilon.hs b/ADP/Fusion/Core/Term/Epsilon.hs
new file mode 100644
--- /dev/null
+++ b/ADP/Fusion/Core/Term/Epsilon.hs
@@ -0,0 +1,35 @@
+
+-- | 'Epsilon' is a global or local starting (or ending, depending on the view)
+-- point for a grammar.
+
+module ADP.Fusion.Core.Term.Epsilon where
+
+import Data.Data
+import Data.Strict.Tuple
+import Data.Typeable
+import GHC.Generics(Generic)
+
+import Data.PrimitiveArray
+
+import ADP.Fusion.Core.Classes
+import ADP.Fusion.Core.Multi
+
+
+
+data LocalGlobal = Local | Global
+  deriving (Eq,Ord,Read,Show,Data,Typeable,Generic)
+
+data Epsilon (lg ∷ LocalGlobal) = Epsilon
+
+instance Build (Epsilon lg)
+
+instance (Element ls i) => Element (ls :!: Epsilon lg) i where
+  data Elm (ls :!: Epsilon lg) i = ElmEpsilon !(RunningIndex i) !(Elm ls i)
+  type Arg (ls :!: Epsilon lg)   = Arg ls :. ()
+  getArg (ElmEpsilon _ l) = getArg l :. ()
+  getIdx (ElmEpsilon i _) = i
+  {-# Inline getArg #-}
+  {-# Inline getIdx #-}
+
+type instance TermArg (Epsilon lg) = ()
+
diff --git a/ADP/Fusion/Core/Term/MultiChr.hs b/ADP/Fusion/Core/Term/MultiChr.hs
new file mode 100644
--- /dev/null
+++ b/ADP/Fusion/Core/Term/MultiChr.hs
@@ -0,0 +1,49 @@
+
+-- |
+--
+-- TODO Rename @Chr@ to @Vtx@, a vertex parser is a generalization of
+-- a char parser. But this is only semantics, so not super important to do
+-- now.
+
+module ADP.Fusion.Core.Term.MultiChr where
+
+import           Data.Strict.Tuple
+import           GHC.TypeNats
+import qualified Data.Vector.Generic as VG
+
+import           Data.PrimitiveArray
+
+import           ADP.Fusion.Core.Classes
+import           ADP.Fusion.Core.Multi
+
+
+
+-- | A multi-character parser.
+
+data MultiChr (c ∷ Nat) (v ∷ * → *) (x ∷ *) where
+  MultiChr ∷ VG.Vector v x
+           ⇒ !(v x)
+           → MultiChr c v x
+
+-- | smart constructor for regular 1-character parsers
+
+multiChr :: VG.Vector v x => v x -> MultiChr c v x
+multiChr = MultiChr
+{-# Inline multiChr #-}
+
+instance Build (MultiChr c v x)
+
+instance
+  ( Element ls i
+  ) => Element (ls :!: MultiChr c v x) i where
+    data Elm (ls :!: MultiChr c v x) i = ElmMultiChr !(v x) !(RunningIndex i) !(Elm ls i)
+    type Arg (ls :!: MultiChr c v x)   = Arg ls :. v x
+    getArg (ElmMultiChr x _ ls) = getArg ls :. x
+    getIdx (ElmMultiChr _ i _ ) = i
+    {-# Inline getArg #-}
+    {-# Inline getIdx #-}
+
+deriving instance (Show i, Show (RunningIndex i), Show (v x), Show (Elm ls i)) => Show (Elm (ls :!: MultiChr c v x) i)
+
+type instance TermArg (MultiChr c v x) = v x
+
diff --git a/ADP/Fusion/Core/Term/PeekIndex.hs b/ADP/Fusion/Core/Term/PeekIndex.hs
new file mode 100644
--- /dev/null
+++ b/ADP/Fusion/Core/Term/PeekIndex.hs
@@ -0,0 +1,30 @@
+
+module ADP.Fusion.Core.Term.PeekIndex where
+
+import Data.Strict.Tuple
+
+import Data.PrimitiveArray
+
+import ADP.Fusion.Core.Classes
+import ADP.Fusion.Core.Multi
+
+
+
+data PeekIndex i = PeekIndex
+
+instance Build (PeekIndex i)
+
+instance
+  ( Element ls i
+  ) => Element (ls :!: PeekIndex i) i where
+    data Elm (ls :!: PeekIndex i) i = ElmPeekIndex !i !(RunningIndex i) !(Elm ls i)
+    type Arg (ls :!: PeekIndex i)   = Arg ls :. i
+    getArg (ElmPeekIndex x _  ls)    = getArg ls :. x
+    getIdx (ElmPeekIndex _ i  _ )    = i
+    {-# Inline getArg #-}
+    {-# Inline getIdx #-}
+
+deriving instance (Show i, Show (RunningIndex i), Show (Elm ls i)) => Show (Elm (ls :!: PeekIndex i) i)
+
+type instance TermArg (PeekIndex i) = PeekIndex i
+
diff --git a/ADP/Fusion/Core/Term/Str.hs b/ADP/Fusion/Core/Term/Str.hs
new file mode 100644
--- /dev/null
+++ b/ADP/Fusion/Core/Term/Str.hs
@@ -0,0 +1,61 @@
+
+module ADP.Fusion.Core.Term.Str where
+
+import           Data.Strict.Tuple
+import           GHC.TypeLits
+import           GHC.TypeNats
+import qualified Data.Vector.Generic as VG
+
+import           Data.PrimitiveArray
+
+import           ADP.Fusion.Core.Classes
+import           ADP.Fusion.Core.Multi
+
+
+
+-- | A @Str@ wraps an input vector and provides type-level annotations on
+-- linked @Str@'s, their minimal and maximal size.
+--
+-- If @linked ∷ Maybe Symbol@ is set to @Just aName@, then all @Str@'s that are
+-- part of the same rule share their size information. This allows rules of the
+-- kind @X -> a Y b@ where @a,b@ have a common maximal size.
+--
+-- @minSz@ and @maxSz@ provide minimal and maximal parser width, if set.
+--
+-- TODO consider if @maxSz@ could do with just @Nat@
+
+data Str (linked ∷ Maybe Symbol) (minSz ∷ Nat) (maxSz ∷ Maybe Nat) v x where
+  Str ∷ VG.Vector v x
+      ⇒ !(v x)
+      → Str linked minSz maxSz v x
+
+-- | Construct string parsers with no special constraints.
+
+manyV ∷ VG.Vector v x ⇒ v x → Str Nothing 0 Nothing v x
+manyV = Str
+{-# Inline manyV #-}
+
+someV ∷ VG.Vector v x ⇒ v x → Str Nothing 1 Nothing v x
+someV = Str
+{-# Inline someV #-}
+
+-- TODO really need to be able to remove this system. Forgetting @Build@ gives
+-- very strange type errors.
+
+instance Build (Str linked minSz maxSz v x)
+
+instance
+  ( Element ls i
+  , VG.Vector v x
+  ) => Element (ls :!: Str linked minSz maxSz v x) i where
+    data Elm (ls :!: Str linked minSz maxSz v x) i = ElmStr !(v x) !(RunningIndex i) !(Elm ls i)
+    type Arg (ls :!: Str linked minSz maxSz v x)   = Arg ls :. v x
+    getArg (ElmStr x _ ls) = getArg ls :. x
+    getIdx (ElmStr _ i _ ) = i
+    {-# Inline getArg #-}
+    {-# Inline getIdx #-}
+
+deriving instance (Show i, Show (RunningIndex i), Show (v x), Show (Elm ls i)) => Show (Elm (ls :!: Str linked minSz maxSz v x) i)
+
+type instance TermArg (Str linked minSz maxSz v x) = v x
+
diff --git a/ADP/Fusion/Core/Term/Switch.hs b/ADP/Fusion/Core/Term/Switch.hs
new file mode 100644
--- /dev/null
+++ b/ADP/Fusion/Core/Term/Switch.hs
@@ -0,0 +1,48 @@
+
+-- | 'Switch'es allow enabling and disabling individual rules on a global
+-- level.
+--
+-- TODO Consider moving the switch status to the type level.
+-- TODO Consider using patterns for the switch status and encode using @Int@s.
+
+module ADP.Fusion.Core.Term.Switch where
+
+import           Data.Strict.Tuple
+import qualified Data.Vector.Generic as VG
+
+import           Data.PrimitiveArray
+
+import           ADP.Fusion.Core.Classes
+import           ADP.Fusion.Core.Multi
+
+
+
+-- | Explicit naming of the status of the switch.
+
+data SwitchStatus = Disabled | Enabled
+  deriving (Eq,Ord,Show)
+
+-- | Terminal for the switch. The switch status is not given to any function,
+-- since processing of the rule already indicates that the switch is enabled --
+-- if all other symbols parse successfully. Due to consistency, the type of
+-- result is @()@.
+
+data Switch where
+  Switch ∷ !SwitchStatus → Switch
+
+instance Build Switch
+
+instance
+  ( Element ls i
+  ) => Element (ls :!: Switch) i where
+    data Elm (ls :!: Switch) i = ElmSwitch !(RunningIndex i) !(Elm ls i)
+    type Arg (ls :!: Switch)   = Arg ls :. ()
+    getArg (ElmSwitch _ ls) = getArg ls :. ()
+    getIdx (ElmSwitch i _ ) = i
+    {-# Inline getArg #-}
+    {-# Inline getIdx #-}
+
+deriving instance (Show i, Show (RunningIndex i), Show (Elm ls i)) => Show (Elm (ls :!: Switch) i)
+
+type instance TermArg Switch = ()
+
diff --git a/ADP/Fusion/Core/Term/Test.hs b/ADP/Fusion/Core/Term/Test.hs
new file mode 100644
--- /dev/null
+++ b/ADP/Fusion/Core/Term/Test.hs
@@ -0,0 +1,60 @@
+
+module ADP.Fusion.Core.Term.Test where
+
+import           Data.Strict.Tuple
+import qualified Data.Vector.Generic as VG
+
+import           Data.PrimitiveArray
+
+import           ADP.Fusion.Core.Classes
+import           ADP.Fusion.Core.Multi
+
+
+
+-- | 'Test' terminals return "strings", i.e. vectors of @Chr@s. They allow
+-- the user to specify @[ 0 .. ]@ atoms to be parsed at once. It is
+-- possible to both, limit the minimal and maximal number.
+--
+-- NOTE gadt comments are not parsed by haddock?
+
+{-
+data Test v x where
+  Test :: VG.Vector v x
+        => (Int -> Int -> v x -> v x)  -- @slice@ function
+        -> Int                         -- minimal size
+        -> Int                         -- maximal size (just use s.th. big if you don't want a limit)
+        -> (v x)                       -- the actual vector
+        -> Test v x
+
+manyS :: VG.Vector v x => v x -> Test v x
+manyS = \xs -> Test VG.unsafeSlice 0 (VG.length xs) xs
+{-# Inline manyS #-}
+
+someS :: VG.Vector v x => v x -> Test v x
+someS = \xs -> Test VG.unsafeSlice 1 (VG.length xs) xs
+{-# Inline someS #-}
+
+strng :: VG.Vector v x => Int -> Int -> v x -> Test v x
+strng = \minL maxL xs -> Test VG.unsafeSlice minL maxL xs
+{-# Inline strng #-}
+-}
+
+data Test v x where
+  Test :: VG.Vector v x => v x -> Test v x
+
+instance Build (Test v x)
+
+instance
+  ( Element ls i
+  ) => Element (ls :!: Test v x) i where
+  data Elm (ls :!: Test v x) i = ElmTest !(v x) !(RunningIndex i) !(Elm ls i)
+  type Arg (ls :!: Test v x)   = Arg ls :. v x
+  getArg (ElmTest x _ ls) = getArg ls :. x
+  getIdx (ElmTest _ i _ ) = i
+  {-# Inline getArg #-}
+  {-# Inline getIdx #-}
+
+deriving instance (Show i, Show (RunningIndex i), Show (v x), Show (Elm ls i)) => Show (Elm (ls :!: Test v x) i)
+
+type instance TermArg (Test v x) = v x
+
diff --git a/ADP/Fusion/Core/TyLvlIx.hs b/ADP/Fusion/Core/TyLvlIx.hs
new file mode 100644
--- /dev/null
+++ b/ADP/Fusion/Core/TyLvlIx.hs
@@ -0,0 +1,112 @@
+
+-- | Type-level indexing functionality
+
+module ADP.Fusion.Core.TyLvlIx
+  ( module ADP.Fusion.Core.TyLvlIx
+  , module GHC.TypeLits
+  ) where
+
+import Data.Proxy
+import GHC.TypeLits
+
+import Data.PrimitiveArray.Index.Class hiding (map)
+
+import ADP.Fusion.Core.Classes (RunningIndex (..))
+
+
+
+-- | Given some complete index list @ixTy@ and some lower-dimensional
+-- version @myTy@, walk down along @ixTy@ until we have @is:.i ~ ms:.m@ and
+-- return @m@.
+
+class GetIndexGo ixTy myTy (cmp :: Ordering) where
+  type ResolvedIx ixTy myTy cmp :: *
+  getIndexGo :: ixTy -> (Proxy myTy) -> (Proxy cmp) -> ResolvedIx ixTy myTy cmp
+
+instance GetIndexGo (ix:.i) (my:.m) EQ where
+  type ResolvedIx (ix:.i) (my:.m) EQ = i
+  getIndexGo (ix:.i) _ _ = seq ix $ i
+  {-# Inline [0] getIndexGo #-}
+
+instance (GetIndexGo ix (my:.m) (CmpNat (ToNat ix) (ToNat (my:.m)))) => GetIndexGo (ix:.i) (my:.m) GT where
+  type ResolvedIx (ix:.i) (my:.m) GT = ResolvedIx ix (my:.m) (CmpNat (ToNat ix) (ToNat (my:.m)))
+  getIndexGo (ix:._) p _ = getIndexGo ix p (Proxy :: Proxy (CmpNat (ToNat ix) (ToNat (my:.m))))
+  {-# Inline [0] getIndexGo #-}
+
+instance (GetIndexGo ix Z (CmpNat (ToNat ix) (ToNat Z))) => GetIndexGo (ix:.i) Z GT where
+  type ResolvedIx (ix:.i) Z GT = ResolvedIx ix Z (CmpNat (ToNat ix) (ToNat Z))
+  getIndexGo (ix:._) p _ = getIndexGo ix p (Proxy :: Proxy (CmpNat (ToNat ix) (ToNat Z)))
+  {-# Inline [0] getIndexGo #-}
+
+instance GetIndexGo Z Z EQ where
+  type ResolvedIx Z Z EQ = Z
+  getIndexGo _ _ _ = Z
+  {-# Inline [0] getIndexGo #-}
+
+
+
+instance GetIndexGo (RunningIndex (ix:.i)) (RunningIndex (my:.m)) EQ where
+  type ResolvedIx (RunningIndex (ix:.i)) (RunningIndex (my:.m)) EQ = RunningIndex i
+  getIndexGo (ix:.:i) _ _ = seq ix i
+  {-# Inline [0] getIndexGo #-}
+
+instance
+  ( GetIndexGo (RunningIndex ix) (RunningIndex (my:.m)) (CmpNat (ToNat (RunningIndex ix)) (ToNat (RunningIndex (my:.m))))
+  ) => GetIndexGo (RunningIndex (ix:.i)) (RunningIndex (my:.m)) GT where
+  type ResolvedIx (RunningIndex (ix:.i)) (RunningIndex (my:.m)) GT = ResolvedIx (RunningIndex ix) (RunningIndex (my:.m)) (CmpNat (ToNat (RunningIndex ix)) (ToNat (RunningIndex (my:.m))))
+  getIndexGo (ix:.:_) p _ = getIndexGo ix p (Proxy :: Proxy (CmpNat (ToNat (RunningIndex ix)) (ToNat (RunningIndex (my:.m)))))
+  {-# Inline [0] getIndexGo #-}
+
+instance
+  ( GetIndexGo (RunningIndex ix) (RunningIndex Z) (CmpNat (ToNat (RunningIndex ix)) (ToNat (RunningIndex Z)))
+  ) => GetIndexGo (RunningIndex (ix:.i)) (RunningIndex Z) GT where
+  type ResolvedIx (RunningIndex (ix:.i)) (RunningIndex Z) GT = ResolvedIx (RunningIndex ix) (RunningIndex Z) (CmpNat (ToNat (RunningIndex ix)) (ToNat (RunningIndex Z)))
+  getIndexGo (ix:.:_) p _ = getIndexGo ix p (Proxy :: Proxy (CmpNat (ToNat (RunningIndex ix)) (ToNat (RunningIndex Z))))
+  {-# Inline [0] getIndexGo #-}
+
+instance GetIndexGo (RunningIndex Z) (RunningIndex Z) EQ where
+  type ResolvedIx (RunningIndex Z) (RunningIndex Z) EQ = RunningIndex Z
+  getIndexGo riz _ _ = riz
+  {-# Inline [0] getIndexGo #-}
+
+
+
+-- | Wrap @GetIndexGo@ and the type-level shenanigans.
+
+type GetIndex l r = GetIndexGo l r (CmpNat (ToNat l) (ToNat r))
+
+type GetIx l r = ResolvedIx l r (CmpNat (ToNat l) (ToNat r))
+
+-- | Simplifying wrapper around @getIndexGo@.
+
+getIndex
+  :: forall ixTy myTy
+  .  GetIndex ixTy myTy
+  => ixTy
+  -> Proxy myTy
+  -> GetIx ixTy myTy
+getIndex ixTy myTy = getIndexGo ixTy (Proxy :: Proxy myTy) (Proxy :: Proxy (CmpNat (ToNat ixTy) (ToNat myTy)))
+{-# Inline [0] getIndex #-}
+
+
+
+-- | Given some index structure @x@, return the dimensional number in
+-- @Nat@s.
+
+type family ToNat x :: Nat
+
+type instance ToNat Z       = 0
+type instance ToNat (is:.i) = ToNat is + 1
+type instance ToNat (RunningIndex Z) = 0
+type instance ToNat (RunningIndex (is:.i)) = ToNat (RunningIndex is) + 1
+
+
+
+{-
+
+testggg :: (Z:.Int:.Char) -> Int
+testggg ab = getIndex ab (Proxy :: Proxy (Z:.Int)) --  (Z:.(3::Int))
+{-# NoInline testggg #-}
+
+-}
+
diff --git a/ADP/Fusion/GAPlike.hs b/ADP/Fusion/GAPlike.hs
deleted file mode 100644
--- a/ADP/Fusion/GAPlike.hs
+++ /dev/null
@@ -1,571 +0,0 @@
-{-# LANGUAGE ConstraintKinds #-}
-{-# LANGUAGE DefaultSignatures #-}
-{-# LANGUAGE EmptyDataDecls #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE PackageImports #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE UndecidableInstances #-}
-
--- | 
---
--- HINTS for writing your own (Non-) terminals:
---
--- - ALWAYS provide types for local functions of 'mkStream' and
--- 'mkStreamInner'. Otherwise stream-fusion gets confused and doesn't optimize.
--- (Observable in core by looking for 'Left', 'RIght' constructors and 'SPEC'
--- constructors.
-
-module ADP.Fusion.GAPlike where
-
-import Control.Monad.Primitive
-import Data.Primitive.Types (Prim(..))
-import Data.Vector.Fusion.Stream.Size
-import GHC.Prim (Constraint)
-import qualified Data.Vector.Fusion.Stream.Monadic as S
-import qualified Data.Vector.Unboxed as VU
-
-import Data.PrimitiveArray (PrimArrayOps(..), MPrimArrayOps(..))
-import "PrimitiveArray" Data.Array.Repa.Index
-import qualified Data.PrimitiveArray as PA
-import qualified Data.PrimitiveArray.Zero.Unboxed as ZU
-
-
-
--- * The required type classes. Each class does its own thing.
-
--- | The 'Build' class. Combines the arguments into a stack before they are
--- turned into a stream.
---
---
---
--- To use, simply write "instance Build MyDataCtor" as we have sensible default
--- instances.
-
-class Build x where
-  -- | The stack of arguments we are building.
-  type BuildStack x :: *
-  -- | The default is for the left-most element.
-  type BuildStack x = None :. x
-  -- | Given an element, create the stack.
-  build :: x -> BuildStack x
-  -- | Default for the left-most element.
-  default build :: (BuildStack x ~ (None :. x)) => x -> BuildStack x
-  build x = None :. x
-  {-# INLINE build #-}
-
--- | The stream element. Creates a type-level recursive data type containing
--- the extracted arguments.
-
-class StreamElement x where
-  -- | one element of the stream, recursively defined
-  data StreamElm x :: *
-  -- | top-most index of the stream -- typically int
-  type StreamTopIdx  x :: *
-  -- | complete, recursively defined argument of the stream
-  type StreamArg  x :: *
-  -- | Given a stream element, we extract the top-most idx
-  getTopIdx :: StreamElm x -> StreamTopIdx x
-  -- | extract the recursively defined argument in a well-defined way for 'apply'
-  getArg :: StreamElm x -> StreamArg x
-
--- | Given the arguments, creates a stream of 'StreamElement's.
-
-class (StreamConstraint x) => MkStream m x where
-  type StreamConstraint x :: Constraint
-  type StreamConstraint x = ()
-  mkStream      :: (StreamConstraint x) => x -> (Int,Int) -> S.Stream m (StreamElm x)
-  mkStreamInner :: (StreamConstraint x) => x -> (Int,Int) -> S.Stream m (StreamElm x)
-
-
-
--- * Terminates the stack of arguments
-
--- | Very simple data ctor
-
-data None = None
-
--- | For CORE-language, we have our own Arg-terminator
-
-data ArgZ = ArgZ
-
-instance StreamElement None where
-  data StreamElm None    = SeNone !Int
-  type StreamTopIdx None = Int
-  type StreamArg    None = ArgZ
-  getTopIdx (SeNone k) = k
-  getArg _ = ArgZ
-  {-# INLINE getTopIdx #-}
-  {-# INLINE getArg #-}
-
-instance (Monad m) => MkStream m None where
-  mkStream None (i,j) = S.unfoldr step i where
-    step k
-      | k<=j = Just (SeNone i, j+1)
-      | otherwise = Nothing
-    {-# INLINE step #-}
-  {-# INLINE mkStream #-}
-  mkStreamInner = mkStream
-  {-# INLINE mkStreamInner #-}
-
-
-
--- * A single character terminal. Using unboxed vector to hold the input. Note
--- that "character" means parsing a scalar, not that the 'Chr' parser only
--- accepts "Char"s.
-
-data Chr e = Chr !(VU.Vector e)
-
-instance Build (Chr e)
-
-instance (StreamElement x) => StreamElement (x:.Chr e) where
-  data StreamElm (x:.Chr e) = SeChr !(StreamElm x) !Int !e
-  type StreamTopIdx (x:.Chr e) = Int
-  type StreamArg (x:.Chr e) = StreamArg x :. e
-  getTopIdx (SeChr _ k _) = k
-  getArg (SeChr x _ e) = getArg x :. e
-  {-# INLINE getTopIdx #-}
-  {-# INLINE getArg #-}
-
--- TODO I think, we can rewrite both versions to use S.map instead of S.flatten.
-
-instance (Monad m, MkStream m x, StreamElement x, StreamTopIdx x ~ Int, VU.Unbox e) => MkStream m (x:.Chr e) where
-  mkStream (x:.Chr es) (i,j) = S.flatten mk step Unknown $ mkStream x (i,j-1) where
-    mk :: StreamElm x -> m (StreamElm x, Int)
-    mk x = return (x, getTopIdx x)
-    step :: (StreamElm x, Int) -> m (S.Step (StreamElm x, Int) (StreamElm (x:.Chr e)))
-    step (x,k)
-      | k+1 == j = return $ S.Yield (SeChr x (k+1) (VU.unsafeIndex es k)) (x,j+1)
-      | otherwise = return S.Done
-    {-# INLINE mk #-}
-    {-# INLINE step #-}
-  {-# INLINE mkStream #-}
-  mkStreamInner (x:.Chr es) (i,j) = S.flatten mk step Unknown $ mkStreamInner x (i,j-1) where
-    mk :: StreamElm x -> m (StreamElm x, Int)
-    mk x = return (x, getTopIdx x)
-    step :: (StreamElm x, Int) -> m (S.Step (StreamElm x, Int) (StreamElm (x:.Chr e)))
-    step (x,k)
-      | k < j     = return $ S.Yield (SeChr x (k+1) (VU.unsafeIndex es k)) (x,j+1)
-      | otherwise = return $ S.Done
-    {-# INLINE mk #-}
-    {-# INLINE step #-}
-  {-# INLINE mkStreamInner #-}
-
-
-
--- * Empty and non-empty tables.
---
--- TODO This will probably become more funny with triangular tables ...
-
--- | empty subwords allowed
-
-data E
-
--- | only non-empty subwords
-
-data N
-
-class TransToN t where
-  type TransTo t :: *
-  transToN :: t -> TransTo t
-
--- | Used by the instances below for index calculations.
-
-class TblType tt where
-  initDeltaIdx :: tt -> Int
-
-instance TblType E where
-  initDeltaIdx _ = 0
-  {-# INLINE initDeltaIdx #-}
-
-instance TblType N where
-  initDeltaIdx _ = 1
-  {-# INLINE initDeltaIdx #-}
-
--- ** Immutable tables
-
-data Tbl c es = Tbl !es
-
-instance TransToN (Tbl c es) where
-  type TransTo (Tbl c es) = Tbl N es
-  transToN (Tbl es) = Tbl es
-  {-# INLINE transToN #-}
-
-instance Build (Tbl c es)
-
-instance (StreamElement x, PrimArrayOps arr DIM2 e, TblType c) => StreamElement (x:.Tbl c (arr DIM2 e)) where
-  data StreamElm    (x:.Tbl c (arr DIM2 e)) = SeTbl !(StreamElm x) !Int !e
-  type StreamTopIdx (x:.Tbl c (arr DIM2 e)) = Int
-  type StreamArg    (x:.Tbl c (arr DIM2 e)) = StreamArg x :. e
-  getTopIdx (SeTbl _ k _) = k
-  getArg    (SeTbl x _ e) = getArg x :. e
-  {-# INLINE getTopIdx #-}
-  {-# INLINE getArg #-}
-
-instance (Monad m, MkStream m x, StreamElement x, StreamTopIdx x ~ Int, PrimArrayOps arr DIM2 e, TblType c) => MkStream m (x:.Tbl c (arr DIM2 e)) where
-  -- | The outer stream function assumes that mkStreamInner generates a valid
-  -- stream that does not need to be checked. (This should always be true!).
-  -- The table entry to read is [k,j], as we supposedly are generating the
-  -- outermost stream. Even more "outermost" streams will have changed 'j'
-  -- beforehand. 'mkStream' should only ever be used if 'j' can be fixed.
-  mkStream (x:.Tbl t) (i,j) = S.map step $ mkStreamInner x (i,j - initDeltaIdx (undefined :: c)) where
-    step :: StreamElm x -> StreamElm (x:.Tbl c (arr DIM2 e))
-    step x = let k = getTopIdx x in SeTbl x j (t PA.! (Z:.k:.j))
-    {-# INLINE step #-}
-  -- | The inner stream will, in each step, check if the current subword [k,l]
-  -- (forall l>=k) is valid and terminate the stream once l>j.
-  mkStreamInner (x:.Tbl t) (i,j) = S.flatten mk step Unknown $ mkStreamInner x (i,j) where
-    mk :: StreamElm x -> m (StreamElm x, Int)
-    mk x = return (x, getTopIdx x + initDeltaIdx (undefined :: c))
-    step :: (StreamElm x, Int) -> m (S.Step (StreamElm x, Int) (StreamElm (x:.Tbl c (arr DIM2 e))))
-    step (x,l)
-      | l<=j      = return $ S.Yield (SeTbl x l (t PA.! (Z:.k:.l))) (x,l+1)
-      | otherwise = return $ S.Done
-      where k = getTopIdx x
-    {-# INLINE mk #-}
-    {-# INLINE step #-}
-  {-# INLINE mkStream #-}
-  {-# INLINE mkStreamInner #-}
-
--- ** Mutable tables in some monad.
-
-data MTbl c es = MTbl !es
-
-instance TransToN (MTbl c es) where
-  type TransTo (MTbl c es) = MTbl N es
-  transToN (MTbl es) = MTbl es
-  {-# INLINE transToN #-}
-
-mtblN :: es -> MTbl N es
-mtblN es = MTbl es
-{-# INLINE mtblN #-}
-
-mtblE :: es -> MTbl E es
-mtblE es = MTbl es
-{-# INLINE mtblE #-}
-
-instance Build (MTbl c es)
-
-instance (StreamElement x, MPrimArrayOps marr DIM2 e, TblType c) => StreamElement (x:.MTbl c (marr s DIM2 e)) where
-  data StreamElm    (x:.MTbl c (marr s DIM2 e)) = SeMTbl !(StreamElm x) !Int !e
-  type StreamTopIdx (x:.MTbl c (marr s DIM2 e)) = Int
-  type StreamArg    (x:.MTbl c (marr s DIM2 e)) = StreamArg x :. e
-  getTopIdx (SeMTbl _ k _) = k
-  getArg    (SeMTbl x _ e) = getArg x :. e
-  {-# INLINE getTopIdx #-}
-  {-# INLINE getArg #-}
-
-instance
-  ( Monad m
-  , PrimMonad m
-  , MkStream m x
-  , StreamElement x
-  , StreamTopIdx x ~ Int
-  , MPrimArrayOps marr DIM2 e
-  , TblType c
-  , s ~ PrimState m
-  ) => MkStream m (x:.MTbl c (marr s DIM2 e)) where
-  -- | The outer stream function assumes that mkStreamInner generates a valid
-  -- stream that does not need to be checked. (This should always be true!).
-  -- The table entry to read is [k,j], as we supposedly are generating the
-  -- outermost stream. Even more "outermost" streams will have changed 'j'
-  -- beforehand. 'mkStream' should only ever be used if 'j' can be fixed.
-  mkStream (x:.MTbl t) (i,j) = S.mapM step $ mkStreamInner x (i,j - initDeltaIdx (undefined :: c)) where
-    step :: StreamElm x -> m (StreamElm (x:.MTbl c (marr s DIM2 e)))
-    step x = let k = getTopIdx x in PA.readM t (Z:.k:.j) >>= \e -> return $ SeMTbl x j e
-    {-# INLINE step #-}
-  -- | The inner stream will, in each step, check if the current subword [k,l]
-  -- (forall l>=k) is valid and terminate the stream once l>j.
-  mkStreamInner (x:.MTbl t) (i,j) = S.flatten mk step Unknown $ mkStreamInner x (i,j) where
-    mk :: StreamElm x -> m (StreamElm x, Int)
-    mk x = return (x, getTopIdx x + initDeltaIdx (undefined :: c))
-    step :: (StreamElm x, Int) -> m (S.Step (StreamElm x, Int) (StreamElm (x:.MTbl c (marr s DIM2 e))))
-    step (x,l)
-      | l<=j      = readM t (Z:.k:.l) >>= \e -> return $ S.Yield (SeMTbl x l e) (x,l+1)
-      | otherwise = return $ S.Done
-      where k = getTopIdx x
-    {-# INLINE mk #-}
-    {-# INLINE step #-}
-  {-# INLINE mkStream #-}
-  {-# INLINE mkStreamInner #-}
-
--- ** Some convenience functions.
-
-tNtoE :: Tbl N x -> Tbl E x
-tNtoE (Tbl x) = Tbl x
-{-# INLINE tNtoE #-}
-
-tEtoN :: Tbl E x -> Tbl N x
-tEtoN (Tbl x) = Tbl x
-{-# INLINE tEtoN #-}
-
-
-
--- * Parses an empty subword.
-
--- | The empty subword. Can not be part of a more complex RHS for obvious
--- reasons: "S -> E S" doesn't make sense. Used in some grammars as the base
--- case.
-
-data Empty = Empty
-
-instance Build Empty where
-  type BuildStack Empty = Empty
-  build c = c
-  {-# INLINE build #-}
-
-instance StreamElement (Empty) where
-  data StreamElm    Empty = SeEmpty !Int
-  type StreamTopIdx Empty = Int
-  type StreamArg    Empty = ArgZ :. ()
-  getTopIdx (SeEmpty k) = k
-  getArg    (SeEmpty _) = ArgZ :. ()
-  {-# INLINE getTopIdx #-}
-  {-# INLINE getArg #-}
-
-instance (Monad m) => MkStream m (Empty) where
-  mkStream Empty (i,j) = S.unfoldr step i where
-    step k
-      | k==j      = Just (SeEmpty k, j+1)
-      | otherwise = Nothing
-    {-# INLINE step #-}
-  mkStreamInner = error "undefined for Empty"
-  {-# INLINE mkStream #-}
-  {-# INLINE mkStreamInner #-}
-
-
-
--- * Parsing subwords with restriced size. Both min- and max-size are given
--- when binding input.
-
-data RestrictedRegion e = RRegion !Int !Int !(VU.Vector e)
-
-instance Build (RestrictedRegion e)
-
-instance (StreamElement x) => StreamElement (x:.RestrictedRegion e) where
-  data StreamElm (x:.RestrictedRegion e) = SeResRegion !(StreamElm x) !Int (VU.Vector e)
-  type StreamTopIdx (x:.RestrictedRegion e) = Int
-  type StreamArg (x:.RestrictedRegion e) = StreamArg x :. (VU.Vector e)
-  getTopIdx (SeResRegion _ k _) = k
-  getArg (SeResRegion x _ e) = getArg x :. e
-  {-# INLINE getTopIdx #-}
-  {-# INLINE getArg #-}
-
-instance (Monad m, MkStream m x, StreamElement x, StreamTopIdx x ~ Int, VU.Unbox e) => MkStream m (x:.RestrictedRegion e) where
-  mkStream (x:.RRegion minR maxR xs) (i,j) = S.flatten mk step Unknown $ mkStream x (i,j-1) where
-    mk :: StreamElm x -> m (StreamElm x, Int)
-    mk x = return (x, getTopIdx x)
-    step :: (StreamElm x, Int) -> m (S.Step (StreamElm x, Int) (StreamElm (x:.RestrictedRegion e)))
-    step (x,k)
-      | k+minR <= j && k+maxR >= j = return $ S.Yield (SeResRegion x k (VU.unsafeSlice k (max maxR (j-k)) xs)) (x,j+1)
-      | otherwise = return S.Done
-    {-# INLINE mk #-}
-    {-# INLINE step #-}
-  {-# INLINE mkStream #-}
-  mkStreamInner (x:.RRegion minR maxR xs) (i,j) = S.flatten mk step Unknown $ mkStream x (i,j) where
-    mk :: StreamElm x -> m (StreamElm x, Int)
-    mk x = return (x, getTopIdx x + minR)
-    step :: (StreamElm x, Int) -> m (S.Step (StreamElm x, Int) (StreamElm (x:.RestrictedRegion e)))
-    step (x,l)
-      | l<=j && (l-k)<=maxR = return $ S.Yield (SeResRegion x l (VU.unsafeSlice k (l-k) xs)) (x,j+1)
-      | otherwise           = return S.Done
-      where k = getTopIdx x
-    {-# INLINE mk #-}
-    {-# INLINE step #-}
-  {-# INLINE mkStreamInner #-}
-
-
-
--- * Backtracking tables.
---
--- Since we want the slow forward phase to be fast, in the backtracking phase,
--- we need to keep track of additional things. The backtracking table 'BTtbl'
--- requires the table and an additional backtracking function. You should use
--- the same composed function as for the forward pahse creating the bound table
--- in the first place.
-
--- | The backtracking table 'BTtbl" captures a DP table and the function used
--- to fill it.
-
-data BTtbl c t g = BTtbl t g
-
-instance TransToN (BTtbl c t g) where
-  type TransTo (BTtbl c t g) = BTtbl N t g
-  transToN (BTtbl t g) = BTtbl t g
-  {-# INLINE transToN #-}
-
-bttblN :: t -> g -> BTtbl N t g
-bttblN t g = BTtbl t g
-{-# INLINE bttblN #-}
-
-bttblE :: t -> g -> BTtbl E t g
-bttblE t g = BTtbl t g
-{-# INLINE bttblE #-}
-
-instance Build (BTtbl c t g)
-
--- | The backtracking function, given our index pair, return a stream of
--- backtracked results. (Return as in we are in a monad).
---
--- TODO Should this be "(Int,Int) -> m (SM.Stream Id b)" or are there cases
--- where we'd like to have monadic effects on the "b"s?
-
-type BTfun m b = (Int,Int) -> m (S.Stream m b)
-
-instance (Monad m, StreamElement x, TblType c) => StreamElement (x:.BTtbl c (ZU.Arr0 DIM2 e) (BTfun m b)) where
-  data StreamElm    (x:.BTtbl c (ZU.Arr0 DIM2 e) (BTfun m b)) = SeBTtbl !(StreamElm x) !Int !e (m (S.Stream m b))
-  type StreamTopIdx (x:.BTtbl c (ZU.Arr0 DIM2 e) (BTfun m b)) = Int
-  type StreamArg    (x:.BTtbl c (ZU.Arr0 DIM2 e) (BTfun m b)) = StreamArg x :. (e, m (S.Stream m b))
-  getTopIdx (SeBTtbl _ k _ _) = k
-  getArg    (SeBTtbl x _ e g) = getArg x :. (e,g)
-  {-# INLINE getTopIdx #-}
-  {-# INLINE getArg #-}
-
-instance
-  ( Monad m
-  , MkStream m x
-  , StreamElement x
-  , VU.Unbox e
-  , StreamTopIdx x ~ Int
-  , TblType c
-  ) => MkStream m (x:.BTtbl c (ZU.Arr0 DIM2 e) (BTfun m b)) where
-  mkStream (x:.BTtbl t g) (i,j) = S.map step $ mkStreamInner x (i,j - initDeltaIdx (undefined :: c)) where
-    step :: StreamElm x -> StreamElm (x:.BTtbl c (ZU.Arr0 DIM2 e) (BTfun m b))
-    step x = let k = getTopIdx x in SeBTtbl x j (t PA.! (Z:.k:.j)) (g (k,j))
-    {-# INLINE step #-}
-  mkStreamInner (x:.BTtbl t g) (i,j) = S.flatten mk step Unknown $ mkStreamInner x (i,j) where
-    mk :: StreamElm x -> m (StreamElm x, Int)
-    mk x = return (x, getTopIdx x + initDeltaIdx (undefined :: c))
-    step :: (StreamElm x, Int) -> m (S.Step (StreamElm x, Int) (StreamElm (x:.BTtbl c (ZU.Arr0 DIM2 e) (BTfun m b))))
-    step (x,l)
-      | l<=j      = return $ S.Yield (SeBTtbl x l (t PA.! (Z:.k:.l)) (g (k,l))) (x,l+1)
-      | otherwise = return $ S.Done
-      where k = getTopIdx x
-    {-# INLINE mk #-}
-    {-# INLINE step #-}
-  {-# INLINE mkStream #-}
-  {-# INLINE mkStreamInner #-}
-
-
-
--- * Build complex stacks
-
-instance Build x => Build (x,y) where
-  type BuildStack (x,y) = BuildStack x :. y
-  build (x,y) = build x :. y
-  {-# INLINE build #-}
-
-
-
--- * combinators
-
-infixl 8 <<<
-(<<<) f t ij = S.map (\s -> apply f $ getArg s) $ mkStream (build t) ij
-{-# INLINE (<<<) #-}
-
-infixl 7 |||
-(|||) xs ys ij = xs ij S.++ ys ij
-{-# INLINE (|||) #-}
-
-infixl 6 ...
-(...) s h ij = h $ s ij
-{-# INLINE (...) #-}
-
-infixl 6 ..@
-(..@) s h ij = h ij $ s ij
-{-# INLINE (..@) #-}
-
-infixl 9 ~~
-(~~) = (,)
-{-# INLINE (~~) #-}
-
-infixl 9 %
-(%) = (,)
-{-# INLINE (%) #-}
-
-
-
--- * Apply function 'f' in '(<<<)'
-
-class Apply x where
-  type Fun x :: *
-  apply :: Fun x -> x
-
-instance Apply (ArgZ:.a -> res) where
-  type Fun (ArgZ:.a -> res) = a -> res
-  apply fun (ArgZ:.a) = fun a
-  {-# INLINE apply #-}
-
-instance Apply (ArgZ:.a:.b -> res) where
-  type Fun (ArgZ:.a:.b -> res) = a->b -> res
-  apply fun (ArgZ:.a:.b) = fun a b
-  {-# INLINE apply #-}
-
-instance Apply (ArgZ:.a:.b:.c -> res) where
-  type Fun (ArgZ:.a:.b:.c -> res) = a->b->c -> res
-  apply fun (ArgZ:.a:.b:.c) = fun a b c
-  {-# INLINE apply #-}
-
-instance Apply (ArgZ:.a:.b:.c:.d -> res) where
-  type Fun (ArgZ:.a:.b:.c:.d -> res) = a->b->c->d -> res
-  apply fun (ArgZ:.a:.b:.c:.d) = fun a b c d
-  {-# INLINE apply #-}
-
-instance Apply (ArgZ:.a:.b:.c:.d:.e -> res) where
-  type Fun (ArgZ:.a:.b:.c:.d:.e -> res) = a->b->c->d->e -> res
-  apply fun (ArgZ:.a:.b:.c:.d:.e) = fun a b c d e
-  {-# INLINE apply #-}
-
-instance Apply (ArgZ:.a:.b:.c:.d:.e:.f -> res) where
-  type Fun (ArgZ:.a:.b:.c:.d:.e:.f -> res) = a->b->c->d->e->f -> res
-  apply fun (ArgZ:.a:.b:.c:.d:.e:.f) = fun a b c d e f
-  {-# INLINE apply #-}
-
-instance Apply (ArgZ:.a:.b:.c:.d:.e:.f:.g -> res) where
-  type Fun (ArgZ:.a:.b:.c:.d:.e:.f:.g -> res) = a->b->c->d->e->f->g -> res
-  apply fun (ArgZ:.a:.b:.c:.d:.e:.f:.g) = fun a b c d e f g
-  {-# INLINE apply #-}
-
-instance Apply (ArgZ:.a:.b:.c:.d:.e:.f:.g:.h -> res) where
-  type Fun (ArgZ:.a:.b:.c:.d:.e:.f:.g:.h -> res) = a->b->c->d->e->f->g->h -> res
-  apply fun (ArgZ:.a:.b:.c:.d:.e:.f:.g:.h) = fun a b c d e f g h
-  {-# INLINE apply #-}
-
-instance Apply (ArgZ:.a:.b:.c:.d:.e:.f:.g:.h:.i -> res) where
-  type Fun (ArgZ:.a:.b:.c:.d:.e:.f:.g:.h:.i -> res) = a->b->c->d->e->f->g->h->i -> res
-  apply fun (ArgZ:.a:.b:.c:.d:.e:.f:.g:.h:.i) = fun a b c d e f g h i
-  {-# INLINE apply #-}
-
-instance Apply (ArgZ:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j -> res) where
-  type Fun (ArgZ:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j -> res) = a->b->c->d->e->f->g->h->i->j -> res
-  apply fun (ArgZ:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j) = fun a b c d e f g h i j
-  {-# INLINE apply #-}
-
-instance Apply (ArgZ:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j:.k -> res) where
-  type Fun (ArgZ:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j:.k -> res) = a->b->c->d->e->f->g->h->i->j->k -> res
-  apply fun (ArgZ:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j:.k) = fun a b c d e f g h i j k
-  {-# INLINE apply #-}
-
-instance Apply (ArgZ:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j:.k:.l -> res) where
-  type Fun (ArgZ:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j:.k:.l -> res) = a->b->c->d->e->f->g->h->i->j->k->l -> res
-  apply fun (ArgZ:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j:.k:.l) = fun a b c d e f g h i j k l
-  {-# INLINE apply #-}
-
-instance Apply (ArgZ:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j:.k:.l:.m -> res) where
-  type Fun (ArgZ:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j:.k:.l:.m -> res) = a->b->c->d->e->f->g->h->i->j->k->l->m -> res
-  apply fun (ArgZ:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j:.k:.l:.m) = fun a b c d e f g h i j k l m
-  {-# INLINE apply #-}
-
-instance Apply (ArgZ:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j:.k:.l:.m:.n -> res) where
-  type Fun (ArgZ:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j:.k:.l:.m:.n -> res) = a->b->c->d->e->f->g->h->i->j->k->l->m->n -> res
-  apply fun (ArgZ:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j:.k:.l:.m:.n) = fun a b c d e f g h i j k l m n
-  {-# INLINE apply #-}
-
-instance Apply (ArgZ:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j:.k:.l:.m:.n:.o -> res) where
-  type Fun (ArgZ:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j:.k:.l:.m:.n:.o -> res) = a->b->c->d->e->f->g->h->i->j->k->l->m->n->o -> res
-  apply fun (ArgZ:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j:.k:.l:.m:.n:.o) = fun a b c d e f g h i j k l m n o
-  {-# INLINE apply #-}
-
diff --git a/ADP/Fusion/GAPlike/Criterion.hs b/ADP/Fusion/GAPlike/Criterion.hs
deleted file mode 100644
--- a/ADP/Fusion/GAPlike/Criterion.hs
+++ /dev/null
@@ -1,179 +0,0 @@
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE PackageImports #-}
-
-module ADP.Fusion.GAPlike.Criterion where
-
-import Control.Monad.ST
-import Criterion.Main
-import Data.Char
-import qualified Data.Vector.Fusion.Stream.Monadic as S
-import qualified Data.Vector.Fusion.Stream as SP
-
-import Data.PrimitiveArray
-import Data.PrimitiveArray.Unboxed.VectorZero as UVZ
-import Data.PrimitiveArray.Unboxed.Zero as UZ
-import "PrimitiveArray" Data.Array.Repa.Index
-import "PrimitiveArray" Data.Array.Repa.Shape
-
-import ADP.Fusion.GAPlike
-import ADP.Fusion.GAPlike.DevelCommon
-
-
-
-criterionMain = defaultMain
-  [ bgroup "testTTT3"
-    [ bench "  10" (whnf (testTTT 0)   10)
-    , bench " 100" (whnf (testTTT 0)  100)
-    , bench "1000" (whnf (testTTT 0) 1000)
-    ]
-  , bgroup "testTTTT4"
-    [ bench "  10" (whnf (testTTTT 0)   10)
-    , bench " 100" (whnf (testTTTT 0)  100)
-    , bench "1000" (whnf (testTTTT 0) 1000)
-    ]
-  , bgroup "testTTTT4ga"
-    [ bench "  10" (whnf (testTTTTga 0)   10)
-    , bench " 100" (whnf (testTTTTga 0)  100)
-    , bench "1000" (whnf (testTTTTga 0) 1000)
-    ]
-  , bgroup "testTTTT4gaPA"
-    [ bench "  10" (whnf (testTTTTgaPA 0)   10)
-    , bench " 100" (whnf (testTTTTgaPA 0)  100)
-    , bench "1000" (whnf (testTTTTgaPA 0) 1000)
-    ]
-  , bgroup "testTTTT4gaImmu"
-    [ bench "  10" (whnf (testTTTTgaImmu 0)   10)
-    , bench " 100" (whnf (testTTTTgaImmu 0)  100)
-    , bench "1000" (whnf (testTTTTgaImmu 0) 1000)
-    ]
-  , bgroup "testTTTT4gaImmuPA"
-    [ bench "  10" (whnf (testTTTTgaImmuPA 0)   10)
-    , bench " 100" (whnf (testTTTTgaImmuPA 0)  100)
-    , bench "1000" (whnf (testTTTTgaImmuPA 0) 1000)
-    ]
-  ]
-
-
-
--- * Criterion tests
-
-testC :: Int -> Int -> Int
-testC i j = runST doST where
-  doST :: ST s Int
-  doST = do
-    let c = Chr dvu
-    (gord1 <<< c ... ghsum) (i,j)
-{-# NOINLINE testC #-}
-
-gTestC (ord1,hsum) c =
-  (ord1 <<< c ... hsum)
-
-aTestC = (ord1,hsum) where
-  ord1 = gord1
-  hsum = ghsum
-
-testCC :: Int -> Int -> Int
-testCC i j = runST doST where
-  doST :: ST s Int
-  doST = do
-    let c = Chr dvu
-    let d = Chr dvu
-    (gord2 <<< c % d ... ghsum) (i,j)
-{-# NOINLINE testCC #-}
-
-type TBL s = Tbl N (UVZ.MArr0 s DIM2 Int)
-
-testT :: Int -> Int -> Int
-testT i j = runST doST where
-  doST :: ST s Int
-  doST = do
-    tbl :: TBL s <- Tbl `fmap` fromAssocsM (Z:.0:.0) (Z:.j:.j) 1 []
-    (id <<< tbl ... ghsum) (i,j)
-{-# NOINLINE testT #-}
-
-testTT :: Int -> Int -> Int
-testTT i j = runST doST where
-  doST :: ST s Int
-  doST = do
-    tbl :: TBL s <- Tbl `fmap` fromAssocsM (Z:.0:.0) (Z:.j:.j) 1 []
-    (gplus2 <<< tbl % tbl ... ghsum) (i,j)
-  {-# INLINE doST #-}
-{-# NOINLINE testTT #-}
-
-testTTT :: Int -> Int -> Int
-testTTT i j = runST doST where
-  doST :: ST s Int
-  doST = do
-    tbl :: TBL s <- Tbl `fmap` fromAssocsM (Z:.0:.0) (Z:.j:.j) 1 []
-    (gplus3 <<< tbl % tbl % tbl ... ghsum) (i,j)
-{-# NOINLINE testTTT #-}
-
-testTTTT :: Int -> Int -> Int
-testTTTT i j = runST doST where
-  doST :: ST s Int
-  doST = do
-    tbl :: TBL s <- Tbl `fmap` fromAssocsM (Z:.0:.0) (Z:.j:.j) (1::Int) []
-    (gplus4 <<< tbl % tbl % tbl % tbl ... ghsum) (i,j)
-  {-# INLINE doST #-}
-{-# NOINLINE testTTTT #-}
-
-testTTTTga :: Int -> Int -> Int
-testTTTTga i j = runST doST where
-  doST :: ST s Int
-  doST = do
-    tbl :: TBL s <- Tbl `fmap` fromAssocsM (Z:.0:.0) (Z:.j:.j) (1::Int) []
-    gTTTga aTTTga tbl (i,j)
-  {-# INLINE doST #-}
-{-# NOINLINE testTTTTga #-}
-
-testTTTTgaPA :: Int -> Int -> Int
-testTTTTgaPA i j = runST doST where
-  doST :: ST s Int
-  doST = do
-    tbl :: Tbl N (UZ.MArr0 s DIM2 Int) <- Tbl `fmap` fromAssocsM (Z:.0:.0) (Z:.j:.j) (1::Int) []
-    gTTTga aTTTga tbl (i,j)
-  {-# INLINE doST #-}
-{-# NOINLINE testTTTTgaPA #-}
-
-testTTTTgaImmu :: Int -> Int -> Int
-testTTTTgaImmu i j =
-    let tbl = (Tbl $ fromAssocs (Z:.0:.0) (Z:.j:.j) 1 []) :: Tbl N (UVZ.Arr0 DIM2 Int) 
-    in tbl `seq` gTTTga aTTTgaImmu tbl (i,j)
-{-# NOINLINE testTTTTgaImmu #-}
-
-testTTTTgaImmuPA :: Int -> Int -> Int
-testTTTTgaImmuPA i j =
-    let tbl = (Tbl $ fromAssocs (Z:.0:.0) (Z:.j:.j) 1 []) :: Tbl N (UZ.Arr0 DIM2 Int) 
-    in tbl `seq` gTTTga aTTTgaImmu tbl (i,j)
-{-# NOINLINE testTTTTgaImmuPA #-}
-
-gTTTga (plus4, hsum) tbl =
-  (plus4 <<< tbl % tbl % tbl % tbl ... hsum)
-{-# INLINE gTTTga #-}
-
-aTTTga = (plus4, hsum) where
-  plus4 = gplus4
-  hsum = ghsum
-
-aTTTgaImmu = (plus4, hsum) where
-  plus4 = gplus4
-  hsum = gihsum
-{-# INLINE aTTTgaImmu #-}
-
-gord1 a = ord a
-
-gord2 a b = ord a + ord b
-
-gord3 a b c = ord a + ord b + ord c
-
-gplus2 a b = a+b
-
-gplus3 a b c = a+b+c
-
-gplus4 a b c d = a+b+c+d
-
-ghsum :: S.Stream (ST s) Int -> ST s Int
-ghsum = S.foldl' (+) 0
-
-gihsum :: SP.Stream Int -> Int
-gihsum = SP.foldl' (+) 0
diff --git a/ADP/Fusion/GAPlike/DevelCommon.hs b/ADP/Fusion/GAPlike/DevelCommon.hs
deleted file mode 100644
--- a/ADP/Fusion/GAPlike/DevelCommon.hs
+++ /dev/null
@@ -1,22 +0,0 @@
-{-# LANGUAGE PackageImports #-}
-
-module ADP.Fusion.GAPlike.DevelCommon where
-
-import qualified Data.PrimitiveArray as PA
-import qualified Data.Vector.Unboxed as VU
-
-import Data.PrimitiveArray.Unboxed.VectorZero as UVZ
-import Data.PrimitiveArray.Unboxed.Zero as UZ
-import "PrimitiveArray" Data.Array.Repa.Index
-import "PrimitiveArray" Data.Array.Repa.Shape
-
-
-
-dvu = VU.fromList $ concat $ replicate 10 ['a'..'z']
-{-# NOINLINE dvu #-}
-
-type PAT = UVZ.Arr0 DIM2 Int
-pat :: PAT
-pat = PA.fromAssocs (Z:.0:.0) (Z:.1000:.1000) 0 [(Z:.i:.j,j-i) | i <-[0..1000], j<-[i..1000] ]
-{-# NOINLINE pat #-}
-
diff --git a/ADP/Fusion/GAPlike/QuickCheck.hs b/ADP/Fusion/GAPlike/QuickCheck.hs
deleted file mode 100644
--- a/ADP/Fusion/GAPlike/QuickCheck.hs
+++ /dev/null
@@ -1,57 +0,0 @@
-{-# LANGUAGE PackageImports #-}
-{-# LANGUAGE TemplateHaskell #-}
-
-module ADP.Fusion.GAPlike.QuickCheck where
-
-import Test.QuickCheck
-import Test.QuickCheck.All
-import qualified Data.Vector.Fusion.Stream as SP
-import qualified Data.Vector.Unboxed as VU
-
-import "PrimitiveArray" Data.Array.Repa.Index
-import "PrimitiveArray" Data.Array.Repa.Shape
-import Data.PrimitiveArray
-
-import ADP.Fusion.QuickCheck.Arbitrary
-import ADP.Fusion.GAPlike.DevelCommon
-import ADP.Fusion.GAPlike
-
-
-
--- * QuickCheck
-
-checkC_fusion (i,j) = id <<< Chr dvu ... SP.toList $ (i,j)
-checkC_list   (i,j) = [dvu VU.! i | i+1==j]
-prop_checkC = checkC_fusion === checkC_list
-
-checkCC_fusion (i,j) = (,) <<< Chr dvu % Chr dvu ... SP.toList $ (i,j)
-checkCC_list   (i,j) = [ (dvu VU.! i, dvu VU.! (i+1)) | i+2==j ]
-prop_checkCC = checkCC_fusion === checkCC_list
-
-checkP_fusion (i,j) = id <<< (Tbl pat :: Tbl E PAT)  ... SP.toList $ (i,j)
-checkP_list   (i,j) = [ (pat!(Z:.i:.j)) | i<=j ]
-prop_checkP = checkP_fusion === checkP_list
-
-checkPP_fusion (i,j) = let tbl = Tbl pat :: Tbl E PAT
-                       in  (,) <<< tbl % tbl ... SP.toList $ (i,j)
-checkPP_list   (i,j) = [ (pat!(Z:.i:.k), pat!(Z:.k:.j)) | k<-[i..j] ]
-prop_checkPP = checkPP_fusion === checkPP_list
-
-checkCPC_fusion (i,j) = let tbl = Tbl pat :: Tbl E PAT
-                        in  (,,) <<< Chr dvu % tbl % Chr dvu ... SP.toList $ (i,j)
-checkCPC_list (i,j) = [ (dvu VU.! i, pat!(Z:.i+1:.j-1), dvu VU.! (j-1)) | i+2<=j ]
-prop_checkCPC = checkCPC_fusion === checkCPC_list
-
-checkNN_fusion (i,j) = let tbl = Tbl pat :: Tbl N PAT
-                       in  (,) <<< tbl % tbl ... SP.toList $ (i,j)
-checkNN_list   (i,j) = [ (pat!(Z:.i:.k), pat!(Z:.k:.j)) | k<-[i+1..j-1] ]
-prop_checkNN = checkNN_fusion === checkNN_list
-
-
-
-options = stdArgs {maxSuccess = 1000}
-
-customCheck = quickCheckWithResult options
-
-allProps = $forAllProperties customCheck
-
diff --git a/ADP/Fusion/Monadic.hs b/ADP/Fusion/Monadic.hs
deleted file mode 100644
--- a/ADP/Fusion/Monadic.hs
+++ /dev/null
@@ -1,197 +0,0 @@
-{-# LANGUAGE NoMonomorphismRestriction #-}
-{-# LANGUAGE PackageImports #-}
-
--- | Monadic combinators. Code like
---
--- @f <<< xs ~~~ ys ... Stream.sum@
---
--- will generate efficient GHC core for a dynamic program comparable to
---
--- @sum [ f (xs!(i,k)) (ys!(k,j)) | k<-[i..j]]@.
-
-module ADP.Fusion.Monadic where
-
-import "PrimitiveArray" Data.Array.Repa.Index
-import qualified Data.Vector.Fusion.Stream.Monadic as S
-
-import ADP.Fusion.Monadic.Internal
-
-
-
--- * Apply functions to arguments.
-
--- | A monadic version of the function application combinator. Applies 'f'
--- which has a monadic effect.
-
-infixl 8 #<<
-(#<<) f t ij = S.mapM (\(_,_,c) -> apply f c) $ streamGen t ij
-{-# INLINE (#<<) #-}
-
--- | Pure function application combinator. Applies 'f' which is pure. The
--- arguments to 'f', meaning 't' can be monadic, however!
-
-infixl 8 <<<
-(<<<) f t ij = S.map (\(_,_,c) -> apply f c) $ streamGen t ij
-{-# INLINE (<<<) #-}
-
-
-
--- * Combine multiple right-hand sides of a non-terminal in a context-free
--- grammar.
-
--- | If both, 'xs' and 'ys' are streams of candidate answers, they can be
--- combined here. The answer (or sort) type of 'xs' and 'ys' has to be the
--- same. Works like @(++)@ for lists.
-
-infixl 7 |||
-(|||) xs ys ij = xs ij S.++ ys ij
-{-# INLINE (|||) #-}
-
-
-
--- * Reduce streams to single answers.
---
--- NOTE "Single answers" can be of a vector-type! One is not constrained to
--- scalar results. This allows for many exiting algorithms.
-
--- | Reduces a streams of answers to the type of stored answers. The resulting
--- type could be scalar, which it will be for highest-performance algorithms,
--- or it could be a subset of answers stored in some kind of data structure.
-
-infixl 6 ...
-(...) stream h ij = h $ stream ij
-{-# INLINE (...) #-}
-
--- | Specialized version of choice function application, with a choice function
--- that needs to know the subword index it is working on.
-
-infixl 6 ..@
-(..@) stream h ij = h ij $ stream ij
-{-# INLINE (..@) #-}
-
-
-
--- * Combinators to chain function arguments.
-
-
-
--- ** General combinator creation.
-
--- | General function to create combinators. The left-hand side @xs@ in @xs
--- `comb` ys@ will have a size between @minL@ and @maxL@, while @ys@ and
--- /everything to its right will be guaranteed @minR@ size.
-
-makeLeft_MinRight (minL,maxL) minR = comb where
-  {-# INLINE comb #-}
-  comb xs ys = Box mk step xs ys
-  {-# INLINE mk #-}
-  mk (z:.k:.j,a,b) = return (z:.k:.k+minL:.j,a,b)
-  {-# INLINE step #-}
-  step (z:.k:.l:.j,a,b)
-    | l<=j-minR && l<=k+maxL = return $ S.Yield (z:.k:.l:.j,a,b) (z:.k:.l+1:.j,a,b)
-    | otherwise              = return $ S.Done
-{-# INLINE makeLeft_MinRight #-}
-
--- | Create combinators which are to be used in the right-most position of a
--- chain. 1st, they make sure that the second to last region has a size of at
--- least 'minL'. 2nd, they constrain the last argument to a size between 'minR'
--- and 'maxR'.
-
-makeMinLeft_Right minL (minR,maxR) = comb where
-  {-# INLINE comb #-}
-  comb xs ys = Box mk step xs ys
-  {-# INLINE mk #-}
-  mk (z:.k:.j,a,b) = let l = max (k+minL) (j-maxR) in return (z:.k:.l:.j,a,b)
-  {-# INLINE step #-}
-  step (z:.k:.l:.j,a,b)
-    | l<=j-minR = return $ S.Yield (z:.k:.l:.j,a,b) (z:.k:.l+1:.j,a,b)
-    | otherwise = return $ S.Done
-{-# INLINE makeMinLeft_Right #-}
-
-
-
--- ** A number of often-used combinators.
-
-infixl 9 -~+, +~-, -~~, ~~-
-
-(-~+) = makeLeft_MinRight (1,1) 1
-{-# INLINE (-~+) #-}
-
-(+~-) = makeMinLeft_Right 1 (1,1)
-{-# INLINE (+~-) #-}
-
-(-~~) = makeLeft_MinRight (1,1) 0
-{-# INLINE (-~~) #-}
-
-(~~-) = makeMinLeft_Right 0 (1,1)
-{-# INLINE (~~-) #-}
-
-(+~--) = makeMinLeft_Right 1 (2,2)
-{-# INLINE (+~--) #-}
-
-infixl 9 ~~~
-(~~~) xs ys = Box mk step xs ys where
-  {-# INLINE mk #-}
-  mk (z:.k:.j,vidx,vstack) = return $ (z:.k:.k:.j,vidx,vstack)
-  {-# INLINE step #-}
-  step (z:.k:.l:.j,vidx,vstack)
-    | l<=j      = return $ S.Yield (z:.k:.l:.j,vidx,vstack) (z:.k:.l+1:.j,vidx,vstack)
-    | otherwise = return $ S.Done
-{-# INLINE (~~~) #-}
-
--- | @xs +~+ ys@ with @xs@ and @ys@ non-empty. The non-emptyness constraint on
--- @ys@ works only for two arguments. With three or more arguments, a
--- left-leaning combinator to the right of @ys@ is required to establish
--- non-emptyness.
-
-infixl 9 +~+
-(+~+) xs ys = Box mk step xs ys where
-  {-# INLINE mk #-}
-  mk (z:.k:.j,vidx,vstack) = return $ (z:.k:.k+1:.j,vidx,vstack)
-  {-# INLINE step #-}
-  step (z:.k:.l:.j,vidx,vstack)
-    | l+1<=j    = return $ S.Yield (z:.k:.l:.j,vidx,vstack) (z:.k:.l+1:.j,vidx,vstack)
-    | otherwise = return $ S.Done
-{-# INLINE (+~+) #-}
-
--- | @ls ~~~ xs !-~+ ys@ with xs having a size of one and @ls@ further to the
--- left having a size of one or more.
-
-infixl 9 !-~+
-(!-~+) xs ys = Box mk step xs ys where
-  {-# INLINE mk #-}
-  mk (z:.k:.j,vidx,vstack)
-    | k>0       = return $ (z:.k:.k+1:.j,vidx,vstack)
-    | otherwise = return $ (z:.k:.j+1:.j,vidx,vstack)
-  {-# INLINE step #-}
-  step (z:.k:.l:.j,vidx,vstack)
-    | l+1<=j    = return $ S.Yield (z:.k:.l:.j,vidx,vstack) (z:.k:.j+1:.j,vidx,vstack)
-    | otherwise = return $ S.Done
-{-# INLINE (!-~+) #-}
-
--- | @xs +~-! ys ~~~ rs@ with @ys@ having a size of one and @rs@ further to the
--- right having a size of one.
-
-infixl 9 +~-!
-(+~-!) xs ys = Box mk step xs ys where
-  {-# INLINE mk #-}
-  mk (z:.k:.j,vidx,vstack) = return $ (z:.k:.j-2:.j,vidx,vstack)
-  {-# INLINE step #-}
-  step (z:.k:.l:.j,vidx,vstack)
-    | l+2==j    = return $ S.Yield (z:.k:.l:.j,vidx,vstack) (z:.k:.j+1:.j,vidx,vstack)
-    | otherwise = return $ S.Done
-{-# INLINE (+~-!) #-}
-
--- | @xs -~- ys@ produces an answer only if both @xs@ and @ys@ have size one.
--- The total size here then is two.
-
-infixl 9 -~-
-(-~-) xs ys = Box mk step xs ys where
-  {-# INLINE mk #-}
-  mk (z:.k:.j,vidx,vstack) = return $ (z:.k:.k+1:.j,vidx,vstack)
-  {-# INLINE step #-}
-  step (z:.k:.l:.j,vidx,vstack)
-    | k+1==l && l+1==j = return $ S.Yield (z:.k:.l:.j,vidx,vstack) (z:.k:.l+1:.j,vidx,vstack)
-    | otherwise        = return $ S.Done
-{-# INLINE (-~-) #-}
-
diff --git a/ADP/Fusion/Monadic/Internal.hs b/ADP/Fusion/Monadic/Internal.hs
deleted file mode 100644
--- a/ADP/Fusion/Monadic/Internal.hs
+++ /dev/null
@@ -1,492 +0,0 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE DoAndIfThenElse #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE FunctionalDependencies #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE OverlappingInstances #-}
-{-# LANGUAGE PackageImports #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE UndecidableInstances #-}
-
-{-# OPTIONS_HADDOCK hide #-}
-
--- | The internal working of ADPfusion. All combinator applications are turned
--- into efficient code during compile time.
---
--- If you have a data structure to be used as an argument in a combinator
--- chain, derive an instance 'ExtractValue', 'StreamGen', and 'PreStreamGen'.
---
--- NOTE: If this doesn't happen, it is a possible bug, or GHC changed its
--- optimizer (like with GHC 7.2 -> 7.4).
---
--- TODO If possible, instance generation will be using the Generics system in
--- the future.
-
-module ADP.Fusion.Monadic.Internal where
-
-import Control.Monad.Primitive
-import Control.Monad.ST
-import Data.List (intersperse)
-import Data.Primitive.Types
-import Data.Vector.Fusion.Stream.Size
-import "PrimitiveArray" Data.Array.Repa.Index
-import "PrimitiveArray" Data.Array.Repa.Shape
-import qualified Data.Vector.Fusion.Stream.Monadic as S
-import qualified Data.Vector.Unboxed as VU
-import Text.Printf
-
-import qualified Data.PrimitiveArray as PA
-import qualified Data.PrimitiveArray.Zero.Unboxed as ZU
-import qualified Data.PrimitiveArray.Zero as Z
-
-
-
--- * StreamGen
-
--- | Generate stream from either one (DIM2 -> m cnt) or some combination of
--- terminals derived from uses of nextTo.
-
-class Monad m => StreamGen m t r | t -> r where
-  streamGen :: t -> DIM2 -> S.Stream m r
-
-#define mkStreamGen(cnt) \
-instance (Monad m, ExtractValue m (cnt), Asor (cnt) ~ k, Elem (cnt) ~ elm) \
-=> StreamGen m (cnt) (DIM2,Z:.k,Z:.elm) where { \
-  {-# INLINE streamGen #-} \
-;  streamGen x ij = extractStreamLast x $ preStreamGen x ij }
-
-mkStreamGen(DIM2 -> Scalar elm)
-mkStreamGen(DIM2 -> ScalarM elm)
-mkStreamGen(DIM2 -> Vect elm)
-mkStreamGen(DIM2 -> VectM elm)
-mkStreamGen(ZU.MArr0 s sh elm)
-mkStreamGen(ZU.Arr0 sh elm)
-
-mkStreamGen(Z.MArr0 s sh (VU.Vector elm))
-mkStreamGen(Z.Arr0 sh (VU.Vector elm))
-
--- | two or more elements combined by NextTo (~~~), "xs" as anything, "ys" is
--- monadic.
-
-instance
-  ( Monad m
-  , ExtractValue m ys, Asor ys ~ cY, Elem ys ~ eY
-  , PreStreamGen m (Box mk step xs ys) (idx:.Int,adx:.cX,arg:.eX)
-  , Idx2 _idx ~ idx
-  ) => StreamGen m (Box mk step xs ys) (idx:.Int,adx:.cX:.cY,arg:.eX:.eY) where
-  streamGen (Box mk step xs ys) ij
-    = extractStreamLast ys
-    $ preStreamGen (Box mk step xs ys) ij
-  {-# INLINE streamGen #-}
-
-
-
--- * PreStreamGen
-
--- | Required by most 'StreamGen' instances just before 'extractStreamLast' is
--- called.
-
-class Monad m => PreStreamGen m s q | s -> q where
-  preStreamGen
-    :: s      -- ^ the composite type of the arguments
-    -> DIM2   -- ^ the original index @(Z:.i:.j)@
-    -> S.Stream m q -- ^ the stream we get out of it
-
--- | Creates the single step on the left which does nothing more then set the
--- outermost indices to (i,j). This does not use the alpha/omega's
-
-singlePreStreamGen ij = S.unfoldr step ij where
-  {-# INLINE step #-}
-  step (Z:.i:.j)
-    | i<=j      = Just ((Z:.i:.j ,Z,Z), Z:.j+1:.j)
-    | otherwise = Nothing
-{-# INLINE singlePreStreamGen #-}
-
-#define mkPreStreamGen(s) \
-instance (Monad m) => PreStreamGen m (s) (DIM2,Z,Z) where { \
-  {-# INLINE preStreamGen #-} \
-;  preStreamGen _ = singlePreStreamGen }
-
-mkPreStreamGen(DIM2 -> Scalar elm)
-mkPreStreamGen(DIM2 -> ScalarM elm)
-mkPreStreamGen(DIM2 -> Vect elm)
-mkPreStreamGen(DIM2 -> VectM elm)
-mkPreStreamGen(ZU.MArr0 s sh elm)
-mkPreStreamGen(ZU.Arr0 sh elm)
-
-mkPreStreamGen(Z.MArr0 s sh (VU.Vector elm))
-mkPreStreamGen(Z.Arr0 sh (VU.Vector elm))
-
--- | the first two arguments from nextTo, monadic xs.
-
-instance ( Monad m
-         , ExtractValue m xs, Asor xs ~ cX, Elem xs ~ eX
-         , PreStreamGen m xs xsStack
-         , (idxX,adxX,argX) ~ xsStack
-         , (z0:.Int:.Int) ~ idxX
-         , ((idxX,adxX,argX) -> m (idxX:.Int,adxX,argX)) ~ mk
-         , ((idxX:.Int,adxX,argX) -> m (S.Step (idxX:.Int,adxX,argX) (idxX:.Int,adxX,argX))) ~ step
-         ) => PreStreamGen m (Box mk step xs ys) (idxX:.Int,adxX:.cX,argX:.eX) where
-  preStreamGen (Box mk step xs ys) ij
-    = extractStream xs
-    $ S.flatten mk step Unknown
-    $ preStreamGen xs ij
-  {-# INLINE preStreamGen #-}
-
--- | Pre-stream generation for deeply nested boxes.
-
-instance
-  ( Monad m
-  , ExtractValue m xs, Asor xs ~ cX, Elem xs ~ eX
-  , PreStreamGen m (Box box2 box3 box1 xs) xsStack
-  , (idxX,adxX,argX) ~ xsStack
-  , (z0:.Int:.Int) ~ idxX
-  , ((idxX,adxX,argX) -> m (idxX:.Int,adxX,argX)) ~ mk
-  , ((idxX:.Int,adxX,argX) -> m (S.Step (idxX:.Int,adxX,argX) (idxX:.Int,adxX,argX))) ~ step
-  ) => PreStreamGen m (Box mk step (Box box2 box3 box1 xs) ys) (idxX:.Int,adxX:.cX,argX:.eX) where
-  preStreamGen (Box mk step box@(Box _ _ _ xs) ys) ij
-    = extractStream xs
-    $ S.flatten mk step Unknown
-    $ preStreamGen box ij
-  {-# INLINE preStreamGen #-}
-
-
-
--- * ExtractValue: extract values from data structures.
-
-class (Monad m) => ExtractValue m cnt where
-  type Asor cnt :: *
-  type Elem cnt :: *
-  extractValue  :: ()
-                => cnt
-                -> DIM2
-                -> Asor cnt
-                -> m (Elem cnt)
-  extractStream :: ()
-                => cnt
-                -> S.Stream m (Idx3 z,astack,vstack)
-                -> S.Stream m (Idx3 z,astack:.Asor cnt,vstack:.Elem cnt)
-  extractStreamLast :: ()
-                    => cnt
-                    -> S.Stream m (Idx2 z,astack,vstack)
-                    -> S.Stream m (Idx2 z,astack:.Asor cnt,vstack:.Elem cnt)
-
--- | Mutable arrays.
-
-instance
-  ( PrimMonad m
-  , VU.Unbox elm
-  , PrimState m ~ s
-  , DIM2 ~ sh
-  ) => ExtractValue m (ZU.MArr0 s sh elm) where
-  type Asor (ZU.MArr0 s sh elm) = Z
-  type Elem (ZU.MArr0 s sh elm) = elm
-  extractValue cnt ij z = do
-    x <- PA.readM cnt ij
-    x `seq` return x
-  extractStream cnt stream = S.mapM addElm stream where
-    addElm (z:.k:.x:.l, astack, vstack) = do
-      vadd <- PA.readM cnt (Z:.k:.x)
-      vadd `seq` return (z:.k:.x:.l, astack:.Z, vstack :. vadd)
-  extractStreamLast sngl stream = S.mapM addElm stream where
-    addElm (z:.k:.x, astack, vstack) = do
-      vadd <- PA.readM sngl (Z:.k:.x)
-      vadd `seq` return (z:.k:.x, astack:.Z, vstack:.vadd)
-  {-# INLINE extractValue #-}
-  {-# INLINE extractStream #-}
-  {-# INLINE extractStreamLast #-}
-
--- | Immutable arrays.
-
-instance
-  ( Monad m
-  , VU.Unbox elm
-  , DIM2 ~ sh
-  ) => ExtractValue m (ZU.Arr0 sh elm) where
-  type Asor (ZU.Arr0 sh elm) = Z
-  type Elem (ZU.Arr0 sh elm) = elm
-  extractValue cnt ij z = do
-    let x = PA.index cnt ij
-    x `seq` return x
-  extractStream cnt stream = S.map addElm stream where
-    addElm (z:.k:.x:.l, astack, vstack) = let vadd = PA.index cnt (Z:.k:.x) in
-      vadd `seq` (z:.k:.x:.l, astack:.Z, vstack :. vadd)
-  extractStreamLast cnt stream = S.map addElm stream where
-    addElm (z:.k:.x, astack, vstack) = let vadd = PA.index cnt (Z:.k:.x) in
-      vadd `seq` (z:.k:.x, astack:.Z, vstack:.vadd)
-  {-# INLINE extractValue #-}
-  {-# INLINE extractStream #-}
-  {-# INLINE extractStreamLast #-}
-
--- | Function with 'Scalar' return value.
-
-instance
-  ( Monad m
-  ) => ExtractValue m (DIM2 -> Scalar elm) where
-  type Asor (DIM2 -> Scalar elm) = Z
-  type Elem (DIM2 -> Scalar elm) = elm
-  extractValue cnt ij z = do
-    let Scalar x = cnt ij
-    x `seq` return x
-  extractStream cnt stream = S.map addElm stream where
-    addElm (z:.k:.x:.l, astack, vstack) = let Scalar vadd = cnt (Z:.k:.x) in
-      vadd `seq` (z:.k:.x:.l, astack:.Z, vstack :. vadd)
-  extractStreamLast cnt stream = S.map addElm stream where
-    addElm (z:.k:.x, astack, vstack) = let Scalar vadd = cnt (Z:.k:.x) in
-      vadd `seq` (z:.k:.x, astack:.Z, vstack:.vadd)
-  {-# INLINE extractValue #-}
-  {-# INLINE extractStream #-}
-  {-# INLINE extractStreamLast #-}
-
--- | Function with monadic 'Scalar' return value.
-
-instance
-  ( Monad m
-  ) => ExtractValue m (DIM2 -> ScalarM (m elm)) where
-  type Asor (DIM2 -> ScalarM (m elm)) = Z
-  type Elem (DIM2 -> ScalarM (m elm)) = elm
-  extractValue cnt ij z = do
-    let ScalarM x' = cnt ij
-    x <- x'
-    x `seq` return x
-  extractStream cnt stream = S.mapM addElm stream where
-    addElm (z:.k:.x:.l, astack, vstack) = do
-      let ScalarM vadd' = cnt (Z:.k:.x)
-      vadd <- vadd'
-      vadd `seq` return (z:.k:.x:.l, astack:.Z, vstack :. vadd)
-  extractStreamLast cnt stream = S.mapM addElm stream where
-    addElm (z:.k:.x, astack, vstack) = do
-      let ScalarM vadd' = cnt (Z:.k:.x)
-      vadd <- vadd'
-      vadd `seq` return (z:.k:.x, astack:.Z, vstack:.vadd)
-  {-# INLINE extractValue #-}
-  {-# INLINE extractStream #-}
-  {-# INLINE extractStreamLast #-}
-
--- | This instance is a bit crazy, since the accessor is the current stream
--- itself. No idea how efficient this is (need to squint at CORE), but I plan
--- to use it for backtracking only.
---
--- TODO Using this instance tends to break to optimizer ;-) -- don't use it
--- yet!
-
-instance
-  ( Monad m
-  ) => ExtractValue m (DIM2 -> S.Stream m elm) where
-  type Asor (DIM2 -> S.Stream m elm) = S.Stream m elm
-  type Elem (DIM2 -> S.Stream m elm) = elm
-  extractValue cnt ij z = error "this function is not well-defined for these streams"
-  extractStream cnt stream = S.flatten mk step Unknown $ stream where
-    mk (z:.k:.l:.j,as,vs) = do
-      let strm = cnt (Z:.k:.l)
-      return (z:.k:.l:.j,as:.strm,vs)
-    step (idx,as:.strm,vs) = do
-      isNull <- S.null strm
-      if isNull
-      then return $ S.Done
-      else do hd <- S.head strm
-              hd `seq` return $ S.Yield (idx,as:.strm,vs:.hd) (idx,as:.S.tail strm,vs)
-  extractStreamLast cnt stream = S.flatten mk step Unknown $ stream where
-    mk (z:.l:.j,as,vs) = do
-      let strm = cnt (Z:.l:.j)
-      return (z:.l:.j,as:.strm,vs)
-    step (idx,as:.strm,vs) = do
-      isNull <- S.null strm
-      if isNull
-      then return $ S.Done
-      else do hd <- S.head strm
-              hd `seq` return $ S.Yield (idx,as:.strm,vs:.hd) (idx,as:.S.tail strm,vs)
-  {-# INLINE extractValue #-}
-  {-# INLINE extractStream #-}
-  {-# INLINE extractStreamLast #-}
-
--- | Instance of boxed array with vector-valued cells. We assume that we want
--- to store multiple results for each cell. If the intent is to store one
--- scalar result, use the 'Scalar' wrapper.
-
-instance
-  ( PrimMonad m
-  , Prim elm
-  , VU.Unbox elm
-  , PrimState m ~ s
-  , DIM2 ~ sh
-  ) => ExtractValue m (Z.MArr0 s sh (VU.Vector elm)) where
-  type Asor (Z.MArr0 s sh (VU.Vector elm)) = Int
-  type Elem (Z.MArr0 s sh (VU.Vector elm)) = elm
-  extractValue cnt ij z = do
-    x <- PA.readM cnt ij
-    let y = x `VU.unsafeIndex` z
-    y `seq` return y
-  extractStream cnt stream = S.flatten mk step Unknown $ stream where
-    mk (idx,as,vs) = return (idx,as:.0,vs)
-    step (z:.k:.l:.j,as:.a,vs) = do
-      x <- PA.readM cnt (Z:.k:.l)
-      case (x VU.!? a) of
-        Just v  -> v `seq` return $ S.Yield (z:.k:.l:.j,as:.a,vs:.v) (z:.k:.l:.j,as:.(a+1),vs)
-        Nothing -> return $ S.Done
-  extractStreamLast cnt stream = S.flatten mk step Unknown $ stream where
-    mk (idx,as,vs) = return (idx,as:.0,vs)
-    step (z:.l:.j,as:.a,vs) = do
-      x <- PA.readM cnt (Z:.l:.j)
-      case (x VU.!? a) of
-        Just v  -> v `seq` return $ S.Yield (z:.l:.j,as:.a,vs:.v) (z:.l:.j,as:.(a+1),vs)
-        Nothing -> return $ S.Done
-  {-# INLINE extractValue #-}
-  {-# INLINE extractStream #-}
-  {-# INLINE extractStreamLast #-}
-
--- | vector-based cells
-
-instance
-  ( Monad m
-  , Prim elm
-  , VU.Unbox elm
-  , DIM2 ~ sh
-  ) => ExtractValue m (Z.Arr0 sh (VU.Vector elm)) where
-  type Asor (Z.Arr0 sh (VU.Vector elm)) = Int
-  type Elem (Z.Arr0 sh (VU.Vector elm)) = elm
-  extractValue cnt ij z = do
-    let x = PA.index cnt ij
-    let y = x `VU.unsafeIndex` z
-    y `seq` return y
-  extractStream cnt stream = S.flatten mk step Unknown $ stream where
-    mk (idx,as,vs) = return (idx,as:.0,vs)
-    step (z:.k:.l:.j,as:.a,vs) = do
-      let x = PA.index cnt (Z:.k:.l)
-      case (x VU.!? a) of
-        Just v  -> v `seq` return $ S.Yield (z:.k:.l:.j,as:.a,vs:.v) (z:.k:.l:.j,as:.(a+1),vs)
-        Nothing -> return $ S.Done
-  extractStreamLast cnt stream = S.flatten mk step Unknown $ stream where
-    mk (idx,as,vs) = return (idx,as:.0,vs)
-    step (z:.l:.j,as:.a,vs) = do
-      let x = PA.index cnt (Z:.l:.j)
-      case (x VU.!? a) of
-        Just v  -> v `seq` return $ S.Yield (z:.l:.j,as:.a,vs:.v) (z:.l:.j,as:.(a+1),vs)
-        Nothing -> return $ S.Done
-  {-# INLINE extractValue #-}
-  {-# INLINE extractStream #-}
-  {-# INLINE extractStreamLast #-}
-
-
--- * Apply function 'f' with arguments on a stack 'x'.
---
--- NOTE look at the end of this part for mkApply before writing instances by
--- hand... ;-)
-
-class Apply x where
-  type Fun x :: *
-  apply :: Fun x -> x
-
-instance Apply (Z:.a -> res) where
-  type Fun (Z:.a -> res) = a -> res
-  apply fun (Z:.a) = fun a
-  {-# INLINE apply #-}
-
-instance Apply (Z:.a:.b -> res) where
-  type Fun (Z:.a:.b -> res) = a->b -> res
-  apply fun (Z:.a:.b) = fun a b
-  {-# INLINE apply #-}
-
-instance Apply (Z:.a:.b:.c -> res) where
-  type Fun (Z:.a:.b:.c -> res) = a->b->c -> res
-  apply fun (Z:.a:.b:.c) = fun a b c
-  {-# INLINE apply #-}
-
-instance Apply (Z:.a:.b:.c:.d -> res) where
-  type Fun (Z:.a:.b:.c:.d -> res) = a->b->c->d -> res
-  apply fun (Z:.a:.b:.c:.d) = fun a b c d
-  {-# INLINE apply #-}
-
-instance Apply (Z:.a:.b:.c:.d:.e -> res) where
-  type Fun (Z:.a:.b:.c:.d:.e -> res) = a->b->c->d->e -> res
-  apply fun (Z:.a:.b:.c:.d:.e) = fun a b c d e
-  {-# INLINE apply #-}
-
-instance Apply (Z:.a:.b:.c:.d:.e:.f -> res) where
-  type Fun (Z:.a:.b:.c:.d:.e:.f -> res) = a->b->c->d->e->f -> res
-  apply fun (Z:.a:.b:.c:.d:.e:.f) = fun a b c d e f
-  {-# INLINE apply #-}
-
-instance Apply (Z:.a:.b:.c:.d:.e:.f:.g -> res) where
-  type Fun (Z:.a:.b:.c:.d:.e:.f:.g -> res) = a->b->c->d->e->f->g -> res
-  apply fun (Z:.a:.b:.c:.d:.e:.f:.g) = fun a b c d e f g
-  {-# INLINE apply #-}
-
-instance Apply (Z:.a:.b:.c:.d:.e:.f:.g:.h -> res) where
-  type Fun (Z:.a:.b:.c:.d:.e:.f:.g:.h -> res) = a->b->c->d->e->f->g->h -> res
-  apply fun (Z:.a:.b:.c:.d:.e:.f:.g:.h) = fun a b c d e f g h
-  {-# INLINE apply #-}
-
-instance Apply (Z:.a:.b:.c:.d:.e:.f:.g:.h:.i -> res) where
-  type Fun (Z:.a:.b:.c:.d:.e:.f:.g:.h:.i -> res) = a->b->c->d->e->f->g->h->i -> res
-  apply fun (Z:.a:.b:.c:.d:.e:.f:.g:.h:.i) = fun a b c d e f g h i
-  {-# INLINE apply #-}
-
-instance Apply (Z:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j -> res) where
-  type Fun (Z:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j -> res) = a->b->c->d->e->f->g->h->i->j -> res
-  apply fun (Z:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j) = fun a b c d e f g h i j
-  {-# INLINE apply #-}
-
-instance Apply (Z:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j:.k -> res) where
-  type Fun (Z:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j:.k -> res) = a->b->c->d->e->f->g->h->i->j->k -> res
-  apply fun (Z:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j:.k) = fun a b c d e f g h i j k
-  {-# INLINE apply #-}
-
-instance Apply (Z:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j:.k:.l -> res) where
-  type Fun (Z:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j:.k:.l -> res) = a->b->c->d->e->f->g->h->i->j->k->l -> res
-  apply fun (Z:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j:.k:.l) = fun a b c d e f g h i j k l
-  {-# INLINE apply #-}
-
-instance Apply (Z:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j:.k:.l:.m -> res) where
-  type Fun (Z:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j:.k:.l:.m -> res) = a->b->c->d->e->f->g->h->i->j->k->l->m -> res
-  apply fun (Z:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j:.k:.l:.m) = fun a b c d e f g h i j k l m
-  {-# INLINE apply #-}
-
-instance Apply (Z:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j:.k:.l:.m:.n -> res) where
-  type Fun (Z:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j:.k:.l:.m:.n -> res) = a->b->c->d->e->f->g->h->i->j->k->l->m->n -> res
-  apply fun (Z:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j:.k:.l:.m:.n) = fun a b c d e f g h i j k l m n
-  {-# INLINE apply #-}
-
-instance Apply (Z:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j:.k:.l:.m:.n:.o -> res) where
-  type Fun (Z:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j:.k:.l:.m:.n:.o -> res) = a->b->c->d->e->f->g->h->i->j->k->l->m->n->o -> res
-  apply fun (Z:.a:.b:.c:.d:.e:.f:.g:.h:.i:.j:.k:.l:.m:.n:.o) = fun a b c d e f g h i j k l m n o
-  {-# INLINE apply #-}
-
-{-
-mkApply to = do
-  let xs    = ['a' .. to]
-  let args  = concat . (":.":) . intersperse ":." . map (:[]) $ xs
-  let arga  = concat . intersperse "->" . map (:[]) $ xs
-  let args' = intersperse ' ' xs
-  printf "instance Apply (Z%s -> res) where\n" args
-  printf "  type Fun (Z%s -> res) = %s -> res\n" args arga
-  printf "  apply fun (Z%s) = fun %s\n" args args'
-  printf "  {-# INLINE apply #-}\n"
--}
-
-
-
--- * helper stuff
-
-data Box mk step xs ys = Box mk step xs ys
-
-type Idx3 z = z:.Int:.Int:.Int
-
-type Idx2 z = z:.Int:.Int
-
-
-
--- * wrappers for functions instead of arrays as arguments. It can be much
--- cheaper in terms of writing code to just provide a function @DIM2 -> Scalar
--- a@ instead of writing instances for your data structure.
-
-newtype Scalar a = Scalar {unScalar :: a}
-
-newtype ScalarM a = ScalarM {unScalarM :: a}
-
-newtype Vect a = Vect {unVect :: a}
-
-newtype VectM a = VectM {unVectM :: a}
diff --git a/ADP/Fusion/PointL.hs b/ADP/Fusion/PointL.hs
new file mode 100644
--- /dev/null
+++ b/ADP/Fusion/PointL.hs
@@ -0,0 +1,33 @@
+
+-- | This exports everything needed for sequence-based alignment style
+-- algorithms.
+--
+-- Here are some notes on implementation of the Inside and Outside 
+--
+-- X_j     -> S_{j-1} X_{j-1} c_j
+-- Y_{j-1} -> S_?     X_j     c_j
+-- Y_j     -> S_{j+1} X_{j+1} c_{j+1}
+
+module ADP.Fusion.PointL
+  ( module ADP.Fusion.Core
+  , module ADP.Fusion.PointL.Core
+  , module ADP.Fusion.PointL.SynVar.Indices
+--  , module ADP.Fusion.PointL.SynVar.Recursive
+  , module ADP.Fusion.PointL.Term.Chr
+  , module ADP.Fusion.PointL.Term.Deletion
+  , module ADP.Fusion.PointL.Term.Epsilon
+  , module ADP.Fusion.PointL.Term.MultiChr
+  , module ADP.Fusion.PointL.Term.Str
+  ) where
+
+import ADP.Fusion.Core
+
+import ADP.Fusion.PointL.Core
+import ADP.Fusion.PointL.SynVar.Indices
+--import ADP.Fusion.PointL.SynVar.Recursive
+import ADP.Fusion.PointL.Term.Chr
+import ADP.Fusion.PointL.Term.Deletion
+import ADP.Fusion.PointL.Term.Epsilon
+import ADP.Fusion.PointL.Term.MultiChr
+import ADP.Fusion.PointL.Term.Str
+
diff --git a/ADP/Fusion/PointL/Core.hs b/ADP/Fusion/PointL/Core.hs
new file mode 100644
--- /dev/null
+++ b/ADP/Fusion/PointL/Core.hs
@@ -0,0 +1,191 @@
+
+{-# Language MagicHash #-}
+
+module ADP.Fusion.PointL.Core where
+
+import GHC.Generics (Generic, Generic1)
+import Control.DeepSeq
+import Data.Proxy
+import Data.Vector.Fusion.Stream.Monadic (singleton,map,filter,Step(..))
+import Debug.Trace
+import Prelude hiding (map,filter)
+import GHC.Exts
+import GHC.TypeLits
+
+import Data.PrimitiveArray hiding (map)
+
+import ADP.Fusion.Core.Classes
+import ADP.Fusion.Core.Multi
+
+
+
+-- * Contexts, and running indices.
+
+type instance InitialContext (PointL I) = IStatic 0
+
+type instance InitialContext (PointL O) = OStatic 0
+
+type instance InitialContext (PointL C) = Complement
+
+newtype instance RunningIndex (PointL I) = RiPlI Int
+  deriving (Generic)
+
+deriving instance NFData (RunningIndex (PointL I))
+
+data instance RunningIndex (PointL O) = RiPlO !Int !Int
+  deriving (Generic)
+
+newtype instance RunningIndex (PointL C) = RiPlC Int
+  deriving (Generic)
+
+
+
+-- * Inside
+
+-- ** Single-tape
+--
+-- TODO should IStatic do these additional control of @I <=# d@? cf. Epsilon Local.
+
+instance
+  ( Monad m
+  , KnownNat d
+  )
+  ⇒ MkStream m (IStatic d) S (PointL I) where
+  mkStream Proxy S grd (LtPointL (I# u)) (PointL (I# i))
+    = staticCheck# ( grd `andI#` (i >=# 0#) `andI#` (i <=# d) `andI#` (i <=# u) )
+    . singleton . ElmS $ RiPlI 0
+    where (I# d) = fromIntegral $ natVal (Proxy ∷ Proxy d)
+  {-# Inline mkStream #-}
+
+instance
+  ( Monad m
+  , KnownNat d
+  )
+  ⇒ MkStream m (IVariable d) S (PointL I) where
+  mkStream Proxy S grd (LtPointL (I# u)) (PointL (I# i))
+    = staticCheck# (grd `andI#` (i >=# 0#) `andI#` (i <=# u) )
+    . singleton . ElmS $ RiPlI 0
+  {-# Inline mkStream #-}
+
+-- ** Multi-tape
+
+instance
+  ( Monad m
+  , MkStream m ps S is
+  , KnownNat d
+  ) ⇒ MkStream m (ps:.IStatic d) S (is:.PointL I) where
+  mkStream Proxy S grd (lus:..LtPointL (I# u)) (is:.PointL (I# i))
+    = map (\(ElmS e) -> ElmS $ e :.: RiPlI 0)
+    $ mkStream (Proxy ∷ Proxy ps) S (grd `andI#` (i >=# 0#) `andI#` (i <=# d) `andI#` (i <=# u)) lus is
+    --    $ mkStream (Proxy ∷ Proxy ps) S (grd `andI#` (i >=# 0#)) lus is
+    -- NOTE we should optimize which parameters are actually required, the gain is about 10% on the
+    -- NeedlemanWunsch algorithm
+    where (I# d) = fromIntegral $ natVal (Proxy ∷ Proxy d)
+  {-# Inline mkStream #-}
+
+instance
+  ( Monad m
+  , MkStream m ps S is
+  , KnownNat d
+  ) ⇒ MkStream m (ps:.IVariable d) S (is:.PointL I) where
+  mkStream Proxy S grd (lus:..LtPointL (I# u)) (is:.PointL (I# i))
+    = map (\(ElmS e) -> ElmS $ e :.: RiPlI 0)
+    $ mkStream (Proxy ∷ Proxy ps) S (grd `andI#` (i >=# 0#) `andI#` (i <=# u)) lus is
+    --    $ mkStream (Proxy ∷ Proxy ps) S (grd `andI#` (i >=# 0#)) lus is
+  {-# Inline mkStream #-}
+
+
+
+-- * Outside
+
+-- ** Single-tape
+
+instance
+  ( Monad m
+  , KnownNat d
+  ) ⇒ MkStream m (OStatic d) S (PointL O) where
+  mkStream Proxy S grd (LtPointL (I# u)) (PointL (I# i))
+    = staticCheck# (grd `andI#` (i >=# 0#) `andI#` (i +# d ==# u))
+    -- ???  `andI#` (u ==# i)
+    . singleton . ElmS $ RiPlO (I# i) (I# (i +# d))
+    where (I# d) = fromIntegral $ natVal (Proxy ∷ Proxy d)
+  {-# Inline mkStream #-}
+
+instance
+  ( Monad m
+  , KnownNat d
+  ) ⇒ MkStream m (OFirstLeft d) S (PointL O) where
+  mkStream Proxy s grd (LtPointL (I# u)) (PointL (I# i))
+    = staticCheck# (grd `andI#` (i >=# 0#) `andI#` (i +# d <=# u))
+    . singleton . ElmS $ RiPlO (I# i) (I# (i +# d))
+    where (I# d) = fromIntegral $ natVal (Proxy ∷ Proxy d)
+  {-# Inline mkStream #-}
+
+-- ** Multi-tape
+
+instance
+  ( Monad m
+  , MkStream m ps S is
+  , KnownNat d
+  ) ⇒ MkStream m (ps:.OStatic d) S (is:.PointL O) where
+  mkStream Proxy S grd (lus:..LtPointL (I# u)) (is:.PointL (I# i))
+    = map (\(ElmS zi) -> ElmS $ zi :.: RiPlO (I# i) (I# (i +# d)))
+    -- ???  `andI#` (u ==# i)
+    $ mkStream (Proxy ∷ Proxy ps) S (grd `andI#` (i >=# 0#) `andI#` (i +# d ==# u)) lus is
+    where (I# d) = fromIntegral $ natVal (Proxy ∷ Proxy d)
+  {-# Inline mkStream #-}
+
+instance
+  ( Monad m
+  , MkStream m ps S is
+  , KnownNat d
+  ) ⇒ MkStream m (ps:.OFirstLeft d) S (is:.PointL O) where
+  mkStream Proxy S grd (lus:..LtPointL (I# u)) (is:.PointL (I# i))
+    = map (\(ElmS zi) -> ElmS $ zi :.: RiPlO (I# i) (I# (i +# d)))
+    $ mkStream (Proxy ∷ Proxy ps) S (grd `andI#` (i >=# 0#) `andI#` (i +# d <=# u)) lus is
+    where (I# d) = fromIntegral $ natVal (Proxy ∷ Proxy d)
+  {-# Inline mkStream #-}
+
+
+
+-- * Complemented
+
+-- ** Single-tape
+
+instance
+  ( Monad m
+  ) ⇒ MkStream m Complement S (PointL C) where
+  mkStream Proxy S grd (LtPointL (I# u)) (PointL (I# i))
+    = error "write me" -- staticCheck# (grd `andI#` (i >=# 0#) `andI#` (i <=# u)) . singleton . ElmS $ RiPlC (I# i)
+  {-# Inline mkStream #-}
+
+-- ** Multi-tape
+
+instance
+  ( Monad m
+  , MkStream m ps S is
+  ) ⇒ MkStream m (ps:.Complement) S (is:.PointL C) where
+  mkStream Proxy S grd (lus:..LtPointL (I# u)) (is:.PointL (I# i))
+    = error "write me"
+    -- -- = map (\(ElmS zi) → ElmS $ zi :.: RiPlC (I# i))
+    -- -- $ mkStream (Proxy ∷ Proxy ps) S (grd `andI#` (i >=# 0#) `andI#` (i <=# u)) lus is
+  {-# Inline mkStream #-}
+
+
+
+-- * Table index modification
+
+instance (MinSize minSize) ⇒ TableStaticVar pos minSize u (PointL I) where
+  -- NOTE this code used to destroy fusion. If we inline tableStreamIndex
+  -- very late (after 'mkStream', probably) then everything works out.
+  tableStreamIndex Proxy minSz _upperBound (PointL j) = PointL $ j - minSize minSz
+  {-# INLINE [0] tableStreamIndex #-}
+
+instance (MinSize minSize) ⇒ TableStaticVar pos minSize u (PointL O) where
+  tableStreamIndex Proxy minSz _upperBound (PointL j) = PointL $ j - minSize minSz
+  {-# INLINE [0] tableStreamIndex #-}
+
+instance (MinSize minSize) ⇒ TableStaticVar pos minSize u (PointL C) where
+  tableStreamIndex Proxy minSz _upperBound (PointL k) = PointL $ k - minSize minSz
+  {-# INLINE [0] tableStreamIndex #-}
+
diff --git a/ADP/Fusion/PointL/SynVar/Indices.hs b/ADP/Fusion/PointL/SynVar/Indices.hs
new file mode 100644
--- /dev/null
+++ b/ADP/Fusion/PointL/SynVar/Indices.hs
@@ -0,0 +1,139 @@
+
+-- | Index movement for syntactic variables in linear @PointL@ grammars.
+--
+-- Syntactic variables for @PointL@ indices can be both, static and variable.
+-- Static is the default, whenever we have @X -> X a@ where @a@ is a character
+-- or similar. However, we can expect to see @a@ as a string as well. Then, @X@
+-- on the r.h.s. is variable.
+
+module ADP.Fusion.PointL.SynVar.Indices where
+
+import Data.Proxy
+import Data.Vector.Fusion.Stream.Monadic (map,Stream,head,mapM,Step(..),flatten)
+import Data.Vector.Fusion.Util (delay_inline)
+import Debug.Trace
+import Prelude hiding (map,head,mapM)
+
+import Data.PrimitiveArray hiding (map)
+
+import ADP.Fusion.Core
+import ADP.Fusion.Core.SynVar.Indices
+import ADP.Fusion.PointL.Core
+
+
+
+-- * type function for the type of the left position
+
+-- ** Inside
+
+type instance LeftPosTy (IStatic d) (TwITbl b s m arr EmptyOk (PointL I) x) (PointL I) = IVariable d
+type instance LeftPosTy (IStatic d) (TwITblBt b s arr EmptyOk (PointL I) x mB mF r) (PointL I) = IVariable d
+
+type instance LeftPosTy (IVariable d) (TwITbl b s m arr EmptyOk (PointL I) x) (PointL I) = IVariable d
+type instance LeftPosTy (IVariable d) (TwITblBt b s arr EmptyOk (PointL I) x mB mF r) (PointL I) = IVariable d
+
+-- ** Outside
+
+type instance LeftPosTy (OStatic d) (TwITbl b s m arr EmptyOk (PointL O) x) (PointL O) = OFirstLeft d
+type instance LeftPosTy (OStatic d) (TwITblBt b s arr EmptyOk (PointL O) x mB mF r) (PointL O) = OFirstLeft d
+
+-- TODO @OLeftOf@
+
+type instance LeftPosTy (OFirstLeft d) (TwITbl b s m arr EmptyOk (PointL O) x) (PointL O) = TypeError
+  (Text "OFirstLeft is illegal for outside tables. Check your grammars for multiple Outside syntactic variable on the r.h.s!")
+type instance LeftPosTy (OFirstLeft d) (TwITblBt b s arr EmptyOk (PointL O) x mB mF r) (PointL O) = TypeError
+  (Text "OFirstLeft is illegal for outside tables. Check your grammars for multiple Outside syntactic variable on the r.h.s!")
+
+type instance LeftPosTy (OLeftOf d) (TwITbl b s m arr EmptyOk (PointL O) x) (PointL O) = TypeError
+  (Text "OLeftOf is illegal for outside tables. Check your grammars for multiple Outside syntactic variable on the r.h.s!")
+type instance LeftPosTy (OLeftOf d) (TwITblBt s b arr EmptyOk (PointL O) x mB mF r) (PointL O) = TypeError
+  (Text "OLeftOf is illegal for outside tables. Check your grammars for multiple Outside syntactic variable on the r.h.s!")
+
+-- ** Complement. Note that @Complement@ joins inside and outside syntactic
+-- variables.
+
+type instance LeftPosTy Complement (TwITbl b s m arr EmptyOk (PointL I) x) (PointL C) = Complement
+type instance LeftPosTy Complement (TwITblBt b s arr EmptyOk (PointL I) x mB mF r) (PointL C) = Complement
+
+type instance LeftPosTy Complement (TwITbl b s m arr EmptyOk (PointL O) x) (PointL C) = Complement
+type instance LeftPosTy Complement (TwITblBt b s arr EmptyOk (PointL O) x mB mF r) (PointL C) = Complement
+
+
+
+-- * 'AddIndexDense' instances
+
+-- ** Inside
+
+instance
+  ( AddIndexDenseContext ps elm x0 i0 cs c us (PointL I) is (PointL I)
+  , MinSize c
+  )
+  ⇒ AddIndexDense (ps:.IStatic d) elm (cs:.c) (us:.PointL I) (is:.PointL I) where
+  addIndexDenseGo Proxy (cs:._) (ubs:..ub) (us:..u) (is:.i)
+    = map (\(SvS s t y') → SvS s (t:.i) (y' :.: RiPlI (fromPointL i)))
+    . addIndexDenseGo (Proxy ∷ Proxy ps) cs ubs us is
+  {-# Inline addIndexDenseGo #-}
+
+instance
+  ( AddIndexDenseContext ps elm x0 i0 cs c us (PointL I) is (PointL I)
+  , MinSize c
+  )
+  ⇒ AddIndexDense (ps:.IVariable d) elm (cs:.c) (us:.PointL I) (is:.PointL I) where
+  addIndexDenseGo Proxy (cs:.c) (ubs:..ub) (us:..u) (is:.PointL i)
+    = flatten mk step . addIndexDenseGo (Proxy ∷ Proxy ps) cs ubs us is
+    where mk svS = let RiPlI k = getIndex (getIdx $ sS svS {- sIx svS -} ) (Proxy :: PRI is (PointL I))
+                   in  return $ svS :. k
+          step (svS@(SvS s t y') :. k)
+            | k + csize > i = return $ Done
+            | otherwise     = return $ Yield (SvS s (t:.PointL k) (y' :.: RiPlI k)) (svS :. k+1)
+            where csize = minSize c
+          {-# Inline [0] mk   #-}
+          {-# Inline [0] step #-}
+  {-# Inline addIndexDenseGo #-}
+
+
+
+-- ** Outside
+
+instance
+  ( AddIndexDenseContext ps elm x0 i0 cs c us (PointL O) is (PointL O)
+  , MinSize c
+  ) ⇒ AddIndexDense (ps:.OStatic d) elm (cs:.c) (us:.PointL O) (is:.PointL O) where
+  addIndexDenseGo Proxy (cs:._) (ubs:..ub) (us:..u) (is:.i)
+    = map (\(SvS s t y') → let RiPlO oi oo = getIndex (getIdx s) (Proxy :: PRI is (PointL O))
+                           in  SvS s (t:.PointL oo) (y' :.: RiPlO oi oo) )
+    . addIndexDenseGo (Proxy ∷ Proxy ps) cs ubs us is
+  {-# Inline addIndexDenseGo #-}
+
+instance
+  ( AddIndexDenseContext ps elm x0 i0 cs c us (PointL O) is (PointL O)
+  , MinSize c
+  ) ⇒ AddIndexDense (ps:.ORightOf d) elm (cs:.c) (us:.PointL O) (is:.PointL O) where
+  addIndexDenseGo Proxy (cs:._) (ubs:..ub) (us:..u) (is:.i)
+    = map (\(SvS s t y') → let RiPlO oi oo = getIndex (getIdx s) (Proxy :: PRI is (PointL O))
+                           in  SvS s (t:.PointL oo) (y' :.: RiPlO oi oo) )
+    . addIndexDenseGo (Proxy ∷ Proxy ps) cs ubs us is
+  {-# Inline addIndexDenseGo #-}
+
+
+
+-- ** Complement
+
+instance
+  ( AddIndexDenseContext ps elm x0 i0 cs c us (PointL I) is (PointL C)
+  ) ⇒ AddIndexDense (ps:.Complement) elm (cs:.c) (us:.PointL I) (is:.PointL C) where
+  addIndexDenseGo Proxy (cs:._) (ubs:..ub) (us:..u) (is:.i)
+    = map (\(SvS s t y) → let RiPlC k = getIndex (getIdx s) (Proxy :: PRI is (PointL C))
+                          in  SvS s (t:.PointL k) (y :.: RiPlC k) )
+    . addIndexDenseGo (Proxy ∷ Proxy ps) cs ubs us is
+  {-# Inline addIndexDenseGo #-}
+
+instance
+  ( AddIndexDenseContext ps elm x0 i0 cs c us (PointL O) is (PointL C)
+  ) ⇒ AddIndexDense (ps:.Complement) elm (cs:.c) (us:.PointL O) (is:.PointL C) where
+  addIndexDenseGo Proxy (cs:._) (ubs:..ub) (us:..u) (is:.i)
+    = map (\(SvS s t y) → let RiPlC k = getIndex (getIdx s) (Proxy :: PRI is (PointL C))
+                          in  SvS s (t:.PointL k) (y:.:RiPlC k) )
+    . addIndexDenseGo (Proxy ∷ Proxy ps) cs ubs us is
+  {-# Inline addIndexDenseGo #-}
+
diff --git a/ADP/Fusion/PointL/Term/Chr.hs b/ADP/Fusion/PointL/Term/Chr.hs
new file mode 100644
--- /dev/null
+++ b/ADP/Fusion/PointL/Term/Chr.hs
@@ -0,0 +1,81 @@
+
+module ADP.Fusion.PointL.Term.Chr where
+
+import           Data.Proxy
+import           Data.Strict.Tuple
+import           Debug.Trace
+import qualified Data.Vector.Fusion.Stream.Monadic as S
+import qualified Data.Vector.Generic as VG
+import           GHC.Exts
+
+import           Data.PrimitiveArray
+
+import           ADP.Fusion.Core
+import           ADP.Fusion.Core.Term.Chr
+import           ADP.Fusion.PointL.Core
+
+
+
+type instance LeftPosTy (IStatic d) (Chr r x) (PointL I) = IStatic d
+--type instance LeftPosTy (IVariable d) (Chr r x) (PointL I) = IVariable d
+
+type instance LeftPosTy (OStatic d) (Chr r x) (PointL O) = OStatic (d+1)
+
+-- | First try in getting this right with a @termStream@.
+--
+-- TODO use @PointL i@ since this is probably the same for all single-tape
+-- instances with @ElmChr@.
+--
+-- TODO it might even be possible to auto-generate this code via TH.
+
+instance
+  forall pos posLeft m ls r x i
+  . ( TermStream m (Z:.pos) (TermSymbol M (Chr r x)) (Elm (Term1 (Elm ls (PointL i))) (Z :. PointL i)) (Z:.PointL i)
+    , posLeft ~ LeftPosTy pos (Chr r x) (PointL i)
+    , TermStaticVar pos (Chr r x) (PointL i)
+    , MkStream m posLeft ls (PointL i)
+    )
+  ⇒ MkStream m pos (ls :!: Chr r x) (PointL i) where
+  mkStream pos (ls :!: Chr f xs) grd us is
+    = S.map (\(ss,ee,ii) -> ElmChr ee ii ss) -- recover ElmChr
+    . addTermStream1 pos (Chr f xs) us is
+    $ mkStream (Proxy ∷ Proxy posLeft) ls (termStaticCheck pos (Chr f xs) us is grd) us (termStreamIndex pos (Chr f xs) is)
+  {-# Inline mkStream #-}
+
+
+-- | 
+
+instance
+  ( TermStreamContext m ps ts s x0 i0 is (PointL I)
+  ) => TermStream m (ps:.IStatic d) (TermSymbol ts (Chr r x)) s (is:.PointL I) where
+  termStream Proxy (ts:|Chr f xs) (us:..LtPointL u) (is:.PointL i)
+    -- NOTE changing from @f xs (i-1)@ to @f xs $! i-1@, forcing @i-1@ first,
+    -- yielding 50% better performance in Needleman-Wunsch
+    = S.map (\(TState s ii ee) -> TState s (ii:.:RiPlI i) (ee:. (f xs $! i-1)))
+    . termStream (Proxy ∷ Proxy ps) ts us is
+  {-# Inline termStream #-}
+
+instance
+  ( TermStreamContext m ps ts s x0 i0 is (PointL O)
+  ) => TermStream m (ps:.OStatic d) (TermSymbol ts (Chr r x)) s (is:.PointL O) where
+  termStream Proxy (ts:|Chr f xs) (us:..LtPointL u) (is:.PointL i)
+    = S.map (\(TState s ii ee) ->
+                let RiPlO k o = getIndex (getIdx s) (Proxy :: PRI is (PointL O))
+                in  TState s (ii:.: RiPlO (k+1) o) (ee:.f xs k))
+    . termStream (Proxy ∷ Proxy ps) ts us is
+  {-# Inline termStream #-}
+
+
+
+instance TermStaticVar (IStatic d) (Chr r x) (PointL I) where
+  termStreamIndex Proxy (Chr f x) (PointL j) = PointL $! j-1
+  termStaticCheck Proxy (Chr f x) _ (PointL j) grd = grd
+  {-# Inline [0] termStreamIndex #-}
+  {-# Inline [0] termStaticCheck #-}
+
+instance TermStaticVar (OStatic d) (Chr r x) (PointL O) where
+  termStreamIndex Proxy (Chr f x) (PointL j) = PointL $ j
+  termStaticCheck Proxy (Chr f x) _ (PointL j) grd = grd
+  {-# Inline [0] termStreamIndex #-}
+  {-# Inline [0] termStaticCheck #-}
+
diff --git a/ADP/Fusion/PointL/Term/Deletion.hs b/ADP/Fusion/PointL/Term/Deletion.hs
new file mode 100644
--- /dev/null
+++ b/ADP/Fusion/PointL/Term/Deletion.hs
@@ -0,0 +1,85 @@
+
+module ADP.Fusion.PointL.Term.Deletion where
+
+import           Data.Proxy
+import           Data.Strict.Tuple
+import qualified Data.Vector.Fusion.Stream.Monadic as S
+import           GHC.Exts
+
+import           Data.PrimitiveArray
+
+import           ADP.Fusion.Core
+import           ADP.Fusion.Core.Term.Deletion
+import           ADP.Fusion.PointL.Core
+
+
+
+type instance LeftPosTy (IStatic   d) Deletion (PointL I) = IStatic d
+type instance LeftPosTy (IVariable d) Deletion (PointL I) = IVariable d
+
+type instance LeftPosTy (OStatic d) Deletion (PointL O) = OStatic d
+
+instance
+  forall pos posLeft m ls i
+  . ( TermStream m (Z:.pos) (TermSymbol M Deletion) (Elm (Term1 (Elm ls (PointL i))) (Z :. PointL i)) (Z:.PointL i)
+    , posLeft ~ LeftPosTy pos Deletion (PointL i)
+    , TermStaticVar pos Deletion (PointL i)
+    , MkStream m posLeft ls (PointL i)
+    )
+  ⇒ MkStream m pos (ls :!: Deletion) (PointL i) where
+  mkStream pos (ls :!: Deletion) grd us is
+    = S.map (\(ss,ee,ii) -> ElmDeletion ii ss)
+    . addTermStream1 pos Deletion us is
+    $ mkStream (Proxy ∷ Proxy posLeft) ls (termStaticCheck pos Deletion us is grd) us (termStreamIndex pos Deletion is)
+  {-# Inline mkStream #-}
+
+
+
+instance
+  ( TermStreamContext m ps ts s x0 i0 is (PointL I)
+  )
+  ⇒ TermStream m (ps:.IStatic d) (TermSymbol ts Deletion) s (is:.PointL I) where
+  termStream Proxy (ts:|Deletion) (us:..LtPointL u) (is:.PointL i)
+    = S.map (\(TState s ii ee) -> TState s (ii:.:RiPlI i) (ee:.()))
+    . termStream (Proxy ∷ Proxy ps) ts us is
+  {-# Inline termStream #-}
+
+instance
+  ( TermStreamContext m ps ts s x0 i0 is (PointL I)
+  )
+  ⇒ TermStream m (ps:.IVariable d) (TermSymbol ts Deletion) s (is:.PointL I) where
+  termStream Proxy (ts:|Deletion) (us:..LtPointL u) (is:.PointL i)
+    = S.map (\(TState s ii ee) -> TState s (ii:.:RiPlI i) (ee:.()))
+    . termStream (Proxy ∷ Proxy ps) ts us is
+  {-# Inline termStream #-}
+
+instance
+  ( TermStreamContext m ps ts s x0 i0 is (PointL O)
+  ) => TermStream m (ps:.OStatic d) (TermSymbol ts Deletion) s (is:.PointL O) where
+  termStream Proxy (ts:|Deletion) (us:..LtPointL u) (is:.PointL i)
+    = S.map (\(TState s ii ee) ->
+                let io = getIndex (getIdx s) (Proxy :: PRI is (PointL O))
+                in  TState s (ii:.: io) (ee:.()))
+    . termStream (Proxy ∷ Proxy ps) ts us is
+  {-# Inline termStream #-}
+
+
+
+instance TermStaticVar (IStatic d) Deletion (PointL I) where
+  termStreamIndex Proxy Deletion (PointL j) = PointL j
+  termStaticCheck Proxy Deletion _ (PointL j) grd = grd
+  {-# Inline [0] termStreamIndex #-}
+  {-# Inline [0] termStaticCheck #-}
+
+instance TermStaticVar (IVariable d) Deletion (PointL I) where
+  termStreamIndex Proxy Deletion (PointL j) = PointL j
+  termStaticCheck Proxy Deletion _ (PointL j) grd = grd
+  {-# Inline [0] termStreamIndex #-}
+  {-# Inline [0] termStaticCheck #-}
+
+instance TermStaticVar oAny Deletion (PointL O) where
+  termStreamIndex Proxy Deletion (PointL j) = PointL j
+  termStaticCheck Proxy Deletion _ (PointL j) grd = grd
+  {-# Inline [0] termStreamIndex #-}
+  {-# Inline [0] termStaticCheck #-}
+
diff --git a/ADP/Fusion/PointL/Term/Epsilon.hs b/ADP/Fusion/PointL/Term/Epsilon.hs
new file mode 100644
--- /dev/null
+++ b/ADP/Fusion/PointL/Term/Epsilon.hs
@@ -0,0 +1,119 @@
+
+-- | Rules of the type @X → ε@ denote termination of parsing if @X@ is empty.
+
+module ADP.Fusion.PointL.Term.Epsilon where
+
+import           Data.Proxy
+import           Data.Strict.Tuple
+import qualified Data.Vector.Fusion.Stream.Monadic as S
+import           GHC.Exts
+
+import           Data.PrimitiveArray
+
+import           ADP.Fusion.Core
+import           ADP.Fusion.Core.Term.Epsilon
+import           ADP.Fusion.PointL.Core
+
+
+
+type instance LeftPosTy (IStatic d) (Epsilon Global) (PointL I) = IStatic d
+type instance LeftPosTy (IStatic d) (Epsilon Local) (PointL I) = IVariable d  -- to actually allow local epsilons to work, IStatic does additional static controls
+--type instance LeftPosTy (IVariable d) Epsilon (PointL I) = IVariable d
+
+type instance LeftPosTy (OStatic d) (Epsilon Global) (PointL O) = OStatic d
+
+instance
+  forall pos posLeft m ls i lg
+  . ( TermStream m (Z:.pos) (TermSymbol M (Epsilon lg)) (Elm (Term1 (Elm ls (PointL i))) (Z :. PointL i)) (Z:.PointL i)
+    , posLeft ~ LeftPosTy pos (Epsilon lg) (PointL i)
+    , TermStaticVar pos (Epsilon lg) (PointL i)
+    , MkStream m posLeft ls (PointL i)
+    )
+  ⇒ MkStream m pos (ls :!: (Epsilon lg)) (PointL i) where
+  mkStream Proxy (ls :!: Epsilon) grd us is
+    = S.map (\(ss,ee,ii) -> ElmEpsilon ii ss)
+    . addTermStream1 (Proxy ∷ Proxy pos) (Epsilon @lg) us is
+    $ mkStream (Proxy ∷ Proxy posLeft)
+               ls
+               (termStaticCheck (Proxy ∷ Proxy pos) (Epsilon @lg) us is grd)
+               us
+               (termStreamIndex (Proxy ∷ Proxy pos) (Epsilon @lg) is)
+  {-# Inline mkStream #-}
+
+
+instance
+  ( TermStreamContext m ps ts s x0 i0 is (PointL I)
+  )
+  ⇒ TermStream m (ps:.IStatic d) (TermSymbol ts (Epsilon lg)) s (is:.PointL I) where
+  termStream Proxy (ts:|Epsilon) (us:..LtPointL u) (is:.PointL i)
+    = S.map (\(TState s ii ee) ->
+              let RiPlI k = getIndex (getIdx s) (Proxy :: PRI is (PointL I))
+              in  TState s (ii:.:RiPlI k) (ee:.()))
+    . termStream (Proxy ∷ Proxy ps) ts us is
+  {-# Inline termStream #-}
+
+{-
+instance
+  ( TermStreamContext m ps ts s x0 i0 is (PointL I)
+  )
+  ⇒ TermStream m (ps:.IVariable d) (TermSymbol ts Epsilon) s (is:.PointL I) where
+  termStream Proxy (ts:|Epsilon) (us:..LtPointL u) (is:.PointL i)
+    = S.map (\(TState s ii ee) ->
+              let RiPlI k = getIndex (getIdx s) (Proxy :: PRI is (PointL I))
+              in  TState s (ii:.:RiPlI k) (ee:.()))
+    . termStream (Proxy ∷ Proxy ps) ts us is
+  {-# Inline termStream #-}
+-}
+
+instance
+  ( TermStreamContext m ps ts s x0 i0 is (PointL O)
+  ) => TermStream m (ps:.OStatic d) (TermSymbol ts (Epsilon lg)) s (is:.PointL O) where
+  termStream Proxy (ts:|Epsilon) (us:..LtPointL u) (is:.PointL i)
+    = S.map (\(TState s ii ee) ->
+                let io = getIndex (getIdx s) (Proxy :: PRI is (PointL O))
+                in  TState s (ii:.:io) (ee:.()))
+    . termStream (Proxy ∷ Proxy ps) ts us is
+  {-# Inline termStream #-}
+
+-- | We assume that @ε / Epsilon@ is ever only the single symbol (maybe apart
+-- from @- / Deletion@) on a tape. Hence The instance is only active in
+-- @IStatic 0@ cases.
+
+instance TermStaticVar (IStatic 0) (Epsilon Global) (PointL I) where
+  termStreamIndex Proxy Epsilon (PointL i     ) = PointL i
+  termStaticCheck Proxy Epsilon _ (PointL (I# i)) grd = (i ==# 0#) `andI#` grd
+  {-# Inline [0] termStreamIndex #-}
+  {-# Inline [0] termStaticCheck #-}
+
+instance TermStaticVar (IStatic 0) (Epsilon Local) (PointL I) where
+  termStreamIndex Proxy Epsilon (PointL i     ) = PointL i
+  -- | Local epsilons are *always* possible.
+  termStaticCheck Proxy Epsilon _ (PointL (I# i)) grd = grd
+  {-# Inline termStreamIndex #-}
+  {-# Inline termStaticCheck #-}
+
+instance TermStaticVar (OStatic 0) (Epsilon Global) (PointL O) where
+  termStreamIndex Proxy Epsilon (PointL i     ) = PointL i
+  -- |
+  --
+  -- TODO Consider this as a potential bug: we do *not* check that the upper
+  -- bound @us@ (which we not even hand over to termStaticCheck but should) is
+  -- equal to the current index @i@. HERE this ends up not being a bug because
+  -- @Epsilon@ keeps the positional system at @OStatic@ and does not move to
+  -- @ORightOf@ or anything, and in correct epsilon rules, everything is fine.
+  --
+  -- We even end up being correct with @X -> whatever epsilon@ because epsilon
+  -- is neutral ...
+  --
+  -- TODO But we should probably statically assert that epsilon is the only
+  -- symbol on the r.h.s. of whatever we write ...
+  termStaticCheck Proxy Epsilon (LtPointL (I# u)) (PointL (I# i)) grd = (u ==# i) `andI#` grd
+  {-# Inline [0] termStreamIndex #-}
+  {-# Inline [0] termStaticCheck #-}
+
+instance TermStaticVar (OStatic 0) (Epsilon Local) (PointL O) where
+  termStreamIndex Proxy Epsilon (PointL i     ) = PointL i
+  termStaticCheck Proxy Epsilon (LtPointL (I# u)) (PointL (I# i)) grd = grd
+  {-# Inline [0] termStreamIndex #-}
+  {-# Inline [0] termStaticCheck #-}
+
diff --git a/ADP/Fusion/PointL/Term/MultiChr.hs b/ADP/Fusion/PointL/Term/MultiChr.hs
new file mode 100644
--- /dev/null
+++ b/ADP/Fusion/PointL/Term/MultiChr.hs
@@ -0,0 +1,85 @@
+
+module ADP.Fusion.PointL.Term.MultiChr where
+
+import           Data.Proxy
+import           Data.Strict.Tuple
+import           Debug.Trace
+import           GHC.Exts
+--import           GHC.TypeNats
+import qualified Data.Vector.Fusion.Stream.Monadic as S
+import qualified Data.Vector.Generic as VG
+
+import           Data.PrimitiveArray
+
+import           ADP.Fusion.Core
+import           ADP.Fusion.Core.Term.MultiChr
+import           ADP.Fusion.PointL.Core
+
+
+
+type instance LeftPosTy (IStatic d) (MultiChr c v x) (PointL I) = IStatic d
+--type instance LeftPosTy (IVariable d) (Chr r x) (PointL I) = IVariable d
+
+type instance LeftPosTy (OStatic d) (MultiChr c v x) (PointL O) = OStatic (d + c)
+
+-- | First try in getting this right with a @termStream@.
+--
+-- TODO use @PointL i@ since this is probably the same for all single-tape
+-- instances with @ElmChr@.
+--
+-- TODO it might even be possible to auto-generate this code via TH.
+
+instance
+  forall pos posLeft m ls c v x i
+  . ( TermStream m (Z:.pos) (TermSymbol M (MultiChr c v x)) (Elm (Term1 (Elm ls (PointL i))) (Z :. PointL i)) (Z:.PointL i)
+    , posLeft ~ LeftPosTy pos (MultiChr c v x) (PointL i)
+    , TermStaticVar pos (MultiChr c v x) (PointL i)
+    , MkStream m posLeft ls (PointL i)
+    )
+  ⇒ MkStream m pos (ls :!: MultiChr c v x) (PointL i) where
+  mkStream pos (ls :!: MultiChr xs) grd us is
+    = S.map (\(ss,ee,ii) -> ElmMultiChr ee ii ss) -- recover ElmChr
+    . addTermStream1 pos (MultiChr @v @x @c xs) us is
+    $ mkStream (Proxy ∷ Proxy posLeft) ls (termStaticCheck pos (MultiChr @v @x @c xs) us is grd) us (termStreamIndex pos (MultiChr @v @x @c xs) is)
+  {-# Inline mkStream #-}
+
+
+-- | 
+
+instance
+  ( TermStreamContext m ps ts s x0 i0 is (PointL I)
+  , KnownNat c
+  ) => TermStream m (ps:.IStatic d) (TermSymbol ts (MultiChr c v x)) s (is:.PointL I) where
+  termStream Proxy (ts:|MultiChr xs) (us:..LtPointL u) (is:.PointL i)
+    = let !c = fromIntegral $ natVal (Proxy ∷ Proxy c) in
+      S.map (\(TState s ii ee) -> TState s (ii:.:RiPlI i) (ee:. VG.unsafeSlice (i-c) c xs))
+    . termStream (Proxy ∷ Proxy ps) ts us is
+  {-# Inline termStream #-}
+
+instance
+  ( TermStreamContext m ps ts s x0 i0 is (PointL O)
+  , KnownNat c
+  ) => TermStream m (ps:.OStatic d) (TermSymbol ts (MultiChr c v x)) s (is:.PointL O) where
+  termStream Proxy (ts:|MultiChr xs) (us:..LtPointL u) (is:.PointL i)
+    = S.map (\(TState s ii ee) ->
+                let RiPlO k o = getIndex (getIdx s) (Proxy :: PRI is (PointL O))
+                    c = fromIntegral $ natVal (Proxy ∷ Proxy c)
+                in  TState s (ii:.: RiPlO (k+c) o) (ee:.VG.unsafeSlice k c xs))
+    . termStream (Proxy ∷ Proxy ps) ts us is
+  {-# Inline termStream #-}
+
+
+
+instance (KnownNat c) ⇒ TermStaticVar (IStatic d) (MultiChr c v x) (PointL I) where
+  termStreamIndex Proxy (MultiChr x) (PointL j) = PointL $ j-(fromIntegral $ natVal (Proxy ∷ Proxy c))
+  termStaticCheck Proxy (MultiChr x) _ (PointL j) grd = grd
+  {-# Inline [0] termStreamIndex #-}
+  {-# Inline [0] termStaticCheck #-}
+
+instance TermStaticVar (OStatic d) (MultiChr c v x) (PointL O) where
+  termStreamIndex Proxy (MultiChr x) (PointL j) = PointL $ j
+  -- | TODO check if @c@ to the right goes out of bounds?
+  termStaticCheck Proxy (MultiChr x) _ (PointL j) grd = grd
+  {-# Inline [0] termStreamIndex #-}
+  {-# Inline [0] termStaticCheck #-}
+
diff --git a/ADP/Fusion/PointL/Term/Str.hs b/ADP/Fusion/PointL/Term/Str.hs
new file mode 100644
--- /dev/null
+++ b/ADP/Fusion/PointL/Term/Str.hs
@@ -0,0 +1,87 @@
+
+module ADP.Fusion.PointL.Term.Str where
+
+import           Data.Proxy
+import           Data.Strict.Tuple
+import           Debug.Trace
+import           GHC.Exts
+--import           GHC.TypeNats
+import qualified Data.Vector.Fusion.Stream.Monadic as S
+import qualified Data.Vector.Generic as VG
+
+import           Data.PrimitiveArray
+
+import           ADP.Fusion.Core
+import           ADP.Fusion.Core.Term.Str
+import           ADP.Fusion.PointL.Core
+
+
+
+-- minSz done via TermStaticVar ?!
+
+type instance LeftPosTy (IStatic   d) (Str linked minSz maxSz v x) (PointL I) = IVariable d
+type instance LeftPosTy (IVariable d) (Str linked minSz maxSz v x) (PointL I) = IVariable d
+
+{-
+type instance LeftPosTy (OStatic d) (Chr r x) (PointL O) = OStatic (d+1)
+-}
+
+-- | 
+
+instance
+  forall pos posLeft m ls linked minSz maxSz v x i
+  . ( TermStream m (Z:.pos) (TermSymbol M (Str linked minSz maxSz v x))
+                 (Elm (Term1 (Elm ls (PointL i))) (Z :. PointL i)) (Z:.PointL i)
+    , posLeft ~ LeftPosTy pos (Str linked minSz maxSz v x) (PointL i)
+    , TermStaticVar pos (Str linked minSz maxSz v x) (PointL i)
+    , MkStream m posLeft ls (PointL i)
+    )
+  ⇒ MkStream m pos (ls :!: Str linked minSz maxSz v x) (PointL i) where
+  mkStream pos (ls :!: Str xs) grd us is
+    = S.map (\(ss,ee,ii) -> ElmStr ee ii ss) -- recover ElmChr
+    . addTermStream1 pos (Str @v @x @linked @minSz @maxSz xs) us is
+    $ mkStream (Proxy ∷ Proxy posLeft) ls
+               (termStaticCheck pos (Str @v @x @linked @minSz @maxSz xs) us is grd)
+               us (termStreamIndex pos (Str @v @x @linked @minSz @maxSz xs) is)
+  {-# Inline mkStream #-}
+
+-- | Note that the @minSz@ should automatically work out due to the encoding in
+-- @d@.
+
+instance
+  ( TermStreamContext m ps ts s x0 i0 is (PointL I)
+  ) ⇒ TermStream m (ps:.IStatic d) (TermSymbol ts (Str Nothing minSz Nothing v x)) s (is:.PointL I) where
+  termStream Proxy (ts:|Str xs) (us:..LtPointL u) (is:.PointL i)
+    = S.map (\(TState s ii ee) →
+                let RiPlI k = getIndex (getIdx s) (Proxy ∷ PRI is (PointL I))
+                in  TState s (ii:.:RiPlI i) (ee:.VG.slice k (i-k) xs))
+    . termStream (Proxy ∷ Proxy ps) ts us is
+  {-# Inline termStream #-}
+
+{-
+instance
+  ( TermStreamContext m ps ts s x0 i0 is (PointL O)
+  ) => TermStream m (ps:.OStatic d) (TermSymbol ts (Chr r x)) s (is:.PointL O) where
+  termStream Proxy (ts:|Chr f xs) (us:..LtPointL u) (is:.PointL i)
+    = S.map (\(TState s ii ee) ->
+                let RiPlO k o = getIndex (getIdx s) (Proxy :: PRI is (PointL O))
+                in  TState s (ii:.: RiPlO (k+1) o) (ee:.f xs k))
+    . termStream (Proxy ∷ Proxy ps) ts us is
+  {-# Inline termStream #-}
+-}
+
+instance (KnownNat minSz)
+  ⇒ TermStaticVar (IStatic d) (Str Nothing minSz Nothing v x) (PointL I) where
+  termStreamIndex Proxy (Str xs) (PointL j) = PointL $ j - fromIntegral (natVal (Proxy ∷ Proxy minSz))
+  termStaticCheck Proxy (Str xs) _ (PointL j) grd = grd
+  {-# Inline [0] termStreamIndex #-}
+  {-# Inline [0] termStaticCheck #-}
+
+{-
+instance TermStaticVar (OStatic d) (Chr r x) (PointL O) where
+  termStreamIndex Proxy (Chr f x) (PointL j) = PointL $ j
+  termStaticCheck Proxy (Chr f x) (PointL j) = 1#
+  {-# Inline [0] termStreamIndex #-}
+  {-# Inline [0] termStaticCheck #-}
+-}
+
diff --git a/ADP/Fusion/PointL/Term/Switch.hs b/ADP/Fusion/PointL/Term/Switch.hs
new file mode 100644
--- /dev/null
+++ b/ADP/Fusion/PointL/Term/Switch.hs
@@ -0,0 +1,75 @@
+
+module ADP.Fusion.PointL.Term.Switch where
+
+import           Data.Proxy
+import           Data.Strict.Tuple
+import           Debug.Trace
+import qualified Data.Vector.Fusion.Stream.Monadic as S
+import qualified Data.Vector.Generic as VG
+import           GHC.Exts
+
+import           Data.PrimitiveArray
+
+import           ADP.Fusion.Core
+import           ADP.Fusion.Core.Term.Switch
+import           ADP.Fusion.PointL.Core
+
+
+
+type instance LeftPosTy (IStatic   d) Switch (PointL I) = IStatic   d
+type instance LeftPosTy (IVariable d) Switch (PointL I) = IVariable d
+
+type instance LeftPosTy (OStatic d) Switch (PointL O) = OStatic d
+
+-- | 
+
+instance
+  forall pos posLeft m ls r x i
+  . ( TermStream m (Z:.pos) (TermSymbol M Switch) (Elm (Term1 (Elm ls (PointL i))) (Z :. PointL i)) (Z:.PointL i)
+    , posLeft ~ LeftPosTy pos Switch (PointL i)
+    , TermStaticVar pos Switch (PointL i)
+    , MkStream m posLeft ls (PointL i)
+    )
+  ⇒ MkStream m pos (ls :!: Switch) (PointL i) where
+  mkStream pos (ls :!: Switch s) grd us is
+    = S.map (\(ss,ee,ii) -> ElmSwitch ii ss) -- recover ElmChr
+    . addTermStream1 pos (Switch s) us is
+    $ mkStream (Proxy ∷ Proxy posLeft) ls (termStaticCheck pos (Switch s) us is grd) us (termStreamIndex pos (Switch s) is)
+  {-# Inline mkStream #-}
+
+
+-- | 
+
+instance
+  ( TermStreamContext m ps ts s x0 i0 is (PointL I)
+  ) => TermStream m (ps:.IStatic d) (TermSymbol ts Switch) s (is:.PointL I) where
+  termStream Proxy (ts:|Switch s) (us:..LtPointL u) (is:.PointL i)
+    = S.map (\(TState s ii ee) -> TState s (ii:.:RiPlI i) (ee:. ()))
+    . termStream (Proxy ∷ Proxy ps) ts us is
+  {-# Inline termStream #-}
+
+instance
+  ( TermStreamContext m ps ts s x0 i0 is (PointL O)
+  ) => TermStream m (ps:.OStatic d) (TermSymbol ts Switch) s (is:.PointL O) where
+  termStream Proxy (ts:|Switch s) (us:..LtPointL u) (is:.PointL i)
+    = S.map (\(TState s ii ee) ->
+                let ko = getIndex (getIdx s) (Proxy :: PRI is (PointL O))
+                in  TState s (ii:.:ko) (ee:.()))
+    . termStream (Proxy ∷ Proxy ps) ts us is
+  {-# Inline termStream #-}
+
+
+
+instance TermStaticVar (IStatic d) Switch (PointL I) where
+  termStreamIndex Proxy (Switch s) (PointL j) = PointL $ j
+  -- TODO is trac #15696 a problem here?
+  termStaticCheck Proxy (Switch s) _ (PointL j) grd = dataToTag# s `andI#` grd -- case s of {Enabled → grd; Disabled → 0# }
+  {-# Inline [0] termStreamIndex #-}
+  {-# Inline [0] termStaticCheck #-}
+
+instance TermStaticVar (OStatic d) Switch (PointL O) where
+  termStreamIndex Proxy (Switch s) (PointL j) = PointL $ j
+  termStaticCheck Proxy (Switch s) _ (PointL j) grd = case s of {Enabled → grd; Disabled → 0# }
+  {-# Inline [0] termStreamIndex #-}
+  {-# Inline [0] termStaticCheck #-}
+
diff --git a/ADP/Fusion/PointR.hs b/ADP/Fusion/PointR.hs
new file mode 100644
--- /dev/null
+++ b/ADP/Fusion/PointR.hs
@@ -0,0 +1,29 @@
+
+-- | This exports everything needed for sequence-based alignment style
+-- algorithms.
+--
+-- Here are some notes on implementation of the Inside and Outside 
+--
+-- X_j     -> S_{j-1} X_{j-1} c_j
+-- Y_{j-1} -> S_?     X_j     c_j
+-- Y_j     -> S_{j+1} X_{j+1} c_{j+1}
+
+module ADP.Fusion.PointR
+  ( module ADP.Fusion.Core
+  , module ADP.Fusion.PointR.Core
+  , module ADP.Fusion.PointR.SynVar.Indices
+  , module ADP.Fusion.PointR.Term.Chr
+  , module ADP.Fusion.PointR.Term.Deletion
+  , module ADP.Fusion.PointR.Term.Epsilon
+  , module ADP.Fusion.PointR.Term.MultiChr
+  ) where
+
+import ADP.Fusion.Core
+
+import ADP.Fusion.PointR.Core
+import ADP.Fusion.PointR.SynVar.Indices
+import ADP.Fusion.PointR.Term.Chr
+import ADP.Fusion.PointR.Term.Deletion
+import ADP.Fusion.PointR.Term.Epsilon
+import ADP.Fusion.PointR.Term.MultiChr
+
diff --git a/ADP/Fusion/PointR/Core.hs b/ADP/Fusion/PointR/Core.hs
new file mode 100644
--- /dev/null
+++ b/ADP/Fusion/PointR/Core.hs
@@ -0,0 +1,121 @@
+
+{-# Language MagicHash #-}
+
+module ADP.Fusion.PointR.Core where
+
+import GHC.Generics (Generic, Generic1)
+import Control.DeepSeq
+import Data.Proxy
+import Data.Vector.Fusion.Stream.Monadic (singleton,map,filter,Step(..))
+import Debug.Trace
+import Prelude hiding (map,filter)
+import GHC.Exts
+import GHC.TypeLits
+
+import Data.PrimitiveArray hiding (map)
+
+import ADP.Fusion.Core.Classes
+import ADP.Fusion.Core.Multi
+
+
+
+-- * Contexts, and running indices.
+
+type instance InitialContext (PointR I) = IStatic 0
+
+type instance InitialContext (PointR O) = OStatic 0
+
+type instance InitialContext (PointR C) = Complement
+
+newtype instance RunningIndex (PointR I) = RiPrI Int
+  deriving (Generic)
+
+deriving instance NFData (RunningIndex (PointR I))
+
+data instance RunningIndex (PointR O) = RiPrO !Int !Int
+  deriving (Generic)
+
+newtype instance RunningIndex (PointR C) = RiPrC Int
+  deriving (Generic)
+
+
+
+-- * Inside
+
+-- ** Single-tape
+
+instance
+  ( Monad m
+  , KnownNat d
+  )
+  ⇒ MkStream m (IStatic d) S (PointR I) where
+  mkStream Proxy S grd (LtPointR (I# u)) (PointR (I# i))
+    = staticCheck# ( grd `andI#` (i >=# 0#) `andI#` (i +# d ==# u) )   -- TODO include @d@ correctly: i<=d
+    . singleton . ElmS . RiPrI $ I# i
+    where (I# d) = fromIntegral $ natVal (Proxy ∷ Proxy d)
+  {-# Inline mkStream #-}
+
+instance
+  ( Monad m
+  , KnownNat d
+  )
+  ⇒ MkStream m (IVariable d) S (PointR I) where
+  mkStream Proxy S grd (LtPointR (I# u)) (PointR (I# i))
+    = staticCheck# (grd `andI#` (i >=# 0#) `andI#` (i +# d <=# u))
+    . singleton . ElmS . RiPrI $ I# i
+    where (I# d) = fromIntegral $ natVal (Proxy ∷ Proxy d)
+  {-# Inline mkStream #-}
+
+
+
+-- ** Multi-tape
+
+instance
+  ( Monad m
+  , MkStream m ps S is
+  , KnownNat d
+  ) ⇒ MkStream m (ps:.IStatic d) S (is:.PointR I) where
+  mkStream Proxy S grd (lus:..LtPointR (I# u)) (is:.PointR (I# i))
+    = map (\(ElmS e) -> ElmS $ e :.: RiPrI (I# i))
+    $ mkStream (Proxy ∷ Proxy ps) S (grd `andI#` (i >=# 0#) `andI#` (i +# d ==# u)) lus is
+    where (I# d) = fromIntegral $ natVal (Proxy ∷ Proxy d)
+  {-# Inline mkStream #-}
+
+instance
+  ( Monad m
+  , MkStream m ps S is
+  , KnownNat d
+  ) ⇒ MkStream m (ps:.IVariable d) S (is:.PointR I) where
+  mkStream Proxy S grd (lus:..LtPointR (I# u)) (is:.PointR (I# i))
+    = map (\(ElmS e) -> ElmS $ e :.: RiPrI (I# i))
+    $ mkStream (Proxy ∷ Proxy ps) S (grd `andI#` (i >=# 0#) `andI#` (i +# d <=# u)) lus is
+    where (I# d) = fromIntegral $ natVal (Proxy ∷ Proxy d)
+  {-# Inline mkStream #-}
+
+
+
+-- * Outside
+
+-- ** Single-tape
+
+
+
+
+-- * Complemented
+
+-- ** Single-tape
+
+
+-- ** Multi-tape
+
+
+
+
+-- * Table index modification
+
+instance (MinSize minSize) ⇒ TableStaticVar pos minSize u (PointR I) where
+  -- NOTE this code used to destroy fusion. If we inline tableStreamIndex
+  -- very late (after 'mkStream', probably) then everything works out.
+  tableStreamIndex Proxy minSz _upperBound (PointR j) = PointR $ j + minSize minSz
+  {-# INLINE [0] tableStreamIndex #-}
+
diff --git a/ADP/Fusion/PointR/SynVar/Indices.hs b/ADP/Fusion/PointR/SynVar/Indices.hs
new file mode 100644
--- /dev/null
+++ b/ADP/Fusion/PointR/SynVar/Indices.hs
@@ -0,0 +1,44 @@
+
+-- | Index movement for syntactic variables in linear @PointL@ grammars.
+--
+-- Syntactic variables for @PointL@ indices can be both, static and variable.
+-- Static is the default, whenever we have @X -> X a@ where @a@ is a character
+-- or similar. However, we can expect to see @a@ as a string as well. Then, @X@
+-- on the r.h.s. is variable.
+
+module ADP.Fusion.PointR.SynVar.Indices where
+
+import Data.Proxy
+import Data.Vector.Fusion.Stream.Monadic (map,Stream,head,mapM,Step(..),flatten)
+import Data.Vector.Fusion.Util (delay_inline)
+import Debug.Trace
+import Prelude hiding (map,head,mapM)
+
+import Data.PrimitiveArray hiding (map)
+
+import ADP.Fusion.Core
+import ADP.Fusion.Core.SynVar.Indices
+import ADP.Fusion.PointR.Core
+
+
+
+type instance LeftPosTy (IStatic d) (TwITbl b s m arr EmptyOk (PointR I) x) (PointR I) = IVariable d
+type instance LeftPosTy (IStatic d) (TwITblBt b s arr EmptyOk (PointR I) x mB mF r) (PointR I) = IVariable d
+
+type instance LeftPosTy (IVariable d) (TwITbl b s m arr EmptyOk (PointR I) x) (PointR I) = IVariable d
+type instance LeftPosTy (IVariable d) (TwITblBt b s arr EmptyOk (PointR I) x mB mF r) (PointR I) = IVariable d
+
+
+
+instance
+  ( AddIndexDenseContext ps elm x0 i0 cs c us (PointR I) is (PointR I)
+  , MinSize c
+  )
+  ⇒ AddIndexDense (ps:.IStatic d) elm (cs:.c) (us:.PointR I) (is:.PointR I) where
+  addIndexDenseGo Proxy (cs:._) (ubs:..ub) (us:..LtPointR u) (is:.i)
+    = map (\(SvS s t y') →
+        let RiPrI k = getIndex (getIdx s) (Proxy ∷ PRI is (PointR I))
+        in  SvS s (t:.PointR k) (y' :.: RiPrI  u))
+    . addIndexDenseGo (Proxy ∷ Proxy ps) cs ubs us is
+  {-# Inline addIndexDenseGo #-}
+
diff --git a/ADP/Fusion/PointR/Term/Chr.hs b/ADP/Fusion/PointR/Term/Chr.hs
new file mode 100644
--- /dev/null
+++ b/ADP/Fusion/PointR/Term/Chr.hs
@@ -0,0 +1,72 @@
+
+module ADP.Fusion.PointR.Term.Chr where
+
+import           Data.Proxy
+import           Data.Strict.Tuple
+import           Debug.Trace
+import qualified Data.Vector.Fusion.Stream.Monadic as S
+import qualified Data.Vector.Generic as VG
+import           GHC.Exts
+
+import           Data.PrimitiveArray
+
+import           ADP.Fusion.Core
+import           ADP.Fusion.Core.Term.Chr
+import           ADP.Fusion.PointR.Core
+
+
+
+type instance LeftPosTy (IStatic   d) (Chr r x) (PointR I) = IStatic   (d+1)
+type instance LeftPosTy (IVariable d) (Chr r x) (PointR I) = IVariable (d+1)
+
+
+
+instance
+  forall pos posLeft m ls r x i
+  . ( TermStream m (Z:.pos) (TermSymbol M (Chr r x)) (Elm (Term1 (Elm ls (PointR i))) (Z :. PointR i)) (Z:.PointR i)
+    , posLeft ~ LeftPosTy pos (Chr r x) (PointR i)
+    , TermStaticVar pos (Chr r x) (PointR i)
+    , MkStream m posLeft ls (PointR i)
+    )
+  ⇒ MkStream m pos (ls :!: Chr r x) (PointR i) where
+  {-# Inline mkStream #-}
+  mkStream pos (ls :!: Chr f xs) grd us is
+    = S.map (\(ss,ee,ii) -> ElmChr ee ii ss)
+    . addTermStream1 pos (Chr f xs) us is
+    $ mkStream (Proxy ∷ Proxy posLeft) ls (termStaticCheck pos (Chr f xs) us is grd) us (termStreamIndex pos (Chr f xs) is)
+
+
+instance
+  ( TermStreamContext m ps ts s x0 i0 is (PointR I)
+  ) => TermStream m (ps:.IStatic d) (TermSymbol ts (Chr r x)) s (is:.PointR I) where
+  {-# Inline termStream #-}
+  termStream Proxy (ts:|Chr f xs) (us:..LtPointR u) (is:.PointR i)
+    = S.map (\(TState s ii ee) →
+        let RiPrI k = getIndex (getIdx s) (Proxy ∷ PRI is (PointR I))
+        in  TState s (ii:.:RiPrI (k+1)) (ee:. f xs k))
+    . termStream (Proxy ∷ Proxy ps) ts us is
+
+instance
+  ( TermStreamContext m ps ts s x0 i0 is (PointR I)
+  ) => TermStream m (ps:.IVariable d) (TermSymbol ts (Chr r x)) s (is:.PointR I) where
+  {-# Inline termStream #-}
+  termStream Proxy (ts:|Chr f xs) (us:..LtPointR u) (is:.PointR i)
+    = S.map (\(TState s ii ee) ->
+        let RiPrI k = getIndex (getIdx s) (Proxy ∷ PRI is (PointR I))
+        in  TState s (ii:.:RiPrI (k+1)) (ee:. f xs k))
+    . termStream (Proxy ∷ Proxy ps) ts us is
+
+
+
+instance TermStaticVar (IStatic d) (Chr r x) (PointR I) where
+  termStreamIndex Proxy (Chr f x) (PointR j) = PointR $ j
+  termStaticCheck Proxy (Chr f x) (LtPointR _) (PointR j) grd = grd
+  {-# Inline [0] termStreamIndex #-}
+  {-# Inline [0] termStaticCheck #-}
+
+instance TermStaticVar (IVariable d) (Chr r x) (PointR I) where
+  termStreamIndex Proxy (Chr f x) (PointR j) = PointR $ j
+  termStaticCheck Proxy (Chr f x) (LtPointR _) (PointR j) grd = grd
+  {-# Inline [0] termStreamIndex #-}
+  {-# Inline [0] termStaticCheck #-}
+
diff --git a/ADP/Fusion/PointR/Term/Deletion.hs b/ADP/Fusion/PointR/Term/Deletion.hs
new file mode 100644
--- /dev/null
+++ b/ADP/Fusion/PointR/Term/Deletion.hs
@@ -0,0 +1,69 @@
+
+module ADP.Fusion.PointR.Term.Deletion where
+
+import           Data.Proxy
+import           Data.Strict.Tuple
+import qualified Data.Vector.Fusion.Stream.Monadic as S
+import           GHC.Exts
+
+import           Data.PrimitiveArray
+
+import           ADP.Fusion.Core
+import           ADP.Fusion.Core.Term.Deletion
+import           ADP.Fusion.PointR.Core
+
+
+
+type instance LeftPosTy (IStatic   d) Deletion (PointR I) = IStatic d
+type instance LeftPosTy (IVariable d) Deletion (PointR I) = IVariable d
+
+
+
+instance
+  forall pos posLeft m ls i
+  . ( TermStream m (Z:.pos) (TermSymbol M Deletion) (Elm (Term1 (Elm ls (PointR i))) (Z :. PointR i)) (Z:.PointR i)
+    , posLeft ~ LeftPosTy pos Deletion (PointR i)
+    , TermStaticVar pos Deletion (PointR i)
+    , MkStream m posLeft ls (PointR i)
+    )
+  ⇒ MkStream m pos (ls :!: Deletion) (PointR i) where
+  {-# Inline mkStream #-}
+  mkStream pos (ls :!: Deletion) grd us is
+    = S.map (\(ss,ee,ii) -> ElmDeletion ii ss)
+    . addTermStream1 pos Deletion us is
+    $ mkStream (Proxy ∷ Proxy posLeft) ls (termStaticCheck pos Deletion us is grd) us (termStreamIndex pos Deletion is)
+
+
+
+instance
+  ( TermStreamContext m ps ts s x0 i0 is (PointR I)
+  )
+  ⇒ TermStream m (ps:.IStatic d) (TermSymbol ts Deletion) s (is:.PointR I) where
+  {-# Inline termStream #-}
+  termStream Proxy (ts:|Deletion) (us:..LtPointR u) (is:.PointR i)
+    = S.map (\(TState s ii ee) -> TState s (ii:.:RiPrI i) (ee:.()))
+    . termStream (Proxy ∷ Proxy ps) ts us is
+
+instance
+  ( TermStreamContext m ps ts s x0 i0 is (PointR I)
+  )
+  ⇒ TermStream m (ps:.IVariable d) (TermSymbol ts Deletion) s (is:.PointR I) where
+  {-# Inline termStream #-}
+  termStream Proxy (ts:|Deletion) (us:..LtPointR u) (is:.PointR i)
+    = S.map (\(TState s ii ee) -> TState s (ii:.:RiPrI i) (ee:.()))
+    . termStream (Proxy ∷ Proxy ps) ts us is
+
+
+
+instance TermStaticVar (IStatic d) Deletion (PointR I) where
+  termStreamIndex Proxy Deletion (PointR j) = PointR j
+  termStaticCheck Proxy Deletion _ (PointR j) grd = grd
+  {-# Inline [0] termStreamIndex #-}
+  {-# Inline [0] termStaticCheck #-}
+
+instance TermStaticVar (IVariable d) Deletion (PointR I) where
+  termStreamIndex Proxy Deletion (PointR j) = PointR j
+  termStaticCheck Proxy Deletion _ (PointR j) grd = grd
+  {-# Inline [0] termStreamIndex #-}
+  {-# Inline [0] termStaticCheck #-}
+
diff --git a/ADP/Fusion/PointR/Term/Epsilon.hs b/ADP/Fusion/PointR/Term/Epsilon.hs
new file mode 100644
--- /dev/null
+++ b/ADP/Fusion/PointR/Term/Epsilon.hs
@@ -0,0 +1,66 @@
+
+-- | Rules of the type @X → ε@ denote termination of parsing if @X@ is empty.
+
+module ADP.Fusion.PointR.Term.Epsilon where
+
+import           Data.Proxy
+import           Data.Strict.Tuple
+import qualified Data.Vector.Fusion.Stream.Monadic as S
+import           GHC.Exts
+
+import           Data.PrimitiveArray
+
+import           ADP.Fusion.Core
+import           ADP.Fusion.Core.Term.Epsilon
+import           ADP.Fusion.PointR.Core
+
+
+
+type instance LeftPosTy (IStatic d) (Epsilon Global) (PointR I) = IStatic d
+
+instance
+  forall pos posLeft m ls i lg
+  . ( TermStream m (Z:.pos) (TermSymbol M (Epsilon lg)) (Elm (Term1 (Elm ls (PointR i))) (Z :. PointR i)) (Z:.PointR i)
+    , posLeft ~ LeftPosTy pos (Epsilon lg) (PointR i)
+    , TermStaticVar pos (Epsilon lg) (PointR i)
+    , MkStream m posLeft ls (PointR i)
+    )
+  ⇒ MkStream m pos (ls :!: Epsilon lg) (PointR i) where
+  mkStream Proxy (ls :!: Epsilon) grd us is
+    = S.map (\(ss,ee,ii) -> ElmEpsilon ii ss)
+    . addTermStream1 (Proxy ∷ Proxy pos) (Epsilon @lg) us is
+    $ mkStream (Proxy ∷ Proxy posLeft)
+               ls
+               (termStaticCheck (Proxy ∷ Proxy pos) (Epsilon @lg) us is grd)
+               us
+               (termStreamIndex (Proxy ∷ Proxy pos) (Epsilon @lg) is)
+  {-# Inline mkStream #-}
+
+
+instance
+  ( TermStreamContext m ps ts s x0 i0 is (PointR I)
+  )
+  ⇒ TermStream m (ps:.IStatic d) (TermSymbol ts (Epsilon lg)) s (is:.PointR I) where
+  termStream Proxy (ts:|Epsilon) (us:..LtPointR u) (is:.PointR i)
+    = S.map (\(TState s ii ee) ->
+              let RiPrI k = getIndex (getIdx s) (Proxy :: PRI is (PointR I))
+              in  TState s (ii:.:RiPrI k) (ee:.()))
+    . termStream (Proxy ∷ Proxy ps) ts us is
+  {-# Inline termStream #-}
+
+
+
+-- TODO need upper bound in @termStaticCheck@ to be able to check against that!
+
+instance TermStaticVar (IStatic 0) (Epsilon Global) (PointR I) where
+  termStreamIndex Proxy Epsilon (PointR i     ) = PointR i
+  termStaticCheck Proxy Epsilon (LtPointR (I# u)) (PointR (I# i)) grd = (i ==# u) `andI#` grd
+  {-# Inline termStreamIndex #-}
+  {-# Inline termStaticCheck #-}
+
+instance TermStaticVar (IStatic 0) (Epsilon Local) (PointR I) where
+  termStreamIndex Proxy Epsilon (PointR i     ) = PointR i
+  termStaticCheck Proxy Epsilon (LtPointR (I# u)) (PointR (I# i)) grd = grd
+  {-# Inline termStreamIndex #-}
+  {-# Inline termStaticCheck #-}
+
diff --git a/ADP/Fusion/PointR/Term/MultiChr.hs b/ADP/Fusion/PointR/Term/MultiChr.hs
new file mode 100644
--- /dev/null
+++ b/ADP/Fusion/PointR/Term/MultiChr.hs
@@ -0,0 +1,77 @@
+
+module ADP.Fusion.PointR.Term.MultiChr where
+
+import           Data.Proxy
+import           Data.Strict.Tuple
+import           Debug.Trace
+import           GHC.Exts
+--import           GHC.TypeNats
+import qualified Data.Vector.Fusion.Stream.Monadic as S
+import qualified Data.Vector.Generic as VG
+
+import           Data.PrimitiveArray
+
+import           ADP.Fusion.Core
+import           ADP.Fusion.Core.Term.MultiChr
+import           ADP.Fusion.PointR.Core
+
+
+
+type instance LeftPosTy (IStatic d)   (MultiChr c v x) (PointR I) = IStatic (d+c)
+type instance LeftPosTy (IVariable d) (MultiChr c v x) (PointR I) = IVariable (d+c)
+
+
+
+instance
+  forall pos posLeft m ls c v x i
+  . ( TermStream m (Z:.pos) (TermSymbol M (MultiChr c v x)) (Elm (Term1 (Elm ls (PointR i))) (Z :. PointR i)) (Z:.PointR i)
+    , posLeft ~ LeftPosTy pos (MultiChr c v x) (PointR i)
+    , TermStaticVar pos (MultiChr c v x) (PointR i)
+    , MkStream m posLeft ls (PointR i)
+    )
+  ⇒ MkStream m pos (ls :!: MultiChr c v x) (PointR i) where
+  mkStream pos (ls :!: MultiChr xs) grd us is
+    = S.map (\(ss,ee,ii) -> ElmMultiChr ee ii ss) -- recover ElmChr
+    . addTermStream1 pos (MultiChr @v @x @c xs) us is
+    $ mkStream (Proxy ∷ Proxy posLeft) ls (termStaticCheck pos (MultiChr @v @x @c xs) us is grd) us (termStreamIndex pos (MultiChr @v @x @c xs) is)
+  {-# Inline mkStream #-}
+
+
+instance
+  ( TermStreamContext m ps ts s x0 i0 is (PointR I)
+  , KnownNat c
+  ) => TermStream m (ps:.IStatic d) (TermSymbol ts (MultiChr c v x)) s (is:.PointR I) where
+  termStream Proxy (ts:|MultiChr xs) (us:..LtPointR u) (is:.PointR i)
+    = let !c = fromIntegral $ natVal (Proxy ∷ Proxy c) in
+      S.map (\(TState s ii ee) ->
+        let RiPrI k = getIndex (getIdx s) (Proxy ∷ PRI is (PointR I))
+        in  TState s (ii:.:RiPrI (k+c)) (ee:. VG.unsafeSlice k c xs))
+    . termStream (Proxy ∷ Proxy ps) ts us is
+  {-# Inline termStream #-}
+
+instance
+  ( TermStreamContext m ps ts s x0 i0 is (PointR I)
+  , KnownNat c
+  ) => TermStream m (ps:.IVariable d) (TermSymbol ts (MultiChr c v x)) s (is:.PointR I) where
+  termStream Proxy (ts:|MultiChr xs) (us:..LtPointR u) (is:.PointR i)
+    = let !c = fromIntegral $ natVal (Proxy ∷ Proxy c) in
+      S.map (\(TState s ii ee) ->
+        let RiPrI k = getIndex (getIdx s) (Proxy ∷ PRI is (PointR I))
+        in  TState s (ii:.:RiPrI (k+c)) (ee:. VG.unsafeSlice k c xs))
+    . termStream (Proxy ∷ Proxy ps) ts us is
+  {-# Inline termStream #-}
+
+
+
+instance (KnownNat c) ⇒ TermStaticVar (IStatic d) (MultiChr c v x) (PointR I) where
+  termStreamIndex Proxy (MultiChr x) (PointR j) = PointR $ j
+  termStaticCheck Proxy (MultiChr x) _ (PointR j) grd = grd
+  {-# Inline [0] termStreamIndex #-}
+  {-# Inline [0] termStaticCheck #-}
+
+instance (KnownNat c) ⇒ TermStaticVar (IVariable d) (MultiChr c v x) (PointR I) where
+  termStreamIndex Proxy (MultiChr x) (PointR j) = PointR $ j
+  termStaticCheck Proxy (MultiChr x) _ (PointR j) grd = grd
+  {-# Inline [0] termStreamIndex #-}
+  {-# Inline [0] termStaticCheck #-}
+
diff --git a/ADP/Fusion/QuickCheck.hs b/ADP/Fusion/QuickCheck.hs
deleted file mode 100644
--- a/ADP/Fusion/QuickCheck.hs
+++ /dev/null
@@ -1,185 +0,0 @@
-{-# LANGUAGE NoMonomorphismRestriction #-}
-{-# LANGUAGE PackageImports #-}
-{-# LANGUAGE TemplateHaskell #-}
-
--- | QuickCheck properties for a number of ADPfusion combinators. Each test is
--- once written using ADPfusion and once using list comprehensions. Typing
--- @allProps@ in ghci will run all tests, prefixed @prop_@ with a thousand
--- tests each.
-
-module ADP.Fusion.QuickCheck where
-
-import Data.List
-import Data.Vector.Fusion.Stream.Size
-import Data.Vector.Fusion.Util
-import qualified Data.Vector.Fusion.Stream as S
-import qualified Data.Vector.Unboxed as VU
-import Test.QuickCheck
-import Test.QuickCheck.All
-
-import "PrimitiveArray" Data.Array.Repa.Index
-
-import ADP.Fusion.QuickCheck.Arbitrary
-import qualified ADP.Fusion as F
-import qualified ADP.Fusion.Monadic as M
-import qualified ADP.Fusion.Monadic.Internal as F
-
-
-
-options = stdArgs {maxSuccess = 1000}
-
-customCheck = quickCheckWithResult options
-
-allProps = $forAllProperties customCheck
-
-
-
--- * Some definitions:
---
--- @O@ means one
--- @M@ means many
--- @P@ means one or more
--- @ML_x_y@ is for a makeLeftCombinator with boundaries x and y
-
--- ** @xs -~+ ys@, size @xs@ = 1, size @ys@ >= 1.
-
-fOP (i,j) = S.toList $ (,) F.<<< fRegion F.-~+ fRegion F.... id $ Z:.i:.j
-
-lOP (i,j) = [ ((i,i+1), (i+1,j)) | i+1<=j-1 ]
-
-prop_OP = fOP === lOP
-
--- ** @xs -~~ ys -~~ zs@, size @xs@ = 1, size @ys@ = 1, size @zs@ >= 0.
-
-fOOP (i,j) = S.toList $ (,,) F.<<< fRegion F.-~~ fRegion F.-~~ fRegion F.... id $ Z:.i:.j
-
-lOOP (i,j) = [ ( (i,i+1), (i+1,i+2), (i+2,j) ) | i+2<=j ]
-
-prop_OOP = fOOP === lOOP
-
--- ** @xs +~- ys@, size @xs@ >= 1, size @ys@ = 1.
-
-fPO (i,j) = S.toList $ (,) F.<<< fRegion F.+~- fRegion F.... id $ Z:.i:.j
-
-lPO (i,j) = [ ( (i,j-1), (j-1,j) ) | i+1<=j-1 ]
-
-prop_PO (Small i, Small j) = fPO (i,j) == lPO (i,j)
-
--- ** @xs -~+ ys +~- zs@, size @xs@ = 1, size @ys@ >= 1, size @zs@ = 1. This is
--- a "hairpin" in RNA bioinformatics.
-
-fOPO (i,j) = S.toList $ (,,) F.<<< fRegion F.-~+ fRegion F.+~- fRegion F.... id $ Z:.i:.j
-
-lOPO (i,j) = [ ( (i,i+1), (i+1,j-1), (j-1,j) ) | i+2<=j, i+1<j-1 ]
-
-prop_OPO = fOPO === lOPO
-
--- ** The central region is non-empty, with two size-1 regions on each side.
--- Will create @O(n)@ candidates, which will all fail, except for the last one
--- (if @j-i@ is large enough).
-
-fOOPOOslow (i,j) = S.toList $ (,,,,) F.<<< fRegion F.-~+ fRegion F.-~+ fRegion F.+~+ fRegion F.-~- fRegion F.... id $ Z:.i:.j
-
-lOOPOO (i,j) = [ ( (i,i+1), (i+1,i+2), (i+2,j-2), (j-2,j-1), (j-1,j) ) | i+4<=j, i+2<j-2 ]
-
-prop_OOPOOslow = fOOPOOslow === lOOPOO
-
--- ** The above test can be sped up by the use of the @+~--@ combinator. It
--- fixes the left and right side, by allowing only exactly size two on its
--- right. Each combinator here will 'Yield' exactly once, then be 'Done'.
-
-fOOPOOfast (i,j) = S.toList $ (,,,,) F.<<< fRegion F.-~+ fRegion F.-~+ fRegion F.+~-- fRegion F.-~- fRegion F.... id $ Z:.i:.j
-
-prop_OOPOOfast = fOOPOOfast === lOOPOO
-
--- ** A complex right-hand side which was problematic in 0.0.0.3 of ADPfusion.
--- In original ADP @base -~~ weak ~~- base +~+ string@ we want the @base@ parts
--- to have size 1, @weak@ of any size, and @string@ to be non-empty. In
--- ADPfusion @as -~+ bs@ means that @as@ has size one, @bs@ size 1 or more.
-
-fOPOP (i,j) = S.toList $ (,,,) F.<<< fRegion F.-~+ fRegion F.+~+ fRegion F.-~+ fRegion F.... id $ Z:.i:.j
-
-lOPOP (i,j) = [ ( (i,i+1), (i+1,k), (k,k+1), (k+1,j) ) | k <- [i+1 .. j-2], i+1<k, k+1<j ]
-
-prop_OPOP = fOPOP === lOPOP
-
--- ** One more of those complex right-hand sides. This one is already rather
--- complicated. We have @one -~+ one -~+ many +~+ one -~~ one -~+ plus@ where
--- @one@ has size 1, many has size 0 to many, plus has size 1 to many. The last
--- combinator @-~+@ again short-curcuits by being 'Done' once the left-hand
--- side is larger than one.
-
-fOOPOOP (i,j) = S.toList $ (,,,,,) F.<<< fRegion F.-~+ fRegion F.-~+ fRegion F.+~+ fRegion F.-~~ fRegion F.-~+ fRegion F.... id $ Z:.i:.j
-
-lOOPOOP (i,j) = [ ( (i,i+1), (i+1,i+2), (i+2,k), (k,k+1), (k+1,k+2), (k+2,j) ) | k <- [i+2 .. j-3], i+2<k, k+2<j ]
-
-prop_OOPOOP = fOOPOOP === lOOPOOP
-
--- ** We now introduce two independently moving indices and size zero regions.
-
-fMMM (i,j) = S.toList $ (,,) F.<<< fRegion F.~~~ fRegion F.~~~ fRegion F.... id $ Z:.i:.j
-
-lMMM (i,j) = [ ( (i,k), (k,l), (l,j) ) | k <- [i..j], l<-[k..j] ]
-
-prop_MMM = fMMM === lMMM
-
--- ** Three independent regions, each one enclosed by two size-1 regions.
--- Compile-time hog.
-
-fOPOOPOOPO (i,j) = S.toList $ (,,,,,,,,) F.<<< fRegion F.-~+ fRegion F.+~+ fRegion F.-~+
-                                          {--} fRegion F.-~+ fRegion F.+~+ fRegion F.-~+
-                                          {--} fRegion F.-~+ fRegion F.+~- fRegion F.... id $ Z:.i:.j
-
-lOPOOPOOPO (i,j) = [ ( (i,i+1), (i+1,k), (k,k+1), {--} (k+1,k+2), (k+2,l), (l,l+1), {--} (l+1,l+2), (l+2,j-1), (j-1,j) )
-                   | k<-[i+1 .. j-5], l<-[k+2 .. j-3], i+1<k, k+2<l, l+2<j-1 ]
-
-prop_OPOOPOOPO = fOPOOPOOPO === lOPOOPOOPO
-
--- ** Two non-empty regions, the right one with single-size regions around it.
--- (sorry about the name)
-
-fPOPO (i,j) = S.toList $ (,,,) F.<<< fRegion F.+~+ fRegion F.-~+ fRegion F.+~- fRegion F.... id $ Z:.i:.j
-
-lPOPO (i,j) = [ ( (i,k), (k,k+1), (k+1,j-1), (j-1,j) ) | k <- [i+1 .. j-3] ]
-
-prop_POPO (Small i, Small j) = fPOPO (i,j) == lPOPO (i,j)
-
--- ** Sanity-checking special constraints.
-
-fOO (i,j) = S.toList $ (,) F.<<< fRegion F.-~- fRegion F.... id $ Z:.i:.j
-
-lOO (i,j) = [ ( (i,i+1), (j-1,j) ) | i+2==j ]
-
-prop_OO (Small i, Small j) = fOO (i,j) == lOO (i,j)
-
--- ** Two non-empty regions
-
-fPP (i,j) = S.toList $ (,) F.<<< fRegion F.+~+ fRegion F.... id $ Z:.i:.j
-
-lPP (i,j) = [ ( (i,k), (k,j) ) | k<-[i+1 .. j-1] ]
-
-prop_PP (Small i, Small j) = fPP (i,j) == lPP (i,j)
-
--- ** using 'makeLeft_MinRight'
-
-fML_1_4M (i,j) = S.toList $ (,) F.<<< fRegion `ml_1_4` fRegion F.... id $ Z:.i:.j where
-  infixl 9 `ml_1_4`
-  ml_1_4 = F.makeLeft_MinRight (1,4) 0
-
-lML_1_4M (i,j) = [ ( (i,k), (k,j) ) | k <- [i+1 .. min (i+4) j] ]
-
-prop_ML_1_4M = fML_1_4M === lML_1_4M
-
--- ** using 'makeLeft_MinRight' and 'makeMinLeft_Right'. Inner regions fixed to
--- be non-empty.
-
-fML_1_4MMR_1_4 (i,j) = S.toList $ (,,) F.<<< fRegion `ml_1_4` fRegion `mr_1_4` fRegion F.... id $ Z:.i:.j where
-  infixl 9 `ml_1_4`
-  ml_1_4 = F.makeLeft_MinRight (1,4) 1
-  infixl 9 `mr_1_4`
-  mr_1_4 = F.makeMinLeft_Right 1 (1,4)
-
-lML_1_4MMR_1_4 (i,j) = [ ( (i,k), (k,l), (l,j) ) | k<-[i+1 .. min (i+4) j], l <- [max k (j-4) .. j-1], k<l ]
-
-prop_ML_1_4MMR_1_4 = fML_1_4MMR_1_4 === lML_1_4MMR_1_4
-
diff --git a/ADP/Fusion/QuickCheck/Arbitrary.hs b/ADP/Fusion/QuickCheck/Arbitrary.hs
deleted file mode 100644
--- a/ADP/Fusion/QuickCheck/Arbitrary.hs
+++ /dev/null
@@ -1,39 +0,0 @@
-{-# LANGUAGE PackageImports #-}
-
-module ADP.Fusion.QuickCheck.Arbitrary where
-
-import Test.QuickCheck
-import Test.QuickCheck.All
-
-import "PrimitiveArray" Data.Array.Repa.Index
-
-import qualified ADP.Fusion.Monadic.Internal as F
-
-lAchar (i,j) = [j | i+1 == j]
-
--- |
---
--- NOTE we have to add 1 to the i-index. Legacy ADP reads chars from an input
--- array starting at "1", while ADPfusion starts arrays at "0".
-
-fAchar :: DIM2 -> (F.Scalar Int)
-fAchar (Z:.i:.j) = F.Scalar $ (i+1)
-
-fRegion :: DIM2 -> (F.Scalar (Int,Int))
-fRegion (Z:.i:.j) = F.Scalar $ (i,j)
-
--- * quickcheck stuff
-
-newtype Small = Small Int
-  deriving (Show)
-
-instance Arbitrary Small where
-  arbitrary = Small `fmap` choose (0,50)
-  shrink (Small x)
-    | x>0       = [Small $ x-1]
-    | otherwise = []
-
-small x = x>=0 && x <=50
-
-(===) f g (Small i, Small j) = f (i,j) == g (i,j)
-
diff --git a/ADP/Fusion/Unit.hs b/ADP/Fusion/Unit.hs
new file mode 100644
--- /dev/null
+++ b/ADP/Fusion/Unit.hs
@@ -0,0 +1,18 @@
+
+-- | Unit indices have just a single element in their set. This is actually
+-- *not* useless, since it can be used to "fold" from another index
+-- structure into the single @()@ element.
+
+module ADP.Fusion.Unit
+  ( module ADP.Fusion.Core
+  , module ADP.Fusion.Unit.SynVar.Indices
+  , module ADP.Fusion.Unit.Term.Deletion
+  , module ADP.Fusion.Unit.Term.Epsilon
+  ) where
+
+import ADP.Fusion.Core
+
+import ADP.Fusion.Unit.SynVar.Indices
+import ADP.Fusion.Unit.Term.Deletion
+import ADP.Fusion.Unit.Term.Epsilon
+
diff --git a/ADP/Fusion/Unit/Core.hs b/ADP/Fusion/Unit/Core.hs
new file mode 100644
--- /dev/null
+++ b/ADP/Fusion/Unit/Core.hs
@@ -0,0 +1,116 @@
+
+-- |
+--
+-- TODO the 'mkStream' instances here are probably wonky for everything that is
+-- non-static.
+--
+-- TODO should @d@ in each case here be @d==0@? What is the exact meaning @d@
+-- should convey?
+
+module ADP.Fusion.Unit.Core where
+
+import Data.Proxy
+import Data.Vector.Fusion.Stream.Monadic (singleton,map,filter,Step(..))
+import Debug.Trace
+import Prelude hiding (map,filter)
+
+import Data.PrimitiveArray hiding (map)
+
+import ADP.Fusion.Core.Classes
+import ADP.Fusion.Core.Multi
+
+
+
+type instance InitialContext (Unit I) = IStatic 0
+
+type instance InitialContext (Unit O) = OStatic 0
+
+type instance InitialContext (Unit C) = Complement
+
+data instance RunningIndex (Unit t) = RiUnit
+
+
+
+instance
+  ( Monad m
+  )
+  ⇒ MkStream m (IStatic d) S (Unit I) where
+  mkStream Proxy S grd LtUnit Unit
+    = staticCheck# grd
+    . singleton $ ElmS RiUnit
+  {-# Inline mkStream #-}
+
+instance
+  ( Monad m
+  )
+  ⇒ MkStream m (IVariable d) S (Unit I) where
+  mkStream Proxy S grd LtUnit Unit
+    = staticCheck# grd
+    . singleton $ ElmS RiUnit
+  {-# Inline mkStream #-}
+
+instance
+  ( Monad m
+  )
+  ⇒ MkStream m (OStatic d) S (Unit O) where
+  mkStream Proxy S grd LtUnit Unit
+    = staticCheck# grd
+    . singleton $ ElmS RiUnit
+  {-# Inline mkStream #-}
+
+instance
+  ( Monad m
+  )
+  ⇒ MkStream m Complement S (Unit C) where
+  mkStream Proxy S grd LtUnit Unit
+    = staticCheck# grd
+    . singleton $ ElmS RiUnit
+  {-# Inline mkStream #-}
+
+--instance
+--  forall m ps p is
+--  . ( Monad m
+--    , MkStream m ps S is
+--    )
+--  ⇒ MkStream m ('(:.) ps p) S (is:.Unit I) where
+--  mkStream Proxy S grd (us:.._) (is:._)
+--    = map (\(ElmS zi) -> ElmS $ zi :.: RiU)
+--    $ mkStream (Proxy ∷ Proxy ps) S grd us is
+--  {-# Inline mkStream #-}
+--
+--instance
+--  forall m ps p is
+--  . ( Monad m
+--    , MkStream m ps S is
+--    )
+--  ⇒ MkStream m ('(:.) ps p) S (is:.Unit O) where
+--  mkStream Proxy S grd (us:.._) (is:._)
+--    = map (\(ElmS zi) -> ElmS $ zi :.: RiU)
+--    $ mkStream (Proxy ∷ Proxy ps) S grd us is
+--  {-# Inline mkStream #-}
+--
+--instance
+--  forall m ps p is
+--  . ( Monad m
+--    , MkStream m ps S is
+--    )
+--  ⇒ MkStream m ('(:.) ps p) S (is:.Unit C) where
+--  mkStream Proxy S grd (us:.._) (is:._)
+--    = map (\(ElmS zi) -> ElmS $ zi :.: RiU)
+--    $ mkStream (Proxy ∷ Proxy ps) S grd us is
+--  {-# Inline mkStream #-}
+--
+--
+--
+--instance TableStaticVar pos c u (Unit I) where
+--  tableStreamIndex _ _ _ _ = Unit
+--  {-# Inline [0] tableStreamIndex #-}
+--
+--instance TableStaticVar pos c u (Unit O) where
+--  tableStreamIndex _ _ _ _ = Unit
+--  {-# Inline [0] tableStreamIndex #-}
+--
+--instance TableStaticVar pos c u (Unit C) where
+--  tableStreamIndex _ _ _ _ = Unit
+--  {-# Inline [0] tableStreamIndex #-}
+
diff --git a/ADP/Fusion/Unit/SynVar/Indices.hs b/ADP/Fusion/Unit/SynVar/Indices.hs
new file mode 100644
--- /dev/null
+++ b/ADP/Fusion/Unit/SynVar/Indices.hs
@@ -0,0 +1,70 @@
+
+-- | TODO if we have a table that has min-size @>0@ we need to immediately
+-- terminate @addIndexDenseGo@ !
+
+module ADP.Fusion.Unit.SynVar.Indices where
+
+import Data.Proxy
+import Data.Vector.Fusion.Stream.Monadic (map,Stream,head,mapM,Step(..))
+import Data.Vector.Fusion.Util (delay_inline)
+import Prelude hiding (map,head,mapM)
+
+import Data.PrimitiveArray hiding (map)
+
+import ADP.Fusion.Core
+import ADP.Fusion.Unit.Core
+
+
+
+type instance LeftPosTy (IStatic d) (TwITbl b s m arr EmptyOk (Unit I) x) (Unit I) = IStatic d
+type instance LeftPosTy (IStatic d) (TwITblBt b s arr EmptyOk (Unit I) x mB mF r) (Unit I) = IStatic d
+
+type instance LeftPosTy (OStatic d) (TwITbl b s m arr EmptyOk (Unit O) x) (Unit O) = OStatic d
+type instance LeftPosTy (OStatic d) (TwITblBt b s arr EmptyOk (Unit O) x mB mF r) (Unit O) = OStatic d
+
+type instance LeftPosTy Complement (TwITbl b s m arr EmptyOk (Unit I) x) (Unit C) = Complement
+type instance LeftPosTy Complement (TwITblBt b s arr EmptyOk (Unit I) x mB mF r) (Unit C) = Complement
+
+type instance LeftPosTy Complement (TwITbl b s m arr EmptyOk (Unit O) x) (Unit C) = Complement
+type instance LeftPosTy Complement (TwITblBt b s arr EmptyOk (Unit O) x mB mF r) (Unit C) = Complement
+
+instance
+  ( AddIndexDenseContext ps elm x0 i0 cs c us (Unit I) is (Unit I)
+  , MinSize c
+  )
+  ⇒ AddIndexDense (ps:.Unit d) elm (cs:.c) (us:.Unit I) (is:.Unit I) where
+  addIndexDenseGo Proxy (cs:._) (ubs:..ub) (us:..u) (is:.i)
+    = map (\(SvS s t y') → SvS s (t:.i) (y' :.: RiUnit))
+    . addIndexDenseGo (Proxy ∷ Proxy ps) cs ubs us is
+  {-# Inline addIndexDenseGo #-}
+
+instance
+  ( AddIndexDenseContext ps elm x0 i0 cs c us (Unit O) is (Unit O)
+  , MinSize c
+  )
+  ⇒ AddIndexDense (ps:.Unit d) elm (cs:.c) (us:.Unit O) (is:.Unit O) where
+  addIndexDenseGo Proxy (cs:._) (ubs:..ub) (us:..u) (is:.i)
+    = map (\(SvS s t y') → SvS s (t:.i) (y' :.: RiUnit))
+    . addIndexDenseGo (Proxy ∷ Proxy ps) cs ubs us is
+  {-# Inline addIndexDenseGo #-}
+
+instance
+  ( AddIndexDenseContext ps elm x0 i0 cs c us (Unit I) is (Unit C)
+  , MinSize c
+  )
+  ⇒ AddIndexDense (ps:.Unit d) elm (cs:.c) (us:.Unit I) (is:.Unit C) where
+  addIndexDenseGo Proxy (cs:._) (ubs:..ub) (us:..u) (is:.i)
+    = map (\(SvS s t y') → SvS s (t:.Unit) (y' :.: RiUnit))
+    . addIndexDenseGo (Proxy ∷ Proxy ps) cs ubs us is
+  {-# Inline addIndexDenseGo #-}
+
+instance
+  ( AddIndexDenseContext ps elm x0 i0 cs c us (Unit O) is (Unit C)
+  , MinSize c
+  )
+  ⇒ AddIndexDense (ps:.Unit d) elm (cs:.c) (us:.Unit O) (is:.Unit C) where
+  addIndexDenseGo Proxy (cs:._) (ubs:..ub) (us:..u) (is:.i)
+    = map (\(SvS s t y') → SvS s (t:.Unit) (y' :.: RiUnit))
+    . addIndexDenseGo (Proxy ∷ Proxy ps) cs ubs us is
+  {-# Inline addIndexDenseGo #-}
+
diff --git a/ADP/Fusion/Unit/Term/Deletion.hs b/ADP/Fusion/Unit/Term/Deletion.hs
new file mode 100644
--- /dev/null
+++ b/ADP/Fusion/Unit/Term/Deletion.hs
@@ -0,0 +1,47 @@
+
+module ADP.Fusion.Unit.Term.Deletion where
+
+import           Data.Proxy
+import           Data.Strict.Tuple
+import qualified Data.Vector.Fusion.Stream.Monadic as S
+import           GHC.Exts
+
+import           Data.PrimitiveArray
+
+import           ADP.Fusion.Core
+import           ADP.Fusion.Unit.Core
+
+
+
+instance
+  forall m pos posLeft ls i
+  . ( TermStream m (Z:.pos) (TermSymbol M Deletion) (Elm (Term1 (Elm ls (Unit i))) (Z :. Unit i)) (Z:.Unit i)
+    , posLeft ~ LeftPosTy pos Deletion (Unit i)
+    , TermStaticVar pos Deletion (Unit i)
+    , MkStream m posLeft ls (Unit i)
+    )
+  ⇒ MkStream m pos (ls :!: Deletion) (Unit i) where
+  mkStream pos (ls :!: Deletion) grd us is
+    = S.map (\(ss,ee,ii) -> ElmDeletion ii ss)
+    . addTermStream1 pos Deletion us is
+    . mkStream (Proxy ∷ Proxy posLeft) ls (termStaticCheck pos Deletion us is grd) us
+    $ (termStreamIndex pos Deletion is)
+  {-# Inline mkStream #-}
+
+
+instance
+  ( TermStreamContext m ps ts s x0 i0 is (Unit I)
+  , Monad m
+  , (TermStream m ps ts (Elm x0 i0) is)
+  ) => TermStream m ('(:.) ps p) (TermSymbol ts Deletion) s (is:.Unit I) where
+  termStream Proxy (ts:|Deletion) (us:.._) (is:._)
+    = S.map (\(TState s ii ee) -> TState s (ii:.:RiUnit) (ee:.()))
+    . termStream (Proxy ∷ Proxy ps) ts us is
+  {-# Inline termStream #-}
+
+instance TermStaticVar (IStatic d) Deletion (Unit I) where
+  termStreamIndex Proxy Deletion Unit = Unit
+  termStaticCheck Proxy Deletion _ Unit grd = grd
+  {-# Inline [0] termStreamIndex #-}
+  {-# Inline [0] termStaticCheck #-}
+
diff --git a/ADP/Fusion/Unit/Term/Epsilon.hs b/ADP/Fusion/Unit/Term/Epsilon.hs
new file mode 100644
--- /dev/null
+++ b/ADP/Fusion/Unit/Term/Epsilon.hs
@@ -0,0 +1,65 @@
+
+module ADP.Fusion.Unit.Term.Epsilon where
+
+import           Data.Proxy
+import           Data.Strict.Tuple
+import qualified Data.Vector.Fusion.Stream.Monadic as S
+import           GHC.Exts
+
+import           Data.PrimitiveArray
+
+import           ADP.Fusion.Core
+import           ADP.Fusion.Unit.Core
+
+
+
+instance
+  forall m pos posLeft ls i lg
+  . ( TermStream m (Z:.pos) (TermSymbol M (Epsilon lg)) (Elm (Term1 (Elm ls (Unit i))) (Z:.Unit i)) (Z:.Unit i)
+    , posLeft ~ LeftPosTy pos (Epsilon lg) (Unit i)
+    , TermStaticVar pos (Epsilon lg) (Unit i)
+    , MkStream m posLeft ls (Unit i)
+    )
+  ⇒ MkStream m pos (ls :!: Epsilon lg) (Unit i) where
+  mkStream pos (ls :!: Epsilon) grd us is
+    = S.map (\(ss,ee,ii) -> ElmEpsilon ii ss)
+    . addTermStream1 pos (Epsilon @lg) us is
+    . mkStream (Proxy ∷ Proxy posLeft) ls (termStaticCheck pos (Epsilon @lg) us is grd) us
+    $ termStreamIndex pos (Epsilon @lg) is
+  {-# Inline mkStream #-}
+
+
+
+--instance
+--  ( TermStreamContext m ps ts s x0 i0 is (Unit I)
+--  , TermStream m ps ts (Elm x0 i0) is
+--  ) ⇒ TermStream m (TermSymbol ts Epsilon) s (is:.Unit I) where
+--  termStream (ts:|Epsilon) (cs:.IStatic ()) (us:.._) (is:._)
+--    = S.map (\(TState s ii ee) -> TState s (ii:.:RiU) (ee:.()))
+--    . termStream ts cs us is
+--  {-# Inline termStream #-}
+
+{-
+instance
+  ( TstCtx m ts s x0 i0 is (Unit O)
+  ) => TermStream m (TermSymbol ts Epsilon) s (is:.Unit O) where
+  termStream (ts:|Epsilon) (cs:.OStatic ()) (us:.._) (is:._)
+    = S.map (\(TState s ii ee) -> TState s (ii:.:RiU) (ee:.()))
+    . termStream ts cs us is
+  {-# Inline termStream #-}
+
+
+
+instance TermStaticVar Epsilon (Unit I) where
+  termStaticVar _ _ _ = IStatic ()
+  termStreamIndex _ _ _ = Unit
+  {-# Inline [0] termStaticVar #-}
+  {-# Inline [0] termStreamIndex #-}
+
+instance TermStaticVar Epsilon (Unit O) where
+  termStaticVar _ _ _ = OStatic ()
+  termStreamIndex _ _ _ = Unit
+  {-# Inline [0] termStaticVar #-}
+  {-# Inline [0] termStreamIndex #-}
+-}
+
diff --git a/ADPfusion.cabal b/ADPfusion.cabal
--- a/ADPfusion.cabal
+++ b/ADPfusion.cabal
@@ -1,171 +1,411 @@
+cabal-version:  2.2
 name:           ADPfusion
-version:        0.1.0.0
-author:         Christian Hoener zu Siederdissen, 2011-2012
-copyright:      Christian Hoener zu Siederdissen, 2011-2012
-homepage:       http://www.tbi.univie.ac.at/~choener/adpfusion
-maintainer:     choener@tbi.univie.ac.at
-category:       Algorithms, Data Structures, Bioinformatics
-license:        BSD3
+version:        0.6.0.0
+author:         Christian Hoener zu Siederdissen, 2011-2019
+copyright:      Christian Hoener zu Siederdissen, 2011-2019
+homepage:       https://github.com/choener/ADPfusion
+bug-reports:    https://github.com/choener/ADPfusion/issues
+maintainer:     choener@bioinf.uni-leipzig.de
+category:       Algorithms, Data Structures, Bioinformatics, Formal Languages
+license:        BSD-3-Clause
 license-file:   LICENSE
 build-type:     Simple
 stability:      experimental
-cabal-version:  >= 1.6.0
-synopsis:
-                Efficient, high-level dynamic programming.
+tested-with:    GHC == 8.6.4
+synopsis:       Efficient, high-level dynamic programming.
 description:
-                ADPfusion combines stream-fusion (using the stream interface
-                provided by the vector library) and type-level programming to
-                provide highly efficient dynamic programming combinators.
-                .
-                From the programmers' viewpoint, ADPfusion behaves very much
-                like the original ADP implementation
-                <http://bibiserv.techfak.uni-bielefeld.de/adp/> developed by
-                Robert Giegerich and colleagues, though both combinator
-                semantics and backtracking are different.
-                .
-                The library internals, however, are designed not only to speed
-                up ADP by a large margin (which this library does), but also to
-                provide further runtime improvements by allowing the programmer
-                to switch over to other kinds of data structures with better
-                time and space behaviour. Most importantly, dynamic programming
-                tables can be strict, removing indirections present in lazy,
-                boxed tables.
-                .
-                As a simple benchmark, consider the Nussinov78 algorithm which
-                translates to three nested for loops (for C). In the figure,
-                four different approaches are compared using inputs with size
-                100 characters to 1000 characters in increments of 100
-                characters. "C" is an implementation ("./C/" directory) in "C"
-                using "gcc -O3". "ADP" is the original ADP approach (see link
-                above), while "GAPC" uses the "GAP" language
-                (<http://gapc.eu/>).
-                <<https://github.com/choener/ADPfusion/gaplike-performance.png>>
-                .
-                Please note that actual performance will depend much on table
-                layout and data structures accessed during calculations, but in
-                general performance is very good: close to C and better than
-                other high-level approaches (that I know of).
-                .
-                .
-                .
-                Even complex ADP code tends to be completely optimized to loops
-                that use only unboxed variables (Int# and others,
-                indexIntArray# and others).
-                .
-                Completely novel (compared to ADP), is the idea of allowing
-                efficient monadic combinators. This facilitates writing code
-                that performs backtracking, or samples structures
-                stochastically, among others things.
-                .
-                This version is still highly experimental and makes use of
-                multiple recent improvements in GHC. This is particularly true
-                for the monadic interface.
-                .
-                .
-                .
-                Newley added are the ADP.Fusion.GAPlike modules. These allow
-                for writing grammars with only one (non)-terminal combinator.
-                The logic for index manipulation is now moved into data types
-                for terminals and non-terminals.
-                .
-                While this change leads to slightly more complicated instances
-                for each new terminal or non-terminal, the overall code
-                complexity is significantly lower. In addition, Constraint
-                Kinds make complex interactions between (non)-terminals
-                possible, while still managing to produce high-performance
-                code.
-                .
-                The final goal would, of course, be to have no inter-terminal
-                combinators anymore.
-                .
-                * GHC 7.6, LLVM, and -fnew-codegen recommended: gives a speedup
-                  of x2 for GAPcriterion
-                .
-                .
-                .
-                .
-                Long term goals: Outer indices with more than two dimensions,
-                specialized table design, a combinator library, a library for
-                computational biology.
-                .
-                Two algorithms from the realm of computational biology are
-                provided as examples on how to write dynamic programming
-                algorithms using this library:
-                <http://hackage.haskell.org/package/Nussinov78> and
-                <http://hackage.haskell.org/package/RNAFold>.
-                .
-                Changes since 0.0.1.2:
-                .
-                * require GHC 7.6
-                .
-                * ADP.Fusion.GAPlike module for (almost) combinator-less grammars
-                .
-                * ConstraintKinds for constrained parsers in GAPlike.
-                .
-                .
+                <http://www.bioinf.uni-leipzig.de/Software/gADP/ generalized Algebraic Dynamic Programming>
                 .
-                Changes since 0.0.1.0:
+                ADPfusion combines stream-fusion (using the stream interface provided by the vector
+                library) and type-level programming to provide highly efficient dynamic programming
+                combinators.
                 .
-                * compatibility with GHC 7.4
+                ADPfusion allows writing dynamic programs for single- and multi-tape problems.
+                Inputs can be sequences, or sets. New input types can be defined, without having to
+                rewrite this library thanks to the open-world assumption of ADPfusion.
                 .
-                * note: still using fundeps & and TFs together. The TF-only version does not optimize as well (I know why but not yet how to fix it)
+                The library provides the machinery for Outside and Ensemble algorithms as well.
+                Ensemble algorithms combine Inside and Outside calculations.
                 .
+                Starting with version 0.4.1 we support writing multiple context-free grammars
+                (interleaved syntactic variables). Such grammars have applications in bioinformatics
+                and linguistics.
                 .
+                The homepage provides a number of tutorial-style examples, with linear and
+                context-free grammars over sequence and set inputs.
                 .
-                Using the new code generator?
+                The formal background for generalized algebraic dynamic programming and ADPfusion is
+                described in a number of papers. These can be found on the gADP homepage and in the
+                README.
                 .
-                The new code generator is not official yet, but I recommend trying it out:
-                <<https://github.com/choener/ADPfusion/gaplike-newcodegen.png>>
+                Note: The core @ADPfusion@ library only provides machinery for linear language over
+                sequences. The add-ons @ADPfusionSubword@, @ADPfusionForest@, and others provide
+                specialized machinery for other types of formal languages.
 
 
 
 Extra-Source-Files:
   README.md
-  ADP/Fusion/QuickCheck.hs
-  ADP/Fusion/QuickCheck/Arbitrary.hs
+  changelog.md
 
 
-Flag devel
-  description: build criterion benchmarks and pull in QuickCheck
-  default: False
 
+flag debug
+  description:  Enable bounds checking and various other debug operations at the cost of a significant performance penalty.
+  default:      False
+  manual:       True
 
+flag debugoutput
+  description:  Enable debug output, which spams the screen full of index information
+  default:      False
+  manual:       True
+
+flag debugdump
+  description:  Enable dumping intermediate / core files
+  default:      False
+  manual:       True
+
+flag dump-core
+  description: Dump HTML for the core generated by GHC during compilation
+  default:     False
+  manual:      True
+
+flag examples
+  description:  build the examples
+  default:      False
+  manual:       True
+
+flag spectest
+  description:  build the spec-ctor test case
+  default:      False
+  manual:       True
+
+flag devel
+  description:  build additional tests
+  default:      False
+  manual:       True
+
+flag btstruc
+  description:  performance test for backtracking structures
+  default:      False
+  manual:       True
+
+flag llvm
+  description:  use llvm
+  default:      False
+  manual:       True
+
+
+
+common deps
+  build-depends: base               >= 4.7    && < 5.0
+               , bits               >= 0.4
+               , containers
+               , deepseq
+               , ghc-prim
+               , mmorph             >= 1.0
+               , mtl                >= 2.0
+               , primitive          >= 0.5.4
+               , QuickCheck         >= 2.7
+               , singletons         >= 2.4
+               , strict             >= 0.3
+               , template-haskell   >= 2.0
+               , th-orphans         >= 0.12
+               , transformers       >= 0.3
+               , tuple              >= 0.3
+               , vector             >= 0.11
+               --
+               , DPutils            == 0.1.0.*
+               , OrderedBits        == 0.0.2.*
+               , PrimitiveArray     == 0.10.0.*
+  default-extensions: BangPatterns
+                    , ConstraintKinds
+                    , CPP
+                    , DataKinds
+                    , DefaultSignatures
+                    , DeriveAnyClass
+                    , DeriveDataTypeable
+                    , DeriveGeneric
+                    , FlexibleContexts
+                    , FlexibleInstances
+                    , GADTs
+                    , KindSignatures
+                    , MagicHash
+                    , MultiParamTypeClasses
+                    -- PolyKinds is very important to get GHC to pick up all
+                    -- the instances correctly.
+                    , PolyKinds
+                    , RankNTypes
+                    , RecordWildCards
+                    , ScopedTypeVariables
+                    , StandaloneDeriving
+                    , TemplateHaskell
+                    , TupleSections
+                    , TypeApplications
+                    , TypeFamilies
+                    , TypeOperators
+                    , TypeSynonymInstances
+                    , UndecidableInstances
+                    , UnicodeSyntax
+  default-language:
+    Haskell2010
+  ghc-options:
+    -O2 -funbox-strict-fields
+  if flag(debugdump)
+    ghc-options:
+      -ddump-to-file
+      -ddump-simpl
+      -dsuppress-all
+  if flag(dump-core)
+    build-depends: dump-core
+    ghc-options: -fplugin=DumpCore -fplugin-opt DumpCore:core-html
+
+
+
 library
-  build-depends:
-    base >= 4 && < 5,
-    ghc-prim,
-    primitive      == 0.5.*   ,
-    vector         == 0.10.*  ,
-    PrimitiveArray == 0.4.*
+  import:
+    deps
   exposed-modules:
-    ADP.Fusion
-    ADP.Fusion.Monadic
-    ADP.Fusion.Monadic.Internal
-    ADP.Fusion.GAPlike
+    -- core system
+    ADP.Fusion.Core
+    ADP.Fusion.Core.Apply
+    ADP.Fusion.Core.Classes
+    ADP.Fusion.Core.Multi
+    ADP.Fusion.Core.SynVar.Array
+    ADP.Fusion.Core.SynVar.Array.Type
+    ADP.Fusion.Core.SynVar.Axiom
+    ADP.Fusion.Core.SynVar.Backtrack
+    ADP.Fusion.Core.SynVar.Fill
+    ADP.Fusion.Core.SynVar.FillTyLvl
+    ADP.Fusion.Core.SynVar.Indices
+    ADP.Fusion.Core.SynVar.Recursive.Type
+    ADP.Fusion.Core.SynVar.Split.Type
+    ADP.Fusion.Core.SynVar.TableWrap
+    ADP.Fusion.Core.Term.Chr
+    ADP.Fusion.Core.Term.Deletion
+    ADP.Fusion.Core.Term.Edge
+    ADP.Fusion.Core.Term.Epsilon
+    ADP.Fusion.Core.Term.MultiChr
+    ADP.Fusion.Core.Term.PeekIndex
+    ADP.Fusion.Core.Term.Str
+    ADP.Fusion.Core.Term.Switch
+    ADP.Fusion.Core.Term.Test
+    ADP.Fusion.Core.TH
+    ADP.Fusion.Core.TH.Backtrack
+    ADP.Fusion.Core.TH.Common
+    ADP.Fusion.Core.TyLvlIx
+--    -- Point L
+    ADP.Fusion.PointL
+    ADP.Fusion.PointL.Core
+    ADP.Fusion.PointL.SynVar.Indices
+--    ADP.Fusion.PointL.SynVar.Recursive
+    ADP.Fusion.PointL.Term.Chr
+    ADP.Fusion.PointL.Term.Deletion
+    ADP.Fusion.PointL.Term.Epsilon
+    ADP.Fusion.PointL.Term.MultiChr
+    ADP.Fusion.PointL.Term.Str
+    ADP.Fusion.PointL.Term.Switch
+--    ADP.Fusion.PointL.Term.Test
+--    -- Point R
+    ADP.Fusion.PointR
+    ADP.Fusion.PointR.Core
+    ADP.Fusion.PointR.SynVar.Indices
+    ADP.Fusion.PointR.Term.Chr
+    ADP.Fusion.PointR.Term.Deletion
+    ADP.Fusion.PointR.Term.Epsilon
+    ADP.Fusion.PointR.Term.MultiChr
+    -- Unit
+    ADP.Fusion.Unit
+    ADP.Fusion.Unit.Core
+    ADP.Fusion.Unit.SynVar.Indices
+    ADP.Fusion.Unit.Term.Deletion
+    ADP.Fusion.Unit.Term.Epsilon
+--    -- tutorials
+--    ADP.Fusion.Tutorial.NeedlemanWunsch
 
+
+
+test-suite properties
+  import:
+    deps
+  type:
+    exitcode-stdio-1.0
+  main-is:
+    properties.hs
+  other-modules:
+    QuickCheck.Common
+    QuickCheck.Point
   ghc-options:
-    -O2 -funbox-strict-fields
+    -threaded -rtsopts -with-rtsopts=-N
+  hs-source-dirs:
+    tests
+  cpp-options:
+    -DADPFUSION_TEST_SUITE_PROPERTIES
+  build-depends: ADPfusion
+               , tasty                        >= 0.11
+               , tasty-quickcheck             >= 0.8
+               , tasty-th                     >= 0.1
 
-executable GAPcriterion
-  buildable:
-    False
-  if flag(devel)
+
+
+-- Very simple two-sequence alignment.
+
+executable NeedlemanWunsch
+
+  if flag(examples)
     buildable:
       True
-    build-depends:
-      criterion  == 0.6.* ,
-      QuickCheck == 2.5
-  other-modules:
-    ADP.Fusion.GAPlike.DevelCommon
-    ADP.Fusion.GAPlike.Criterion
-    ADP.Fusion.GAPlike.QuickCheck
+    build-depends:  base
+                 ,  ADPfusion
+                 ,  primitive
+                 ,  PrimitiveArray
+                 ,  template-haskell
+                 ,  vector
+                 ,  DPutils
+  else
+    buildable:
+      False
+  hs-source-dirs:
+    src
   main-is:
-    Tests/GAPcriterion.hs
+    NeedlemanWunsch.hs
+  default-language:
+    Haskell2010
+  default-extensions: BangPatterns
+                    , DataKinds
+                    , FlexibleContexts
+                    , FlexibleInstances
+                    , MultiParamTypeClasses
+                    , PartialTypeSignatures
+                    , PolyKinds
+                    , RecordWildCards
+                    , TemplateHaskell
+                    , TypeApplications
+                    , TypeFamilies
+                    , TypeOperators
+                    , UnicodeSyntax
   ghc-options:
-    -fllvm -O2 -funbox-strict-fields -optlo-O3 -optlo-std-compile-opts
-  if impl(GHC > 7.4)
+    -O2
+    -funbox-strict-fields
+    -- these parameters do well enough with GHC 8.2
+    -- for larger programs, we may have to increase the number of worker
+    -- arguments.
+    -flate-dmd-anal
+    -fspec-constr-count=20
+    -fspec-constr-keen
+    -fspec-constr-recursive=20
+    -fspec-constr-threshold=20
+  if flag(debugdump)
     ghc-options:
-      -fnew-codegen
+      -ddump-to-file
+      -ddump-simpl
+      -dsuppress-all
+  if flag(llvm)
+    ghc-options:
+      -fllvm
+      -optlo-O3
+  if flag(dump-core)
+    build-depends: dump-core
+    ghc-options: -fplugin=DumpCore -fplugin-opt DumpCore:core-html
+
+
+
+executable SmithWaterman
+
+  if flag(examples)
+    buildable:
+      True
+    build-depends:  base
+                 ,  ADPfusion
+                 ,  primitive
+                 ,  PrimitiveArray
+                 ,  template-haskell
+                 ,  vector
+                 ,  DPutils
+  else
+    buildable:
+      False
+  hs-source-dirs:
+    src
+  main-is:
+    SmithWaterman.hs
+  default-language:
+    Haskell2010
+  default-extensions: BangPatterns
+                    , DataKinds
+                    , FlexibleContexts
+                    , FlexibleInstances
+                    , MultiParamTypeClasses
+                    , PartialTypeSignatures
+                    , PolyKinds
+                    , RecordWildCards
+                    , TemplateHaskell
+                    , TypeApplications
+                    , TypeFamilies
+                    , TypeOperators
+                    , UnicodeSyntax
+  ghc-options:
+    -O2
+    -funbox-strict-fields
+    -- these parameters do well enough with GHC 8.2
+    -- for larger programs, we may have to increase the number of worker
+    -- arguments.
+    -flate-dmd-anal
+    -fspec-constr-count=20
+    -fspec-constr-keen
+    -fspec-constr-recursive=20
+    -fspec-constr-threshold=20
+  if flag(debugdump)
+    ghc-options:
+      -ddump-to-file
+      -ddump-simpl
+      -dsuppress-all
+  if flag(llvm)
+    ghc-options:
+      -fllvm
+      -optlo-O3
+  if flag(dump-core)
+    build-depends: dump-core
+    ghc-options: -fplugin=DumpCore -fplugin-opt DumpCore:core-html
+
+
+
+-- Very simple two-sequence alignment.
+
+executable spectest
+
+  if flag(spectest)
+    buildable:
+      True
+    build-depends:  base
+                 ,  ADPfusion
+                 ,  PrimitiveArray
+                 ,  template-haskell
+                 ,  vector
+  else
+    buildable:
+      False
+  hs-source-dirs:
+    src
+  main-is:
+    SpecTest.hs
+  default-language:
+    Haskell2010
+  default-extensions: BangPatterns
+                    , FlexibleContexts
+                    , FlexibleInstances
+                    , MultiParamTypeClasses
+                    , RecordWildCards
+                    , TemplateHaskell
+                    , TypeFamilies
+                    , TypeOperators
+  ghc-options:
+    -O2
+    -funbox-strict-fields
+    -funfolding-use-threshold1000
+    -funfolding-keeness-factor1000
+
+
 
 
 source-repository head
diff --git a/LICENSE b/LICENSE
--- a/LICENSE
+++ b/LICENSE
@@ -1,4 +1,4 @@
-Copyright Christian Hoener zu Siederdissen 2011-2012
+Copyright Christian Hoener zu Siederdissen 2011-2015
 
 All rights reserved.
 
diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -1,15 +1,38 @@
+[![Build Status](https://travis-ci.org/choener/ADPfusion.svg?branch=master)](https://travis-ci.org/choener/ADPfusion)
 
-ADPfusion
-(c) 2012, Christian Hoener zu Siederdissen
-University of Vienna, Vienna, Austria
-choener@tbi.univie.ac.at
-LICENSE: BSD3
+# ADPfusion
 
+[*generalized Algebraic Dynamic Programming Homepage*](http://www.bioinf.uni-leipzig.de/Software/gADP/)
 
+Ideas implemented here are described in a couple of papers:
 
-Introduction
-============
 
+
+1.  Christian Hoener zu Siederdissen  
+    *Sneaking Around ConcatMap: Efficient Combinators for Dynamic Programming*  
+    2012, Proceedings of the 17th ACM SIGPLAN international conference on Functional programming  
+    [paper](http://doi.acm.org/10.1145/2364527.2364559) [preprint](http://www.tbi.univie.ac.at/newpapers/pdfs/TBI-p-2012-2.pdf)  
+1.  Andrew Farmer, Christian Höner zu Siederdissen, and Andy Gill.  
+    *The HERMIT in the stream: fusing stream fusion’s concatMap*  
+    2014, Proceedings of the ACM SIGPLAN 2014 workshop on Partial evaluation and program manipulation.  
+    [paper](http://dl.acm.org/citation.cfm?doid=2543728.2543736)  
+1.  Christian Höner zu Siederdissen, Ivo L. Hofacker, and Peter F. Stadler.  
+    *Product Grammars for Alignment and Folding*  
+    2014, IEEE/ACM Transactions on Computational Biology and Bioinformatics. 99  
+    [paper](http://ieeexplore.ieee.org/xpl/articleDetails.jsp?arnumber=6819790)  
+1.  Christian Höner zu Siederdissen, Sonja J. Prohaska, and Peter F. Stadler  
+    *Algebraic Dynamic Programming over General Data Structures*  
+    2015, BMC Bioinformatics  
+    [preprint](http://www.bioinf.uni-leipzig.de/Software/gADP/preprints/hoe-pro-2015.pdf)  
+1.  Maik Riechert, Christian Höner zu Siederdissen, and Peter F. Stadler  
+    *Algebraic dynamic programming for multiple context-free languages*  
+    2016, Theoretical Computer Science  
+    [preprint](http://www.bioinf.uni-leipzig.de/Software/gADP/preprints/rie-hoe-2015.pdf)  
+
+
+
+# Introduction
+
 ADPfusion combines stream-fusion (using the stream interface provided by the
 vector library) and type-level programming to provide highly efficient dynamic
 programming combinators.
@@ -34,84 +57,23 @@
 combinators. This facilitates writing code that performs backtracking, or
 samples structures stochastically, among others things.
 
-This version is still highly experimental and makes use of multiple recent
-improvements in GHC. This is particularly true for the monadic interface.
 
-Long term goals: Outer indices with more than two dimensions, specialized table
-design, a combinator library, a library for computational biology.
 
-Two algorithms from the realm of computational biology are provided as examples
-on how to write dynamic programming algorithms using this library:
-<http://hackage.haskell.org/package/Nussinov78> and
-<http://hackage.haskell.org/package/RNAfold>.
 
-
-Installation
-============
-
-If GHC-7.2.2/GHC-7.4, LLVM and cabal-install are available, you should be all
-set. I recommend using cabal-dev as it provides a very nice sandbox (replace
-cabal-dev with cabal otherwise).
-
-If you go with cabal-dev, no explicit installation is necessary and ADPfusion
-will be installed in the sandbox together with the example algorithms or your
-own.
-
-For a more global installation, "cabal install ADPfusion" should do the trick.
-
-To run the Quickcheck tests, do an additional "cabal-dev install QuickCheck",
-then "cabal-dev ghci", ":l ADP/Fusion/QuickCheck.hs", and "allProps". Loading
-the quickcheck module should take a bit due to compilation. "allProps" tests
-all properties and should yield no errors.
-
-
-
-Notes
-=====
-
-If you have problems, find bugs, or want to use this library to write your own
-DP algorithms, please send me a mail. I'm very interested in hearing what is
-missing.
-
-One of the things I'll be integrating is an extension to higher dimensions
-(more than two).
+# Installation
 
-Right now, I am not quite happy with the construction and destruction of the
-"Box" representations. These will change soon. In addition, an analysis of the
-actual combinators should remove the need for nested applications of objective
-functions in many cases.
+Follow the [gADP examples](http://www.bioinf.uni-leipzig.de/Software/gADP/index.html).
 
 
 
-VERSION HISTORY
-===============
+# Implementors Notes (if you want to extend ADPfusion)
 
-- 0.0.0.3:
-  - initial version, together with submitted paper
+These have been moved to [HACKING.md](https://github.com/choener/ADPfusion/blob/master/HACKING.md).
 
-- 0.0.0.4:
-  - based most combinators on just two generalized Box creators
-  - cleaned up and simplified RNAfold example
-  - RNAfold execution now a bit slower. Simplified energy functions typically
-    only have three arguments now, which can be of 'Primary' type. While this
-    reduces speed because we will repeatedly ask for the same value, it is much
-    easier to handle the different functions and ``play'' with fusion
-    properties.
-  - RNAfold compilation massively faster: execution/compilation tradoff is
-    worth it for experimenting with ADPfusion; still faster than anything
-    except RNAfold itself. We are now now 2.8x times slower, but 3.5x times
-    slower
-  - Quickcheck properties for many combinators
-  - Unit tests for RNAfold functions
-  - will soon split off RNAfold and Nussinov and publish three hackage
-    libraries
-  - this version was never available, after being done, a split into library
-    and examples was performed.
+#### Contact
 
-- 0.0.1.0
-  - providing just the library. Examples are found in different libraries.
+Christian Hoener zu Siederdissen  
+Leipzig University, Leipzig, Germany  
+choener@bioinf.uni-leipzig.de  
+<http://www.bioinf.uni-leipzig.de/~choener/>  
 
-- 0.0.1.1
-  - this version should be compatible with GHC-7.4, at least GHC-7,4.2-rc1.
-  - a type family (TF) version has not been able to show the same performance
-    as fundeps. This means that fundeps for Internal.hs stay alive, for now.
diff --git a/Tests/GAPcriterion.hs b/Tests/GAPcriterion.hs
deleted file mode 100644
--- a/Tests/GAPcriterion.hs
+++ /dev/null
@@ -1,9 +0,0 @@
-
-module Main where
-
-import ADP.Fusion.GAPlike2.Criterion
-
-
-
-main = criterionMain
-
diff --git a/changelog.md b/changelog.md
new file mode 100644
--- /dev/null
+++ b/changelog.md
@@ -0,0 +1,106 @@
+0.6.0.0
+-------
+
+- major change as to how rule compilation proceeds (ctor spec -> type class instances)
+- use new PrimitiveArray-0.9.0.0
+- backtrace from any given index using 'axiomAt'
+- Epsilon is tagged @Global or @Local, to allow local-alignment style algorithms
+
+0.5.3.0
+-------
+
+- using unboxed Ints (primbool style) for rule guards. This nets a nice speedup
+  of 30-50% for linear languages
+
+0.5.2.2
+-------
+
+- Modified signature of Edge to make explicit the @From@ and @To@ nodes of the
+  edge. Minor version bump, because @Edge@ is not official yet.
+- optimized table filling yields large improvements for linear languages
+
+0.5.2.1
+-------
+
+- removed upper bounds
+
+0.5.2.0
+-------
+
+- table filling fully inlined in the forward algorithm
+- experimental PrimBool operations
+- note: these optimizations are mostly of interest for linear languages, where
+  is rule (or function call) is comparatively expensive
+- major re-arrangement of modules: import ADP.Fusion.Core for development of
+  novel DP systems. Import ADP.Fusion.Point if you want to write a sequence
+  alignment algorithm
+
+0.5.1.0
+-------
+
+- improved table filling algorithm performance
+- some optimizations to terminal symbols
+
+0.5.0.0
+-------
+
+- complete re-design of Inside / Outside / Complement handling based on phantom
+  types
+- very liberal combination of multi-tape grammars
+- simplified index generation system (both faster, and easier to write new
+  symbol now)
+
+0.4.1.1
+-------
+
+- bugfix in Multitape Subword Index calculations (A.F.S.Indices.hs) [this one
+  is quite spurious. I needed quickcheck to find a suitable minimal example
+  where Pseudoknot.hs fails]
+
+0.4.1.0
+-------
+
+- initial support for multi-context free grammars
+- mcfgs allow for interleaved syntactic variables
+- applications include: natural language modelling and pseudoknotted structures
+  in RNA
+- the simplest formal language that requires this is: a^i b^j a^i b^j
+- the [GenussFold](http://hackage.haskell.org/package/GenussFold) library gives
+  a simple example grammar
+
+0.4.0.2
+-------
+
+- bugfixes
+
+0.4.0.0
+-------
+
+- travic-ci integration
+- forward phase now operates on immutable tables that are internally thawed
+- resembles the behavior of Data.Vector.Generic.constructN
+- Empty needs to be bound to input. We require this as certain index structures
+  have no natural notion of and empty index -- unless one provides additional
+  information in the index
+
+0.3.0.0
+-------
+
+- simplified boundary checking: sometimes gives performance gain (!) due to one
+  loop variable less
+- optimized loop variable design following "The HERMIT in the Stream" (Farmer
+  et al, 2014)
+- somewhat nicer programmer interfaces
+- automatic filling and freezing of tables
+- multiple example algorithms (build with -fexamples switch):
+  - Needleman-Wunsch global alignment
+  - RNA secondary structure prediction using simple base pair maximization
+- updated Table code to handle single-dim Subwords in a better way.
+- simplified backtracking
+
+0.2.x.x
+-------
+
+- Streamlined interface: access everything via ADP.Fusion
+- /Multi-tape/ grammars can now be written and are fused
+
diff --git a/src/NeedlemanWunsch.hs b/src/NeedlemanWunsch.hs
new file mode 100644
--- /dev/null
+++ b/src/NeedlemanWunsch.hs
@@ -0,0 +1,399 @@
+
+{-# Options_GHC -fforce-recomp #-}
+{-# Options_GHC -Wno-partial-type-signatures #-}
+
+-- | The Needleman-Wunsch global alignment algorithm. This algorithm is
+-- extremely simple but provides a good showcase for what ADPfusion offers.
+--
+-- The Needleman-Wunsch algorithm aligns to strings @x = x_1 x_2 x_3 ...@
+-- and @y = y_1 y_2 y_3 ...@ which may be of differing lengths. Assume that
+-- @x_1 ... x_{i-1}@ and @y_1 ... y_{j-1}@ have already been optimally
+-- aligned. We can match @x_i@ with @y_j@, or perform one of two possible
+-- insert-deletion pairs. Either @x_i@ is aligned with @-@ or @-@ is
+-- aligned with @y_j@. More general, in each DP step, either one or both
+-- inputs are extended by one character.
+--
+-- For the actual implementation, we assume however, that we work backward.
+-- The entries @d@, @u@, and @l@ have already been calculated. Now we want
+-- to compute the entry at @x@ in the lower right corner.
+--
+-- @
+--  -----
+--  |d|u|
+--  -----
+--  |l|x|
+--  -----
+-- @
+--
+-- We introduce a generic naming scheme for each possible move. If we move
+-- in a direction, we call it a @step@. If we do not move, then we call it
+-- a @loop@, because the index loops for this computation.
+--
+-- We can arrive from @d@, making a diagonal step, called @step_step@ as we
+-- advance by one in both dimensions. This leads to an alignment of two
+-- characters, one from each input, at @x@, which is combined with the
+-- already calculated alignment at @d@.
+--
+-- We can also just step in the first dimension @step_loop@, going from @l@
+-- to @x@. Which means that the first-dim character does not have
+-- a partner, leading to an insert/deletion or in/del. We typically do not
+-- care in which of the two dimensions the in/del happens, just that it
+-- does.
+--
+-- The third case is an in/del in the other dimension, giving us
+-- @loop_step@ or going from @u@ to @x@.
+--
+-- Of course, if @x@ happens to be the uppermost, leftmost cell, we have
+-- nowhere to come from, so we need to inititialize (or terminate depending
+-- on your view point) using the @nil_nil@ case. That one is the base case.
+--
+-- We also want to know which of the three cases is the best case (coming
+-- from @d,l,u@), this requires a "choice" function or @h@.
+--
+--
+-- We now implement this algorithm using the low-level ADPfusion library.
+-- Follow the code from top to bottom for a tutorial on usage. The
+-- Needleman-Wunsch tutorial for the @FormalGrammars@ library provides
+-- a higher-level style of implementation.
+--
+-- <http://hackage.haskell.org/package/FormalGrammars/docs/FormalLanguage-Tutorial-NeedlemanWunsch.html>
+--
+-- We also provide an implementation based on grammar products, which
+-- simplify the design of alignment-type algorithms. The corresponding
+-- tutorial is here.
+--
+-- <http://hackage.haskell.org/package/GrammarProducts/docs/FormalLanguage-Tutorial-NeedlemanWunsch.html>
+--
+--
+--
+-- We start by importing a bunch of modules, including
+-- @Data.PrimitiveArray@ for low-level arrays and automated filling of the
+-- arrays or tables in the correct order.
+--
+-- We also need to import @ADP.Fusion@ to access the high-level code for
+-- dynamic programs.
+--
+-- Don't forget to inline basically everything!
+--
+-- One note on performance: Needleman-Wunsch is actually one of the worst
+-- cases for ADPfusion. Low-level implementations can get away with a very
+-- small number of code steps for each cell to be filled. We can't /quite/
+-- do this. The relative overhead for each cell to be written into goes
+-- down with more complex grammars and algebras.
+
+module Main (main) where
+
+import           Control.Monad (forM_,when)
+import           Control.Monad.Primitive
+import           Control.Monad.ST
+import           Data.Ord.Fast
+import           Debug.Trace
+import           System.Environment (getArgs)
+import           Text.Printf
+
+-- Streams of parses are the streams defined in the @vector@ package.
+
+import qualified Data.Vector.Fusion.Stream.Monadic as SM
+
+-- We use unboxed vectors to hold the input sequences to be aligned. The
+-- terminal parses work with any vector in the @vector@ package.
+
+import qualified Data.Vector.Unboxed as VU
+import qualified Data.Vector.Storable as VS
+
+-- @Data.PrimitiveArray@ contains data structures, and index structures for
+-- dynamic programming. Notably, the primitive arrays holding the cell data
+-- with Boxed and Unboxed tables. In addition, linear, context-free, and
+-- set data structures are made available.
+
+import           Data.PrimitiveArray as PA hiding (map)
+
+-- @ADP.Fusion.Point@ exposes everything necessary for higher-level DP
+-- algorithms. Depending on the type of DP algorithm, different top-level
+-- modules can be imported. @.Point@ for linear grammars, and @.Core@ are
+-- provided in this package. @.Core@ exports only the core modules required
+-- to extend ADPfusion.
+
+import           ADP.Fusion.PointL
+
+import           Data.Ord.Fast
+
+
+
+-- | A signature connects the types of all non-terminals and terminals with
+-- evaluation (or attribute) functions. In the grammar below, we not only
+-- want to create all possible parses of how two strings can be aligned but
+-- also evaluate each parse and choose the optimal one based on Bellman's
+-- principle of optimality.
+--
+-- We take a close look at the type signatures. @step_step :: x ->
+-- (Z:.c:.c) -> x@ tells us that @step_step@ requires the score from the
+-- non-terminal, typed @x@ for the alignment up to @d@, then we get the two
+-- characters with type @c@ and produce a new non-terminal typed score @x@.
+-- For our simple alignment we'll later choose @Char@ for @c@ and @Int@ for
+-- @x@.
+--
+-- The type of @h :: Stream m x -> m r@ is more interesting. We get
+-- a @Stream@ of @x@'s and produce an @r@ monadically. The left part is
+-- clear @Stream m x@ are the results from the four rules, but the right
+-- part allows us to maybe not only return the best case, types @x == r@,
+-- but maybe the two best cases @r == (x,x)@ or similar. While we do not
+-- use this feature here, it makes ADPfusion fully "classified DP"
+-- capable, which is a really cool feature for advanced algorithms.
+
+data Signature m x r c = Signature
+  { step_step ∷ x → (Z:.c :.c ) → x
+  , step_loop ∷ x → (Z:.c :.()) → x
+  , loop_step ∷ x → (Z:.():.c ) → x
+  , nil_nil   ∷     (Z:.():.()) → x
+  , h         ∷ Stream m x -> m r
+  }
+
+-- | We also want to be able to backtrace the optimal result. Given our
+-- alignment, knowing that we get an alignment score of 29 doesn't help us
+-- much. But with /algebra products/ we can ask for @(optimal <** pretty)@
+-- and get the optimal result /and/ the parse for it.
+--
+-- The @(<**)@ operator is notoriously difficult to write, so we just
+-- compute it ☺.
+--
+-- Note that haddock actually shows @(<**)@, while you just write
+-- @makeAlgebraProductH ['h] ''Signature@ (the primes are TemplateHaskell!,
+-- the only TemplateHaskell we need).
+
+makeAlgebraProduct ''Signature
+
+-- | This is the linear grammar in two dimensions describing the
+-- "Needleman-Wunsch" search space. It will, in principle, enumerate the
+-- exponential number of possible alignment, but due to memoization and the
+-- choice function @h@, the calculation time is @O(N^2)@ and if only one
+-- optimal alignment is requested, backtracking works in linear time.
+--
+-- The grammar first requires a 'Signature', we use @RecordWildCards@ as
+-- a language extension to bind @step_step@ and friends. We also need
+-- a variable for the single non-terminal (@a@), and have two inputs @i1@
+-- and @i2@. Each grammar starts with a "base case" @Z:.@ followed by one
+-- or more pairs of non-terminal plus rules. Here we have one pair @(a,
+-- rules)@, where in @rules@ we combine the four different rules.
+--
+-- @step_step \<\<\< a % (M:>chr i1:>chr i2)@, for example, means that
+-- @step_step@ first gets the non-terminal @a@, which will give the score
+-- up to @d@ (see the ascii-art above), followed by @(%)@ the 2-dim
+-- terminal for @i1@ and @i2@.
+--
+-- Multi-dimensional terminals are built up from the zero-dimension @M@,
+-- separated by @:|@ symbols and just bind the input. In this case we want
+-- individual characters from @i1@ and @i2@, so we write @chr i1@ or @chr
+-- i2@.
+--
+-- Different rules are combined with @(|||)@ and the optimal case is
+-- selected via @... h@. Rules can, of course, be co-recursive, each rule
+-- can request all terminal and non-terminal symbols.
+--
+-- Due to the way @nil_nil@ works on @Epsilon@, @nil_nil@ is actually /only/
+-- called once, when we start the alignment, not for every cell!
+--
+-- /However/, due to this being a high-performance library, we do not
+-- provide a runtime scheme to detect misbehaving rules. Some debug-code is
+-- in place that performs certain checks in non-optimized GHCI sessions,
+-- but optimized code is built for raw speed, without any checks.
+--
+-- If you are a "conventional" DP programmer, you might miss the usual
+-- indices. Just as in the spiritual father of @ADPfusion@, Robert
+-- Giegerichs @ADP@, we hide the actual index calculations.
+
+grammar Signature{..} !a' !i1 !i2 =
+  let a = TW a' ( step_step <<< a % (M:|chr i1:|chr i2)     |||
+                  step_loop <<< a % (M:|chr i1:|Deletion  ) |||
+                  loop_step <<< a % (M:|Deletion  :|chr i2) |||
+                  nil_nil   <<< (M:|Epsilon @Global:|Epsilon @Global)       ... h
+                )
+  in Z:.a
+{-# INLINE grammar #-}
+
+-- | A grammar alone is not enough, we also need to say what a @step_step@
+-- means, or what an optimum is. Here, we do exactly that. We create an
+-- instance of the 'Signature' from above. Since this is a simple example,
+-- we just say that two aligned characters @a@ and @b@ yield a score of
+-- @x+1@ (with @x@ the previous alignment score) if the characters are
+-- identical. Otherwise we lower the score by 2. In/dels incur a cost of
+-- @-1@, meaning that a mismatch is actually the same as two in/dels, one
+-- in each dimension. The start of the alignment gives an initial score of
+-- 0.
+--
+-- And the optimal choice, of course, is to start with a default of
+-- @-999999@ and find the maximum of that score and the choices we are
+-- given.
+
+sScore ∷ Monad m ⇒ Signature m Int Int Char
+sScore = Signature
+  { step_step = \x (Z:.a:.b) → if a==b then x+7 else x-5
+  , step_loop = \x _         → x-3
+  , loop_step = \x _         → x-2
+  , nil_nil   = const 0
+  , h = SM.foldl' fastmax (-999999)
+--  , h = SM.foldl1' fastmax
+  }
+{-# INLINE sScore #-}
+
+-- | Scores alone are not enough, we also want to pretty-print alignments.
+-- An alignment are basically two strings @[String 1, String 2]@, being
+-- turned into a whole stream of alignments, using @Char@s for the
+-- individual characters being aligned.
+--
+-- We follow the same theme as in 'sScore', but this time @h = return
+-- . id@, that is the choice function @h@ does not (!) make choice but
+-- rather returns all alignments. You already heard about @<**@, we'll use
+-- it below.
+
+sPretty ∷ Monad m ⇒ Signature m [String] [[String]] Char
+sPretty = Signature
+  { step_step = \[x,y] (Z:.a :.b ) → [a  :x, b  :y]
+  , step_loop = \[x,y] (Z:.a :.()) → [a  :x, '-':y]
+  , loop_step = \[x,y] (Z:.():.b ) → ['-':x, b  :y]
+  , nil_nil   = const ["",""]
+  , h = SM.toList
+  }
+{-# Inline sPretty #-}
+
+-- | The inside grammar, with efficient table-filling (via
+-- 'nwInsideForward') and backtracking. Requests @k@ co-optimal
+-- backtrackings, given the inputs @i1@ and @i2@. The @fst@ element
+-- returned is the score, the @snd@ are the co-optimal parses.
+
+runNeedlemanWunsch
+  ∷ Int
+  → String
+  → String
+  → (Int,[[String]],PerfCounter)
+runNeedlemanWunsch k i1' i2' = (d, take k bs,perf) where
+  i1 = VU.fromList i1'
+  i2 = VU.fromList i2'
+  n1 = VU.length i1
+  n2 = VU.length i2
+  Mutated (Z:.t) perf eachPerf = nwInsideForward i1 i2
+  d = unId $ axiom t
+  bs = nwInsideBacktrack i1 i2 t
+{-# Noinline runNeedlemanWunsch #-}
+
+-- | The forward or table-filling phase. It is possible to inline this code
+-- directly into 'runNeedlemanWunsch'. Here, this phase is separated. If
+-- you use @ghc-core@ to examine the @GHC Core@ language, you can search
+-- for @nwInsideForward@ and check wether the inside code is optimized
+-- well. This is normally /not/ required, and only done here, because these
+-- algorithms are used to gauge efficiency of the fusion framework as well.
+--
+-- For your own code, you can write as done here, or in the way of
+-- 'runOutsideNeedlemanWunsch'.
+
+nwInsideForward
+  ∷ VU.Vector Char
+  → VU.Vector Char
+  → Mutated (Z:.TwITbl _ _ Id (Dense VU.Vector) (Z:.EmptyOk:.EmptyOk) (Z:.PointL I:.PointL I) Int)
+nwInsideForward !i1 !i2 = {-# SCC "nwInsideForward" #-} runST $ do
+  arr ← newWithPA (ZZ:..LtPointL n1:..LtPointL n2) (-999999)
+  ts ← fillTables $ grammar sScore
+                      (ITbl @_ @_ @_ @_ @0 @0 (Z:.EmptyOk:.EmptyOk) arr)
+                      i1 i2
+  return ts
+  where !n1 = VU.length i1
+        !n2 = VU.length i2
+{-# NoInline nwInsideForward #-}
+
+nwInsideBacktrack
+  ∷ VU.Vector Char
+  → VU.Vector Char
+  → TwITbl _ _ Id (Dense VU.Vector) (Z:.EmptyOk:.EmptyOk) (Z:.PointL I:.PointL I) Int
+  → [[String]]
+nwInsideBacktrack i1 i2 t = {-# SCC "nwInsideBacktrack" #-} unId $ axiom b
+  where !(Z:.b) = grammar (sScore <|| sPretty) (toBacktrack t (undefined :: Id a -> Id a)) i1 i2
+                    :: Z:.TwITblBt _ _ (Dense VU.Vector) (Z:.EmptyOk:.EmptyOk) (Z:.PointL I:.PointL I) Int Id Id [String]
+{-# NoInline nwInsideBacktrack #-}
+
+-- | The outside version of the Needleman-Wunsch alignment algorithm. The
+-- outside grammar is identical to the inside grammar! This is not
+-- generally the case, but here it is. Hence we may just use outside tables
+-- and the grammar from above.
+
+runOutsideNeedlemanWunsch
+  ∷ Int
+  → String
+  → String
+  → (Int,[[String]],PerfCounter)
+runOutsideNeedlemanWunsch k i1' i2' = {-# SCC "runOutside" #-} (d, take k . unId $ axiom b, perf) where
+  i1 = VU.fromList i1'
+  i2 = VU.fromList i2'
+  n1 = VU.length i1
+  n2 = VU.length i2
+  Mutated (Z:.t) perf eachPerf = nwOutsideForward i1 i2
+  d = unId $ axiom t
+  !(Z:.b) = grammar (sScore <|| sPretty) (toBacktrack t (undefined :: Id a -> Id a)) i1 i2
+              :: Z:.TwITblBt _ _ (Dense VU.Vector) (Z:.EmptyOk:.EmptyOk) (Z:.PointL O:.PointL O) Int Id Id [String]
+{-# Noinline runOutsideNeedlemanWunsch #-}
+
+-- | Again, to be able to observe performance, we have extracted the
+-- outside-table-filling part.
+--
+-- The partial type signature is filled by GHC.
+
+nwOutsideForward
+  ∷ VU.Vector Char
+  → VU.Vector Char
+  → Mutated (Z:.TwITbl _ _ Id (Dense VU.Vector) (Z:.EmptyOk:.EmptyOk) (Z:.PointL O:.PointL O) Int)
+nwOutsideForward !i1 !i2 = {-# SCC "nwOutsideForward" #-} runST $ do
+  arr ← newWithPA (ZZ:..LtPointL n1:..LtPointL n2) (-999999)
+  ts ← fillTables $ grammar sScore
+                      (ITbl @_ @_ @_ @_ @0 @0 (Z:.EmptyOk:.EmptyOk) arr)
+                      i1 i2
+  return ts
+  where !n1 = VU.length i1
+        !n2 = VU.length i2
+{-# Noinline nwOutsideForward #-}
+
+-- | This wrapper takes a list of input sequences and aligns each odd
+-- sequence with the next even sequence. We want one alignment for each
+-- such pair.
+--
+-- Since we use basic lists during backtracking, the resulting lists have
+-- to be reversed for inside-backtracking. Note that because the Outside
+-- grammar is quasi-right-linear, it does not require reversing the two
+-- strings.
+--
+-- For real applications, consider using @Data.Sequence@ which has @O(1)@
+-- append and prepend.
+
+align _ [] = return ()
+align _ [c] = putStrLn "single last line"
+align (kI,kO) (a:b:xs) = {-# SCC "align" #-} do
+  putStrLn a
+  putStrLn b
+  let (sI,rsI,perfI) = runNeedlemanWunsch kI a b
+  let (sO,rsO,perfO) = runOutsideNeedlemanWunsch kO a b
+  when (kI>=0) $ forM_ rsI $ \[u,l] -> printf "%s\n%s  %d\n\n" (reverse u) (reverse l) sI
+  when (kO>=0) $ forM_ rsO $ \[u,l] -> printf "%s\n%s  %d\n\n" (id      u) (id      l) sO
+  when (kI>=0) $ print sI
+  when (kO>=0) $ print sO
+  when (kI>=0) . putStrLn $ showPerfCounter perfI
+  when (kO>=0) . putStrLn $ showPerfCounter perfO
+  putStrLn ""
+  align (kI,kO) xs
+
+-- | And finally have a minimal main that reads from stdio.
+--
+-- If you are brave enough then put this through @ghc-core@ and look for
+-- @nwInsideForward@ or @nwOutsideForward@ in the CORE. Everything coming
+-- from the forward phase should be beautifully optimized and the algorithm
+-- should run quite fast.
+
+main = do
+  as <- getArgs
+  let k = case as of
+            [] -> (1,1)
+            [x] -> let x' = read x
+                   in (x',x')
+            [x,y] -> let x' = read x; y' = read y
+                     in  (x',y')
+            args -> error $ "too many arguments"
+  ls <- lines <$> getContents
+  align k ls
+
diff --git a/src/SmithWaterman.hs b/src/SmithWaterman.hs
new file mode 100644
--- /dev/null
+++ b/src/SmithWaterman.hs
@@ -0,0 +1,194 @@
+
+{-# Options_GHC -fforce-recomp #-}
+{-# Options_GHC -Wno-partial-type-signatures #-}
+
+{-# Language MagicHash #-}
+
+
+module Main (main) where
+
+import           Control.Monad (forM_,when)
+import           Debug.Trace
+import           System.Environment (getArgs)
+import           Text.Printf
+import           Control.Monad.Primitive
+import           Control.Monad.ST
+import           Data.Foldable (maximumBy)
+import           Data.Ord (comparing)
+import           Data.Ord.Fast
+import           GHC.Exts
+
+import qualified Data.Vector.Fusion.Stream.Monadic as SM
+import qualified Data.Vector.Unboxed as VU
+
+import           Data.PrimitiveArray as PA hiding (map)
+
+import           ADP.Fusion.PointL
+
+
+
+data Signature m x r c = Signature
+  { step_step ∷ x → (Z:.c :.c ) → x
+  , step_loop ∷ x → (Z:.c :.()) → x
+  , loop_step ∷ x → (Z:.():.c ) → x
+  , nil_nil   ∷     (Z:.():.()) → x
+  , h         ∷ Stream m x -> m r
+  }
+
+makeAlgebraProduct ''Signature
+
+grammar Signature{..} !a' !i1 !i2 =
+  let a = TW a' ( step_step <<< a % (M:|chr i1:|chr i2)     |||
+                  step_loop <<< a % (M:|chr i1:|Deletion  ) |||
+                  loop_step <<< a % (M:|Deletion  :|chr i2) |||
+                  nil_nil   <<< (M:|Epsilon @Local:|Epsilon @Local)       ... h
+                )
+  in Z:.a
+{-# INLINE grammar #-}
+
+fasteq ∷ Char → Char → Int → Int → Int
+{-# Inline fasteq #-}
+fasteq (C# a) (C# b) (I# x) (I# y) =
+  let l = (eqChar# a b)
+  in  I# ( (x *# l) +# (y *# (1# -# l)) )
+
+sScore ∷ Monad m ⇒ Signature m Int Int Char
+sScore = Signature
+  -- { step_step = \x (Z:.a:.b) → if a==b then x + 1 else x-2
+  { step_step = \x (Z:.a:.b) → fasteq a b (x+1) (x-2) -- if a==b then x + 1 else x-2
+  , step_loop = \x _         → x-1
+  , loop_step = \x _         → x-1
+  , nil_nil   = const 0
+  , h = SM.foldl' fastmax (-999999)
+  }
+{-# INLINE sScore #-}
+
+
+sPretty ∷ Monad m ⇒ Signature m [String] [[String]] Char
+sPretty = Signature
+  { step_step = \[x,y] (Z:.a :.b ) → [a  :x, b  :y]
+  , step_loop = \[x,y] (Z:.a :.()) → [a  :x, '-':y]
+  , loop_step = \[x,y] (Z:.():.b ) → ['-':x, b  :y]
+  , nil_nil   = const ["",""]
+  , h = SM.toList
+  }
+{-# Inline sPretty #-}
+
+
+runNeedlemanWunsch
+  ∷ Int
+  → String
+  → String
+  → ((Z:.PointL I:.PointL I),Int,[[String]],PerfCounter)
+runNeedlemanWunsch k i1' i2' = (fst dlocal, snd dlocal, take k bs,perf) where
+  i1 = VU.fromList i1'
+  i2 = VU.fromList i2'
+  n1 = VU.length i1
+  n2 = VU.length i2
+  Mutated (Z:.t) perf eachPerf = nwInsideForward i1 i2
+  dlocal = let TW (ITbl _ t') _ = t
+           in unId . SM.foldl' (\(ap,as) (p,s) → if s > as then (p,s) else (ap,as)) (Z:.PointL 0:.PointL 0,0) $ PA.assocsS t'
+  bs = nwInsideBacktrack i1 i2 t (fst dlocal)
+{-# Noinline runNeedlemanWunsch #-}
+
+
+nwInsideForward
+  ∷ VU.Vector Char
+  → VU.Vector Char
+  → Mutated (Z:.TwITbl _ _ Id (Dense VU.Vector) (Z:.EmptyOk:.EmptyOk) (Z:.PointL I:.PointL I) Int)
+nwInsideForward !i1 !i2 = {-# SCC "nwInsideForward" #-} runST $ do
+  arr ← newWithPA (ZZ:..LtPointL n1:..LtPointL n2) (-999999)
+  ts ← fillTables $ grammar sScore
+                      (ITbl @_ @_ @_ @_ @0 @0 (Z:.EmptyOk:.EmptyOk) arr)
+                      i1 i2
+  return ts
+  where !n1 = VU.length i1
+        !n2 = VU.length i2
+{-# NoInline nwInsideForward #-}
+
+nwInsideBacktrack
+  ∷ VU.Vector Char
+  → VU.Vector Char
+  → TwITbl _ _ Id (Dense VU.Vector) (Z:.EmptyOk:.EmptyOk) (Z:.PointL I:.PointL I) Int
+  → (Z:.PointL I:.PointL I)
+  → [[String]]
+nwInsideBacktrack i1 i2 t k = {-# SCC "nwInsideBacktrack" #-} unId $ axiomAt b k
+  where !(Z:.b) = grammar (sScore <|| sPretty) (toBacktrack t (undefined :: Id a -> Id a)) i1 i2
+                    :: Z:.TwITblBt _ _ (Dense VU.Vector) (Z:.EmptyOk:.EmptyOk) (Z:.PointL I:.PointL I) Int Id Id [String]
+{-# NoInline nwInsideBacktrack #-}
+
+
+--runOutsideNeedlemanWunsch
+--  ∷ Int
+--  → String
+--  → String
+--  → (Int,[[String]],PerfCounter)
+--runOutsideNeedlemanWunsch k i1' i2' = {-# SCC "runOutside" #-} (d, take k . unId $ axiom b, perf) where
+--  i1 = VU.fromList i1'
+--  i2 = VU.fromList i2'
+--  n1 = VU.length i1
+--  n2 = VU.length i2
+--  Mutated (Z:.t) perf eachPerf = nwOutsideForward i1 i2
+--  d = unId $ axiom t
+--  !(Z:.b) = grammar (sScore <|| sPretty) (toBacktrack t (undefined :: Id a -> Id a)) i1 i2
+--              :: Z:.TwITblBt _ _ (Dense VU.Vector) (Z:.EmptyOk:.EmptyOk) (Z:.PointL O:.PointL O) Int Id Id [String]
+--{-# Noinline runOutsideNeedlemanWunsch #-}
+--
+--
+--nwOutsideForward
+--  ∷ VU.Vector Char
+--  → VU.Vector Char
+--  → Mutated (Z:.TwITbl _ _ Id (Dense VU.Vector) (Z:.EmptyOk:.EmptyOk) (Z:.PointL O:.PointL O) Int)
+--nwOutsideForward !i1 !i2 = {-# SCC "nwOutsideForward" #-} runST $ do
+--  arr ← newWithPA (ZZ:..LtPointL n1:..LtPointL n2) (-999999)
+--  ts ← fillTables $ grammar sScore
+--                      (ITbl @_ @_ @_ @_ @0 @0 (Z:.EmptyOk:.EmptyOk) arr)
+--                      i1 i2
+--  return ts
+--  where !n1 = VU.length i1
+--        !n2 = VU.length i2
+--{-# Noinline nwOutsideForward #-}
+
+-- | This wrapper takes a list of input sequences and aligns each odd
+-- sequence with the next even sequence. We want one alignment for each
+-- such pair.
+--
+-- Since we use basic lists during backtracking, the resulting lists have
+-- to be reversed for inside-backtracking. Note that because the Outside
+-- grammar is quasi-right-linear, it does not require reversing the two
+-- strings.
+--
+-- For real applications, consider using @Data.Sequence@ which has @O(1)@
+-- append and prepend.
+
+align _ [] = return ()
+align _ [c] = putStrLn "single last line"
+align (kI,kO) (a:b:xs) = {-# SCC "align" #-} do
+  putStrLn a
+  putStrLn b
+  let (posI,sI,rsI,perfI) = runNeedlemanWunsch kI a b
+  when (kI>=0) $ forM_ rsI $ \[u,l] -> printf "%s\n%s\n  %d   %s\n\n" (reverse u) (reverse l) (sI) (show posI)
+  when (kI>=0) $ print sI
+  when (kI>=0) . putStrLn $ showPerfCounter perfI
+  putStrLn ""
+  align (kI,kO) xs
+
+-- | And finally have a minimal main that reads from stdio.
+--
+-- If you are brave enough then put this through @ghc-core@ and look for
+-- @nwInsideForward@ or @nwOutsideForward@ in the CORE. Everything coming
+-- from the forward phase should be beautifully optimized and the algorithm
+-- should run quite fast.
+
+main = do
+  as <- getArgs
+  let k = case as of
+            [] -> (1,1)
+            [x] -> let x' = read x
+                   in (x',x')
+            [x,y] -> let x' = read x; y' = read y
+                     in  (x',y')
+            args -> error $ "too many arguments"
+  ls <- lines <$> getContents
+  align k ls
+
diff --git a/src/SpecTest.hs b/src/SpecTest.hs
new file mode 100644
--- /dev/null
+++ b/src/SpecTest.hs
@@ -0,0 +1,116 @@
+
+-- | Lets try to get a grip on what specconstr does to our code.
+
+module Main (main) where
+
+import           Control.Applicative
+import           Control.Monad
+import           Data.Vector.Fusion.Stream.Monadic (Stream (..))
+import           Data.Vector.Fusion.Util
+import           Debug.Trace
+import qualified Control.Arrow as A
+import qualified Data.Vector as V
+import qualified Data.Vector.Fusion.Stream.Monadic as SM
+import qualified Data.Vector.Unboxed as VU
+import           System.Environment (getArgs)
+import           System.IO.Unsafe (unsafePerformIO)
+import           Text.Printf
+
+import           Data.PrimitiveArray as PA hiding (map)
+
+import           ADP.Fusion.Point
+
+
+
+
+data Signature m x r c = Signature
+  { step_step :: x -> (Z:.c :.c ) -> x
+  , step_loop :: x -> (Z:.c :.()) -> x
+  , loop_step :: x -> (Z:.():.c ) -> x
+  , nil_nil   ::      (Z:.():.()) -> x
+  , booboo    :: x -> (Z:.c:.c) -> (Z:.c:.c) -> (Z:.c:.c) -> (Z:.c:.c) -> x
+  , h         :: Stream m x -> m r
+  }
+
+
+
+grammar Signature{..} a' i1 i2 =
+  let a = a'  ( --step_step <<< a % (M:|chr i1:|chr i2)     |||
+--                step_loop <<< a % (M:|chr i1:|Deletion  ) |||
+--                loop_step <<< a % (M:|Deletion  :|chr i2) |||
+                step_step <<< a % (M:|chr i1:|chr i2)     |||
+--                step_step <<< a % (M:|chr i1:|chr i2)     |||
+--                step_step <<< a % (M:|chr i1:|chr i2)     |||
+--                step_step <<< a % (M:|chr i1:|chr i2)     |||
+--                step_step <<< a % (M:|chr i1:|chr i2)     |||
+--                step_step <<< a % (M:|chr i1:|chr i2)     |||
+--                step_step <<< a % (M:|chr i1:|chr i2)     |||
+--                step_step <<< a % (M:|chr i1:|chr i2)     |||
+--                booboo    <<< a % (M:|chr i1:|chr i2) % (M:|chr i1:|chr i2) % (M:|chr i1:|chr i2) % (M:|chr i1:|chr i2)    |||
+--                booboo    <<< a % (M:|chr i1:|chr i2) % (M:|chr i1:|chr i2) % (M:|chr i1:|chr i2) % (M:|chr i1:|chr i2)    |||
+--                booboo    <<< a % (M:|chr i1:|chr i2) % (M:|chr i1:|chr i2) % (M:|chr i1:|chr i2) % (M:|chr i1:|chr i2)    |||
+--                booboo    <<< a % (M:|chr i1:|chr i2) % (M:|chr i1:|chr i2) % (M:|chr i1:|chr i2) % (M:|chr i1:|chr i2)    |||
+--                booboo    <<< a % (M:|chr i1:|chr i2) % (M:|chr i1:|chr i2) % (M:|chr i1:|chr i2) % (M:|chr i1:|chr i2)    |||
+--                booboo    <<< a % (M:|chr i1:|chr i2) % (M:|chr i1:|chr i2) % (M:|chr i1:|chr i2) % (M:|chr i1:|chr i2)    |||
+--                booboo    <<< a % (M:|chr i1:|chr i2) % (M:|chr i1:|chr i2) % (M:|chr i1:|chr i2) % (M:|chr i1:|chr i2)    |||
+--                booboo    <<< a % (M:|chr i1:|chr i2) % (M:|chr i1:|chr i2) % (M:|chr i1:|chr i2) % (M:|chr i1:|chr i2)    |||
+--                booboo    <<< a % (M:|chr i1:|chr i2) % (M:|chr i1:|chr i2) % (M:|chr i1:|chr i2) % (M:|chr i1:|chr i2)    |||
+--                booboo    <<< a % (M:|chr i1:|chr i2) % (M:|chr i1:|chr i2) % (M:|chr i1:|chr i2) % (M:|chr i1:|chr i2)    |||
+--                booboo    <<< a % (M:|chr i1:|chr i2) % (M:|chr i1:|chr i2) % (M:|chr i1:|chr i2) % (M:|chr i1:|chr i2)    |||
+--                booboo    <<< a % (M:|chr i1:|chr i2) % (M:|chr i1:|chr i2) % (M:|chr i1:|chr i2) % (M:|chr i1:|chr i2)    |||
+--                booboo    <<< a % (M:|chr i1:|chr i2) % (M:|chr i1:|chr i2) % (M:|chr i1:|chr i2) % (M:|chr i1:|chr i2)    |||
+--                booboo    <<< a % (M:|chr i1:|chr i2) % (M:|chr i1:|chr i2) % (M:|chr i1:|chr i2) % (M:|chr i1:|chr i2)    |||
+--                booboo    <<< a % (M:|chr i1:|chr i2) % (M:|chr i1:|chr i2) % (M:|chr i1:|chr i2) % (M:|chr i1:|chr i2)    |||
+--                nil_nil   <<< (M:|Epsilon:|Epsilon)       |||
+--                nil_nil   <<< (M:|Epsilon:|Epsilon)       |||
+--                nil_nil   <<< (M:|Epsilon:|Epsilon)       |||
+--                nil_nil   <<< (M:|Epsilon:|Epsilon)       |||
+--                nil_nil   <<< (M:|Epsilon:|Epsilon)       |||
+--                nil_nil   <<< (M:|Epsilon:|Epsilon)       |||
+--                nil_nil   <<< (M:|Epsilon:|Epsilon)       |||
+--                nil_nil   <<< (M:|Epsilon:|Epsilon)       |||
+--                nil_nil   <<< (M:|Epsilon:|Epsilon)       |||
+--                nil_nil   <<< (M:|Epsilon:|Epsilon)       |||
+--                nil_nil   <<< (M:|Epsilon:|Epsilon)       |||
+                nil_nil   <<< (M:|Epsilon:|Epsilon)       ... h
+              )
+  in Z:.a
+{-# INLINE grammar #-}
+
+
+sScore :: Monad m => Signature m Int Int Char
+sScore = Signature
+  { step_step = \x (Z:.a:.b) -> if a==b then x+1 else x-2
+  , step_loop = \x _         -> x-1
+  , loop_step = \x _         -> x-1
+  , nil_nil   = const 0
+  , booboo    = \x _ _ _ _   -> x
+  , h = SM.foldl' max (-999999)
+  }
+{-# INLINE sScore #-}
+
+
+runNeedlemanWunsch :: Int -> String -> String -> Int
+runNeedlemanWunsch k i1' i2' = d where
+  i1 = VU.fromList i1'
+  i2 = VU.fromList i2'
+  n1 = VU.length i1
+  n2 = VU.length i2
+  !(Z:.t) = nwInsideForward i1 i2
+  d = unId $ axiom t
+{-# Noinline runNeedlemanWunsch #-}
+
+nwInsideForward :: VU.Vector Char -> VU.Vector Char -> Z:.ITbl Id Unboxed (Z:.EmptyOk:.EmptyOk) (Z:.PointL I:.PointL I) Int
+nwInsideForward i1 i2 = {-# SCC "nwInsideForward" #-} mutateTablesDefault $
+                          grammar sScore
+                          (ITbl 0 0 (Z:.EmptyOk:.EmptyOk) (PA.fromAssocs (Z:.PointL 0:.PointL 0) (Z:.PointL n1:.PointL n2) (-999999) []))
+                          i1 i2
+  where n1 = VU.length i1
+        n2 = VU.length i2
+{-# NoInline nwInsideForward #-}
+
+main = do
+  ls <- lines <$> getContents
+  print $ runNeedlemanWunsch 1 (ls!!0) (ls!!1)
+
+
diff --git a/tests/QuickCheck/Common.hs b/tests/QuickCheck/Common.hs
new file mode 100644
--- /dev/null
+++ b/tests/QuickCheck/Common.hs
@@ -0,0 +1,10 @@
+
+{-# Options_GHC -O0 #-}
+
+module QuickCheck.Common where
+
+import Debug.Trace
+
+
+
+tr zs ls b = traceShow (zs," ",ls,length zs,length ls) b
diff --git a/tests/QuickCheck/Point.hs b/tests/QuickCheck/Point.hs
new file mode 100644
--- /dev/null
+++ b/tests/QuickCheck/Point.hs
@@ -0,0 +1,328 @@
+
+{-# Options_GHC -O0 #-}
+
+module QuickCheck.Point where
+
+import           Control.Applicative
+import           Control.Monad
+import           Data.Strict.Tuple
+import           Data.Vector.Fusion.Util
+import           Debug.Trace
+--import           GHC.TypeNats
+import qualified Data.Vector.Fusion.Stream.Monadic as SM
+import qualified Data.Vector.Unboxed as VU
+import           System.IO.Unsafe
+import           Test.QuickCheck
+import           Test.QuickCheck.All
+import           Test.QuickCheck.Monadic
+-- #ifdef ADPFUSION_TEST_SUITE_PROPERTIES
+import           Test.Tasty.TH
+import           Test.Tasty.QuickCheck
+-- #endif
+
+import           Data.PrimitiveArray
+
+import           ADP.Fusion.PointL
+
+
+
+-- * Epsilon cases
+
+prop_I_Epsilon ix@(PointL j) = zs == ls where
+  zs = (id <<< Epsilon @Global ... stoList) maxPLi ix
+  ls = [ () | j == 0 ]
+
+prop_O_Epsilon ix@(PointL j) = zs == ls where
+  zs = (id <<< Epsilon @Global ... stoList) maxPLo ix
+  ls = [ () | j == maxI ]
+
+prop_I_ZEpsilon ix@(Z:.PointL j) = zs == ls where
+  zs = (id <<< (M:|Epsilon @Global) ... stoList) (ZZ:..maxPLi) ix
+  ls = [ Z:.() | j == 0 ]
+
+prop_O_ZEpsilon ix@(Z:.PointL j) = zs == ls where
+  zs = (id <<< (M:|Epsilon @Global) ... stoList) (ZZ:..maxPLo) ix
+  ls = [ Z:.() | j == maxI ]
+
+prop_O_ZEpsilonEpsilon ix@(Z:.PointL j:.PointL l) = zs == ls where
+  zs = (id <<< (M:|Epsilon @Global:|Epsilon @Global) ... stoList) (ZZ:..maxPLo:..maxPLo) ix
+  ls = [ Z:.():.() | j == maxI, l == maxI ]
+
+
+
+-- * Deletion cases
+
+prop_I_ItNC ix@(PointL j) = zs == ls where
+  zs = ((,,) <<< tSI % Deletion % chr xs ... stoList) maxPLi ix
+  ls = [ ( unsafeIndex xsP (PointL $ j-1)
+         , ()
+         , xs VU.! (j-1)
+         ) | j >= 1, j <= (maxI) ]
+
+prop_O_ItNC ix@(PointL j) = zs == ls where
+  zs = ((,,) <<< tSO % Deletion % chr xs ... stoList) maxPLo ix
+  ls = [ ( unsafeIndex xsPo (PointL $ j+1)
+         , ()
+         , xs VU.! (j+0)
+         ) | j >= 0, j <= (maxI-1) ]
+{-# Noinline prop_O_ItNC #-}
+
+prop_O_ZItNC ix@(Z:.PointL j) = zs == ls where
+  zs = ((,,) <<< tZ1O % (M:|Deletion) % (M:|chr xs) ... stoList) (ZZ:..maxPLo) ix
+  ls = [ ( unsafeIndex xsZPo (Z:.PointL (j+1))
+         , Z:.()
+         , Z:.xs VU.! (j+0)
+         ) | j >= 0, j <= (maxI-1) ]
+
+prop_O_2dimIt_NC_CN ix@(Z:.PointL j:.PointL l) = zs == ls where
+  zs = ((,,) <<< tZ2O % (M:|Deletion:|chr xs) % (M:|chr xs:|Deletion) ... stoList) (ZZ:..maxPLo:..maxPLo) ix
+  ls = [ ( unsafeIndex xsPPo (Z:.PointL (j+1):.PointL (l+1))
+         , Z:.()           :.xs VU.! (l+0)
+         , Z:.xs VU.! (j+0):.()
+         ) | j>=0, l>=0, j<=(maxI-1), l<=(maxI-1) ]
+
+prop_I_2dimIt_NC_CN ix@(Z:.PointL j:.PointL l) = zs == ls where
+  zs = ((,,) <<< tZ2I % (M:|Deletion:|chr xs) % (M:|chr xs:|Deletion) ... stoList) (ZZ:..maxPLi:..maxPLi) ix
+  ls = [ ( unsafeIndex xsPP (Z:.PointL (j-1):.PointL (l-1))
+         , Z:.()           :.xs VU.! (l-1)
+         , Z:.xs VU.! (j-1):.()
+         ) | j>=1, l>=1, j<=maxI, l<=maxI ]
+
+
+
+-- * terminal cases
+
+-- | A single character terminal
+--
+-- X_j -> c_j || j==1
+
+prop_I_Tt ix@(Z:.PointL j) = zs == ls where
+  zs = (id <<< (M:|chr xs) ... stoList) (ZZ:..maxPLi) ix
+  ls = [ (Z:.xs VU.! (j-1)) | 1==j ]
+
+-- |
+--
+-- X_j     -> ε_{j-1} c_j   ||| j==1
+-- E_{j-1} -> X_{j}   c_j
+-- E_j     -> X_{j+1} c_{j+1}    ||| j-1==max ?!
+
+prop_O_Tt ix@(Z:.(PointL j))
+  | zs == ls  = True
+  | otherwise = traceShow (j,zs,ls) False
+  where
+    zs = (id <<< (M:|chr xs) ... stoList) (ZZ:..maxPLo) ix
+    ls = [ (Z:.xs VU.! j) | j==maxI-1 ]
+
+-- | Two single-character terminals
+
+prop_I_CC ix@(Z:.PointL i) = zs == ls where
+  zs = ((,) <<< (M:|chr xs) % (M:|chr xs) ... stoList) (ZZ:..maxPLi) ix
+  ls = [ (Z:.xs VU.! (i-2), Z:.xs VU.! (i-1)) | 2==i ]
+
+-- | Just a table
+
+prop_I_It ix@(PointL j) = zs == ls where
+  zs = (id <<< tSI ... stoList) maxPLi ix
+  ls = [ unsafeIndex xsP ix | j>=0, j<=maxI ]
+
+prop_O_It ix@(PointL j) = zs == ls where
+  zs = (id <<< tSO ... stoList) maxPLo ix
+  ls = [ unsafeIndex xsPo ix | j>=0, j<=maxI ]
+
+prop_I_ZIt ix@(Z:.PointL j) = zs == ls where
+  zs = (id <<< tZ1I ... stoList) (ZZ:..maxPLi) ix
+  ls = [ unsafeIndex xsZP ix | j>=0, j<=maxI ]
+
+prop_I_2dimIt ix@(Z:.PointL i:.PointL j) = zs == ls where
+  zs = (id <<< tZ2I ... stoList) (ZZ:..maxPLi:..maxPLi) ix
+  ls = [ unsafeIndex xsPP ix | j>=0, j<=maxI ]
+
+prop_O_ZIt ix@(Z:.PointL j) = zs == ls where
+  zs = (id <<< tZ1O ... stoList) (ZZ:..maxPLo) ix
+  ls = [ unsafeIndex xsZPo ix | j>=0, j<=maxI ]
+
+-- | Table, then single terminal
+
+prop_I_ItC ix@(PointL j) = zs == ls where
+  zs = ((,) <<< tSI % chr xs ... stoList) maxPLi ix
+  ls = [ ( unsafeIndex xsP (PointL $ j-1)
+         , xs VU.! (j-1)
+         ) | j>=1, j<=maxI ]
+
+-- | @A^*_j -> A^*_{j+1} c_{j+1)@ !
+
+prop_O_ItC ix@(PointL j)
+  | zs == ls  = True
+  | otherwise = traceShow (j,zs,ls) False
+  where
+    zs = ((,) <<< tSO % chr xs ... stoList) maxPLo ix
+    ls = [ ( unsafeIndex xsPo (PointL $ j+1)
+           , xs VU.! (j+0)  -- j-1 in inside, here moved one right!
+           ) | j >= 0, j <= (maxI-1) ]
+
+prop_O_ItCC ix@(PointL j) = zs == ls where
+  zs = ((,,) <<< tSO % chr xs % chr xs ... stoList) maxPLo ix
+  ls = [ ( unsafeIndex xsPo (PointL $ j+2)
+         , xs VU.! (j+0)
+         , xs VU.! (j+1)
+         ) | j >= 0, j <= (maxI-2) ]
+
+prop_O_ItCCC ix@(PointL j) = zs == ls where
+  zs = ((,,,) <<< tSO % chr xs % chr xs % chr xs ... stoList) maxPLo ix
+  ls = [ ( unsafeIndex xsPo (PointL $ j+3)
+         , xs VU.! (j+0)
+         , xs VU.! (j+1)
+         , xs VU.! (j+2)
+         ) | j >= 0, j <= (maxI-3) ]
+
+prop_O_ZItCC ix@(Z:.PointL j) = zs == ls where
+  zs = ((,,) <<< tZ1O % (M:|chr xs) % (M:|chr xs) ... stoList) (ZZ:..maxPLo) ix
+  ls = [ ( unsafeIndex xsZPo (Z:.PointL (j+2))
+         , Z:.xs VU.! (j+0)
+         , Z:.xs VU.! (j+1)
+         ) | j >= 0, j <= (maxI-2) ]
+
+-- | synvar followed by a 2-tape character terminal
+
+prop_I_2dimItCC ix@(Z:.PointL j:.PointL l) = zs == ls where
+  zs = ((,,) <<< tZ2I % (M:|chr xs:|chr xs) % (M:|chr xs:|chr xs) ... stoList) (ZZ:..maxPLi:..maxPLi) ix
+  ls = [ ( unsafeIndex xsPP (Z:.PointL (j-2):.PointL (l-2))
+         , Z:.xs VU.! (j-2):.xs VU.! (l-2)
+         , Z:.xs VU.! (j-1):.xs VU.! (l-1)
+         ) | j>=2, l>=2, j<=maxI, l<=maxI ]
+
+prop_O_2dimItCC ix@(Z:.PointL j:.PointL l) = zs == ls where
+  zs = ((,,) <<< tZ2O % (M:|chr xs:|chr xs) % (M:|chr xs:|chr xs) ... stoList) (ZZ:..maxPLo:..maxPLo) ix
+  ls = [ ( unsafeIndex xsPPo (Z:.PointL (j+2):.PointL (l+2))
+         , Z:.xs VU.! (j+0):.xs VU.! (l+0)
+         , Z:.xs VU.! (j+1):.xs VU.! (l+1)
+         ) | j>=0, l>=0, j<=(maxI-2), l<=(maxI-2) ]
+
+-- * 'Strng' tests
+
+-- ** Just the 'Strng' terminal
+
+prop_I_ManyV ix@(PointL j) = zs == ls where
+  zs = (id <<< manyV xs ... stoList) maxPLi ix
+  ls = [ (VU.slice 0 j xs) ]
+
+prop_I_SomeV ix@(PointL j)
+  | zs == ls  = True
+  | otherwise = traceShow (ix,zs,ls) False
+  where
+  zs = (id <<< someV xs ... stoList) maxPLi ix
+  ls = [ (VU.slice 0 j xs) | j>0 ]
+
+prop_2dim_ManyV_ManyV ix@(Z:.PointL i:.PointL j) = zs == ls where
+  zs = (id <<< (M:|manyV xs:|manyV xs) ... stoList) (ZZ:..maxPLi:..maxPLi) ix
+  ls = [ (Z:.VU.slice 0 i xs:.VU.slice 0 j xs) ]
+
+prop_2dim_SomeV_SomeV ix@(Z:.PointL i:.PointL j) = zs == ls where
+  zs = (id <<< (M:|someV xs:|someV xs) ... stoList) (ZZ:..maxPLi:..maxPLi) ix
+  ls = [ (Z:.VU.slice 0 i xs:.VU.slice 0 j xs) | i > 0 && j > 0 ]
+
+-- ** Together with a syntactic variable.
+
+prop_I_Itbl_ManyV ix@(PointL i) = zs == ls where
+  zs = ((,) <<< tSI % manyV xs ... stoList) maxPLi ix
+  ls = [ (unsafeIndex xsP (PointL k), VU.slice k (i-k) xs) | k <- [0..i] ]
+
+prop_I_Itbl_SomeV ix@(PointL i) = zs == ls where
+  zs = ((,) <<< tSI % someV xs ... stoList) maxPLi ix
+  ls = [ (unsafeIndex xsP (PointL k), VU.slice k (i-k) xs) | k <- [0..i-1] ]
+
+-- | NOTE Be aware of the needed match between the type-level and value-level
+-- @13@s.
+
+prop_I_Itbl_Str ix@(PointL i) = zs == ls where
+  zs = ((,) <<< tSI % Str @_ @_ @Nothing @13 @Nothing xs ... stoList) maxPLi ix
+  ls = [ (unsafeIndex xsP (PointL k), VU.slice k (i-k) xs) | k <- [0..i-13] ]
+
+-- | And now for some funny type-level shenanigans.
+
+prop_I_Itbl_StrTyLvl (Positive bound', ix@(PointL i)) = let bound = bound' `mod` 23 in
+  case (someNatVal bound) of
+    Nothing → error "zzz"
+    Just (SomeNat (Proxy ∷ Proxy b)) →
+      let zs = ((,) <<< tSI % Str @_ @_ @Nothing @b @Nothing xs ... stoList) maxPLi ix
+          ls = [ (unsafeIndex xsP (PointL k), VU.slice k (i-k) xs) | k <- [0..i-bv] ]
+          bv = fromIntegral $ natVal (Proxy ∷ Proxy b)
+      in  zs == ls
+
+prop_I_1dim_Itbl_ManyV ix@(Z:.PointL i) = zs == ls where
+  zs = ((,) <<< tZ1I % (M:|manyV xs) ... stoList) (ZZ:..maxPLi) ix
+  ls = [ (unsafeIndex xsZP (Z:.PointL k), Z:. VU.slice k (i-k) xs) | k <- [0..i] ]
+
+prop_I_1dim_Itbl_SomeV ix@(Z:.PointL i) = zs == ls where
+  zs = ((,) <<< tZ1I % (M:|someV xs) ... stoList) (ZZ:..maxPLi) ix
+  ls = [ (unsafeIndex xsZP (Z:.PointL k), Z:. VU.slice k (i-k) xs) | k <- [0..i-1] ]
+
+prop_I_2dim_Itbl_ManyV_ManyV ix@(Z:.PointL i:.PointL j) = zs == ls where
+  zs = ((,) <<< tZ2I % (M:|manyV xs:|manyV xs) ... stoList) (ZZ:..maxPLi:..maxPLi) ix
+  ls = [ (unsafeIndex xsPP (Z:.PointL k:.PointL l), Z:. VU.slice k (i-k) xs :. VU.slice l (j-l) xs) | k <- [0..i], l <- [0..j] ]
+
+prop_I_2dim_Itbl_SomeV_SomeV ix@(Z:.PointL i:.PointL j) = zs == ls where
+  zs = ((,) <<< tZ2I % (M:|someV xs:|someV xs) ... stoList) (ZZ:..maxPLi:..maxPLi) ix
+  ls = [ (unsafeIndex xsPP (Z:.PointL k:.PointL l), Z:. VU.slice k (i-k) xs :. VU.slice l (j-l) xs) | k <- [0..i-1], l <- [0..j-1] ]
+
+
+
+stoList = unId . SM.toList
+
+--infixl 8 >>>
+--(>>>) f xs = \lu ij -> SM.map f . mkStream (build xs) (initialContext ij) lu $ ij
+
+tSI  = TW (ITbl @_ @_ @_ @_ @0 @0 EmptyOk xsP)  (\ (_ :: LimitType (PointL I)) (_ :: PointL I) -> Id (1::Int))
+tSO  = TW (ITbl @_ @_ @_ @_ @0 @0 EmptyOk xsPo) (\ (_ :: LimitType (PointL O)) (_ :: PointL O) -> Id (1::Int))
+tZ1I = TW (ITbl @_ @_ @_ @_ @0 @0 (Z:.EmptyOk) xsZP) (\ (_::LimitType (Z:.PointL I)) (_::Z:.PointL I) -> Id (1::Int))
+tZ1O = TW (ITbl @_ @_ @_ @_ @0 @0 (Z:.EmptyOk) xsZPo) (\ (_::LimitType (Z:.PointL O)) (_::Z:.PointL O) -> Id (1::Int))
+tZ2I = TW (ITbl @_ @_ @_ @_ @0 @0 (Z:.EmptyOk:.EmptyOk) xsPP) (\ (_::LimitType (Z:.PointL I:.PointL I)) (_::Z:.PointL I:.PointL I) -> Id (1::Int))
+tZ2O = TW (ITbl @_ @_ @_ @_ @0 @0 (Z:.EmptyOk:.EmptyOk) xsPPo) (\ (_::LimitType (Z:.PointL O:.PointL O)) (_::Z:.PointL O:.PointL O) -> Id (1::Int))
+
+xsP :: Unboxed (PointL I) Int
+xsP = fromList maxPLi [0 ..]
+
+xsZP :: Unboxed (Z:.PointL I) Int
+xsZP = fromList (ZZ:..maxPLi) [0 ..]
+
+xsPo :: Unboxed (PointL O) Int
+xsPo = fromList maxPLo [0 ..]
+
+xsZPo :: Unboxed (Z:.PointL O) Int
+xsZPo = fromList (ZZ:..maxPLo) [0 ..]
+
+xsPP :: Unboxed (Z:.PointL I:.PointL I) Int
+xsPP = fromList (ZZ:..maxPLi:..maxPLi) [0 ..]
+
+xsPPo :: Unboxed (Z:.PointL O:.PointL O) Int
+xsPPo = fromList (ZZ:..maxPLo:..maxPLo) [0 ..]
+
+mxsPP = unsafePerformIO $ zzz where
+  zzz :: IO (MutArr IO (Unboxed (Z:.PointL I:.PointL I) Int))
+  zzz = fromListM (ZZ:..maxPLi:..maxPLi) [0 ..]
+
+maxI =100
+
+maxPLi :: LimitType (PointL I)
+maxPLi = LtPointL maxI
+
+maxPLo :: LimitType (PointL O)
+maxPLo = LtPointL maxI
+
+xs = VU.fromList [0 .. maxI - 1 :: Int]
+
+-- * general quickcheck stuff
+
+options = stdArgs {maxSuccess = 1000 } -- 0}
+
+customCheck = quickCheckWithResult options
+
+return []
+allProps = $forAllProperties customCheck
+
+
+
+-- #ifdef ADPFUSION_TEST_SUITE_PROPERTIES
+testgroup_point = $(testGroupGenerator)
+-- #endif
+
diff --git a/tests/properties.hs b/tests/properties.hs
new file mode 100644
--- /dev/null
+++ b/tests/properties.hs
@@ -0,0 +1,14 @@
+
+-- | Test all properties automatically.
+
+module Main where
+
+import Test.Tasty
+
+import QuickCheck.Point   (testgroup_point)
+
+
+
+main :: IO ()
+main = defaultMain testgroup_point
+