diff --git a/ADP/Fusion/Base/Classes.hs b/ADP/Fusion/Base/Classes.hs
--- a/ADP/Fusion/Base/Classes.hs
+++ b/ADP/Fusion/Base/Classes.hs
@@ -1,6 +1,7 @@
 
 module ADP.Fusion.Base.Classes where
 
+import           Data.Proxy
 import           Data.Strict.Tuple
 import qualified Data.Vector.Fusion.Stream.Monadic as S
 
@@ -28,6 +29,34 @@
   type Context i :: *
   initialContext :: i -> Context i
 
+-- | 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.
+--
+-- TODO Sometimes, the actual RunningIndex ctors are not erased. This could
+-- be due to <https://ghc.haskell.org/trac/ghc/ticket/2289>. To test, we
+-- should transform RunningIndex into a type class to give us access to the
+-- left and right member, also we should create instances a la
+-- @RunningIndex (is :. Subword I) = RiSwI !(RunningIndex is) !Int@.
+-- Hopefully, these are completely erased.
+
+{-
+class RunningIndexCl i where
+  type RecursiveRl i :: *
+  type ThisRI i :: *
+-}
+
+data family RunningIndex i :: *
+
+data instance RunningIndex (is:.i) = !(RunningIndex is) :.: !(RunningIndex i)
+
+data instance RunningIndex Z = RiZ
+
+deriving instance Show (RunningIndex Z)
+
+
 -- | 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
@@ -41,8 +70,7 @@
   type RecElm x i :: *
   type Arg    x   :: *
   getArg :: Elm x i -> Arg x
-  getIdx :: Elm x i -> i
-  getOmx :: Elm x i -> i
+  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
@@ -80,16 +108,14 @@
 instance
   (
   ) => Element S i where
-  data Elm S i = ElmS !i !i
+  data Elm S i = ElmS !(RunningIndex i)
   type Arg S   = Z
-  getArg (ElmS _ _) = Z
-  getIdx (ElmS i _) = i
-  getOmx (ElmS _ o) = o
+  getArg (ElmS _) = Z
+  getIdx (ElmS i) = i
   {-# Inline getArg #-}
   {-# Inline getIdx #-}
-  {-# Inline getOmx #-}
 
-deriving instance Show ix => Show (Elm S ix)
+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.
@@ -114,35 +140,59 @@
 -- indices, or finally they can be 'OnlyZero' (only @i==j@ allowed) which is
 -- useful in multi-dimensional casese.
 
-data TableConstraint
-  = EmptyOk
-  | NonEmpty
-  | OnlyZero
-  deriving (Eq,Show)
+--data TableConstraint
+--  = EmptyOk
+--  | NonEmpty
+--  | OnlyZero
+--  deriving (Eq,Show)
 
+data EmptyOk = EmptyOk
+
+data NonEmpty = NonEmpty
+
+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 #-}
+
+{-
 minSize :: TableConstraint -> Int
 minSize NonEmpty = 1
 minSize _        = 0
-{-# INLINE minSize #-}
+{-# Inline [0] minSize #-}
+-}
 
 -- |
 --
 -- TODO Rewrite to generalize easily over multi-dim cases.
 
 class ModifyConstraint t where
-  toNonEmpty :: t -> t
-  toEmpty    :: t -> t
-
--- |
-
-type family   TblConstraint x       :: *
+  type TNE t :: *
+  type TE  t :: *
+  toNonEmpty :: t -> TNE t
+  toEmpty    :: t -> TE  t
 
-type instance TblConstraint (is:.i) =  TblConstraint is :. TblConstraint i
-type instance TblConstraint Z       = Z
+--
+--instance ModifyConstraint EmptyOk
+--  type TNE EmptyOk = NonEmpty
+--  type TE  EmptyOk = 
 
--- TODO move into the sub-modules
+-- |
 
-type instance TblConstraint (PointL  t) = TableConstraint
-type instance TblConstraint (PointR  t) = TableConstraint
-type instance TblConstraint (Subword t) = TableConstraint
+--type family   TblConstraint x       :: *
+--
+--type instance TblConstraint (is:.i) =  TblConstraint is :. TblConstraint i
+--type instance TblConstraint Z       = Z
+--
+---- TODO move into the sub-modules
+--
+--type instance TblConstraint (PointL  t) = TableConstraint
+--type instance TblConstraint (PointR  t) = TableConstraint
+--type instance TblConstraint (Subword t) = TableConstraint
 
diff --git a/ADP/Fusion/Base/Multi.hs b/ADP/Fusion/Base/Multi.hs
--- a/ADP/Fusion/Base/Multi.hs
+++ b/ADP/Fusion/Base/Multi.hs
@@ -37,50 +37,43 @@
 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)) !i !i !(Elm ls i)
+  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
-  getOmx (ElmTS _ _ o _ ) = o
+  getArg (ElmTS a _ ls) = getArg ls :. a
+  getIdx (ElmTS _ i _ ) = i
   {-# INLINE getArg #-}
   {-# INLINE getIdx #-}
 
-deriving instance (Show i, Show (TermArg (TermSymbol a b)), Show (Elm ls i)) => Show (Elm (ls :!: TermSymbol a b) i)
+deriving instance (Show i, Show (RunningIndex i), Show (TermArg (TermSymbol a b)), Show (Elm ls i)) => Show (Elm (ls :!: TermSymbol a b) i)
 
 instance
   ( Monad m
   , MkStream m ls i
   , Element ls i
---  , TerminalStream m (TermSymbol a b) i
   , TermStaticVar (TermSymbol a b) i
-  , TermStream m (TermSymbol a b) i i
+  , TermStream m (TermSymbol a b) (Elm ls i) i
   ) => MkStream m (ls :!: TermSymbol a b) i where
   mkStream (ls :!: ts) sv lu i
-    = map (\(TState sS _ _ ii oo ee) -> ElmTS ee ii oo sS)
+    = map (\(TState sS ii ee) -> ElmTS ee ii sS)
     . termStream ts sv lu i
-    {-
-    = S.map fromTerminalStream
-    . terminalStream ts sv i
-    . S.map toTerminalStream
-    -}
-    . map (\s -> TState s (getIdx s) (getOmx s) Z Z Z)
+    . map (\s -> TState s RiZ Z)
     $ mkStream ls (termStaticVar ts sv i) lu (termStreamIndex ts sv i)
   {-# Inline mkStream #-}
 
--- | Handles each individual argument within a stack of terminal symbols.
-
-class TerminalStream m t i where
-  terminalStream :: t -> Context i -> i -> S.Stream m (S5 s j j i i) -> S.Stream m (S6 s j j i i (TermArg t))
-
-iPackTerminalStream a sv    (ii:._)  = terminalStream a sv ii     . S.map (\(S5 s zi zo    (is:.i)     (os:.o) ) -> S5 s (zi:.i) (zo:.o)    is     os )
-{-# Inline iPackTerminalStream #-}
-
-instance (Monad m) => TerminalStream m M Z where
-  terminalStream M _ Z = S.map (\(S5 s j1 j2 Z Z) -> S6 s j1 j2 Z Z Z)
-  {-# INLINE terminalStream #-}
+---- | Handles each individual argument within a stack of terminal symbols.
+--
+--class TerminalStream m t i where
+--  terminalStream :: t -> Context i -> i -> S.Stream m (S5 s j j i i) -> S.Stream m (S6 s j j i i (TermArg t))
+--
+--iPackTerminalStream a sv    (ii:._)  = terminalStream a sv ii     . S.map (\(S5 s zi zo    (is:.i)     (os:.o) ) -> S5 s (zi:.i) (zo:.o)    is     os )
+--{-# Inline iPackTerminalStream #-}
+--
+--instance (Monad m) => TerminalStream m M Z where
+--  terminalStream M _ Z = S.map (\(S5 s j1 j2 Z Z) -> S6 s j1 j2 Z Z Z)
+--  {-# INLINE terminalStream #-}
 
 instance Monad m => MkStream m S Z where
-  mkStream _ _ _ _ = S.singleton (ElmS Z Z)
+  mkStream _ _ _ _ = S.singleton (ElmS RiZ)
   {-# INLINE mkStream #-}
 
 -- | For multi-dimensional terminals we need to be able to calculate how the
@@ -94,8 +87,8 @@
 instance TermStaticVar M Z where
   termStaticVar   _ _ _ = Z
   termStreamIndex _ _ _ = Z
-  {-# INLINE termStaticVar #-}
-  {-# INLINE termStreamIndex #-}
+  {-# INLINE [0] termStaticVar #-}
+  {-# INLINE [0] termStreamIndex #-}
 
 instance
   ( TermStaticVar a is
@@ -103,26 +96,26 @@
   ) => TermStaticVar (TermSymbol a b) (is:.i) where
   termStaticVar   (a:|b) (vs:.v) (is:.i) = termStaticVar   a vs is :. termStaticVar   b v i
   termStreamIndex (a:|b) (vs:.v) (is:.i) = termStreamIndex a vs is :. termStreamIndex b v i
-  {-# INLINE termStaticVar #-}
-  {-# INLINE termStreamIndex #-}
-
-data S3 a b c           = S3 !a !b !c
-
-data S4 a b c d         = S4 !a !b !c !d
-
-data S5 a b c d e       = S5 !a !b !c !d !e
-
-data S6 a b c d e f     = S6 !a !b !c !d !e !f
-
-data S7 a b c d e f g   = S7 !a !b !c !d !e !f !g
+  {-# INLINE [0] termStaticVar #-}
+  {-# INLINE [0] termStreamIndex #-}
 
-data S8 a b c d e f g h = S8 !a !b !c !d !e !f !g !h
+--data S3 a b c           = S3 !a !b !c
+--
+--data S4 a b c d         = S4 !a !b !c !d
+--
+--data S5 a b c d e       = S5 !a !b !c !d !e
+--
+--data S6 a b c d e f     = S6 !a !b !c !d !e !f
+--
+--data S7 a b c d e f g   = S7 !a !b !c !d !e !f !g
+--
+--data S8 a b c d e f g h = S8 !a !b !c !d !e !f !g !h
 
-fromTerminalStream (S6 s Z Z i o e) = ElmTS e i o s
-{-# INLINE fromTerminalStream #-}
+--fromTerminalStream (S6 s Z Z i o e) = ElmTS e i o s
+--{-# INLINE fromTerminalStream #-}
 
-toTerminalStream s = S5 s Z Z (getIdx s) (getOmx s)
-{-# INLINE toTerminalStream #-}
+--toTerminalStream s = S5 s Z Z (getIdx s) (getOmx s)
+--{-# INLINE toTerminalStream #-}
 
 instance RuleContext Z where
   type Context Z = Z
@@ -134,17 +127,17 @@
   initialContext (is:.i) = initialContext is:.initialContext i
   {-# INLINE initialContext #-}
 
-class TableStaticVar u i where
-  tableStaticVar   :: Proxy u -> TblConstraint u -> Context i -> i -> Context i
-  tableStreamIndex :: Proxy u -> TblConstraint u -> Context i -> i -> i
+class TableStaticVar u c i where
+  tableStaticVar   :: Proxy u -> c -> Context i -> i -> Context i
+  tableStreamIndex :: Proxy u -> c -> Context i -> i -> i
 
-instance TableStaticVar u Z where
+instance TableStaticVar c u Z where
   tableStaticVar   _ _ _ _ = Z
   tableStreamIndex _ _ _ _ = Z
   {-# INLINE [0] tableStaticVar   #-}
   {-# INLINE [0] tableStreamIndex #-}
 
-instance (TableStaticVar us is, TableStaticVar u i) => TableStaticVar (us:.u) (is:.i) where
+instance (TableStaticVar us cs is, TableStaticVar u c i) => TableStaticVar (us:.u) (cs:.c) (is:.i) where
   tableStaticVar   _ (cs:.c) (vs:.v) (is:.i) = tableStaticVar   (Proxy :: Proxy us) cs vs is :. tableStaticVar   (Proxy :: Proxy u) c v i
   tableStreamIndex _ (cs:.c) (vs:.v) (is:.i) = tableStreamIndex (Proxy :: Proxy us) cs vs is :. tableStreamIndex (Proxy :: Proxy u) c v i
   {-# INLINE [0] tableStaticVar   #-}
@@ -152,21 +145,22 @@
 
 
 
-data TermState s a i e = TState
-  { tS  :: !s -- | state coming in from the left
-  , tIx :: !a -- | @I/C@ index from @sS@
-  , tOx :: !a -- | @O@ index from @sS@
---  , tt  :: !u -- | @I/C@ building up state to index the @table@.
-  , iIx :: !i -- | @I/C@ building up state to hand over to next symbol
-  , iOx :: !i -- | @O@ building up state to hand over to next symbol
-  , eTS :: !e -- | element data
+data TermState s i e = TState
+  { tS  :: !s -- ^ state coming in from the left
+--  , tIx :: !(RunningIndex a) --  @I/C@ index from @sS@
+  , iIx :: !(RunningIndex i) -- ^ @I/C@ building up state to hand over to next symbol
+  , eTS :: !e -- ^ element data
   }
 
-class TermStream m t a i where
-  termStream :: t -> Context i -> i -> i -> Stream m (TermState s a Z Z) -> Stream m (TermState s a i (TermArg t))
+--getTIX :: (Element x0 a, s ~ Elm x0 a) => TermState s a i e -> RunningIndex a
+--getTIX (TState s a i e) = getIdx s
+--{-# Inline getTIX #-}
 
-instance TermStream m M a Z where
-  termStream _ _ _ _ = id
+class TermStream m t s i where
+  termStream :: t -> Context i -> i -> i -> Stream m (TermState s Z Z) -> Stream m (TermState s i (TermArg t))
+
+instance (Monad m) => TermStream m M s Z where
+  termStream _ _ _ _ = id -- map (\(!s) -> s)
   {-# Inline termStream #-}
 
 -- |
@@ -178,33 +172,55 @@
 
 addTermStream1
   :: ( Monad m
-     , TermStream m (TermSymbol M t) (Z:.a) (Z:.i)
-     , s ~ Elm x0 a
-     , Element x0 a
+     , TermStream m (TermSymbol M t) (Elm (Term1 s) (Z:.i)) (Z:.i)
      )
-  => t -> Context i -> i -> i -> Stream m s -> Stream m (s,TermArg t,i,i)
+  => t -> Context i -> i -> i -> Stream m s -> Stream m (s,TermArg t,RunningIndex i)
 addTermStream1 t c u i
-  = map (\(TState sS _ _ (Z:.ii) (Z:.oo) (Z:.ee)) -> (sS,ee,ii,oo))
+  = map (\(TState (ElmTerm1 sS) (RiZ:.:ii) (Z:.ee)) -> (sS,ee,ii))
   . termStream (M:|t) (Z:.c) (Z:.u) (Z:.i)
-  . map (\s -> TState s (Z:.getIdx s) (Z:.getOmx s) Z Z Z)
+  . 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
 
 type TmkCtx1 m ls t i
   = ( Monad m
     , MkStream m ls i
-    , TermStream m (TermSymbol M t) (Z:.i) (Z:.i)
+    , TermStream m (TermSymbol M t) (Elm (Term1 (Elm ls i)) (Z:.i)) (Z:.i)
     , Element ls i
     , TermStaticVar t i
     )
 
 -- | @Term TermStream@ context
 
-type TstCtx1 m ts a is i
+--type TstCtx1 m ts s sixty is i
+--  = ( Monad m
+--    , TermStream m ts s is
+--    , GetIndex (RunningIndex sixty) (RunningIndex (is:.i))
+--    , GetIx (RunningIndex sixty) (RunningIndex (is:.i)) ~ (RunningIndex i)
+--    )
+
+type TstCtx m ts s x0 sixty is i
   = ( Monad m
-    , TermStream m ts a is
-    , GetIndex a (is:.i)
-    , GetIx a (is:.i) ~ i
+    , TermStream m 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/Base/Point.hs b/ADP/Fusion/Base/Point.hs
--- a/ADP/Fusion/Base/Point.hs
+++ b/ADP/Fusion/Base/Point.hs
@@ -1,6 +1,7 @@
 
 module ADP.Fusion.Base.Point where
 
+import Data.Proxy
 import Data.Vector.Fusion.Stream.Monadic (singleton,map,filter,Step(..))
 import Debug.Trace
 import Prelude hiding (map,filter)
@@ -27,85 +28,87 @@
   initialContext _ = Complemented
   {-# Inline initialContext #-}
 
+newtype instance RunningIndex (PointL I) = RiPlI Int
 
+data instance RunningIndex (PointL O) = RiPlO !Int !Int
 
-instance (Monad m) => MkStream m S (PointL I) where
-  mkStream S (IStatic d) (PointL u) (PointL j)
-    = staticCheck (j>=0 && j<=d) . singleton $ ElmS (PointL 0) (PointL 0)
-  mkStream S (IVariable _) (PointL u) (PointL j)
-    = staticCheck (0<=j) . singleton $ ElmS (PointL 0) (PointL 0)
-  {-# Inline mkStream #-}
+data instance RunningIndex (PointL C) = RiPlC !Int
 
-instance (Monad m) => MkStream m S (PointL O) where
-  mkStream S (OStatic d) (PointL u) (PointL i)
-    = staticCheck (i>=0 && i+d<=u && u == i) . singleton $ ElmS (PointL i) (PointL $ i+d)
-  mkStream S (OFirstLeft d) (PointL u) (PointL i)
-    = staticCheck (i>=0 && i+d<=u) . singleton $ ElmS (PointL i) (PointL $ i+d)
-  {-# Inline mkStream #-}
 
 
+instance (Monad m) => MkStream m S (PointL I) where
+  mkStream S (IStatic d) (PointL u) (PointL i)
+    = staticCheck (i>=0 && i<=d && i<=u)
+    . singleton . ElmS $ RiPlI 0
+  mkStream S (IVariable _) (PointL u) (PointL i)
+    = staticCheck (i>=0 && i<=u)
+    . singleton . ElmS $ RiPlI 0
+  {-# Inline mkStream #-}
 
 instance
   ( Monad m
   , MkStream m S is
---  , Context (is:.PointL) ~ (Context is:.(InsideContext Int))
   ) => MkStream m S (is:.PointL I) where
   mkStream S (vs:.IStatic d) (lus:.PointL u) (is:.PointL i)
-    = staticCheck (i>=0 && i<=d && i<=u)
-    . map (\(ElmS zi zo) -> ElmS (zi:.PointL 0) (zo:.PointL 0))
+    = map (\(ElmS zi) -> ElmS $ zi :.: RiPlI 0)
+    . staticCheck (i>=0 && i<=d && i<=u)
     $ mkStream S vs lus is
-  {-
-  mkStream S (vs:.IVariable ) (lus:.PointL u) (is:.PointL i)
-    = flatten mk step Unknown $ mkStream S vs lus is
-    where mk e = i `seq` return (e,i)
-          step (ElmS zi zo,k )
-            | k>=0 && k<=u = return $ Yield (ElmS (zi:.PointL k) (zo:.PointL 0)) (ElmS zi zo, -1)
-            | otherwise    = return $ Done
-          {-# Inline [0] mk   #-}
-          {-# Inline [0] step #-}
-  -}
-  -- TODO here, we have a problem in the interplay of @staticCheck@ or
-  -- @flatten@ and how we modify @is@. Apparently, once we demand to know
-  -- about @i@, fusion breaks down.
   mkStream S (vs:.IVariable d) (lus:.PointL u) (is:.PointL i)
-    = staticCheck (i>=0 && i<=u)
-    $ map (\(ElmS zi zo) -> ElmS (zi:.PointL 0) (zo:.PointL 0))
+    = map (\(ElmS zi) -> ElmS $ zi :.: RiPlI 0)
+    . staticCheck (i>=0 && i<=u)
     $ mkStream S vs lus is
   {-# INLINE mkStream #-}
 
+
+
+instance (Monad m) => MkStream m S (PointL O) where
+  mkStream S (OStatic d) (PointL u) (PointL i)
+    = staticCheck (i>=0 && i+d<=u && u == i) . singleton . ElmS $ RiPlO i (i+d)
+  mkStream S (OFirstLeft d) (PointL u) (PointL i)
+    = staticCheck (i>=0 && i+d<=u) . singleton . ElmS $ RiPlO i (i+d)
+  {-# Inline mkStream #-}
+
 instance
   ( Monad m
   , MkStream m S is
---  , Context (Outside (is:.PointL)) ~ (Context (Outside is) :. OutsideContext Int)
   ) => MkStream m S (is:.PointL O) where
   mkStream S (vs:.OStatic d) (lus:.PointL u) (is:.PointL i)
     = staticCheck (i>=0 && i+d == u)
-    . map (\(ElmS zi zo) -> ElmS (zi:.PointL i) (zo:.(PointL $ i+d)))
+    . map (\(ElmS zi) -> ElmS $ zi :.: RiPlO i (i+d))
     $ mkStream S vs lus is
   mkStream S (vs:.OFirstLeft d) (us:.PointL u) (is:.PointL i)
     = staticCheck (i>=0 && i+d<=u)
-    . map (\(ElmS zi zo) -> ElmS (zi:.PointL i) (zo:.(PointL $ i+d)))
+    . map (\(ElmS zi) -> ElmS $ zi :.: RiPlO i (i+d))
     $ mkStream S vs us is
   {-# Inline mkStream #-}
 
-instance (TblConstraint u ~ TableConstraint) => TableStaticVar u (PointL I) where
+
+
+instance (Monad m) => MkStream m S (PointL C) where
+  mkStream S Complemented (PointL u) (PointL i)
+    = staticCheck (i>=0 && i<=u) . singleton . ElmS $ RiPlC i
+  {-# Inline mkStream #-}
+
+
+
+instance (MinSize c) => TableStaticVar u c (PointL I) where
   tableStaticVar _ _ (IStatic   d) _ = IVariable d
   tableStaticVar _ _ (IVariable d) _ = IVariable d
   -- NOTE this code used to destroy fusion. If we inline tableStreamIndex
   -- very late (after 'mkStream', probably) then everything works out.
-  tableStreamIndex _ c _ (PointL j)
-    | c==EmptyOk  = PointL j
-    | c==NonEmpty = PointL $ j-1
-    | c==OnlyZero = PointL j -- this should then actually request a size in 'tableStaticVar' ...
+  tableStreamIndex _ c _ (PointL j) = PointL $ j - minSize c
   {-# INLINE [0] tableStaticVar   #-}
   {-# INLINE [0] tableStreamIndex #-}
 
-instance (TblConstraint u ~ TableConstraint) => TableStaticVar u (PointL O) where
-  tableStaticVar   _ _ (OStatic d) _ = OFirstLeft d
-  tableStreamIndex _ c _ (PointL j)
-    | c==EmptyOk  = (PointL j)
-    | c==NonEmpty = (PointL $ j-1)
-    | c==OnlyZero = (PointL j) -- this should then actually request a size in 'tableStaticVar' ...
+instance (MinSize c) => TableStaticVar u c (PointL O) where
+  tableStaticVar   _ _ (OStatic d) _          = OFirstLeft d
+  tableStreamIndex _ c _           (PointL j) = PointL $ j - minSize c
+  {-# INLINE [0] tableStaticVar   #-}
+  {-# INLINE [0] tableStreamIndex #-}
+
+instance (MinSize c) => TableStaticVar u c (PointL C) where
+  tableStaticVar   _ _ Complemented _          = Complemented
+  tableStreamIndex _ c _            (PointL k) = PointL $ k - minSize c
   {-# INLINE [0] tableStaticVar   #-}
   {-# INLINE [0] tableStreamIndex #-}
 
diff --git a/ADP/Fusion/Base/Set.hs b/ADP/Fusion/Base/Set.hs
--- a/ADP/Fusion/Base/Set.hs
+++ b/ADP/Fusion/Base/Set.hs
@@ -5,6 +5,7 @@
 
 module ADP.Fusion.Base.Set where
 
+import Data.Proxy
 import Data.Vector.Fusion.Stream.Monadic (singleton,filter,enumFromStepN,map,unfoldr)
 import Debug.Trace
 import Prelude hiding (map,filter)
@@ -18,8 +19,8 @@
 
 
 
-type instance TblConstraint (BitSet t)  = TableConstraint
-type instance TblConstraint (BS2 i j t) = TableConstraint
+--type instance TblConstraint (BitSet t)  = TableConstraint
+--type instance TblConstraint (BS2 i j t) = TableConstraint
 
 
 
@@ -43,8 +44,13 @@
   initialContext _ = Complemented
   {-# Inline initialContext #-}
 
+newtype instance RunningIndex (BitSet I) = RiBsI (BitSet I)
 
+data instance RunningIndex (BitSet O) = RiBsO !(BitSet O) !(BitSet O)
 
+data instance RunningIndex (BitSet C) = RiBsC !(BitSet C) !(BitSet C)
+
+
 instance RuleContext (BS2 First Last I) where
   type Context (BS2 First Last I) = InsideContext Int
   initialContext _ = IStatic 0
@@ -60,8 +66,14 @@
   initialContext _ = Complemented
   {-# Inline initialContext #-}
 
+newtype instance RunningIndex (BS2 First Last I) = RiBs2I (BS2 First Last I)
 
+data instance RunningIndex (BS2 First Last O) = RiBs2O !(BS2 First Last O) !(BS2 First Last O)
 
+data instance RunningIndex (BS2 First Last C) = RiBs2C !(BS2 First Last C) !(BS2 First Last C)
+
+
+
 instance
   ( Monad m
   ) => MkStream m S (BitSet I) where
@@ -71,7 +83,7 @@
   -- @s@ has been recovered. Otherwise we would have an @IVariable@
   -- context.
   mkStream S (IStatic rb) u s
-    = staticCheck (rb <= ps) . map (\k -> ElmS (popShiftL s k) 0) $ unfoldr go strt
+    = staticCheck (rb <= ps) . map (\k -> ElmS . RiBsI $ popShiftL s k) $ unfoldr go strt
     where strt = Just $ BitSet $ 2^(ps - rb) - 1
           ps   = popCount s
           go Nothing  = Nothing
@@ -79,7 +91,7 @@
   -- | Once we are variable, we do not reserve any bits, just check that
   -- the total reservation (if any) works.
   mkStream S (IVariable rb) u s
-    = staticCheck (rb <= popCount s) . singleton $ ElmS 0 0
+    = staticCheck (rb <= popCount s) . singleton . ElmS $ RiBsI 0
   {-# Inline mkStream #-}
 
 -- | Initial index construction for outside Bitsets. Bits set to @0@
@@ -100,11 +112,11 @@
   ) => MkStream m S (BitSet O) where
   -- | Same argument as above for @BitSet O@ construction.
   mkStream S (OStatic rb) u s
-    = staticCheck (rb + popCount s <= popCount u) . singleton $ ElmS s s
+    = staticCheck (rb + popCount s <= popCount u) . singleton . ElmS $ RiBsO s s
   mkStream S (ORightOf _) u s
     = error "ADP.Fusion.Base.Set: Entered ORightOf/BitSet (this is probably wrong because it means we have an outside cfg with only terminals on the r.h.s, and the terminals are not a single Outside-Epsilon)"
   mkStream S (OFirstLeft rb) u s
-    = staticCheck (rb + popCount s <= popCount u) . singleton $ ElmS s s
+    = staticCheck (rb + popCount s <= popCount u) . singleton . ElmS $ RiBsO s s
 --  mkStream S (OLeftOf rp) u s
 --    = staticCheck (popCount s + rp <= popCount u) . singleton $ ElmS s s
   {-# Inline mkStream #-}
@@ -117,9 +129,9 @@
   ( Monad m
   ) => MkStream m S (BS2 First Last I) where
   mkStream S (IStatic rp) u sij@(BS2 s (Iter i) _)
-    = staticCheck (popCount s == 0 && rp == 0) . singleton $ ElmS (BS2 0 (Iter i) (Iter i)) undefbs2i
+    = staticCheck (popCount s == 0 && rp == 0) . singleton . ElmS . RiBs2I $ BS2 0 (Iter i) (Iter i)
   mkStream S (IVariable rp) u sij@(BS2 s (Iter i) _)
-    = staticCheck (popCount s >= rp) . singleton $ ElmS (BS2 0 (Iter i) (Iter i)) undefbs2i
+    = staticCheck (popCount s >= rp) . singleton . ElmS . RiBs2I $ BS2 0 (Iter i) (Iter i)
   {-# Inline mkStream #-}
 
 instance
@@ -142,23 +154,23 @@
 undefi = (-1)
 {-# Inline undefi #-}
 
-instance TableStaticVar (u O) (BitSet O) where
+instance TableStaticVar (u O) c (BitSet O) where
   tableStaticVar _ _ (OStatic  d) _ = OFirstLeft d
   tableStaticVar _ _ (ORightOf d) _ = OFirstLeft d
   tableStreamIndex _ c _ bs = bs
   {-# INLINE [0] tableStaticVar   #-}
   {-# INLINE [0] tableStreamIndex #-}
 
-instance TableStaticVar (u I) (BitSet O) where
+instance TableStaticVar c (u I) (BitSet O) where
 
-instance (TblConstraint u ~ TableConstraint) => TableStaticVar u (BitSet I) where
+instance (MinSize c) => TableStaticVar u c (BitSet I) where
   tableStaticVar _ c (IStatic   d) _ = IVariable $ d - minSize c -- TODO rly?
   tableStaticVar _ _ (IVariable d) _ = IVariable $ d
   tableStreamIndex _ c _ bitSet = bitSet -- TODO rly?
   {-# INLINE [0] tableStaticVar   #-}
   {-# INLINE [0] tableStreamIndex #-}
 
-instance (TblConstraint u ~ TableConstraint) => TableStaticVar u (BS2 i j I) where
+instance TableStaticVar c u (BS2 i j I) where
 
 -- | We sometimes need 
 
diff --git a/ADP/Fusion/Base/Subword.hs b/ADP/Fusion/Base/Subword.hs
--- a/ADP/Fusion/Base/Subword.hs
+++ b/ADP/Fusion/Base/Subword.hs
@@ -30,8 +30,23 @@
   initialContext _ = Complemented
   {-# Inline initialContext #-}
 
+-- | The moving index @k@ in @Subword (i:.k)@.
 
+newtype instance RunningIndex (Subword I) = RiSwI Int
 
+-- | The moving indices @Inside (i:.j)@ and @Outside (k:.l)@ in order @i
+-- j k l@.
+--
+-- TODO can we do with 2x Int?
+
+data instance RunningIndex (Subword O) = RiSwO !Int !Int !Int !Int
+
+-- | The indices @Subword (i:.j)@ in order @i j@.
+
+data instance RunningIndex (Subword C) = RiSwC !Int !Int
+
+
+
 -- | NOTE it seems that a static check within an @IVariable@ context
 -- destroys fusion; maybe because of the outer flatten? We don't actually
 -- need a static check anyway because the next flatten takes care of
@@ -43,23 +58,27 @@
 
 instance (Monad m) => MkStream m S (Subword I) where
   mkStream S (IStatic ()) (Subword (_:.h)) (Subword (i:.j))
-    = staticCheck (i>=0 && i==j && j<=h)
+    -- = staticCheck (0<=i && i<=j)
+    = filter (const $ 0<=i && i<=j)
     . singleton
-    $ ElmS (subword i i) (subword 0 0)
+    . ElmS $ RiSwI i
   mkStream S (IVariable ()) (Subword (_:.h)) (Subword (i:.j))
-    = filter (const $ 0<=i && i<=j && j<=h) . singleton $ ElmS (subword i i) (subword 0 0)
+    -- = staticCheck (0<=i && i<=j)
+    = filter (const $ 0<=i && i<=j && j<=h)
+    . singleton
+    . ElmS $ RiSwI i
   {-# Inline mkStream #-}
 
 instance (Monad m) => MkStream m S (Subword O) where
   mkStream S (OStatic (di:.dj)) (Subword (_:.h)) (Subword (i:.j))
-    = staticCheck (i==0 && j+dj==h) . singleton $ ElmS (subword i j) (Subword (i:.j+dj))
+    = staticCheck (i==0 && j+dj==h) . singleton . ElmS $ RiSwO i j  i (j+dj)
   mkStream S (OFirstLeft (di:.dj)) (Subword (_:.h)) (Subword (i:.j))
     = let i' = i-di
-      in  staticCheck (0 <= i' && i<=j && j+dj<=h) . singleton $ ElmS (subword i' i') (subword i' i')
+      in  staticCheck (0 <= i' && i<=j && j+dj<=h) . singleton . ElmS $ RiSwO i' i' i' i'
   mkStream S (OLeftOf (di:.dj)) (Subword (_:.h)) (Subword (i:.j))
     = let i' = i-di
       in  staticCheck (0 <= i' && i<=j && j+dj<=h)
-    $ map (\k -> ElmS (subword 0 k) (subword k j))
+    $ map (\k -> ElmS $ RiSwO 0 k k j)
     $ enumFromStepN 0 1 (i'+1)
   mkStream S e _ _ = error $ show e ++ "maybe only inside syntactic terminals on the RHS of an outside rule?" -- TODO mostly because I'm not sure if that would be useful
   {-# Inline mkStream #-}
@@ -70,7 +89,7 @@
 
 instance (Monad m) => MkStream m S (Subword C) where
   mkStream S Complemented (Subword (_:.h)) (Subword (i:.j))
-    = map (\(k,l) -> ElmS (subword k l) (subword k l))
+    = map (\(k,l) -> ElmS $ RiSwC k l)
     $ unfoldr go (i,i)
     where go (k,l)
             | k >h || k >j = Nothing
@@ -87,22 +106,19 @@
 --  , Context (is:.Subword) ~ (Context is:.(InsideContext ()))
   ) => MkStream m S (is:.Subword I) where
   mkStream S (vs:.IStatic ()) (lus:.Subword (_:.h)) (ixs:.Subword(i:.j))
-    = staticCheck (i>=0 && i==j && j<=h)
-    . map (\(ElmS zi zo) -> ElmS (zi:.subword i i) (zo:.subword 0 0))
+    = staticCheck (0<=i && i==j) -- && j<=h)
+    . map (\(ElmS zi) -> ElmS (zi:.:RiSwI i))
     $ mkStream S vs lus ixs
   mkStream S (vs:.IVariable ()) (lus:.Subword (_:.h)) (ixs:.Subword (i:.j))
-    = map (\(ElmS zi zo) -> ElmS (zi:.subword i i) (zo:.subword 0 0))
-    . filter (const $ 0<=i && i<=j && j<=h)
+    = map (\(ElmS zi) -> ElmS (zi:.:RiSwI i))
+    . staticCheck (0<=i && i<=j) -- filter (const $ 0<=i && i<=j && j<=h)
     $ mkStream S vs lus ixs
   {-# Inline mkStream #-}
 
-instance (TblConstraint u ~ TableConstraint) => TableStaticVar u (Subword I) where
+instance (MinSize c) => TableStaticVar u c (Subword I) where
   tableStaticVar _ _ (IStatic   d) _ = IVariable d
   tableStaticVar _ _ (IVariable d) _ = IVariable d
-  tableStreamIndex _ c _ (Subword (i:.j))
-    | c==EmptyOk  = subword i j
-    | c==NonEmpty = subword i (j-1)
-    | c==NonEmpty = error "A.F.B.Subword ???"
+  tableStreamIndex _ c _ (Subword (i:.j)) = subword i (j - minSize c)
   {-# INLINE [0] tableStaticVar   #-}
   {-# INLINE [0] tableStreamIndex #-}
 
@@ -111,7 +127,7 @@
 --
 -- TODO @tableStreamIndex@ needs to be fixed
 
-instance TableStaticVar (u O) (Subword O) where
+instance TableStaticVar (u O) c (Subword O) where
   tableStaticVar _ _ (OStatic  d) _ = OFirstLeft d
   tableStaticVar _ _ (ORightOf d) _ = OFirstLeft d
   tableStreamIndex _ c _ (Subword (i:.j)) = subword i j
@@ -123,7 +139,7 @@
 --
 -- TODO @tableStreamIndex@ needs to be fixed
 
-instance TableStaticVar (u I) (Subword O) where
+instance TableStaticVar (u I) c (Subword O) where
   tableStaticVar _ _ (OStatic    d) _ = ORightOf d
   tableStaticVar _ _ (ORightOf   d) _ = ORightOf d
   tableStaticVar _ _ (OFirstLeft d) _ = OLeftOf d
@@ -132,13 +148,13 @@
   {-# INLINE [0] tableStaticVar   #-}
   {-# INLINE [0] tableStreamIndex #-}
 
-instance TableStaticVar (u I) (Subword C) where
+instance TableStaticVar (u I) c (Subword C) where
   tableStaticVar _ _ _ _ = Complemented
   tableStreamIndex _ c _ (Subword (i:.j)) = subword i j
   {-# INLINE [0] tableStaticVar   #-}
   {-# INLINE [0] tableStreamIndex #-}
 
-instance TableStaticVar (u O) (Subword C) where
+instance TableStaticVar (u O) c (Subword C) where
   tableStaticVar _ _ _ _ = Complemented
   tableStreamIndex _ c _ (Subword (i:.j)) = subword i j
   {-# INLINE [0] tableStaticVar   #-}
diff --git a/ADP/Fusion/Base/TyLvlIx.hs b/ADP/Fusion/Base/TyLvlIx.hs
--- a/ADP/Fusion/Base/TyLvlIx.hs
+++ b/ADP/Fusion/Base/TyLvlIx.hs
@@ -8,8 +8,10 @@
 
 import Data.PrimitiveArray hiding (map)
 
+import ADP.Fusion.Base.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@.
@@ -38,6 +40,34 @@
   getIndexGo _ _ _ = Z
   {-# Inline 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) _ _ = i
+  {-# Inline 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 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 getIndexGo #-}
+
+instance GetIndexGo (RunningIndex Z) (RunningIndex Z) EQ where
+  type ResolvedIx (RunningIndex Z) (RunningIndex Z) EQ = RunningIndex Z
+  getIndexGo _ _ _ = RiZ
+  {-# Inline getIndexGo #-}
+
+
+
 -- | Wrap @GetIndexGo@ and the type-level shenanigans.
 
 type GetIndex l r = GetIndexGo l r (CmpNat (ToNat l) (ToNat r))
@@ -64,6 +94,8 @@
 
 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
 
 
 
diff --git a/ADP/Fusion/Base/Unit.hs b/ADP/Fusion/Base/Unit.hs
--- a/ADP/Fusion/Base/Unit.hs
+++ b/ADP/Fusion/Base/Unit.hs
@@ -32,18 +32,20 @@
   initialContext _ = Complemented
   {-# Inline initialContext #-}
 
+data instance RunningIndex (Unit t) = RiU
 
 
+
 instance (Monad m) => MkStream m S (Unit I) where
-  mkStream S _ Unit Unit = singleton $ ElmS Unit Unit
+  mkStream S _ Unit Unit = singleton $ ElmS RiU
   {-# Inline mkStream #-}
 
 instance (Monad m) => MkStream m S (Unit O) where
-  mkStream S _ Unit Unit = singleton $ ElmS Unit Unit
+  mkStream S _ Unit Unit = singleton $ ElmS RiU
   {-# Inline mkStream #-}
 
 instance (Monad m) => MkStream m S (Unit C) where
-  mkStream S _ Unit Unit = singleton $ ElmS Unit Unit
+  mkStream S _ Unit Unit = singleton $ ElmS RiU
   {-# Inline mkStream #-}
 
 instance
@@ -51,7 +53,7 @@
   , MkStream m S is
   ) => MkStream m S (is:.Unit I) where
   mkStream S (vs:._) (us:._) (is:._)
-    = map (\(ElmS zi zo) -> ElmS (zi:.Unit) (zo:.Unit))
+    = map (\(ElmS zi) -> ElmS $ zi :.: RiU)
     $ mkStream S vs us is
   {-# Inline mkStream #-}
 
@@ -60,7 +62,7 @@
   , MkStream m S is
   ) => MkStream m S (is:.Unit O) where
   mkStream S (vs:._) (us:._) (is:._)
-    = map (\(ElmS zi zo) -> ElmS (zi:.Unit) (zo:.Unit))
+    = map (\(ElmS zi) -> ElmS $ zi :.: RiU)
     $ mkStream S vs us is
   {-# Inline mkStream #-}
 
@@ -69,25 +71,25 @@
   , MkStream m S is
   ) => MkStream m S (is:.Unit C) where
   mkStream S (vs:._) (us:._) (is:._)
-    = map (\(ElmS zi zo) -> ElmS (zi:.Unit) (zo:.Unit))
+    = map (\(ElmS zi) -> ElmS $ zi :.: RiU)
     $ mkStream S vs us is
   {-# Inline mkStream #-}
 
 
 
-instance (TblConstraint u ~ TableConstraint) => TableStaticVar u (Unit I) where
+instance TableStaticVar c u (Unit I) where
   tableStaticVar _ _ _ _ = IStatic ()
   tableStreamIndex _ _ _ _ = Unit
   {-# Inline [0] tableStaticVar #-}
   {-# Inline [0] tableStreamIndex #-}
 
-instance (TblConstraint u ~ TableConstraint) => TableStaticVar u (Unit O) where
+instance TableStaticVar c u (Unit O) where
   tableStaticVar _ _ _ _ = OStatic ()
   tableStreamIndex _ _ _ _ = Unit
   {-# Inline [0] tableStaticVar #-}
   {-# Inline [0] tableStreamIndex #-}
 
-instance (TblConstraint u ~ TableConstraint) => TableStaticVar u (Unit C) where
+instance TableStaticVar c u (Unit C) where
   tableStaticVar _ _ _ _ = Complemented
   tableStreamIndex _ _ _ _ = Unit
   {-# Inline [0] tableStaticVar #-}
diff --git a/ADP/Fusion/SynVar/Array.hs b/ADP/Fusion/SynVar/Array.hs
--- a/ADP/Fusion/SynVar/Array.hs
+++ b/ADP/Fusion/SynVar/Array.hs
@@ -23,26 +23,25 @@
 
 -- | Constraints needed to use @iTblStream@.
 
-type ITblCx m ls arr x u i =
-  ( TblConstraint u ~ TableConstraint
-  , TableStaticVar u i
+type ITblCx m ls arr x u c i =
+  ( TableStaticVar u c i
   , MkStream m ls i
   , Element ls i
-  , AddIndexDense (Z:.i) (Z:.u) (Z:.i)
+  , AddIndexDense (Elm (SynVar1 (Elm ls i)) (Z:.i)) (Z:.u) (Z:.c) (Z:.i)
   , PrimArrayOps arr u x
   )
 
 -- | General function for @ITbl@s with skalar indices.
 
 iTblStream
-  :: forall m ls arr x u i . ITblCx m ls arr x u i
-  => Pair ls (ITbl m arr u x)
+  :: forall m ls arr x u c i . ITblCx m ls arr x u c i
+  => Pair ls (ITbl m arr c u x)
   -> Context i
   -> i
   -> i
-  -> Stream m (Elm (ls :!: ITbl m arr u x) i)
+  -> Stream m (Elm (ls :!: ITbl m arr c u x) i)
 iTblStream (ls :!: ITbl _ _ c t _) vs us is
-  = map (\(s,tt,ii',oo') -> ElmITbl (t!tt) ii' oo' s)
+  = map (\(s,tt,ii') -> ElmITbl (t!tt) ii' s)
   . addIndexDense1 c vs us is
   $ mkStream ls (tableStaticVar (Proxy :: Proxy u) c vs is) us (tableStreamIndex (Proxy :: Proxy u) c vs is)
 {-# Inline iTblStream #-}
@@ -50,14 +49,14 @@
 -- | General function for @Backtrack ITbl@s with skalar indices.
 
 btITblStream
-  :: forall mB mF ls arr x r u i . ITblCx mB ls arr x u i
-  => Pair ls (Backtrack (ITbl mF arr u x) mF mB r)
+  :: forall mB mF ls arr x r u c i . ITblCx mB ls arr x u c i
+  => Pair ls (Backtrack (ITbl mF arr c u x) mF mB r)
   -> Context i
   -> i
   -> i
-  -> Stream mB (Elm (ls :!: Backtrack (ITbl mF arr u x) mF mB r) i)
+  -> Stream mB (Elm (ls :!: Backtrack (ITbl mF arr c u x) mF mB r) i)
 btITblStream (ls :!: BtITbl c t bt) vs us is
-    = mapM (\(s,tt,ii',oo') -> bt us' tt >>= \ ~bb -> return $ ElmBtITbl (t!tt) bb ii' oo' s)
+    = mapM (\(s,tt,ii') -> bt us' tt >>= \ ~bb -> return $ ElmBtITbl (t!tt) bb ii' s)
     . addIndexDense1 c vs us is
     $ mkStream ls (tableStaticVar (Proxy :: Proxy u) c vs is) us (tableStreamIndex (Proxy :: Proxy u) c vs is)
     where !us' = snd $ bounds t
@@ -69,69 +68,55 @@
 
 instance
   ( Monad m
-  , ITblCx m ls arr x u (i I)
-  ) => MkStream m (ls :!: ITbl m arr u x) (i I) where
+  , ITblCx m ls arr x u c (i I)
+  ) => MkStream m (ls :!: ITbl m arr c u x) (i I) where
   mkStream = iTblStream
   {-# Inline mkStream #-}
 
 instance
   ( Monad m
-  , ITblCx m ls arr x u (i O)
-  ) => MkStream m (ls :!: ITbl m arr u x) (i O) where
+  , ITblCx m ls arr x u c (i O)
+  ) => MkStream m (ls :!: ITbl m arr c u x) (i O) where
   mkStream = iTblStream
   {-# Inline mkStream #-}
 
 instance
   ( Monad m
-  , ITblCx m ls arr x u (i C)
-  ) => MkStream m (ls :!: ITbl m arr u x) (i C) where
+  , ITblCx m ls arr x u c (i C)
+  ) => MkStream m (ls :!: ITbl m arr c u x) (i C) where
   mkStream = iTblStream
   {-# Inline mkStream #-}
 
 instance
   ( Monad mB
-  , ITblCx mB ls arr x u (i I)
-  ) => MkStream mB (ls :!: Backtrack (ITbl mF arr u x) mF mB r) (i I) where
+  , ITblCx mB ls arr x u c (i I)
+  ) => MkStream mB (ls :!: Backtrack (ITbl mF arr c u x) mF mB r) (i I) where
   mkStream = btITblStream
   {-# Inline mkStream #-}
 
 instance
   ( Monad mB
-  , ITblCx mB ls arr x u (i O)
-  ) => MkStream mB (ls :!: Backtrack (ITbl mF arr u x) mF mB r) (i O) where
+  , ITblCx mB ls arr x u c (i O)
+  ) => MkStream mB (ls :!: Backtrack (ITbl mF arr c u x) mF mB r) (i O) where
   mkStream = btITblStream
   {-# Inline mkStream #-}
 
 instance
   ( Monad mB
-  , ITblCx mB ls arr x u (i C)
-  ) => MkStream mB (ls :!: Backtrack (ITbl mF arr u x) mF mB r) (i C) where
+  , ITblCx mB ls arr x u c (i C)
+  ) => MkStream mB (ls :!: Backtrack (ITbl mF arr c u x) mF mB r) (i C) where
   mkStream = btITblStream
   {-# Inline mkStream #-}
 
-
-
-instance ModifyConstraint (ITbl m arr (Subword t) x) where
+instance ModifyConstraint (ITbl m arr EmptyOk i x) where
+  type TNE (ITbl m arr EmptyOk i x) = ITbl m arr NonEmpty i x
+  type TE  (ITbl m arr EmptyOk i x) = ITbl m arr EmptyOk  i x
   toNonEmpty (ITbl b l _ arr f) = ITbl b l NonEmpty arr f
-  toEmpty    (ITbl b l _ arr f) = ITbl b l EmptyOk  arr f
   {-# Inline toNonEmpty #-}
-  {-# Inline toEmpty #-}
 
-instance ModifyConstraint (ITbl m arr (Z:.Subword t:.Subword t) x) where
-  toNonEmpty (ITbl b l _ arr f) = ITbl b l (Z:.NonEmpty:.NonEmpty) arr f
-  toEmpty    (ITbl b l _ arr f) = ITbl b l (Z:.EmptyOk :.EmptyOk ) arr f
-  {-# Inline toNonEmpty #-}
-  {-# Inline toEmpty #-}
-
-instance ModifyConstraint (Backtrack (ITbl mF arr (Subword t) x) mF mB r) where
+instance ModifyConstraint (Backtrack (ITbl mF arr EmptyOk i x) mF mB r) where
+  type TNE (Backtrack (ITbl mF arr EmptyOk i x) mF mB r) = Backtrack (ITbl mF arr NonEmpty i x) mF mB r
+  type TE  (Backtrack (ITbl mF arr EmptyOk i x) mF mB r) = Backtrack (ITbl mF arr EmptyOk  i x) mF mB r
   toNonEmpty (BtITbl _ arr bt) = BtITbl NonEmpty arr bt
-  toEmpty    (BtITbl _ arr bt) = BtITbl EmptyOk  arr bt
   {-# Inline toNonEmpty #-}
-  {-# Inline toEmpty #-}
-
-instance ModifyConstraint (Backtrack (ITbl mF arr (Z:.Subword t:.Subword t) x) mF mB r) where
-  toNonEmpty (BtITbl _ arr bt) = BtITbl (Z:.NonEmpty:.NonEmpty) arr bt
-  toEmpty    (BtITbl _ arr bt) = BtITbl (Z:.EmptyOk :.EmptyOk ) arr bt
-  {-# Inline toNonEmpty #-}
-  {-# Inline toEmpty #-}
 
diff --git a/ADP/Fusion/SynVar/Array/TermSymbol.hs b/ADP/Fusion/SynVar/Array/TermSymbol.hs
--- a/ADP/Fusion/SynVar/Array/TermSymbol.hs
+++ b/ADP/Fusion/SynVar/Array/TermSymbol.hs
@@ -27,26 +27,26 @@
 -- TODO need to handle @minSize@ conditions!
 
 instance
-  ( TstCtx1 m ts a is (Subword I)
+  ( TstCtx m ts s x0 i0 is (Subword I)
   , PrimArrayOps arr (Subword I) x
-  ) => TermStream m (TermSymbol ts (ITbl m arr (Subword I) x)) a (is:.Subword I) where
+  ) => TermStream m (TermSymbol ts (ITbl m arr c (Subword I) x)) s (is:.Subword I) where
   --
   termStream (ts:|ITbl _ _ _ t _) (cs:.IStatic ()) (us:.u) (is:.Subword (i:.j))
-    = map (\(TState s a b ii oo ee) ->
-              let Subword (_:.l) = getIndex a (Proxy :: Proxy (is:.Subword I))
-                  lj             = subword l j
-              in  TState s a b (ii:.lj) (oo:.subword 0 0) (ee:.t!lj) )
+    = map (\(TState s ii ee) ->
+              let RiSwI l = getIndex (getIdx s) (Proxy :: PRI is (Subword I))
+                  lj      = subword l j
+              in  TState s (ii:.:RiSwI j) (ee:.t!lj) )
     . termStream ts cs us is
   --
   termStream (ts:|ITbl _ _ _ t _) (cs:.IVariable ()) (us:.u) (is:.Subword (i:.j))
     = flatten mk step . termStream ts cs us is
-    where mk tstate@(TState s a b ii oo ee) =
-              let Subword (_:.l) = getIndex a (Proxy :: Proxy (is:.Subword I))
+    where mk tstate@(TState s ii ee) =
+              let RiSwI l = getIndex (getIdx s) (Proxy :: PRI is (Subword I))
               in  return (tstate, l, j - l)
-          step (tstate@(TState s a b ii oo ee), k, z)
+          step (tstate@(TState s ii ee), k, z)
             | z >= 0 = do let l  = j - z
                               kl = subword k l
-                          return $ Yield (TState s a b (ii:.kl) (oo:.subword 0 0) (ee:.t!kl)) (tstate, k, z-1)
+                          return $ Yield (TState s (ii:.:RiSwI l) (ee:.t!kl)) (tstate, k, z-1)
             | otherwise = return $ Done
           {-# Inline [0] mk   #-}
           {-# Inline [0] step #-}
@@ -57,24 +57,24 @@
 -- TODO can we combine the @ITbl@ and @BtITbl@ code again?
 
 instance
-  ( TstCtx1 mB ts a is (Subword I)
+  ( TstCtx mB ts s x0 i0 is (Subword I)
   , PrimArrayOps arr (Subword I) x
-  ) => TermStream mB (TermSymbol ts (Backtrack (ITbl mF arr (Subword I) x) mF mB r)) a (is:.Subword I) where
+  ) => TermStream mB (TermSymbol ts (Backtrack (ITbl mF arr c (Subword I) x) mF mB r)) s (is:.Subword I) where
   termStream (ts:|BtITbl c t bt) (cs:.IStatic ()) (us:.u) (is:.Subword (i:.j))
-    = mapM (\(TState s a b ii oo ee) ->
-                let Subword (_:.l) = getIndex a (Proxy :: Proxy (is:.Subword I))
-                    lj             = subword l j
-                in  bt u lj >>= \ ~bb -> return $ TState s a b (ii:.lj) (oo:.subword 0 0) (ee:.(t!lj,bb)) )
+    = mapM (\(TState s ii ee) ->
+                let RiSwI l = getIndex (getIdx s) (Proxy :: PRI is (Subword I))
+                    lj      = subword l j
+                in  bt u lj >>= \ ~bb -> return $ TState s (ii:.:RiSwI j) (ee:.(t!lj,bb)) )
     . termStream ts cs us is
   termStream (ts:|BtITbl c t bt) (cs:.IVariable ()) (us:.u) (is:.Subword (i:.j))
     = flatten mk step . termStream ts cs us is
-    where mk tstate@(TState s a b ii oo ee) =
-              let Subword (_:.l) = getIndex a (Proxy :: Proxy (is:.Subword I))
+    where mk tstate@(TState s ii ee) =
+              let RiSwI l = getIndex (getIdx s) (Proxy :: PRI is (Subword I))
               in  return (tstate, l, j - l)
-          step (tstate@(TState s a b ii oo ee), k, z)
+          step (tstate@(TState s ii ee), k, z)
             | z >= 0 = do let l  = j - z
                               kl = subword k l
-                          bt u kl >>= \ ~bb -> return $ Yield (TState s a b (ii:.kl) (oo:.subword 0 0) (ee:.(t!kl,bb))) (tstate, k, z-1)
+                          bt u kl >>= \ ~bb -> return $ Yield (TState s (ii:.:RiSwI l) (ee:.(t!kl,bb))) (tstate, k, z-1)
             | otherwise = return $ Done
           {-# Inline [0] mk   #-}
           {-# Inline [0] step #-}
@@ -130,7 +130,7 @@
 --  {-# Inline terminalStream #-}
 
 
-instance TermStaticVar (ITbl m arr (Subword I) x) (Subword I) where
+instance TermStaticVar (ITbl m arr c (Subword I) x) (Subword I) where
   termStaticVar _ (IStatic   d) _ = IVariable d
   termStaticVar _ (IVariable d) _ = IVariable d
   termStreamIndex (ITbl _ _ _ _ _) (IStatic   d) (Subword (i:.j)) = subword i j -- TODO minSize handling !
@@ -138,7 +138,7 @@
   {-# Inline [0] termStaticVar   #-}
   {-# Inline [0] termStreamIndex #-}
 
-instance TermStaticVar (Backtrack (ITbl mF arr (Subword I) x) mF mB r) (Subword I) where
+instance TermStaticVar (Backtrack (ITbl mF arr c (Subword I) x) mF mB r) (Subword I) where
   termStaticVar _ (IStatic   d) _ = IVariable d
   termStaticVar _ (IVariable d) _ = IVariable d
   termStreamIndex (BtITbl _ _ _) (IStatic   d) (Subword (i:.j)) = subword i j -- TODO minSize handling !
diff --git a/ADP/Fusion/SynVar/Array/Type.hs b/ADP/Fusion/SynVar/Array/Type.hs
--- a/ADP/Fusion/SynVar/Array/Type.hs
+++ b/ADP/Fusion/SynVar/Array/Type.hs
@@ -4,42 +4,42 @@
 
 module ADP.Fusion.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 Prelude hiding (map,head,mapM)
-import Data.Proxy
 
 import Data.PrimitiveArray hiding (map)
 
 import ADP.Fusion.Base
-import ADP.Fusion.SynVar.Backtrack
 import ADP.Fusion.SynVar.Axiom
+import ADP.Fusion.SynVar.Backtrack
 import ADP.Fusion.SynVar.Indices
 
 
 
 -- | Immutable table.
 
-data ITbl m arr i x where
+data ITbl m arr c i x where
   ITbl :: { iTblBigOrder    :: !Int
           , iTblLittleOrder :: !Int
-          , iTblConstraint  :: !(TblConstraint i)
+          , iTblConstraint  :: !c
           , iTblArray       :: !(arr i x)
           , iTblFun         :: !(i -> i -> m x)
-          } -> ITbl m arr i x
+          } -> ITbl m arr c i x
 
-instance Build (ITbl m arr i x)
+instance Build (ITbl m arr c i x)
 
-type instance TermArg (ITbl m arr i x) = x
+type instance TermArg (ITbl m arr c i x) = x
 
-instance GenBacktrackTable (ITbl mF arr i x) mF mB r where
-  data Backtrack (ITbl mF arr i x) mF mB r = BtITbl !(TblConstraint i) !(arr i x) (i -> i -> mB [r])
-  type BacktrackIndex (ITbl mF arr i x) = i
+instance GenBacktrackTable (ITbl mF arr c i x) mF mB r where
+  data Backtrack (ITbl mF arr c i x) mF mB r = BtITbl !c !(arr i x) !(i -> i -> mB [r])
+  type BacktrackIndex (ITbl mF arr c i x) = i
   toBacktrack (ITbl _ _ c arr _) _ bt = BtITbl c arr bt
   {-# Inline toBacktrack #-}
 
-type instance TermArg (Backtrack (ITbl mF arr i x) mF mB r) = (x,[r])
+type instance TermArg (Backtrack (ITbl mF arr c i x) mF mB r) = (x,[r])
 
 
 
@@ -49,8 +49,8 @@
   ( Monad m
   , PrimArrayOps arr i x
   , IndexStream i
-  ) => Axiom (ITbl m arr i x) where
-  type AxiomStream (ITbl m arr i x) = m x
+  ) => Axiom (ITbl m arr c i x) where
+  type AxiomStream (ITbl m arr c i x) = m x
   axiom (ITbl _ _ c arr _) = do
     k <- (head . uncurry streamDown) $ bounds arr
     return $ arr ! k
@@ -60,8 +60,8 @@
   ( Monad mB
   , PrimArrayOps arr i x
   , IndexStream i
-  ) => Axiom (Backtrack (ITbl mF arr i x) mF mB r) where
-  type AxiomStream (Backtrack (ITbl mF arr i x) mF mB r) = mB [r]
+  ) => Axiom (Backtrack (ITbl mF arr c i x) mF mB r) where
+  type AxiomStream (Backtrack (ITbl mF arr c i x) mF mB r) = mB [r]
   axiom (BtITbl c arr bt) = do
     h <- (head . uncurry streamDown) $ bounds arr
     bt (snd $ bounds arr) h
@@ -71,36 +71,32 @@
 
 -- * 'Element'
 
-instance Element ls i => Element (ls :!: ITbl m arr j x) i where
-  data Elm    (ls :!: ITbl m arr j x) i = ElmITbl !x !i !i !(Elm ls i)
-  type Arg    (ls :!: ITbl m arr j x)   = Arg ls :. x
-  type RecElm (ls :!: ITbl m arr j x) i = Elm ls i
-  getArg (ElmITbl x _ _ ls) = getArg ls :. x
-  getIdx (ElmITbl _ i _ _ ) = i
-  getOmx (ElmITbl _ _ o _ ) = o
-  getElm (ElmITbl _ _ _ ls) = ls
+instance Element ls i => Element (ls :!: ITbl m arr c j x) i where
+  data Elm    (ls :!: ITbl m arr c j x) i = ElmITbl !x !(RunningIndex i) !(Elm ls i)
+  type Arg    (ls :!: ITbl m arr c j x)   = Arg ls :. x
+  type RecElm (ls :!: ITbl 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 getOmx #-}
   {-# Inline getElm #-}
 
-deriving instance (Show i, Show (Elm ls i), Show x) => Show (Elm (ls :!: ITbl m arr j x) i)
+deriving instance (Show i, Show (RunningIndex i), Show (Elm ls i), Show x) => Show (Elm (ls :!: ITbl m arr c j x) i)
 
-instance Element ls i => Element (ls :!: (Backtrack (ITbl mF arr j x) mF mB r)) i where
-  data Elm    (ls :!: (Backtrack (ITbl mF arr j x) mF mB r)) i = ElmBtITbl !x [r] !i !i !(Elm ls i)
-  type Arg    (ls :!: (Backtrack (ITbl mF arr j x) mF mB r))   = Arg ls :. (x, [r])
-  type RecElm (ls :!: (Backtrack (ITbl mF arr j x) mF mB r)) i = Elm ls i
-  getArg (ElmBtITbl x s _ _ ls) = getArg ls :. (x,s)
-  getIdx (ElmBtITbl _ _ i _ _ ) = i
-  getOmx (ElmBtITbl _ _ _ o _ ) = o
-  getElm (ElmBtITbl _ _ _ _ ls) = ls
+instance Element ls i => Element (ls :!: (Backtrack (ITbl mF arr c j x) mF mB r)) i where
+  data Elm    (ls :!: (Backtrack (ITbl mF arr c j x) mF mB r)) i = ElmBtITbl !x [r] !(RunningIndex i) !(Elm ls i)
+  type Arg    (ls :!: (Backtrack (ITbl mF arr c j x) mF mB r))   = Arg ls :. (x, [r])
+  type RecElm (ls :!: (Backtrack (ITbl mF 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 getOmx #-}
   {-# Inline getElm #-}
 
-instance (Show x, Show i, Show (Elm ls i)) => Show (Elm (ls :!: (Backtrack (ITbl mF arr i x) mF mB r)) i) where
-  show (ElmBtITbl x _ i o s) = show (x,i,o) ++ " " ++ show s
+instance (Show x, Show i, Show (RunningIndex i), Show (Elm ls i)) => Show (Elm (ls :!: (Backtrack (ITbl mF arr c i x) mF mB r)) i) where
+  show (ElmBtITbl x _ i s) = show (x,i) ++ " " ++ show s
 
 
 
@@ -109,13 +105,13 @@
 instance
   ( Monad m
   , Element ls (is:.i)
-  , TableStaticVar (us:.u) (is:.i)
-  , AddIndexDense (is:.i) (us:.u) (is:.i)
+  , TableStaticVar (us:.u) (cs:.c) (is:.i)
+  , AddIndexDense (Elm ls (is:.i)) (us:.u) (cs:.c) (is:.i)
   , MkStream m ls (is:.i)
   , PrimArrayOps arr (us:.u) x
-  ) => MkStream m (ls :!: ITbl m arr (us:.u) x) (is:.i) where
+  ) => MkStream m (ls :!: ITbl m arr (cs:.c) (us:.u) x) (is:.i) where
   mkStream (ls :!: ITbl _ _ c t _) vs us is
-    = map (\(s,tt,ii',oo') -> ElmITbl (t!tt) ii' oo' s)
+    = map (\(s,tt,ii') -> ElmITbl (t!tt) ii' s)
     . addIndexDense c vs us is
     $ mkStream ls (tableStaticVar (Proxy :: Proxy (us:.u)) c vs is) us (tableStreamIndex (Proxy :: Proxy (us:.u)) c vs is)
   {-# Inline mkStream #-}
@@ -123,52 +119,15 @@
 instance
   ( Monad mB
   , Element ls (is:.i)
-  , TableStaticVar (us:.u) (is:.i)
-  , AddIndexDense (is:.i) (us:.u) (is:.i)
+  , TableStaticVar (us:.u) (cs:.c) (is:.i)
+  , AddIndexDense (Elm ls (is:.i)) (us:.u) (cs:.c) (is:.i)
   , MkStream mB ls (is:.i)
   , PrimArrayOps arr (us:.u) x
-  ) => MkStream mB (ls :!: Backtrack (ITbl mF arr (us:.u) x) mF mB r) (is:.i) where
+  ) => MkStream mB (ls :!: Backtrack (ITbl mF arr (cs:.c) (us:.u) x) mF mB r) (is:.i) where
   mkStream (ls :!: BtITbl c t bt) vs us is
-    = mapM (\(s,tt,ii',oo') -> bt us' tt >>= \ ~bb -> return $ ElmBtITbl (t!tt) bb ii' oo' s)
+    = mapM (\(s,tt,ii') -> bt us' tt >>= \ ~bb -> return $ ElmBtITbl (t!tt) bb ii' s)
     . addIndexDense c vs us is
     $ mkStream ls (tableStaticVar (Proxy :: Proxy (us:.u)) c vs is) us (tableStreamIndex (Proxy :: Proxy (us:.u)) c vs is)
     where !us' = snd $ bounds t
   {-# Inline mkStream #-}
-
-{-
-instance
-  ( Monad m
-  , Element ls (Outside (is:.i))
-  , TableStaticVar (Outside (is:.i))
-  , TableIndices (Outside (is:.i))
-  , MkStream m ls (Outside (is:.i))
-  , PrimArrayOps arr (Outside (is:.i)) x
-  , Show (is:.i)
-  ) => MkStream m (ls :!: ITbl m arr (Outside (is:.i)) x) (Outside (is:.i)) where
-  mkStream (ls :!: ITbl _ _ c t _) vs lu is
-    = map (\(S5 s _ _ i o) -> ElmITbl (t ! o) i o s)
-    . tableIndices c vs is
-    . map (\s -> S5 s Z Z (getIdx s) (getOmx s))
-    $ mkStream ls (tableStaticVar vs is) lu (tableStreamIndex c vs is)
-  {-# Inline mkStream #-}
--}
-
-{-
-instance
-  ( Monad mB
-  , Element ls (Outside (is:.i))
-  , TableStaticVar (Outside (is:.i))
-  , TableIndices (Outside (is:.i))
-  , MkStream mB ls (Outside (is:.i))
-  , PrimArrayOps arr (Outside (is:.i)) x
-  , Show (is:.i)
-  ) => MkStream mB (ls :!: Backtrack (ITbl mF arr (Outside (is:.i)) x) mF mB r) (Outside (is:.i)) where
-  mkStream (ls :!: BtITbl c t bt) vs us is
-    = mapM (\(S5 s _ _ i o) -> bt us o >>= \bb -> return $ ElmBtITbl (t ! o) (bb {-bt us o-}) i o s)
-    . tableIndices c vs is
-    . map (\s -> S5 s Z Z (getIdx s) (getOmx s))
-    $ mkStream ls (tableStaticVar vs is) us (tableStreamIndex c vs is)
-  {-# Inline mkStream #-}
--}
-
 
diff --git a/ADP/Fusion/SynVar/Fill.hs b/ADP/Fusion/SynVar/Fill.hs
--- a/ADP/Fusion/SynVar/Fill.hs
+++ b/ADP/Fusion/SynVar/Fill.hs
@@ -17,6 +17,7 @@
 import           Data.PrimitiveArray
 
 import           ADP.Fusion.SynVar.Array -- TODO we want to keep only classes in here, move instances to the corresponding modules
+import           ADP.Fusion.SynVar.Recursive
 
 import           Debug.Trace
 
@@ -94,21 +95,42 @@
   {-# Inline tableLittleOrder #-}
   {-# Inline tableBigOrder #-}
 
-instance (TableOrder ts) => TableOrder (ts:.ITbl im arr i x) where
+instance (TableOrder ts) => TableOrder (ts:.ITbl im arr c i x) where
   tableLittleOrder (ts:.ITbl _ tlo _ _ _) = tlo : tableLittleOrder ts
   tableBigOrder    (ts:.ITbl tbo _ _ _ _) = 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:.IRec 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
+  ( Monad om
+  ) => MutateCell p Z im om i where
+  mutateCell _ _ _ _ Z _ _ = return ()
+  {-# INLINE mutateCell #-}
+
+instance
+  ( MutateCell CFG ts im om i
+  , PrimMonad om
+  ) => MutateCell CFG (ts:.IRec im c i x) im om 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 om i
   , PrimMonad om
-  , Show x, Show i
-  ) => MutateCell CFG (ts:.ITbl im arr i x) im om i where
+  ) => MutateCell CFG (ts:.ITbl im arr c i x) im om i where
   mutateCell h bo lo mrph (ts:.ITbl tbo tlo c arr f) lu i = do
     mutateCell h bo lo mrph ts lu i
     when (bo==tbo && lo==tlo) $ do
@@ -124,7 +146,7 @@
   , MPrimArrayOps arr ZS2 x
   , MutateCell MonotoneMCFG ts im om ZS2
   , PrimMonad om
-  ) => MutateCell MonotoneMCFG (ts:.ITbl im arr ZS2 x) im om ZS2 where
+  ) => MutateCell MonotoneMCFG (ts:.ITbl im arr c ZS2 x) im om ZS2 where
   mutateCell h bo lo mrph (ts:.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
@@ -138,7 +160,7 @@
   , MPrimArrayOps arr (Subword I) x
   , MutateCell h ts im om (Z:.Subword I:.Subword I)
   , PrimMonad om
-  ) => MutateCell h (ts:.ITbl im arr (Subword I) x) im om (Z:.Subword I:.Subword I) where
+  ) => MutateCell h (ts:.ITbl im arr c (Subword I) x) im om (Z:.Subword I:.Subword I) where
   mutateCell h bo lo mrph (ts:.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
@@ -156,30 +178,27 @@
 
 instance
   ( Monad om
-  , MutateCell h (ts:.ITbl im arr i x) im om i
+  , MutateCell h (ts:.ITbl im arr c i x) im om i
   , PrimArrayOps arr i x
   , Show i
   , IndexStream i
-  , TableOrder (ts:.ITbl im arr i x)
-  ) => MutateTables h (ts:.ITbl im arr i x) im om where
+  , TableOrder (ts:.ITbl im arr c i x)
+  ) => MutateTables h (ts:.ITbl im arr c i x) im om where
   mutateTables h mrph tt@(_:.ITbl _ _ _ arr _) = do
     let (from,to) = bounds 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 ->
-      flip SM.mapM_ (streamUp from to) $ \k ->
-        VU.forM_ tlos $ \lo ->
-          --traceShow (bo,k,lo) $
-          mutateCell h bo lo (inline mrph) tt to k
+      case (VU.length tlos) of
+        1 -> let lo = VU.head tlos
+             in  flip SM.mapM_ (streamUp from to) $ \k ->
+                  mutateCell h bo lo (inline mrph) tt to k
+        _ -> flip SM.mapM_ (streamUp from to) $ \k ->
+              VU.forM_ tlos $ \lo ->
+                mutateCell h bo lo (inline mrph) tt to k
     return tt
   {-# INLINE mutateTables #-}
-
-instance
-  ( Monad om
-  ) => MutateCell p Z im om i where
-  mutateCell _ _ _ _ Z _ _ = return ()
-  {-# INLINE mutateCell #-}
 
 -- | Default table filling, assuming that the forward monad is just @IO@.
 --
diff --git a/ADP/Fusion/SynVar/Indices/Classes.hs b/ADP/Fusion/SynVar/Indices/Classes.hs
--- a/ADP/Fusion/SynVar/Indices/Classes.hs
+++ b/ADP/Fusion/SynVar/Indices/Classes.hs
@@ -6,6 +6,7 @@
 
 module ADP.Fusion.SynVar.Indices.Classes where
 
+import Data.Proxy (Proxy(..))
 import Data.Vector.Fusion.Stream.Monadic (map,Stream,head,mapM,flatten,Step(..))
 import Prelude hiding (map,head,mapM)
 
@@ -19,12 +20,12 @@
 -- cases. The type @a@ is the type of the /full stack/ of indices, i.e. the
 -- full multi-tape problem.
 
-class AddIndexDense a u i where
+class AddIndexDense s u c i where
   addIndexDenseGo
     :: (Monad m)
-    => TblConstraint u -> Context i -> i -> i -> Stream m (SvState s a Z Z) -> Stream m (SvState s a u i)
+    => c -> Context i -> i -> i -> Stream m (SvState s a Z Z) -> Stream m (SvState s a u i)
 
-instance AddIndexDense a Z Z where
+instance AddIndexDense a Z Z Z where
   addIndexDenseGo _ _ _ _ = id
   {-# Inline addIndexDenseGo #-}
 
@@ -34,12 +35,10 @@
 -- this will not be true -- herein for @Set@ index structures.
 
 data SvState s a u i = SvS
-  { sS  :: !s -- | state coming in from the left
-  , sIx :: !a -- | @I/C@ index from @sS@
-  , sOx :: !a -- | @O@ index from @sS@
-  , tx  :: !u -- | @I/C@ building up state to index the @table@.
-  , iIx :: !i -- | @I/C@ building up state to hand over to next symbol
-  , iOx :: !i -- | @O@ building up state to hand over to next symbol
+  { sS  :: !s -- ^ state coming in from the left
+--  , sIx :: !(RunningIndex a) --  @I/C@ index from @sS@
+  , tx  :: !u -- ^ @I/C@ building up state to index the @table@.
+  , iIx :: !(RunningIndex i) -- ^ @I/C@ building up state to hand over to next symbol
   }
 
 
@@ -48,13 +47,12 @@
 
 addIndexDense
   :: ( Monad m
-     , AddIndexDense a u i
-     , GetIndex a i
-     , s ~ Elm x0 a
-     , Element x0 a
+     , AddIndexDense s u c i
+     , s ~ Elm x0 i0
+     , Element x0 i0
      )
-  => TblConstraint u -> Context i -> i -> i -> Stream m s -> Stream m (s,u,i,i)
-addIndexDense t c u i = map (\(SvS s _ _ z i' o') -> (s,z,i',o')) . addIndexDenseGo t c u i . map (\s -> (SvS s (getIdx s) (getOmx s) Z Z Z))
+  => c -> Context i -> i -> i -> Stream m s -> Stream m (s,u,RunningIndex i)
+addIndexDense t c u i = map (\(SvS s z i') -> (s,z,i')) . addIndexDenseGo t c u i . map (\s -> (SvS s Z RiZ))
 {-# Inline addIndexDense #-}
 
 -- | In case of 1-dim tables, we wrap the index creation in a multi-dim
@@ -63,14 +61,36 @@
 
 addIndexDense1
   :: ( Monad m
-     , AddIndexDense (Z:.a) (Z:.u) (Z:.i)
+     , AddIndexDense (Elm (SynVar1 (Elm x0 a)) (Z:.i)) (Z:.u) (Z:.c) (Z:.i)
      , GetIndex (Z:.a) (Z:.i)
      , s ~ Elm x0 a
      , Element x0 a
      )
-  => TblConstraint u -> Context i -> i -> i -> Stream m s -> Stream m (s,u,i,i)
-addIndexDense1 t c u i = map (\(SvS s _ _ (Z:.z) (Z:.i') (Z:.o')) -> (s,z,i',o'))
+  => c -> Context i -> i -> i -> Stream m s -> Stream m (s,u,RunningIndex i)
+addIndexDense1 t c u i = map (\(SvS (ElmSynVar1 s) (Z:.z) (RiZ:.:i')) -> (s,z,i'))
                        . addIndexDenseGo (Z:.t) (Z:.c) (Z:.u) (Z:.i)
-                       . map (\s -> (SvS s (Z:.getIdx s) (Z:.getOmx s) Z Z Z))
+                       . map (\s -> (SvS (elmSynVar1 s i) 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 IndexHdr s x0 i0 us u cs c is i =
+  ( AddIndexDense s us cs is
+  , GetIndex (RunningIndex i0) (RunningIndex (is:.i))
+  , GetIx (RunningIndex i0) (RunningIndex (is:.i)) ~ (RunningIndex i)
+  , Element x0 i0
+  , s ~ Elm x0 i0
+  )
 
diff --git a/ADP/Fusion/SynVar/Indices/Point.hs b/ADP/Fusion/SynVar/Indices/Point.hs
--- a/ADP/Fusion/SynVar/Indices/Point.hs
+++ b/ADP/Fusion/SynVar/Indices/Point.hs
@@ -4,6 +4,7 @@
 import Data.Proxy
 import Data.Vector.Fusion.Stream.Monadic (map,Stream,head,mapM,Step(..))
 import Data.Vector.Fusion.Util (delay_inline)
+import Debug.Trace
 import Prelude hiding (map,head,mapM)
 
 import Data.PrimitiveArray hiding (map)
@@ -14,60 +15,48 @@
 
 
 instance
-  ( AddIndexDense a us is
-  , GetIndex a (is:.PointL I)
-  , GetIx a (is:.PointL I) ~ (PointL I)
-  ) => AddIndexDense a (us:.PointL I) (is:.PointL I) where
+  ( IndexHdr s x0 i0 us (PointL I) cs c is (PointL I)
+  , MinSize c
+  ) => AddIndexDense s (us:.PointL I) (cs:.c) (is:.PointL I) where
   addIndexDenseGo (cs:._) (vs:.IStatic d) (us:.u) (is:.i)
-    = map (\(SvS s a b t y' z') -> SvS s a b (t:.i) (y':.i) (z':.PointL 0))
+    = map (\(SvS s t y') -> SvS s (t:.i) (y' :.: RiPlI (fromPointL i)))
     . addIndexDenseGo cs vs us is
   addIndexDenseGo (cs:.c) (vs:.IVariable d) (us:.u) (is:.PointL i)
     = flatten mk step . addIndexDenseGo cs vs us is
-    where mk svS = let PointL k = getIndex (sIx svS) (Proxy :: Proxy (is:.PointL I))
+    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 a b t y' z') :. k)
+          step (svS@(SvS s t y') :. k)
             | k + csize > i = return $ Done
-            | otherwise     = return $ Yield (SvS s a b (t:.PointL k) (y':.PointL k) (z':.PointL 0)) (svS :. k+1)
+            | otherwise     = return $ Yield (SvS s (t:.PointL k) (y' :.: RiPlI k)) (svS :. k+1)
+            where csize = minSize c
           {-# Inline [0] mk   #-}
           {-# Inline [0] step #-}
-          csize = delay_inline minSize c
   {-# Inline addIndexDenseGo #-}
 
 instance
-  ( AddIndexDense a us is
-  , GetIndex a (is:.PointL O)
-  , GetIx a (is:.PointL O) ~ (PointL O)
-  ) => AddIndexDense a (us:.PointL O) (is:.PointL O) where
-  addIndexDenseGo (cs:.c) (vs:.OStatic d) (us:.u) (is:.i)
-    = map (\(SvS s a b t y' z') -> let o = getIndex b (Proxy :: Proxy (is:.PointL O))
-                                   in  SvS s a b (t:.o) (y':.o) (z':.o))
+  ( IndexHdr s x0 i0 us (PointL O) cs c is (PointL O)
+  ) => AddIndexDense s (us:.PointL O) (cs:.c) (is:.PointL O) where
+  addIndexDenseGo (cs:._) (vs:.OStatic d) (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 cs vs us is
-    where csize = delay_inline minSize c
   {-# Inline addIndexDenseGo #-}
 
 instance
-  ( AddIndexDense a us is
-  , GetIndex a (is:.PointL C)
-  , GetIx a (is:.PointL C) ~ (PointL C)
-  ) => AddIndexDense a (us:.PointL I) (is:.PointL C) where
-  addIndexDenseGo (cs:.c) (vs:.Complemented) (us:.u) (is:.i)
-    = map (\(SvS s a b t y z) -> let PointL k = getIndex a (Proxy :: Proxy (is:.PointL C))
-                                     kT = PointL k
-                                     kC = PointL k
-                                 in  SvS s a b (t:.kT) (y:.kC) (z:.kC))
+  ( IndexHdr s x0 i0 us (PointL I) cs c is (PointL C)
+  ) => AddIndexDense s (us:.PointL I) (cs:.c) (is:.PointL C) where
+  addIndexDenseGo (cs:._) (vs:.Complemented) (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 cs vs us is
   {-# Inline addIndexDenseGo #-}
 
 instance
-  ( AddIndexDense a us is
-  , GetIndex a (is:.PointL C)
-  , GetIx a (is:.PointL C) ~ (PointL C)
-  ) => AddIndexDense a (us:.PointL O) (is:.PointL C) where
-  addIndexDenseGo (cs:.c) (vs:.Complemented) (us:.u) (is:.i)
-    = map (\(SvS s a b t y z) -> let PointL k = getIndex a (Proxy :: Proxy (is:.PointL C))
-                                     kT = PointL k
-                                     kC = PointL k
-                                 in  SvS s a b (t:.kT) (y:.kC) (z:.kC))
+  ( IndexHdr s x0 i0 us (PointL O) cs c is (PointL C)
+  ) => AddIndexDense s (us:.PointL O) (cs:.c) (is:.PointL C) where
+  addIndexDenseGo (cs:._) (vs:.Complemented) (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 cs vs us is
   {-# Inline addIndexDenseGo #-}
 
diff --git a/ADP/Fusion/SynVar/Indices/Set0.hs b/ADP/Fusion/SynVar/Indices/Set0.hs
--- a/ADP/Fusion/SynVar/Indices/Set0.hs
+++ b/ADP/Fusion/SynVar/Indices/Set0.hs
@@ -27,10 +27,9 @@
 -- TODO outside and complement code
 
 instance
-  ( AddIndexDense a us is
-  , GetIndex a (is:.BitSet I)
-  , GetIx a (is:.BitSet I) ~ (BitSet I)
-  ) => AddIndexDense a (us:.BitSet I) (is:.BitSet I) where
+  ( IndexHdr s x0 i0 us (BitSet I) cs c is (BitSet I)
+  , MinSize c
+  ) => AddIndexDense s (us:.BitSet I) (cs:.c) (is:.BitSet I) where
   addIndexDenseGo (cs:.c) (vs:.IStatic rb) (us:.u) (is:.i)
     = flatten mk step . addIndexDenseGo cs vs us is
           -- @mk@ builds up the index we start with. First we ask in @l@
@@ -45,11 +44,11 @@
           -- reserve some bits but otherwise are static.
     where mk svS
             | cm < csize = return $ Nothing
-            | otherwise  = {- traceShow ("I0",l,mask,k) . -} return $ Just (svS :. mask :. k)
+            | otherwise  = return $ Just (svS :. mask :. k)
             where k  = (BitSet $ 2^cm-1)
                   cm = popCount mask - rb
                   mask = i `xor` l
-                  l = getIndex (sIx svS) (Proxy :: Proxy (is:.BitSet I))
+                  RiBsI l = getIndex (getIdx $ sS svS) (Proxy :: PRI is (BitSet I))
           step Nothing = return $ Done
           -- @step Just ...@ performs a non-trivial step. First we
           -- calculate the population count of the index for this symbol as
@@ -62,15 +61,15 @@
           --
           -- TODO is the stopping criterion actually right? Should'nd we
           -- look at all set bits? Also consider the comment above on @rb@.
-          step (Just (svS@(SvS s a b t y' z') :. mask :. k))
+          step (Just (svS@(SvS s t y') :. mask :. k))
             | pk > popCount i - rb = return $ Done
             | otherwise            = let kk = popShiftL mask k
-                                         aa = getIndex a (Proxy :: Proxy (is:.BitSet I))
-                                     in  return $ Yield (SvS s a b (t:.kk) (y':.(kk.|.aa)) (z':.0))
+                                         RiBsI aa = getIndex (getIdx s) (Proxy :: PRI is (BitSet I))
+                                     in  return $ Yield (SvS s (t:.kk) (y' :.: RiBsI (kk.|.aa)))
                                                         ((svS :. mask :.) <$> setSucc 0 (2^pm -1) k)
             where pk = popCount k
                   pm = popCount mask
-          csize = delay_inline minSize c  -- minimal set size via constraints
+          !csize = minSize c  -- minimal set size via constraints
           {-# Inline [0] mk   #-}
           {-# Inline [0] step #-}
   addIndexDenseGo (cs:.c) (vs:.IVariable rb) (us:.u) (is:.i)
@@ -80,24 +79,25 @@
           -- bits left. If @cm==0@ then we immediately quit. If not, we
           -- activate one bit.
     where mk svS
-            | c==EmptyOk  = return $ Just (svS :. mask :. cm :. 0)
-            | cm == 0     = return $ Nothing
-            | c==NonEmpty = return $ Just (svS :. mask :. cm :. 1)
+            | csize==0  = return $ Just (svS :. mask :. cm :. csize)
+            | cm == 0   = return $ Nothing
+            | csize==1  = return $ Just (svS :. mask :. cm :. csize)
             where mask = i `xor` l
                   cm   = popCount mask
-                  l    = getIndex (sIx svS) (Proxy :: Proxy (is:.BitSet I))
-          step Nothing = return $ Done
+                  RiBsI l = getIndex (getIdx $ sS svS) (Proxy :: PRI is (BitSet I))
+                  csize = BitSet $ minSize c
           -- if the possible popcount in @i@ is less than the total
           -- popcount in @kk@ and @l@ and the reserved bits in @rb@, then
           -- we continue. This means returning @kk@ as the bitset for
           -- indexing; @kk.|.l@ as all set bits. @setSucc@ will rotate
           -- through all permutations for each popcount and mask.
-          step (Just (svS@(SvS s a b t y' z') :. mask :. cm :. k))
+          step Nothing = return $ Done
+          step (Just (svS@(SvS s t y') :. mask :. cm :. k))
             | popCount i < popCount (kk .|. l) + rb = return $ Done
-            | otherwise = return $ Yield (SvS s a b (t:.kk) (y':.(kk.|.l)) (z':.0))
+            | otherwise = return $ Yield (SvS s (t:.kk) (y' :.: RiBsI (kk.|.l)))
                                          ((svS :. mask :. cm :.) <$> setSucc 0 (2^cm -1) k)
             where kk = popShiftL mask k
-                  l  = getIndex a (Proxy :: Proxy (is:.BitSet I))
+                  RiBsI l  = getIndex (getIdx s) (Proxy :: PRI is (BitSet I))
           {-# Inline [0] mk   #-}
           {-# Inline [0] step #-}
   {-# Inline addIndexDenseGo #-}
@@ -107,21 +107,19 @@
 -- it is the final @RightOf@ object before we have the @FirstLeft@ object.
 
 instance
-  ( AddIndexDense a us is
-  , GetIndex a (is:.BitSet O)
-  , GetIx a (is:.BitSet O) ~ (BitSet O)
-  ) => AddIndexDense a (us:.BitSet O) (is:.BitSet O) where
+  ( IndexHdr s x0 i0 us (BitSet O) cs c is (BitSet O)
+  , MinSize c
+  ) => AddIndexDense s (us:.BitSet O) (cs:.c) (is:.BitSet O) where
   addIndexDenseGo (cs:.c) (vs:.OStatic rb) (us:.u) (is:.i)
     = flatten mk step . addIndexDenseGo cs vs us is
           -- We need to make the number of @0@s smaller, or make the number
           -- of @1@s larger. By an amount given by @rb@. 
     where mk svS
             -- not enough free bits with reserved count
-            | rb + popCount b >= popCount u = return $ Nothing
+            | rb + popCount bso >= popCount u = return $ Nothing
             | otherwise  = return $ Just (svS :. mask :. k)
-            where a = getIndex (sIx svS) (Proxy :: Proxy (is:.BitSet O))
-                  b = getIndex (sOx svS) (Proxy :: Proxy (is:.BitSet O))
-                  mask = u `xor` b -- all bits available for permutations (upper bound, without already set bits)
+            where RiBsO bsi bso = getIndex (getIdx $ sS svS) (Proxy :: PRI is (BitSet O))
+                  mask = u `xor` bso -- all bits available for permutations (upper bound, without already set bits)
                   k = BitSet $ 2 ^ rb - 1 -- the bits we want to trigger
           step Nothing = return $ Done
           -- | @step@ can now provide the outside index with @+rb@ more
@@ -129,18 +127,17 @@
           -- @outside@ provides the mask we can now plug additional
           -- @inside@ objects in -- but only in those plug-ports where @i@
           -- is zero.
-          step (Just (svS@(SvS s a b t y' z') :. mask :. k))
+          step (Just (svS@(SvS s t y') :. mask :. k))
             -- drawing the next bitset ends up over the limit
             | pk > rb   = return $ Done
             | otherwise =
-                let aa = getIndex a (Proxy :: Proxy (is:.BitSet O)) -- this is our inside-type index, it will not be modified here
-                    bb = getIndex b (Proxy :: Proxy (is:.BitSet O))
+                let RiBsO bsi bso = getIndex (getIdx s) (Proxy :: PRI is (BitSet O))
                     kk = popShiftL mask k
-                    tt = kk .|. bb -- the (smaller, more @1@ bits) lookup index
-                in  return $ Yield (SvS s a b (t:.tt) (y':.aa) (z':.tt))
+                    tt = kk .|. bso -- the (smaller, more @1@ bits) lookup index
+                in  return $ Yield (SvS s (t:.tt) (y' :.: RiBsO bsi tt))
                                    ((svS :. mask :.) <$> setSucc 0 (2^rb -1) k)
             where pk = popCount k
-          csize = delay_inline minSize c
+          csize = minSize c
           {-# Inline [0] mk   #-}
           {-# Inline [0] step #-}
   addIndexDenseGo (cs:.c) (vs:.ORightOf rb) (us:.u) (is:.i)
@@ -150,10 +147,10 @@
 -- |
 
 instance
-  ( AddIndexDense a us is
+  ( AddIndexDense a us cs is
   , GetIndex a (is:.BitSet O)
   , GetIx a (is:.BitSet O) ~ (BitSet O)
-  ) => AddIndexDense a (us:.BitSet I) (is:.BitSet O) where
+  ) => AddIndexDense a (us:.BitSet I) (cs:.c) (is:.BitSet O) where
 --  addIndexDenseGo (cs:.c) (vs:.OFirstLeft rb) (us:.u) (is:.i)
 --    = error "ping"
   {-# Inline addIndexDenseGo #-}
diff --git a/ADP/Fusion/SynVar/Indices/Subword.hs b/ADP/Fusion/SynVar/Indices/Subword.hs
--- a/ADP/Fusion/SynVar/Indices/Subword.hs
+++ b/ADP/Fusion/SynVar/Indices/Subword.hs
@@ -33,29 +33,26 @@
 -- @
 
 instance
-  ( AddIndexDense a us is
-  , GetIndex a (is:.Subword I)
-  , GetIx a (is:.Subword I) ~ (Subword I)
-  ) => AddIndexDense a (us:.Subword I) (is:.Subword I) where
+  ( IndexHdr s x0 i0 us (Subword I) cs c is (Subword I)
+  , MinSize c
+  ) => AddIndexDense s (us:.Subword I) (cs:.c) (is:.Subword I) where
   addIndexDenseGo (cs:._) (vs:.IStatic ()) (us:.Subword (_:.u)) (is:.Subword (i:.j))
-    = staticCheck (j<=u)
-    . map (\(SvS s a b t y' z') -> let Subword (_:.l) = getIndex a (Proxy :: Proxy (is:.Subword I))
-                                       lj = subword l j
-                                       oo = subword 0 0
-                                   in  SvS s a b (t:.lj) (y':.lj) (z':.oo))
+    = id -- staticCheck (j<=u)
+    . map (\(SvS s t y') -> let RiSwI l = getIndex (getIdx s) (Proxy :: PRI is (Subword I))
+                                lj = subword l j
+                            in  SvS s (t:.lj) (y' :.: RiSwI j) )
     . addIndexDenseGo cs vs us is
   addIndexDenseGo (cs:.c) (vs:.IVariable ()) (us:.Subword (_:.u)) (is:.Subword (i:.j))
-    = staticCheck (j<=u)
+    = seq csize . id --  staticCheck (j<=u)
     . flatten mk step . addIndexDenseGo cs vs us is
-    where mk   svS = let (Subword (_:.l)) = getIndex (sIx svS) (Proxy :: Proxy (is:.Subword I))
+    where mk   svS = let RiSwI l = getIndex (getIdx $ sS svS) (Proxy :: PRI is (Subword I))
                      in  return $ svS :. (j - l - csize)
-          step (svS@(SvS s a b t y' z') :. zz)
-            | zz >= 0 = do let Subword (_:.k) = getIndex a (Proxy :: Proxy (is:.Subword I))
+          step (svS@(SvS s t y') :. zz)
+            | zz >= 0 = do let RiSwI k = getIndex (getIdx s) (Proxy :: PRI is (Subword I))
                                l = j - zz ; kl = subword k l
-                               oo = subword 0 0
-                           return $ Yield (SvS s a b (t:.kl) (y':.kl) (z':.oo)) (svS :. zz-1)
+                           return $ Yield (SvS s (t:.kl) (y' :.: RiSwI l)) (svS :. zz-1)
             | otherwise =  return $ Done
-          csize = delay_inline minSize c
+          !csize = minSize c
           {-# Inline [0] mk   #-}
           {-# Inline [0] step #-}
   {-# Inline addIndexDenseGo #-}
@@ -70,26 +67,21 @@
 -- and the like.
 
 instance
-  ( AddIndexDense a us is
-  , GetIndex a (is:.Subword O)
-  , GetIx a (is:.Subword O) ~ (Subword O)
-  ) => AddIndexDense a (us:.Subword O) (is:.Subword O) where
+  ( IndexHdr s x0 i0 us (Subword O) cs c is (Subword O)
+  ) => AddIndexDense s (us:.Subword O) (cs:.c) (is:.Subword O) where
   addIndexDenseGo (cs:.c) (vs:.OStatic (di:.dj)) (us:.u) (is:.Subword (i:.j))
-    = map (\(SvS s a b t y' z') -> let Subword (k:._) = getIndex b (Proxy :: Proxy (is:.Subword O))
-                                       kj = subword k (j+dj)
-                                       ij' = subword i j -- (j+dj)
-                                       oo = subword 0 0
-                                   in  SvS s a b (t:.kj) (y':.ij') (z':.kj))
+    = map (\(SvS s t y') -> let RiSwO _ _ k _ = getIndex (getIdx s) (Proxy :: PRI is (Subword O))
+                                kj = subword k (j+dj)
+                            in  SvS s (t:.kj) (y' :.: RiSwO i j k (j+dj)) )
     . addIndexDenseGo cs vs us is
   addIndexDenseGo (cs:.c) (vs:.ORightOf (di:.dj)) (us:.Subword (_:.h)) (is:.Subword (i:.j))
     = flatten mk step . addIndexDenseGo cs vs us is
     where mk svS = return (svS :. j+dj)
-          step (svS@(SvS s a b t y' z') :. l)
-            | l <= h = let Subword (k:._) = getIndex a (Proxy :: Proxy (is:.Subword O))
+          step (svS@(SvS s t y') :. l)
+            | l <= h = let RiSwO k _ _ _ = getIndex (getIdx s) (Proxy :: PRI is (Subword O))
                            kl = subword k l
-                           jj = subword (j+dj) (j+dj)
-                           oo = subword 0 0
-                       in  return $ Yield (SvS s a b (t:.kl) (y':.jj) (z':.kl)) (svS :. l+1)
+                           jdj = j+dj
+                       in  return $ Yield (SvS s (t:.kl) (y' :.: RiSwO jdj jdj k l)) (svS :. l+1)
             | otherwise = return Done
           {-# Inline [0] mk   #-}
           {-# Inline [0] step #-}
@@ -106,52 +98,40 @@
 -- TODO take care of @c@
 
 instance
-  ( AddIndexDense a us is
-  , GetIndex a (is:.Subword O)
-  , GetIx a (is:.Subword O) ~ (Subword O)
-  ) => AddIndexDense a (us:.Subword I) (is:.Subword O) where
+  ( IndexHdr s x0 i0 us (Subword I) cs c is (Subword O)
+  , MinSize c
+  ) => AddIndexDense s (us:.Subword I) (cs:.c) (is:.Subword O) where
   addIndexDenseGo (cs:.c) (vs:.OStatic (di:.dj)) (us:.u) (is:.Subword (i:.j))
-    = map (\(SvS s a b t y' z') -> let Subword (_:.k) = getIndex a (Proxy :: Proxy (is:.Subword O))
-                                       ll@(Subword (_:.l)) = getIndex b (Proxy :: Proxy (is:.Subword O))
-                                       klI = subword (k-dj) (l-dj)
-                                       klO = subword (k-dj) (l-dj)
-                                       oo  = subword 0 0
-                                   in  SvS s a b (t:.klI) (y':.klO) (z':.ll))
+    = map (\(SvS s t y') -> let RiSwO _ k li l = getIndex (getIdx s) (Proxy :: PRI is (Subword O))
+                                klI = subword (k-dj) (l-dj)
+                            in  SvS s (t:.klI) (y':.:RiSwO (k-dj) (l-dj) li l))
     . addIndexDenseGo cs vs us is
   addIndexDenseGo (cs:.c) (vs:.ORightOf d) (us:.u) (is:.Subword (i:.j))
     = flatten mk step . addIndexDenseGo cs vs us is
-    where mk svS = let Subword (_:.l) = getIndex (sIx svS) (Proxy :: Proxy (is:.Subword O))
+    where mk svS = let RiSwO _ l _ _ = getIndex (getIdx $ sS svS) (Proxy :: PRI is (Subword O))
                    in  return (svS :. l :. l + csize)
-          step (svS@(SvS s a b t y' z') :. k :. l)
-            | l <= o    = return $ Yield (SvS s a b (t:.klI) (y':.klO) (z':.zo))
+          step (svS@(SvS s t y') :. k :. l)
+            | l <= oj   = return $ Yield (SvS s (t:.klI) (y' :.: RiSwO k l oi oj))
                                          (svS :. k :. l+1)
             | otherwise = return $ Done
-            where zo@(Subword (_:.o)) = getIndex b (Proxy :: Proxy (is:.Subword O))
+            where RiSwO _ _ oi oj = getIndex (getIdx s) (Proxy :: PRI is (Subword O))
                   klI = subword k l
-                  klO = subword k l
-                  oo = subword 0 0
           csize = minSize c
           {-# Inline [0] mk   #-}
           {-# Inline [0] step #-}
   addIndexDenseGo (cs:.c) (vs:.OFirstLeft (di:.dj)) (us:.u) (is:.Subword (i:.j))
-    = map (\(SvS s a b t y' z') -> let Subword (_:.k) = getIndex a (Proxy :: Proxy (is:.Subword O))
-                                       ll@(Subword (l:._)) = getIndex b (Proxy :: Proxy (is:.Subword O))
-                                       klI = subword k $ i - di
-                                       klO = subword k $ i - di
-                                       oo  = subword 0 0
-                                     in  SvS s a b (t:.klI) (y':.klO) (z':.ll))
+    = map (\(SvS s t y') -> let RiSwO _ k l lj = getIndex (getIdx s) (Proxy :: PRI is (Subword O))
+                                klI = subword k $ i - di
+                            in  SvS s (t:.klI) (y' :.: RiSwO k (i-di) l lj))
     . addIndexDenseGo cs vs us is
   addIndexDenseGo (cs:.c) (vs:.OLeftOf d) (us:.u) (is:.Subword (i:.j))
     = flatten mk step . addIndexDenseGo cs vs us is
-    where mk svS = let Subword (_:.l) = getIndex (sIx svS) (Proxy :: Proxy (is:.Subword O))
+    where mk svS = let RiSwO _ l _ _ = getIndex (getIdx $ sS svS) (Proxy :: PRI is (Subword O))
                    in  return $ svS :. l
-          step (svS@(SvS s a b t y' z') :. l)
-            | l <= i    = let Subword (_:.k) = getIndex a (Proxy :: Proxy (is:.Subword O))
-                              omx = getIndex b (Proxy :: Proxy (is:.Subword O))
+          step (svS@(SvS s t y') :. l)
+            | l <= i    = let RiSwO _ k oi oj = getIndex (getIdx s) (Proxy :: PRI is (Subword O))
                               klI = subword k l
-                              klO = subword k l
-                              oo  = subword 0 0
-                          in  return $ Yield (SvS s a b (t:.klI) (y':.klO) (z':.omx))
+                          in  return $ Yield (SvS s (t:.klI) (y' :.: RiSwO k l oi oj))
                                              (svS :. l+1)
             | otherwise = return $ Done
           csize = minSize c
@@ -169,15 +149,11 @@
 -- @
 
 instance
-  ( AddIndexDense a us is
-  , GetIndex a (is:.Subword C)
-  , GetIx a (is:.Subword C) ~ (Subword C)
-  ) => AddIndexDense a (us:.Subword I) (is:.Subword C) where
+  ( IndexHdr s x0 i0 us (Subword I) cs c is (Subword C)
+  ) => AddIndexDense s (us:.Subword I) (cs:.c) (is:.Subword C) where
   addIndexDenseGo (cs:.c) (vs:.Complemented) (us:.u) (is:.i)
-    = map (\(SvS s a b t y' z') -> let Subword kk = getIndex a (Proxy :: Proxy (is:.Subword C))
-                                       kT = Subword kk -- @k@ Table
-                                       kC = Subword kk
-                                   in  SvS s a b (t:.kT) (y':.kC) (z':.kC))
+    = map (\(SvS s t y') -> let kk@(RiSwC ki kj) = getIndex (getIdx s) (Proxy :: PRI is (Subword C))
+                            in  SvS s (t:.subword ki kj) (y':.:kk))
     . addIndexDenseGo cs vs us is
   {-# Inline addIndexDenseGo #-}
 
@@ -188,15 +164,11 @@
 -- @
 
 instance
-  ( AddIndexDense a us is
-  , GetIndex a (is:.Subword C)
-  , GetIx a (is:.Subword C) ~ (Subword C)
-  ) => AddIndexDense a (us:.Subword O) (is:.Subword C) where
+  ( IndexHdr s x0 i0 us (Subword O) cs c is (Subword C)
+  ) => AddIndexDense s (us:.Subword O) (cs:.c) (is:.Subword C) where
   addIndexDenseGo (cs:.c) (vs:.Complemented) (us:.u) (is:.i)
-    = map (\(SvS s a b t y' z') -> let Subword kk = getIndex a (Proxy :: Proxy (is:.Subword C))
-                                       kT = Subword kk
-                                       kC = Subword kk
-                                   in  SvS s a b (t:.kT) (y':.kC) (z':.kC))
+    = map (\(SvS s t y') -> let kk@(RiSwC ki kj) = getIndex (getIdx s) (Proxy :: PRI is (Subword C))
+                            in  SvS s (t:.subword ki kj) (y':.:kk))
     . addIndexDenseGo cs vs us is
   {-# Inline addIndexDenseGo #-}
 
@@ -207,14 +179,13 @@
 -- @
 
 instance
-  ( AddIndexDense a us is
-  , GetIndex a (is:.Subword C)
-  , GetIx a (is:.Subword C) ~ (Subword C)
-  ) => AddIndexDense a (us:.Subword C) (is:.Subword C) where
+  ( IndexHdr s x0 i0 us (Subword C) cs c is (Subword C)
+  ) => AddIndexDense s (us:.Subword C) (cs:.c) (is:.Subword C) where
   addIndexDenseGo (cs:.c) (vs:.Complemented) (us:.u) (is:.i)
-    = map (\(SvS s a b t y' z') -> let k = getIndex a (Proxy :: Proxy (is:.Subword C))
-                                       oo = subword 0 0
-                                   in  SvS s a b (t:.k) (y':.k) (z':.oo))
+    = map (\(SvS s t y') -> let k = getIndex (getIdx s) (Proxy :: PRI is (Subword C))
+                                RiSwC ki kj = k
+                              in  SvS s (t:.subword ki kj) (y':.:k))
     . addIndexDenseGo cs vs us is
   {-# Inline addIndexDenseGo #-}
+
 
diff --git a/ADP/Fusion/SynVar/Indices/Unit.hs b/ADP/Fusion/SynVar/Indices/Unit.hs
--- a/ADP/Fusion/SynVar/Indices/Unit.hs
+++ b/ADP/Fusion/SynVar/Indices/Unit.hs
@@ -17,42 +17,34 @@
 
 
 instance
-  ( AddIndexDense a us is
-  , GetIndex a (is:.Unit I)
-  , GetIx a (is:.Unit I) ~ (Unit I)
-  ) => AddIndexDense a (us:.Unit I) (is:.Unit I) where
+  ( IndexHdr s x0 i0 us (Unit I) cs c is (Unit I)
+  ) => AddIndexDense s (us:.Unit I) (cs:.c) (is:.Unit I) where
   addIndexDenseGo (cs:._) (vs:.IStatic ()) (us:._) (is:._)
-    = map (\(SvS s a b t y' z') -> SvS s a b (t:.Unit) (y':.Unit) (z':.Unit))
+    = map (\(SvS s t y') -> SvS s (t:.Unit) (y':.:RiU))
     . addIndexDenseGo cs vs us is
   {-# Inline addIndexDenseGo #-}
 
 instance
-  ( AddIndexDense a us is
-  , GetIndex a (is:.Unit O)
-  , GetIx a (is:.Unit O) ~ (Unit O)
-  ) => AddIndexDense a (us:.Unit O) (is:.Unit O) where
+  ( IndexHdr s x0 i0 us (Unit O) cs c is (Unit O)
+  ) => AddIndexDense s (us:.Unit O) (cs:.c) (is:.Unit O) where
   addIndexDenseGo (cs:._) (vs:.OStatic ()) (us:._) (is:._)
-    = map (\(SvS s a b t y' z') -> SvS s a b (t:.Unit) (y':.Unit) (z':.Unit))
+    = map (\(SvS s t y') -> SvS s (t:.Unit) (y':.:RiU))
     . addIndexDenseGo cs vs us is
   {-# Inline addIndexDenseGo #-}
 
 instance
-  ( AddIndexDense a us is
-  , GetIndex a (is:.Unit C)
-  , GetIx a (is:.Unit C) ~ (Unit C)
-  ) => AddIndexDense a (us:.Unit I) (is:.Unit C) where
+  ( IndexHdr s x0 i0 us (Unit I) cs c is (Unit C)
+  ) => AddIndexDense s (us:.Unit I) (cs:.c) (is:.Unit C) where
   addIndexDenseGo (cs:._) (vs:.Complemented) (us:._) (is:._)
-    = map (\(SvS s a b t y' z') -> SvS s a b (t:.Unit) (y':.Unit) (z':.Unit))
+    = map (\(SvS s t y') -> SvS s (t:.Unit) (y':.:RiU))
     . addIndexDenseGo cs vs us is
   {-# Inline addIndexDenseGo #-}
 
 instance
-  ( AddIndexDense a us is
-  , GetIndex a (is:.Unit C)
-  , GetIx a (is:.Unit C) ~ (Unit C)
-  ) => AddIndexDense a (us:.Unit O) (is:.Unit C) where
+  ( IndexHdr s x0 i0 us (Unit O) cs c is (Unit C)
+  ) => AddIndexDense s (us:.Unit O) (cs:.c) (is:.Unit C) where
   addIndexDenseGo (cs:._) (vs:.Complemented) (us:._) (is:._)
-    = map (\(SvS s a b t y' z') -> SvS s a b (t:.Unit) (y':.Unit) (z':.Unit))
+    = map (\(SvS s t y') -> SvS s (t:.Unit) (y':.:RiU))
     . addIndexDenseGo cs vs us is
   {-# Inline addIndexDenseGo #-}
 
diff --git a/ADP/Fusion/SynVar/Recursive/Type.hs b/ADP/Fusion/SynVar/Recursive/Type.hs
--- a/ADP/Fusion/SynVar/Recursive/Type.hs
+++ b/ADP/Fusion/SynVar/Recursive/Type.hs
@@ -1,80 +1,111 @@
 
 module ADP.Fusion.SynVar.Recursive.Type where
 
-import Data.Strict.Tuple ((:!:)(..))
-import Data.Vector.Fusion.Stream.Monadic (Stream,head)
-import Prelude hiding (head)
+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.Base
-import ADP.Fusion.SynVar.Backtrack
 import ADP.Fusion.SynVar.Axiom
+import ADP.Fusion.SynVar.Backtrack
+import ADP.Fusion.SynVar.Indices
 
 
 
-data IRec m i x where
-  IRec :: { iRecConstraint  :: !(TblConstraint i)
+-- | 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 m c i x where
+  IRec :: { iRecConstraint  :: !c
           , iRecFrom        :: !i
           , iRecTo          :: !i
           , iRecFun         :: !(i -> i -> m x)
-          } -> IRec m i x
-
+          } -> IRec m c i x
 
+instance Build (IRec m c i x)
 
-instance Build (IRec m i x)
+type instance TermArg (IRec m c i x) = x
 
-instance GenBacktrackTable (IRec mF i x) mF mB r where
-  data Backtrack (IRec mF i x) mF mB r = BtIRec !(TblConstraint i) !i !i (i -> i -> mB x) (i -> i -> mB [r]) -- (Stream mB r))
-  type BacktrackIndex (IRec mF i x)         = i
+instance GenBacktrackTable (IRec mF c i x) mF mB r where
+  data Backtrack (IRec mF c i x) mF mB r = BtIRec !c !i !i !(i -> i -> mB x) !(i -> i -> mB [r])
+  type BacktrackIndex (IRec mF c i x) = i
   toBacktrack (IRec c iF iT f) mrph bt = BtIRec c iF iT (\lu i -> mrph $ f lu i) bt
-  {-# INLINE toBacktrack #-}
+  {-# Inline toBacktrack #-}
 
 
 
 instance
   ( Monad m
   , IndexStream i
-  ) => Axiom (IRec m i x) where
-  type AxiomStream (IRec m i x) = m x
-  axiom (IRec c l h fun) = do
-    k <- (head . uncurry streamDown) (l,h)
+  ) => Axiom (IRec m c i x) where
+  type AxiomStream (IRec m c i x) = m x
+  axiom (IRec _ l h fun) = do
+    k <- head $ streamDown l h
     fun h k
   {-# Inline axiom #-}
 
 instance
   ( Monad mB
   , IndexStream i
-  ) => Axiom (Backtrack (IRec mF i x) mF mB r) where
-  type AxiomStream (Backtrack (IRec mF i x) mF mB r) = mB [r] -- (Stream mB r)
+  ) => Axiom (Backtrack (IRec mF c i x) mF mB r) where
+  type AxiomStream (Backtrack (IRec mF c i x) mF mB r) = mB [r]
   axiom (BtIRec c l h fun btfun) = do
-    k <- (head . uncurry streamDown) (l,h)
+    k <- head $ streamDown l h
     btfun h k
   {-# Inline axiom #-}
 
 
 
-instance Element ls i => Element (ls :!: IRec m i x) i where
-  data Elm (ls :!: IRec m i x) i = ElmIRec !x !i !i !(Elm ls i)
-  type Arg (ls :!: IRec m i x)   = Arg ls :. x
-  getArg (ElmIRec x _ _ ls) = getArg ls :. x
-  getIdx (ElmIRec _ i _ _ ) = i
-  getOmx (ElmIRec _ _ o _ ) = o
+instance Element ls i => Element (ls :!: IRec m c u x) i where
+  data Elm (ls :!: IRec m c u x) i = ElmIRec !x !(RunningIndex i) !(Elm ls i)
+  type Arg (ls :!: IRec m c u x)   = Arg ls :. x
+  getArg (ElmIRec x _ ls) = getArg ls :. x
+  getIdx (ElmIRec _ i _ ) = i
   {-# Inline getArg #-}
   {-# Inline getIdx #-}
-  {-# Inline getOmx #-}
 
-instance Element ls i => Element (ls :!: (Backtrack (IRec mF i x) mF mB r)) i where
-  data Elm (ls :!: (Backtrack (IRec mF i x) mF mB r)) i = ElmBtIRec !x !(mB (Stream mB r)) !i !i !(Elm ls i)
-  type Arg (ls :!: (Backtrack (IRec mF i x) mF mB r))   = Arg ls :. (x, mB (Stream mB r))
-  getArg (ElmBtIRec x s _ _ ls) = getArg ls :. (x,s)
-  getIdx (ElmBtIRec _ _ i _ _ ) = i
-  getOmx (ElmBtIRec _ _ _ o _ ) = o
+instance Element ls i => Element (ls :!: (Backtrack (IRec mF c u x) mF mB r)) i where
+  data Elm (ls :!: (Backtrack (IRec mF c u x) mF mB r)) i = ElmBtIRec !x [r] !(RunningIndex i) !(Elm ls i)
+  type Arg (ls :!: (Backtrack (IRec mF 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 #-}
-  {-# Inline getOmx #-}
 
-
+instance
+  ( Monad m
+  , Element ls (is:.i)
+  , TableStaticVar (us:.u) (cs:.c) (is:.i)
+  , AddIndexDense (Elm ls (is:.i)) (us:.u) (cs:.c) (is:.i)
+  , MkStream m ls (is:.i)
+  ) => MkStream m (ls :!: IRec m (cs:.c) (us:.u) x) (is:.i) where
+  mkStream (ls :!: IRec c l h fun) vs us is
+    = mapM (\(s,tt,ii) -> (\res -> ElmIRec res ii s) <$> fun h tt)
+    . addIndexDense c vs us is
+    $ mkStream ls (tableStaticVar (Proxy :: Proxy (us:.u)) c vs is) us (tableStreamIndex (Proxy :: Proxy (us:.u)) c vs is)
+  {-# Inline mkStream #-}
 
--- TODO write multi-tape instances
+instance
+  ( Monad mB
+  , Element ls (is:.i)
+  , TableStaticVar (us:.u) (cs:.c) (is:.i)
+  , AddIndexDense (Elm ls (is:.i)) (us:.u) (cs:.c) (is:.i)
+  , MkStream mB ls (is:.i)
+  ) => MkStream mB (ls :!: Backtrack (IRec mF (cs:.c) (us:.u) x) mF mB r) (is:.i) where
+  mkStream (ls :!: BtIRec c l h fun bt) vs us is
+    = mapM (\(s,tt,ii) -> (\res bb -> ElmBtIRec res bb ii s) <$> fun h tt <*> bt h tt)
+    . addIndexDense c vs us is
+    $ mkStream ls (tableStaticVar (Proxy :: Proxy (us:.u)) c vs is) us (tableStreamIndex (Proxy :: Proxy (us:.u)) c vs is)
+  {-# Inline mkStream #-}
 
diff --git a/ADP/Fusion/SynVar/Split/Subword.hs b/ADP/Fusion/SynVar/Split/Subword.hs
--- a/ADP/Fusion/SynVar/Split/Subword.hs
+++ b/ADP/Fusion/SynVar/Split/Subword.hs
@@ -32,18 +32,18 @@
   ( Monad m
   , Element ls (Subword I)
   , MkStream m ls (Subword I)
-  ) => MkStream m (ls :!: Split uId Fragment (ITbl m arr j x)) (Subword I) where
+  ) => MkStream m (ls :!: Split uId Fragment (ITbl m arr c j x)) (Subword I) where
   mkStream (ls :!: Split _) (IStatic ()) hh (Subword (i:.j))
-    = map (\s -> let (Subword (_:.l)) = getIdx s
-                 in  ElmSplitITbl Proxy () (subword l j) (subword 0 0) s)
+    = map (\s -> let RiSwI l = getIdx s
+                 in  ElmSplitITbl Proxy () (RiSwI j) s)
     $ mkStream ls (IVariable ()) hh (delay_inline Subword (i:.j)) -- TODO (see TODO in @Split@) - minSize c))
   mkStream (ls :!: Split _) (IVariable ()) hh (Subword (i:.j))
     = flatten mk step $ mkStream ls (IVariable ()) hh (delay_inline Subword (i:.j)) -- TODO (see above) - minSize c))
-    where mk s = let Subword (_:.l) = getIdx s in return (s :. j - l) -- TODO - minSize c)
-          step (s:.z) | z >= 0 = do let Subword (_:.k) = getIdx s
-                                        l              = j - z
-                                        kl             = subword k l
-                                    return $ Yield (ElmSplitITbl Proxy () kl (subword 0 0) s) (s:. z-1)
+    where mk s = let RiSwI l = getIdx s in return (s :. j - l) -- TODO - minSize c)
+          step (s:.z) | z >= 0 = do let RiSwI k = getIdx s
+                                        l       = j - z
+                                        kl      = subword k l
+                                    return $ Yield (ElmSplitITbl Proxy () (RiSwI l) s) (s:. z-1)
                       | otherwise = return $ Done
           {-# Inline [0] mk   #-}
           {-# Inline [0] step #-}
@@ -56,20 +56,21 @@
   , SplitIxCol uId (SameSid uId (Elm ls (Subword I))) (Elm ls (Subword I))
   , (SplitIxTy uId (SameSid uId (Elm ls (Subword I))) (Elm ls (Subword I)) :. Subword I) ~ mix
   , (PrimArrayOps arr (SplitIxTy uId (SameSid uId (Elm ls (Subword I))) (Elm ls (Subword I)) :. Subword I) x)
-  ) => MkStream m (ls :!: Split uId Final (ITbl m arr mix x)) (Subword I) where
+  , MinSize c
+  ) => MkStream m (ls :!: Split uId Final (ITbl m arr (cs:.c) mix x)) (Subword I) where
   mkStream (ls :!: Split (ITbl _ _ (_:.c) t elm)) (IStatic ()) hh (Subword (i:.j))
-    = map (\s -> let (Subword (_:.l)) = getIdx s
+    = map (\s -> let RiSwI l = getIdx s
                      fmbkm :: mix = collectIx (Proxy :: Proxy uId) s :. subword l j
-                 in  ElmSplitITbl Proxy (t ! fmbkm) (subword l j) (subword 0 0) s)
+                 in  ElmSplitITbl Proxy (t ! fmbkm) (RiSwI j) s)
     $ mkStream ls (IVariable ()) hh (delay_inline Subword (i:.j - minSize c))
   mkStream (ls :!: Split (ITbl _ _ (_:.c) t _)) (IVariable ()) hh (Subword (i:.j))
     = flatten mk step $ mkStream ls (IVariable ()) hh (delay_inline Subword (i:.j - minSize c))
-    where mk s = let Subword (_:.l) = getIdx s in return (s :. (delay_inline id $ j - l - minSize c))
-          step (s:.z) | z >= 0 = do let Subword (_:.k) = getIdx s
-                                        l              = j - z
-                                        kl             = subword k l
-                                        fmbkm :: mix   = collectIx (Proxy :: Proxy uId) s :. kl
-                                    return $ Yield (ElmSplitITbl Proxy (t ! fmbkm) kl (subword 0 0) s) (s:. z-1)
+    where mk s = let RiSwI l = getIdx s in return (s :. (delay_inline id $ j - l - minSize c))
+          step (s:.z) | z >= 0 = do let RiSwI k      = getIdx s
+                                        l            = j - z
+                                        kl           = subword k l
+                                        fmbkm :: mix = collectIx (Proxy :: Proxy uId) s :. kl
+                                    return $ Yield (ElmSplitITbl Proxy (t ! fmbkm) (RiSwI l) s) (s:. z-1)
                       | otherwise = return $ Done
           {-# Inline [0] mk   #-}
           {-# Inline [0] step #-}
@@ -83,18 +84,18 @@
   ( Monad mB
   , Element ls (Subword I)
   , MkStream mB ls (Subword I)
-  ) => MkStream mB (ls :!: Split uId Fragment (Backtrack (ITbl mF arr j x) mF mB r)) (Subword I) where
+  ) => MkStream mB (ls :!: Split uId Fragment (Backtrack (ITbl mF arr c j x) mF mB r)) (Subword I) where
   mkStream (ls :!: Split (BtITbl _ _ _)) (IStatic ()) hh (Subword (i:.j))
-    = map (\s -> let (Subword (_:.l)) = getIdx s
-                 in  ElmSplitBtITbl Proxy () (subword l j) (subword 0 0) s)
+    = map (\s -> let RiSwI l = getIdx s
+                 in  ElmSplitBtITbl Proxy () (RiSwI j) s)
     $ mkStream ls (IVariable ()) hh (delay_inline Subword (i:.j)) -- TODO (see TODO in @Split@) - minSize c))
   mkStream (ls :!: Split _) (IVariable ()) hh (Subword (i:.j))
     = flatten mk step $ mkStream ls (IVariable ()) hh (delay_inline Subword (i:.j)) -- TODO (see above) - minSize c))
-    where mk s = let Subword (_:.l) = getIdx s in return (s :. j - l) -- TODO - minSize c)
-          step (s:.z) | z >= 0 = do let Subword (_:.k) = getIdx s
-                                        l              = j - z
-                                        kl             = subword k l
-                                    return $ Yield (ElmSplitBtITbl Proxy () kl (subword 0 0) s) (s:. z-1)
+    where mk s = let RiSwI l = getIdx s in return (s :. j - l) -- TODO - minSize c)
+          step (s:.z) | z >= 0 = do let RiSwI k = getIdx s
+                                        l       = j - z
+                                        kl      = subword k l
+                                    return $ Yield (ElmSplitBtITbl Proxy () (RiSwI l) s) (s:. z-1)
                       | otherwise = return $ Done
           {-# Inline [0] mk   #-}
           {-# Inline [0] step #-}
@@ -107,23 +108,24 @@
   , SplitIxCol uId (SameSid uId (Elm ls (Subword I))) (Elm ls (Subword I))
   , (SplitIxTy uId (SameSid uId (Elm ls (Subword I))) (Elm ls (Subword I)) :. Subword I) ~ mix
   , (PrimArrayOps arr (SplitIxTy uId (SameSid uId (Elm ls (Subword I))) (Elm ls (Subword I)) :. Subword I) x)
-  ) => MkStream mB (ls :!: Split uId Final (Backtrack (ITbl mF arr mix x) mF mB r)) (Subword I) where
+  , MinSize c
+  ) => MkStream mB (ls :!: Split uId Final (Backtrack (ITbl mF arr (cs:.c) mix x) mF mB r)) (Subword I) where
   mkStream (ls :!: Split (BtITbl (_:.c) t bt)) (IStatic ()) hh (Subword (i:.j))
-    = mapM (\s -> let (Subword (_:.l)) = getIdx s
-                      lj               = subword l j
-                      fmbkm :: mix     = collectIx (Proxy :: Proxy uId) s :. lj
-                      (_,hhhh)         = bounds t -- This is an ugly hack, but we need a notation of higher bound from somewhere
-                  in  bt hhhh fmbkm >>= \ ~bb -> return $ ElmSplitBtITbl Proxy (t ! fmbkm,bb) lj (subword 0 0) s)
+    = mapM (\s -> let RiSwI l      = getIdx s
+                      lj           = subword l j
+                      fmbkm :: mix = collectIx (Proxy :: Proxy uId) s :. lj
+                      (_,hhhh)     = bounds t -- This is an ugly hack, but we need a notation of higher bound from somewhere
+                  in  bt hhhh fmbkm >>= \ ~bb -> return $ ElmSplitBtITbl Proxy (t ! fmbkm,bb) (RiSwI j) s)
     $ mkStream ls (IVariable ()) hh (delay_inline Subword (i:.j - minSize c))
   mkStream (ls :!: Split (BtITbl (_:.c) t bt)) (IVariable ()) hh (Subword (i:.j))
     = flatten mk step $ mkStream ls (IVariable ()) hh (delay_inline Subword (i:.j))
-    where mk s = let Subword (_:.l) = getIdx s in return (s :. (delay_inline id $ j - l - minSize c))
-          step (s:.z) | z >= 0 = do let Subword (_:.k) = getIdx s
-                                        l              = j - z
-                                        kl             = subword k l
-                                        fmbkm :: mix   = collectIx (Proxy :: Proxy uId) s :. kl
-                                        (_,hhhh)       = bounds t -- same ugly hack
-                                    bt hhhh fmbkm >>= \ ~bb -> return $ Yield (ElmSplitBtITbl Proxy (t ! fmbkm,bb) kl (subword 0 0) s) (s:. z-1)
+    where mk s = let RiSwI l = getIdx s in return (s :. (delay_inline id $ j - l - minSize c))
+          step (s:.z) | z >= 0 = do let RiSwI k      = getIdx s
+                                        l            = j - z
+                                        kl           = subword k l
+                                        fmbkm :: mix = collectIx (Proxy :: Proxy uId) s :. kl
+                                        (_,hhhh)     = bounds t -- same ugly hack
+                                    bt hhhh fmbkm >>= \ ~bb -> return $ Yield (ElmSplitBtITbl Proxy (t ! fmbkm,bb) (RiSwI l) s) (s:. z-1)
                       | otherwise = return $ Done
           {-# Inline [0] mk   #-}
           {-# Inline [0] step #-}
diff --git a/ADP/Fusion/SynVar/Split/Type.hs b/ADP/Fusion/SynVar/Split/Type.hs
--- a/ADP/Fusion/SynVar/Split/Type.hs
+++ b/ADP/Fusion/SynVar/Split/Type.hs
@@ -58,9 +58,9 @@
 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 #-}
+--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
 
@@ -68,32 +68,28 @@
 
 instance
   ( Element ls i
-  ) => Element (ls :!: Split uId splitType (ITbl m arr j x)) i where
-  data Elm     (ls :!: Split uId splitType (ITbl m arr j x)) i = ElmSplitITbl !(Proxy uId) !(CalcSplitType splitType x) !i !i !(Elm ls i)
-  type Arg     (ls :!: Split uId splitType (ITbl m arr j x))   = Arg ls :. (CalcSplitType splitType x)
-  type RecElm  (ls :!: Split uId splitType (ITbl m arr j x)) i = Elm ls i
-  getArg (ElmSplitITbl _ x _ _ ls) = getArg ls :. x
-  getIdx (ElmSplitITbl _ _ i _ _ ) = i
-  getOmx (ElmSplitITbl _ _ _ o _ ) = o
-  getElm (ElmSplitITbl _ _ _ _ ls) = ls
+  ) => Element (ls :!: Split uId splitType (ITbl m arr c j x)) i where
+  data Elm     (ls :!: Split uId splitType (ITbl m arr c j x)) i = ElmSplitITbl !(Proxy uId) !(CalcSplitType splitType x) !(RunningIndex i) !(Elm ls i)
+  type Arg     (ls :!: Split uId splitType (ITbl m arr c j x))   = Arg ls :. (CalcSplitType splitType x)
+  type RecElm  (ls :!: Split uId splitType (ITbl 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 getOmx #-}
   {-# Inline getElm #-}
 
 instance
   ( Element ls i
-  ) => Element (ls :!: Split uId splitType (Backtrack (ITbl mF arr j x) mF mB r)) i where
-  data Elm     (ls :!: Split uId splitType (Backtrack (ITbl mF arr j x) mF mB r)) i = ElmSplitBtITbl !(Proxy uId) !(CalcSplitType splitType (x, [r])) !i !i !(Elm ls i)
-  type Arg     (ls :!: Split uId splitType (Backtrack (ITbl mF arr j x) mF mB r))   = Arg ls :. (CalcSplitType splitType (x,[r]))
-  type RecElm  (ls :!: Split uId splitType (Backtrack (ITbl mF arr j x) mF mB r)) i = Elm ls i
-  getArg (ElmSplitBtITbl _ xs _ _ ls) = getArg ls :. xs
-  getIdx (ElmSplitBtITbl _ _ i _ _ ) = i
-  getOmx (ElmSplitBtITbl _ _ _ o _ ) = o
-  getElm (ElmSplitBtITbl _ _ _ _ ls) = ls
+  ) => Element (ls :!: Split uId splitType (Backtrack (ITbl mF arr c j x) mF mB r)) i where
+  data Elm     (ls :!: Split uId splitType (Backtrack (ITbl mF arr c j x) mF mB r)) i = ElmSplitBtITbl !(Proxy uId) !(CalcSplitType splitType (x, [r])) !(RunningIndex i) !(Elm ls i)
+  type Arg     (ls :!: Split uId splitType (Backtrack (ITbl mF arr c j x) mF mB r))   = Arg ls :. (CalcSplitType splitType (x,[r]))
+  type RecElm  (ls :!: Split uId splitType (Backtrack (ITbl mF 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 getOmx #-}
   {-# Inline getElm #-}
 
 
@@ -148,6 +144,12 @@
 
 -- | 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 :: *
@@ -157,7 +159,7 @@
 
 instance SplitIxCol uId b (Elm S i) where
   type SplitIxTy uId b (Elm S i) = Z
-  splitIxCol p b (ElmS _ _) = Z
+  splitIxCol p b (ElmS _) = Z
   {-# Inline splitIxCol #-}
 
 
@@ -172,16 +174,16 @@
 
 instance
   ( SplitIxCol uId (SameSid uId (Elm ls i)) (Elm ls i)
-  ) => SplitIxCol   uId True (Elm (ls :!: Split sId splitType (ITbl m arr j x)) i) where
-  type SplitIxTy uId True (Elm (ls :!: Split sId splitType (ITbl m arr j x)) i) = SplitIxTy uId (SameSid uId (Elm ls i)) (Elm ls i) :. i
-  splitIxCol p b (ElmSplitITbl _ _ i _ e) = collectIx p e :. i
+  ) => SplitIxCol   uId True (Elm (ls :!: Split sId splitType (ITbl m arr c j x)) i) where
+  type SplitIxTy uId True (Elm (ls :!: Split sId splitType (ITbl m arr c j x)) i) = SplitIxTy uId (SameSid uId (Elm ls i)) (Elm ls i) :. i
+  splitIxCol p b (ElmSplitITbl _ _ i e) = collectIx p e :. (error "splitIxCol: RunningIndex i -> i conversion?") -- i
   {-# Inline splitIxCol #-}
 
 instance
   ( SplitIxCol uId (SameSid uId (Elm ls i)) (Elm ls i)
-  ) => SplitIxCol   uId True (Elm (ls :!: Split sId splitType (Backtrack (ITbl mF arr j x) mF mB r)) i) where
-  type SplitIxTy uId True (Elm (ls :!: Split sId splitType (Backtrack (ITbl mF arr j x) mF mB r)) i) = SplitIxTy uId (SameSid uId (Elm ls i)) (Elm ls i) :. i
-  splitIxCol p b (ElmSplitBtITbl _ _ i _ e) = collectIx p e :. i
+  ) => SplitIxCol   uId True (Elm (ls :!: Split sId splitType (Backtrack (ITbl mF arr c j x) mF mB r)) i) where
+  type SplitIxTy uId True (Elm (ls :!: Split sId splitType (Backtrack (ITbl mF 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) = collectIx p e :. (error "splitIxCol: RunningIndex i -> i conversion?") -- i
   {-# Inline splitIxCol #-}
 
 instance
@@ -189,6 +191,6 @@
   , 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` (undefined p t :: SplitIxTy uId (SameSid uId (TermSymbol a b)) (TermSymbol a b))
+  splitIxCol p b (ElmTS t i e) = collectIx p e `zconcat` (undefined p t :: SplitIxTy uId (SameSid uId (TermSymbol a b)) (TermSymbol a b))
   {-# Inline splitIxCol #-}
 
diff --git a/ADP/Fusion/Term/Chr/Point.hs b/ADP/Fusion/Term/Chr/Point.hs
--- a/ADP/Fusion/Term/Chr/Point.hs
+++ b/ADP/Fusion/Term/Chr/Point.hs
@@ -27,7 +27,7 @@
   ( TmkCtx1 m ls (Chr r x) (PointL i)
   ) => MkStream m (ls :!: Chr r x) (PointL i) where
   mkStream (ls :!: Chr f xs) sv us is
-    = S.map (\(ss,ee,ii,oo) -> ElmChr ee ii oo ss) -- recover ElmChr
+    = S.map (\(ss,ee,ii) -> ElmChr ee ii ss) -- recover ElmChr
     . addTermStream1 (Chr f xs) sv us is
     $ mkStream ls (termStaticVar (Chr f xs) sv is) us (termStreamIndex (Chr f xs) sv is)
   {-# Inline mkStream #-}
@@ -41,22 +41,21 @@
 -- NOTE / TODO a bit faster with @seq xs@ ?
 
 instance
-  ( TstCtx1 m ts a is (PointL I)
-  ) => TermStream m (TermSymbol ts (Chr r x)) a (is:.PointL I) where
+  ( TstCtx m ts s x0 i0 is (PointL I)
+  ) => TermStream m (TermSymbol ts (Chr r x)) s (is:.PointL I) where
   termStream (ts:|Chr f xs) (cs:.IStatic d) (us:.PointL u) (is:.PointL i)
-    = seq xs . staticCheck (i>0 && i<=u && i<= VG.length xs)
-    . S.map (\(TState s a b ii oo ee) -> TState s a b (ii:.PointL i) (oo:.PointL 0) (ee:. f xs (i-1)))
+    -- seq xs . staticCheck (i>0 && i<=u && i<= VG.length xs)
+    = S.map (\(TState s ii ee) -> TState s (ii:.:RiPlI i) (ee:. f xs (i-1)))
     . termStream ts cs us is
   {-# Inline termStream #-}
 
 instance
-  ( TstCtx1 m ts a is (PointL O)
-  ) => TermStream m (TermSymbol ts (Chr r x)) a (is:.PointL O) where
+  ( TstCtx m ts s x0 i0 is (PointL O)
+  ) => TermStream m (TermSymbol ts (Chr r x)) s (is:.PointL O) where
   termStream (ts:|Chr f xs) (cs:.OStatic d) (us:.PointL u) (is:.PointL i)
-    = S.map (\(TState s a b ii oo ee) ->
-                let PointL k = getIndex a (Proxy :: Proxy (is:.PointL O))
-                    o        = getIndex b (Proxy :: Proxy (is:.PointL O))
-                in  TState s a b (ii:.PointL (k-d+1)) (oo:.o) (ee:.f xs (k-d-1)))
+    = 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 ts cs us is
   {-# Inline termStream #-}
 
@@ -69,7 +68,7 @@
   {-# Inline [0] termStreamIndex #-}
 
 instance TermStaticVar (Chr r x) (PointL O) where
-  termStaticVar   _ (OStatic d) _ = OStatic (d+1) 
+  termStaticVar   _ (OStatic d) _ = OStatic (d+1)
   termStreamIndex _ _           j = j
   {-# Inline [0] termStaticVar #-}
   {-# Inline [0] termStreamIndex #-}
diff --git a/ADP/Fusion/Term/Chr/Set0.hs b/ADP/Fusion/Term/Chr/Set0.hs
--- a/ADP/Fusion/Term/Chr/Set0.hs
+++ b/ADP/Fusion/Term/Chr/Set0.hs
@@ -12,7 +12,7 @@
 import qualified Data.Vector.Generic as VG
 import           Prelude hiding (map)
 import           Data.Bits
-import           Data.Bits.Extras (msb)
+import           Data.Bits.Extras (msb,Ranked)
 import           Data.Bits.Ordered
 
 import           Data.PrimitiveArray hiding (map)
@@ -26,30 +26,31 @@
   ( TmkCtx1 m ls (Chr r x) (BitSet i)
   ) => MkStream m (ls :!: Chr r x) (BitSet i) where
   mkStream (ls :!: Chr f xs) sv us is
-    = S.map (\(ss,ee,ii,oo) -> ElmChr ee ii oo ss)
+    = S.map (\(ss,ee,ii) -> ElmChr ee ii ss)
     . addTermStream1 (Chr f xs) sv us is
     $ mkStream ls (termStaticVar (Chr f xs) sv is) us (termStreamIndex (Chr f xs) sv is)
   {-# Inline mkStream #-}
 
 instance
-  ( TstCtx1 m ts a is (BitSet I)
-  ) => TermStream m (TermSymbol ts (Chr r x)) a (is:.BitSet I) where
+  ( TstCtx m ts s x0 i0 is (BitSet I)
+  , Ranked (BitSet I)
+  ) => TermStream m (TermSymbol ts (Chr r x)) s (is:.BitSet I) where
   termStream (ts:|Chr f xs) (cs:.IStatic rb) (us:.u) (is:.i)
     = staticCheck (rb <= popCount i && i <= u && VG.length xs > msb u)
     . S.flatten mk step . termStream ts cs us is
           -- we task all set bits @bs@ and also the index @i@ and calculate
           -- the non-set bits @mask@. The mask should have a popcount equal
           -- to @rb + 1@. We then active bit 0 and proceed with @step@.
-    where mk svS = let bs = getIndex (tIx svS) (Proxy :: Proxy (is:.BitSet I))
+    where mk svS = let RiBsI bs = getIndex (getIdx $ tS svS) (Proxy :: PRI is (BitSet I))
                        mask = i `xor` bs
-                   in  {- traceShow ("Chr",i,bs,mask,lsbZ mask) $ -} return (svS :. mask :. lsbZ mask)
+                   in  return (svS :. mask :. lsbZ mask)
           -- In case we can still do a step via @k>=0@, we active bit @k@
           -- in @aa@.
-          step (svS@(TState s a b ii oo ee) :. mask :. k )
+          step (svS@(TState s ii ee) :. mask :. k )
             | k < 0 = return $ Done
             | otherwise =
-            let aa = getIndex a (Proxy :: Proxy (is:.BitSet I))
-            in  return $ Yield (TState s a b (ii:.setBit aa k) (oo:.0) (ee:.f xs k))
+            let RiBsI aa = getIndex (getIdx s) (Proxy :: PRI is (BitSet I))
+            in  return $ Yield (TState s (ii:.: RiBsI (setBit aa k)) (ee:.f xs k))
                                (svS :. mask :. nextActiveZ k mask)
           {-# Inline [0] mk   #-}
           {-# Inline [0] step #-}
diff --git a/ADP/Fusion/Term/Chr/Subword.hs b/ADP/Fusion/Term/Chr/Subword.hs
--- a/ADP/Fusion/Term/Chr/Subword.hs
+++ b/ADP/Fusion/Term/Chr/Subword.hs
@@ -20,60 +20,62 @@
   ( TmkCtx1 m ls (Chr r x) (Subword i)
   ) => MkStream m (ls :!: Chr r x) (Subword i) where
   mkStream (ls :!: Chr f xs) sv us is
-    = S.map (\(ss,ee,ii,oo) -> ElmChr ee ii oo ss)
+    = S.map (\(ss,ee,ii) -> ElmChr ee ii ss)
     . addTermStream1 (Chr f xs) sv us is
     $ mkStream ls (termStaticVar (Chr f xs) sv is) us (termStreamIndex (Chr f xs) sv is)
   {-# Inline mkStream #-}
 
 
 
+-- |
+--
+-- NOTE We do not run 'staticCheck'. Running @staticCheck@ costs about
+-- @10%@ performance and we assume that the frontend will take care of
+-- correct indices anyway.
+
 instance
-  ( TstCtx1 m ts a is (Subword I)
-  ) => TermStream m (TermSymbol ts (Chr r x)) a (is:.Subword I) where
+  ( TstCtx m ts s x0 i0 is (Subword I)
+  ) => TermStream m (TermSymbol ts (Chr r x)) s (is:.Subword I) where
   termStream (ts:|Chr f xs) (cs:.IStatic ()) (us:.u) (is:.Subword (i:.j))
-    = staticCheck (i>=0 && i < j && j <= VG.length xs)
-    . map (\(TState s a b ii oo ee) ->
-              TState s a b (ii:.subword (j-1) j) (oo:.subword 0 0) (ee:.f xs (j-1)) )
+    = id -- staticCheck (i>=0 && i < j && j <= VG.length xs)
+    . map (\(TState s ii ee) ->
+              TState s (ii:.: RiSwI j) (ee:.f xs (j-1)) )
     . termStream ts cs us is
   --
   termStream (ts:|Chr f xs) (cs:.IVariable ()) (us:.u) (is:.Subword (i:.j))
-    = map (\(TState s a b ii oo ee) ->
-              let Subword (_:.l) = getIndex a (Proxy :: Proxy (is:.Subword I))
-              in  TState s a b (ii:.subword l (l+1)) (oo:.subword 0 0) (ee:.f xs l) )
+    = map (\(TState s ii ee) ->
+              let RiSwI l = getIndex (getIdx s) (Proxy :: PRI is (Subword I))
+              in  TState s (ii:.:RiSwI (l+1)) (ee:.f xs l) )
     . termStream ts cs us is
   {-# Inline termStream #-}
 
 instance
-  ( TstCtx1 m ts a is (Subword O)
-  ) => TermStream m (TermSymbol ts (Chr r x)) a (is:.Subword O) where
+  ( TstCtx m ts s x0 i0 is (Subword O)
+  ) => TermStream m (TermSymbol ts (Chr r x)) s (is:.Subword O) where
   termStream (ts:|Chr f xs) (cs:.OStatic (di:.dj)) (us:.u) (is:.Subword (i:.j))
-    = map (\(TState s a b ii oo ee) ->
-              let Subword (_:.k) = getIndex a (Proxy :: Proxy (is:.Subword O))
-                  o              = getIndex b (Proxy :: Proxy (is:.Subword O))
+    = map (\(TState s ii ee) ->
+              let RiSwO _ k oi oj = getIndex (getIdx s) (Proxy :: PRI is (Subword O))
                   l              = k - dj
-              in  TState s a b (ii:.subword k (k+1)) (oo:.o) (ee:.f xs k) )
+              in  TState s (ii:.: RiSwO k (k+1) oi oj) (ee:.f xs k) )
     . termStream ts cs us is
   --
   termStream (ts:|Chr f xs) (cs:.ORightOf (di:.dj)) (us:.u) (is:.i)
-    = map (\(TState s a b ii oo ee) ->
-              let Subword (_:.k) = getIndex a (Proxy :: Proxy (is:.Subword O))
-                  o              = getIndex b (Proxy :: Proxy (is:.Subword O))
+    = map (\(TState s ii ee) ->
+              let RiSwO _ k oi oj = getIndex (getIdx s) (Proxy :: PRI is (Subword O))
                   l              = k - dj - 1
-              in  TState s a b (ii:.subword (k-1) k) (oo:.o) (ee:.f xs l) )
+              in  TState s (ii:.:RiSwO (k-1) k oi oj) (ee:.f xs l) )
     . termStream ts cs us is
   --
   termStream (ts:|Chr f xs) (cs:.OFirstLeft (di:.dj)) (us:.u) (is:.i)
-    = map (\(TState s a b ii oo ee) ->
-              let Subword (_:.k) = getIndex a (Proxy :: Proxy (is:.Subword O))
-                  o              = getIndex b (Proxy :: Proxy (is:.Subword O))
-              in  TState s a b (ii:.subword k (k+1)) (oo:.o) (ee:.f xs k) )
+    = map (\(TState s ii ee) ->
+              let RiSwO _ k oi oj = getIndex (getIdx s) (Proxy :: PRI is (Subword O))
+              in  TState s (ii:.:RiSwO k (k+1) oi oj) (ee:.f xs k) )
     . termStream ts cs us is
   --
   termStream (ts:|Chr f xs) (cs:.OLeftOf (di:.dj)) (us:.u) (is:.i)
-    = map (\(TState s a b ii oo ee) ->
-              let Subword (_:.k) = getIndex a (Proxy :: Proxy (is:.Subword O))
-                  o              = getIndex b (Proxy :: Proxy (is:.Subword O))
-              in  TState s a b (ii:.subword k (k+1)) (oo:.o) (ee:.f xs k) )
+    = map (\(TState s ii ee) ->
+              let RiSwO _ k oi oj = getIndex (getIdx s) (Proxy :: PRI is (Subword O))
+              in  TState s (ii:.:RiSwO k (k+1) oi oj) (ee:.f xs k) )
     . termStream ts cs us is
   {-# Inline termStream #-}
 
diff --git a/ADP/Fusion/Term/Chr/Type.hs b/ADP/Fusion/Term/Chr/Type.hs
--- a/ADP/Fusion/Term/Chr/Type.hs
+++ b/ADP/Fusion/Term/Chr/Type.hs
@@ -24,7 +24,7 @@
 data Chr r x where
   Chr :: VG.Vector v x
       => (v x -> Int -> r)
-      -> (v x)
+      -> !(v x)
       -> Chr r x
 
 -- | smart constructor for regular 1-character parsers
@@ -47,16 +47,14 @@
 instance
   ( Element ls i
   ) => Element (ls :!: Chr r x) i where
-    data Elm (ls :!: Chr r x) i = ElmChr !r !i !i !(Elm ls i)
+    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
-    getOmx (ElmChr _ _ o _ ) = o
+    getArg (ElmChr x _ ls) = getArg ls :. x
+    getIdx (ElmChr _ i _ ) = i
     {-# Inline getArg #-}
     {-# Inline getIdx #-}
-    {-# Inline getOmx #-}
 
-deriving instance (Show i, Show r, Show (Elm ls i)) => Show (Elm (ls :!: Chr r x) i)
+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/Term/Deletion/Point.hs b/ADP/Fusion/Term/Deletion/Point.hs
--- a/ADP/Fusion/Term/Deletion/Point.hs
+++ b/ADP/Fusion/Term/Deletion/Point.hs
@@ -16,7 +16,7 @@
   ( TmkCtx1 m ls Deletion (PointL i)
   ) => MkStream m (ls :!: Deletion) (PointL i) where
   mkStream (ls :!: Deletion) sv us is
-    = S.map (\(ss,ee,ii,oo) -> ElmDeletion ii oo ss)
+    = S.map (\(ss,ee,ii) -> ElmDeletion ii ss)
     . addTermStream1 Deletion sv us is
     $ mkStream ls (termStaticVar Deletion sv is) us (termStreamIndex Deletion sv is)
   {-# Inline mkStream #-}
@@ -24,21 +24,20 @@
 
 
 instance
-  ( TstCtx1 m ts a is (PointL I)
-  ) => TermStream m (TermSymbol ts Deletion) a (is:.PointL I) where
+  ( TstCtx m ts s x0 i0 is (PointL I)
+  ) => TermStream m (TermSymbol ts Deletion) s (is:.PointL I) where
   termStream (ts:|Deletion) (cs:.IStatic d) (us:.PointL u) (is:.PointL i)
-    = S.map (\(TState s a b ii oo ee) -> TState s a b (ii:.PointL i) (oo:.PointL 0) (ee:.()))
+    = S.map (\(TState s ii ee) -> TState s (ii:.:RiPlI i) (ee:.()))
     . termStream ts cs us is
   {-# Inline termStream #-}
 
 instance
-  ( TstCtx1 m ts a is (PointL O)
-  ) => TermStream m (TermSymbol ts Deletion) a (is:.PointL O) where
+  ( TstCtx m ts s x0 i0 is (PointL O)
+  ) => TermStream m (TermSymbol ts Deletion) s (is:.PointL O) where
   termStream (ts:|Deletion) (cs:.OStatic d) (us:.PointL u) (is:.PointL i)
-    = S.map (\(TState s a b ii oo ee) ->
-                let i' = getIndex a (Proxy :: Proxy (is:.PointL O))
-                    o' = getIndex b (Proxy :: Proxy (is:.PointL O))
-                in  TState s a b (ii:.i') (oo:.o') (ee:.()))
+    = S.map (\(TState s ii ee) ->
+                let io = getIndex (getIdx s) (Proxy :: PRI is (PointL O))
+                in  TState s (ii:.: io) (ee:.()))
     . termStream ts cs us is
   {-# Inline termStream #-}
 
diff --git a/ADP/Fusion/Term/Deletion/Subword.hs b/ADP/Fusion/Term/Deletion/Subword.hs
--- a/ADP/Fusion/Term/Deletion/Subword.hs
+++ b/ADP/Fusion/Term/Deletion/Subword.hs
@@ -17,7 +17,7 @@
   ( TmkCtx1 m ls Deletion (Subword i)
   ) => MkStream m (ls :!: Deletion) (Subword i) where
   mkStream (ls :!: Deletion) sv us is
-    = map (\(ss,ee,ii,oo) -> ElmDeletion ii oo ss)
+    = map (\(ss,ee,ii) -> ElmDeletion ii ss)
     . addTermStream1 Deletion sv us is
     $ mkStream ls (termStaticVar Deletion sv is) us (termStreamIndex Deletion sv is)
   {-# Inline mkStream #-}
@@ -25,52 +25,54 @@
 
 
 instance
-  ( TstCtx1 m ts a is (Subword I)
-  ) => TermStream m (TermSymbol ts Deletion) a (is:.Subword I) where
+  ( TstCtx m ts s x0 i0 is (Subword I)
+  ) => TermStream m (TermSymbol ts Deletion) s (is:.Subword I) where
   termStream (ts:|Deletion) (cs:.IStatic d) (us:.u) (is:.Subword (i:.j))
-    = S.map (\(TState s a b ii oo ee) -> TState s a b (ii:.subword j j) (oo:.subword 0 0) (ee:.()) )
+    = S.map (\(TState s ii ee) -> TState s (ii:.:RiSwI j) (ee:.()) )
     . termStream ts cs us is
   termStream (ts:|Deletion) (cs:.IVariable d) (us:.u) (is:.Subword (i:.j))
-    = S.map (\(TState s a b ii oo ee) ->
-                let Subword (_:.l) = getIndex a (Proxy :: Proxy (is:.Subword I))
-                in  TState s a b (ii:.subword l l) (oo:.subword 0 0) (ee:.()) )
+    = S.map (\(TState s ii ee) ->
+                let l = getIndex (getIdx s) (Proxy :: PRI is (Subword I))
+                in  TState s (ii:.:l) (ee:.()) )
     . termStream ts cs us is
   {-# Inline termStream #-}
 
 instance
-  ( TstCtx1 m ts a is (Subword O)
-  ) => TermStream m (TermSymbol ts Deletion) a (is:.Subword O) where
+  ( TstCtx m ts s x0 i0 is (Subword O)
+  ) => TermStream m (TermSymbol ts Deletion) s (is:.Subword O) where
   -- X_ij  -> Y_ik  Z_kj  d_jj        0   i Y k Z j-j   N
   -- Y^_ik -> X^_ij Z_kj  d_jj        0 x i   k Z j-j x N
   -- Z^_kj -> Y_ik  X^_ij d_jj        0 x i Y k   j-j x N
+  termStream (ts:|Deletion) (cs:._) (us:.u) (is:.Subword (i:.j))
+    = S.map (\(TState s ii ee) ->
+                let RiSwO _ k oi oj = getIndex (getIdx s) (Proxy :: PRI is (Subword O))
+                in  TState s (ii:.:RiSwO k k oi oj) (ee:.()) )
+    . termStream ts cs us is
+  {-
   termStream (ts:|Deletion) (cs:.OStatic (di:.dj)) (us:.u) (is:.Subword (i:.j))
-    = S.map (\(TState s a b ii oo ee) ->
-                let Subword (_:.k) = getIndex a (Proxy :: Proxy (is:.Subword O))
-                    o              = getIndex b (Proxy :: Proxy (is:.Subword O))
-                in  TState s a b (ii:.subword k k) (oo:.o) (ee:.()) )
+    = S.map (\(TState s a ii ee) ->
+                let RiSwO _ k oi oj = getIndex a (Proxy :: PRI is (Subword O))
+                in  TState s a (ii:.:RiSwO k k oi oj) (ee:.()) )
     . termStream ts cs us is
   --
   termStream (ts:|Deletion) (cs:.ORightOf (di:.dj)) (us:.u) (is:.Subword (i:.j))
-    = S.map (\(TState s a b ii oo ee) ->
-                let Subword (_:.k) = getIndex a (Proxy :: Proxy (is:.Subword O))
-                    o              = getIndex b (Proxy :: Proxy (is:.Subword O))
-                    l              = k - dj -- TODO needed ?
-                in  TState s a b (ii:.subword k k) (oo:.o) (ee:.()) )
+    = S.map (\(TState s a ii ee) ->
+                let RiSwO _ k oi oj = getIndex a (Proxy :: PRI is (Subword O))
+                in  TState s a (ii:.:RiSwO k k oi oj) (ee:.()) )
     . termStream ts cs us is
   --
   termStream (ts:|Deletion) (cs:.OFirstLeft (di:.dj)) (us:.u) (is:.Subword (i:.j))
-    = S.map (\(TState s a b ii oo ee) ->
-                let Subword (_:.k) = getIndex a (Proxy :: Proxy (is:.Subword O))
-                    o              = getIndex b (Proxy :: Proxy (is:.Subword O))
-                in  TState s a b (ii:.subword k k) (oo:.o) (ee:.()) )
+    = S.map (\(TState s a ii ee) ->
+                let RiSwO _ k oi oj = getIndex a (Proxy :: PRI is (Subword O))
+                in  TState s a (ii:.:RiSwO k k oi oj) (ee:.()) )
     . termStream ts cs us is
   --
   termStream (ts:|Deletion) (cs:.OLeftOf (di:.dj)) (us:.u) (is:.Subword (i:.j))
-    = S.map (\(TState s a b ii oo ee) ->
-                let Subword (_:.k) = getIndex a (Proxy :: Proxy (is:.Subword O))
-                    o              = getIndex b (Proxy :: Proxy (is:.Subword O))
-                in  TState s a b (ii:.subword k k) (oo:.o) (ee:.()) )
+    = S.map (\(TState s a ii ee) ->
+                let RiSwO _ k oi oj = getIndex a (Proxy :: PRI is (Subword O))
+                in  TState s a (ii:.: RiSwO k k oi oj) (ee:.()) )
     . termStream ts cs us is
+  -}
   {-# Inline termStream #-}
 
 
diff --git a/ADP/Fusion/Term/Deletion/Type.hs b/ADP/Fusion/Term/Deletion/Type.hs
--- a/ADP/Fusion/Term/Deletion/Type.hs
+++ b/ADP/Fusion/Term/Deletion/Type.hs
@@ -14,14 +14,12 @@
 instance Build Deletion
 
 instance (Element ls i) => Element (ls :!: Deletion) i where
-  data Elm (ls :!: Deletion) i = ElmDeletion !i !i !(Elm ls i)
+  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
-  getOmx (ElmDeletion _ o _) = o
+  getArg (ElmDeletion _ l) = getArg l :. ()
+  getIdx (ElmDeletion i _) = i
   {-# Inline getArg #-}
   {-# Inline getIdx #-}
-  {-# Inline getOmx #-}
 
 type instance TermArg Deletion = ()
 
diff --git a/ADP/Fusion/Term/Deletion/Unit.hs b/ADP/Fusion/Term/Deletion/Unit.hs
--- a/ADP/Fusion/Term/Deletion/Unit.hs
+++ b/ADP/Fusion/Term/Deletion/Unit.hs
@@ -16,7 +16,7 @@
   ( TmkCtx1 m ls Deletion (Unit i)
   ) => MkStream m (ls :!: Deletion) (Unit i) where
   mkStream (ls :!: Deletion) sv us is
-    = S.map (\(ss,ee,ii,oo) -> ElmDeletion ii oo ss)
+    = S.map (\(ss,ee,ii) -> ElmDeletion ii ss)
     . addTermStream1 Deletion sv us is
     $ mkStream ls (termStaticVar Deletion sv is) us (termStreamIndex Deletion sv is)
   {-# Inline mkStream #-}
@@ -24,18 +24,18 @@
 
 
 instance
-  ( TstCtx1 m ts a is (Unit I)
-  ) => TermStream m (TermSymbol ts Deletion) a (is:.Unit I) where
+  ( TstCtx m ts s x0 i0 is (Unit I)
+  ) => TermStream m (TermSymbol ts Deletion) s (is:.Unit I) where
   termStream (ts:|Deletion) (cs:.IStatic ()) (us:._) (is:._)
-    = S.map (\(TState s a b ii oo ee) -> TState s a b (ii:.Unit) (oo:.Unit) (ee:.()))
+    = S.map (\(TState s ii ee) -> TState s (ii:.:RiU) (ee:.()))
     . termStream ts cs us is
   {-# Inline termStream #-}
 
 instance
-  ( TstCtx1 m ts a is (Unit O)
-  ) => TermStream m (TermSymbol ts Deletion) a (is:.Unit O) where
+  ( TstCtx m ts s x0 i0 is (Unit O)
+  ) => TermStream m (TermSymbol ts Deletion) s (is:.Unit O) where
   termStream (ts:|Deletion) (cs:.OStatic ()) (us:._) (is:._)
-    = S.map (\(TState s a b ii oo ee) -> TState s a b (ii:.Unit) (oo:.Unit) (ee:.()))
+    = S.map (\(TState s ii ee) -> TState s (ii:.:RiU) (ee:.()))
     . termStream ts cs us is
   {-# Inline termStream #-}
 
diff --git a/ADP/Fusion/Term/Edge/Set.hs b/ADP/Fusion/Term/Edge/Set.hs
--- a/ADP/Fusion/Term/Edge/Set.hs
+++ b/ADP/Fusion/Term/Edge/Set.hs
@@ -31,17 +31,17 @@
             | j <  0 && popCount s >= 2 = return $ That (z,bits,maybeLsb bits)
             | popCount s <= max 1 rp    = return $ Naught
             | otherwise                 = error $ show ("Edge",s,i,j)
-            where (BS2 zs _ zk) = getIdx z
+            where RiBs2I (BS2 zs _ zk) = getIdx z
                   bits        = s `xor` zs
           step Naught   = return Done
           step (This z)
             | popCount zs == 0 = return $ Done
-            | otherwise = return $ Yield (ElmEdge (f (getIter zk) (getIter j)) sij undefbs2i z) Naught
-            where (BS2 zs _ zk) = getIdx z
+            | otherwise = return $ Yield (ElmEdge (f (getIter zk) (getIter j)) (RiBs2I sij) z) Naught
+            where RiBs2I (BS2 zs _ zk) = getIdx z
           step (That (z,bits,Nothing)) = return $ Done
-          step (That (z,bits,Just j')) = let (BS2 zs _ (Iter zk)) = getIdx z
-                                             tij'                 = BS2 (zs .|. bit j') (Iter zk) (Iter j')
-                                         in  return $ Yield (ElmEdge (f zk j') tij' undefbs2i z) (That (z,bits,maybeNextActive j' bits))
+          step (That (z,bits,Just j')) = let RiBs2I (BS2 zs _ (Iter zk)) = getIdx z
+                                             tij'                        = BS2 (zs .|. bit j') (Iter zk) (Iter j')
+                                         in  return $ Yield (ElmEdge (f zk j') (RiBs2I tij') z) (That (z,bits,maybeNextActive j' bits))
           {-# Inline [0] mk   #-}
           {-# Inline [0] step #-}
   {-# Inline mkStream #-}
diff --git a/ADP/Fusion/Term/Edge/Type.hs b/ADP/Fusion/Term/Edge/Type.hs
--- a/ADP/Fusion/Term/Edge/Type.hs
+++ b/ADP/Fusion/Term/Edge/Type.hs
@@ -17,16 +17,14 @@
 instance
   ( Element ls i
   ) => Element (ls :!: Edge e) i where
-    data Elm (ls :!: Edge e) i = ElmEdge !e !i !i (Elm ls i)
+    data Elm (ls :!: Edge e) i = ElmEdge !e !(RunningIndex i) (Elm ls i)
     type Arg (ls :!: Edge e)   = Arg ls :. e
-    getArg (ElmEdge e _ _ ls) = getArg ls :. e
-    getIdx (ElmEdge _ i _ _ ) = i
-    getOmx (ElmEdge _ _ o _ ) = o
+    getArg (ElmEdge e _ ls) = getArg ls :. e
+    getIdx (ElmEdge _ i _ ) = i
     {-# Inline getArg #-}
     {-# Inline getIdx #-}
-    {-# Inline getOmx #-}
 
-deriving instance (Show i, Show e, Show (Elm ls i)) => Show (Elm (ls :!: Edge e) i)
+deriving instance (Show i, Show (RunningIndex i), Show e, Show (Elm ls i)) => Show (Elm (ls :!: Edge e) i)
 
 type instance TermArg (Edge e) = e
 
diff --git a/ADP/Fusion/Term/Epsilon/Point.hs b/ADP/Fusion/Term/Epsilon/Point.hs
--- a/ADP/Fusion/Term/Epsilon/Point.hs
+++ b/ADP/Fusion/Term/Epsilon/Point.hs
@@ -16,7 +16,7 @@
   ( TmkCtx1 m ls Epsilon (PointL i)
   ) => MkStream m (ls :!: Epsilon) (PointL i) where
   mkStream (ls :!: Epsilon) sv us is
-    = S.map (\(ss,ee,ii,oo) -> ElmEpsilon ii oo ss)
+    = S.map (\(ss,ee,ii) -> ElmEpsilon ii ss)
     . addTermStream1 Epsilon sv us is
     $ mkStream ls (termStaticVar Epsilon sv is) us (termStreamIndex Epsilon sv is)
   {-# Inline mkStream #-}
@@ -24,21 +24,20 @@
 
 
 instance
-  ( TstCtx1 m ts a is (PointL I)
-  ) => TermStream m (TermSymbol ts Epsilon) a (is:.PointL I) where
+  ( TstCtx m ts s x0 i0 is (PointL I)
+  ) => TermStream m (TermSymbol ts Epsilon) s (is:.PointL I) where
   termStream (ts:|Epsilon) (cs:.IStatic d) (us:.PointL u) (is:.PointL i)
-    = S.map (\(TState s a b ii oo ee) -> TState s a b (ii:.PointL i) (oo:.PointL 0) (ee:.()))
+    = S.map (\(TState s ii ee) -> TState s (ii:.:RiPlI i) (ee:.()))
     . termStream ts cs us is
   {-# Inline termStream #-}
 
 instance
-  ( TstCtx1 m ts a is (PointL O)
-  ) => TermStream m (TermSymbol ts Epsilon) a (is:.PointL O) where
+  ( TstCtx m ts s x0 i0 is (PointL O)
+  ) => TermStream m (TermSymbol ts Epsilon) s (is:.PointL O) where
   termStream (ts:|Epsilon) (cs:.OStatic d) (us:.PointL u) (is:.PointL i)
-    = S.map (\(TState s a b ii oo ee) ->
-                let i' = getIndex a (Proxy :: Proxy (is:.PointL O))
-                    o' = getIndex b (Proxy :: Proxy (is:.PointL O))
-                in  TState s a b (ii:.i') (oo:.o') (ee:.()))
+    = S.map (\(TState s ii ee) ->
+                let io = getIndex (getIdx s) (Proxy :: PRI is (PointL O))
+                in  TState s (ii:.:io) (ee:.()))
     . termStream ts cs us is
   {-# Inline termStream #-}
 
diff --git a/ADP/Fusion/Term/Epsilon/Set.hs b/ADP/Fusion/Term/Epsilon/Set.hs
--- a/ADP/Fusion/Term/Epsilon/Set.hs
+++ b/ADP/Fusion/Term/Epsilon/Set.hs
@@ -20,7 +20,7 @@
   ( TmkCtx1 m ls Epsilon (BitSet i)
   ) => MkStream m (ls :!: Epsilon) (BitSet i) where
   mkStream (ls :!: Epsilon) sv us is
-    = map (\(ss,ee,ii,oo) -> ElmEpsilon ii oo ss)
+    = map (\(ss,ee,ii) -> ElmEpsilon ii ss)
     . addTermStream1 Epsilon sv us is
     $ mkStream ls (termStaticVar Epsilon sv is) us (termStreamIndex Epsilon sv is)
   {-# Inline mkStream #-}
@@ -28,22 +28,22 @@
 
 
 instance
-  ( TstCtx1 m ts a is (BitSet I)
-  ) => TermStream m (TermSymbol ts Epsilon) a (is:.BitSet I) where
+  ( TstCtx m ts s x0 i0 is (BitSet I)
+  ) => TermStream m (TermSymbol ts Epsilon) s (is:.BitSet I) where
   termStream (ts:|Epsilon) (cs:.IStatic r) (us:.u) (is:.i)
     = staticCheck (i==0)
-    . map (\(TState s a b ii oo ee) ->
-              TState s a b (ii:.0) (oo:.0) (ee:.()) )
+    . map (\(TState s ii ee) ->
+              TState s (ii:.:RiBsI 0) (ee:.()) )
     . termStream ts cs us is
   {-# Inline termStream #-}
 
 instance
-  ( TstCtx1 m ts a is (BitSet O)
-  ) => TermStream m (TermSymbol ts Epsilon) a (is:.BitSet O) where
+  ( TstCtx m ts s x0 i0 is (BitSet O)
+  ) => TermStream m (TermSymbol ts Epsilon) s (is:.BitSet O) where
   termStream (ts:|Epsilon) (cs:.OStatic r) (us:.u) (is:.i)
     = staticCheck (i==u)
-    . map (\(TState s a b ii oo ee) ->
-              TState s a b (ii:.u) (oo:.u) (ee:.()) )
+    . map (\(TState s ii ee) ->
+              TState s (ii:.:RiBsO u u) (ee:.()) )
     . termStream ts cs us is
   {-# Inline termStream #-}
 
@@ -69,30 +69,29 @@
   ( TmkCtx1 m ls Epsilon (BS2 First Last i)
   ) => MkStream m (ls :!: Epsilon) (BS2 First Last i) where
   mkStream (ls :!: Epsilon) sv us is
-    = map (\(ss,ee,ii,oo) -> ElmEpsilon ii oo ss)
+    = map (\(ss,ee,ii) -> ElmEpsilon ii ss)
     . addTermStream1 Epsilon sv us is
     $ mkStream ls (termStaticVar Epsilon sv is) us (termStreamIndex Epsilon sv is)
   {-# Inline mkStream #-}
 
 instance
-  ( TstCtx1 m ts a is (BS2 First Last I)
-  ) => TermStream m (TermSymbol ts Epsilon) a (is:.BS2 First Last I) where
+  ( TstCtx m ts s x0 i0 is (BS2 First Last I)
+  ) => TermStream m (TermSymbol ts Epsilon) s (is:.BS2 First Last I) where
   termStream (ts:|Epsilon) (cs:.IStatic r) (us:.u) (is:.BS2 bs _ _)
     = staticCheck (bs==0)
-    . map (\(TState s a b ii oo ee) ->
-              TState s a b (ii:.BS2 0 0 0) (oo:.BS2 0 0 0) (ee:.()) )
+    . map (\(TState s ii ee) ->
+              TState s (ii:.:RiBs2I (BS2 0 0 0)) (ee:.()) )
     . termStream ts cs us is
   {-# Inline termStream #-}
 
 instance
-  ( TstCtx1 m ts a is (BS2 First Last O)
-  ) => TermStream m (TermSymbol ts Epsilon) a (is:.BS2 First Last O) where
+  ( TstCtx m ts s x0 i0 is (BS2 First Last O)
+  ) => TermStream m (TermSymbol ts Epsilon) s (is:.BS2 First Last O) where
   termStream (ts:|Epsilon) (cs:.OStatic r) (us:.BS2 ub uf ul) (is:.BS2 bs f l)
     = staticCheck (ub==bs)
-    . map (\(TState s a b ii oo ee) ->
-              let i' = getIndex a (Proxy :: Proxy (is:.BS2 First Last O))
-                  o' = getIndex b (Proxy :: Proxy (is:.BS2 First Last O))
-              in  TState s a b (ii:.i') (oo:.o') (ee:.()) )
+    . map (\(TState s ii ee) ->
+              let io = getIndex (getIdx s) (Proxy :: PRI is (BS2 First Last O))
+              in  TState s (ii:.:io) (ee:.()) )
     . termStream ts cs us is
   {-# Inline termStream #-}
 
diff --git a/ADP/Fusion/Term/Epsilon/Subword.hs b/ADP/Fusion/Term/Epsilon/Subword.hs
--- a/ADP/Fusion/Term/Epsilon/Subword.hs
+++ b/ADP/Fusion/Term/Epsilon/Subword.hs
@@ -17,7 +17,7 @@
   ( TmkCtx1 m ls Epsilon (Subword i)
   ) => MkStream m (ls :!: Epsilon) (Subword i) where
   mkStream (ls :!: Epsilon) sv us is
-    = map (\(ss,ee,ii,oo) -> ElmEpsilon ii oo ss)
+    = map (\(ss,ee,ii) -> ElmEpsilon ii ss)
     . addTermStream1 Epsilon sv us is
     $ mkStream ls (termStaticVar Epsilon sv is) us (termStreamIndex Epsilon sv is)
   {-# Inline mkStream #-}
@@ -25,24 +25,23 @@
 
 
 instance
-  ( TstCtx1 m ts a is (Subword I)
-  ) => TermStream m (TermSymbol ts Epsilon) a (is:.Subword I) where
+  ( TstCtx m ts s x0 i0 is (Subword I)
+  ) => TermStream m (TermSymbol ts Epsilon) s (is:.Subword I) where
   termStream (ts:|Epsilon) (cs:.IStatic ()) (us:.u) (is:.Subword (i:.j))
-    = staticCheck (i==j)
-    . map (\(TState s a b ii oo ee) ->
-              TState s a b (ii:.subword i j) (oo:.subword 0 0) (ee:.()) )
+    = map (\(TState s ii ee) ->
+              TState s (ii:.:RiSwI j) (ee:.()) )
     . termStream ts cs us is
+    . staticCheck (i==j)
   {-# Inline termStream #-}
 
 instance
-  ( TstCtx1 m ts a is (Subword O)
-  ) => TermStream m (TermSymbol ts Epsilon) a (is:.Subword O) where
+  ( TstCtx m ts s xi0 i0 is (Subword O)
+  ) => TermStream m (TermSymbol ts Epsilon) s (is:.Subword O) where
   termStream (ts:|Epsilon) (cs:.OStatic d) (us:.Subword (ui:.uj)) (is:.Subword (i:.j))
     = staticCheck (ui == i && uj == j) -- TODO correct ?
-    . map (\(TState s a b ii oo ee) ->
-              let i' = getIndex a (Proxy :: Proxy (is:.Subword O))
-                  o' = getIndex b (Proxy :: Proxy (is:.Subword O))
-              in  TState s a b (ii:.i') (oo:.o') (ee:.()) )
+    . map (\(TState s ii ee) ->
+              let io = getIndex (getIdx s) (Proxy :: PRI is (Subword O))
+              in  TState s (ii:.:io) (ee:.()) )
     . termStream ts cs us is
   {-# Inline termStream #-}
 
diff --git a/ADP/Fusion/Term/Epsilon/Type.hs b/ADP/Fusion/Term/Epsilon/Type.hs
--- a/ADP/Fusion/Term/Epsilon/Type.hs
+++ b/ADP/Fusion/Term/Epsilon/Type.hs
@@ -14,14 +14,12 @@
 instance Build Epsilon
 
 instance (Element ls i) => Element (ls :!: Epsilon) i where
-  data Elm (ls :!: Epsilon) i = ElmEpsilon !i !i !(Elm ls i)
+  data Elm (ls :!: Epsilon) i = ElmEpsilon !(RunningIndex i) !(Elm ls i)
   type Arg (ls :!: Epsilon)   = Arg ls :. ()
-  getArg (ElmEpsilon _ _ l) = getArg l :. ()
-  getIdx (ElmEpsilon i _ _) = i
-  getOmx (ElmEpsilon _ o _) = o
+  getArg (ElmEpsilon _ l) = getArg l :. ()
+  getIdx (ElmEpsilon i _) = i
   {-# Inline getArg #-}
   {-# Inline getIdx #-}
-  {-# Inline getOmx #-}
 
 type instance TermArg Epsilon = ()
 
diff --git a/ADP/Fusion/Term/Epsilon/Unit.hs b/ADP/Fusion/Term/Epsilon/Unit.hs
--- a/ADP/Fusion/Term/Epsilon/Unit.hs
+++ b/ADP/Fusion/Term/Epsilon/Unit.hs
@@ -16,7 +16,7 @@
   ( TmkCtx1 m ls Epsilon (Unit i)
   ) => MkStream m (ls :!: Epsilon) (Unit i) where
   mkStream (ls :!: Epsilon) sv us is
-    = S.map (\(ss,ee,ii,oo) -> ElmEpsilon ii oo ss)
+    = S.map (\(ss,ee,ii) -> ElmEpsilon ii ss)
     . addTermStream1 Epsilon sv us is
     $ mkStream ls (termStaticVar Epsilon sv is) us (termStreamIndex Epsilon sv is)
   {-# Inline mkStream #-}
@@ -24,18 +24,18 @@
 
 
 instance
-  ( TstCtx1 m ts a is (Unit I)
-  ) => TermStream m (TermSymbol ts Epsilon) a (is:.Unit I) where
+  ( TstCtx m ts s x0 i0 is (Unit I)
+  ) => TermStream m (TermSymbol ts Epsilon) s (is:.Unit I) where
   termStream (ts:|Epsilon) (cs:.IStatic ()) (us:._) (is:._)
-    = S.map (\(TState s a b ii oo ee) -> TState s a b (ii:.Unit) (oo:.Unit) (ee:.()))
+    = S.map (\(TState s ii ee) -> TState s (ii:.:RiU) (ee:.()))
     . termStream ts cs us is
   {-# Inline termStream #-}
 
 instance
-  ( TstCtx1 m ts a is (Unit O)
-  ) => TermStream m (TermSymbol ts Epsilon) a (is:.Unit O) where
+  ( 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 a b ii oo ee) -> TState s a b (ii:.Unit) (oo:.Unit) (ee:.()))
+    = S.map (\(TState s ii ee) -> TState s (ii:.:RiU) (ee:.()))
     . termStream ts cs us is
   {-# Inline termStream #-}
 
diff --git a/ADP/Fusion/Term/PeekIndex/Subword.hs b/ADP/Fusion/Term/PeekIndex/Subword.hs
--- a/ADP/Fusion/Term/PeekIndex/Subword.hs
+++ b/ADP/Fusion/Term/PeekIndex/Subword.hs
@@ -18,7 +18,7 @@
   , MkStream m ls (Subword C)
   ) => MkStream m (ls :!: PeekIndex (Subword C)) (Subword C) where
   mkStream (ls :!: PeekIndex) Complemented h ij
-    = map (\s -> ElmPeekIndex (getIdx s) (getOmx s) s)
+    = map (\s -> let ri@(RiSwC k l) = getIdx s in ElmPeekIndex (subword k l) ri s)
     $ mkStream ls Complemented h ij
   {-# Inline mkStream #-}
 
diff --git a/ADP/Fusion/Term/PeekIndex/Type.hs b/ADP/Fusion/Term/PeekIndex/Type.hs
--- a/ADP/Fusion/Term/PeekIndex/Type.hs
+++ b/ADP/Fusion/Term/PeekIndex/Type.hs
@@ -16,16 +16,14 @@
 instance
   ( Element ls i
   ) => Element (ls :!: PeekIndex i) i where
-    data Elm (ls :!: PeekIndex i) i = ElmPeekIndex !i !i !(Elm ls i)
-    type Arg (ls :!: PeekIndex i)   = Arg ls :. (i :. i)
-    getArg (ElmPeekIndex i o ls)    = getArg ls :. (i:.o)
-    getIdx (ElmPeekIndex i _ _ )    = i
-    getOmx (ElmPeekIndex _ o _ )    = o
+    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 #-}
-    {-# Inline getOmx #-}
 
-deriving instance (Show i, Show (Elm ls i)) => Show (Elm (ls :!: PeekIndex i) i)
+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/Term/Strng/Point.hs b/ADP/Fusion/Term/Strng/Point.hs
--- a/ADP/Fusion/Term/Strng/Point.hs
+++ b/ADP/Fusion/Term/Strng/Point.hs
@@ -18,7 +18,7 @@
   ( TmkCtx1 m ls (Strng v x) (PointL i)
   ) => MkStream m (ls :!: Strng v x) (PointL i) where
   mkStream (ls :!: strng@(Strng _ minL maxL xs)) sv us is
-    = S.map (\(ss,ee,ii,oo) -> ElmStrng ee ii oo ss)
+    = S.map (\(ss,ee,ii) -> ElmStrng ee ii ss)
     . addTermStream1 strng sv us is
     $ mkStream ls (termStaticVar strng sv is) us (termStreamIndex strng sv is)
   {-# Inline mkStream #-}
@@ -26,52 +26,49 @@
 
 
 instance
-  ( TstCtx1 m ts a is (PointL I)
-  ) => TermStream m (TermSymbol ts (Strng v x)) a (is:.PointL I) where
+  ( TstCtx m ts s x0 i0 is (PointL I)
+  ) => TermStream m (TermSymbol ts (Strng v x)) s (is:.PointL I) where
   --
   termStream (ts:|Strng f minL maxL v) (cs:.IStatic d) (us:.PointL u) (is:.PointL i)
-    = S.map (\(TState s a b ii oo ee) ->
-                let PointL k = getIndex a (Proxy :: Proxy (is:.PointL I))
-                in  TState s a b (ii:.PointL i) (oo:.PointL 0) (ee:.f k (i-k) v))
+    = S.map (\(TState s ii ee) ->
+                let RiPlI k = getIndex (getIdx s) (Proxy :: PRI is (PointL I))
+                in  TState s (ii:.:RiPlI i) (ee:.f k (i-k) v))
     . termStream ts cs us is
   --
   termStream (ts:|Strng f minL maxL v) (cs:.IVariable d) (us:.PointL u) (is:.PointL i)
     = S.flatten mk step . termStream ts cs us is
-    where mk (tstate@(TState s a b ii oo ee)) =
-              let PointL k = getIndex a (Proxy :: Proxy (is:.PointL I))
+    where mk (tstate@(TState s ii ee)) =
+              let RiPlI k = getIndex (getIdx s) (Proxy :: PRI is (PointL I))
               in  return (tstate, i-k-d-minL)
-          step (tstate@(TState s a b ii oo ee), z)
-            | z >= 0 && (l-k <= maxL) = return $ S.Yield (TState s a b (ii:.PointL l) (oo:.o) (ee:.f k (l-k+1) v)) (tstate, z-1)
+          step (tstate@(TState s ii ee), z)
+            | z >= 0 && (l-k <= maxL) = return $ S.Yield (TState s (ii:.:RiPlI l) (ee:.f k (l-k+1) v)) (tstate, z-1)
             | otherwise = return $ S.Done
-            where PointL k = getIndex a (Proxy :: Proxy (is:.PointL I))
-                  o        = PointL 0
+            where RiPlI k = getIndex (getIdx s) (Proxy :: PRI is (PointL I))
                   l        = i - z - d
           {-# Inline [0] mk   #-}
           {-# Inline [0] step #-}
   {-# Inline termStream #-}
 
 instance
-  ( TstCtx1 m ts a is (PointL O)
-  ) => TermStream m (TermSymbol ts (Strng v x)) a (is:.PointL O) where
+  ( TstCtx m ts s x0 i0 is (PointL O)
+  ) => TermStream m (TermSymbol ts (Strng v x)) s (is:.PointL O) where
   --
   termStream (ts:|Strng f minL maxL v) (cs:.OStatic d) (us:.PointL u) (is:.PointL i)
-    = S.map (\(TState s a b ii oo ee) ->
-                let PointL k = getIndex a (Proxy :: Proxy (is:.PointL O))
-                    o        = getIndex b (Proxy :: Proxy (is:.PointL O))
-                in  TState s a b (ii:.PointL (i-d+1)) (oo:.o) (ee:.f k (i-k) v)) -- @i-d+1 or k-d+1@ ?
+    = S.map (\(TState s ii ee) ->
+                let RiPlO k o = getIndex (getIdx s) (Proxy :: PRI is (PointL O))
+                in  TState s (ii:.:RiPlO (i-d+1) o) (ee:.f k (i-k) v)) -- @i-d+1 or k-d+1@ ?
     . termStream ts cs us is
   --
   termStream (ts:|Strng f minL maxL v) (cs:.ORightOf d) (us:.PointL u) (is:.PointL i)
     = S.flatten mk step . termStream ts cs us is
-    where mk (tstate@(TState s a b ii oo ee)) =
-              let PointL k = getIndex a (Proxy :: Proxy (is:.PointL O))
+    where mk (tstate@(TState s ii ee)) =
+              let RiPlO k _ = getIndex (getIdx s) (Proxy :: PRI is (PointL O))
               in  return (tstate, i-k-d-minL)
-          step (tstate@(TState s a b ii oo ee), z)
-            | z >= 0 && (l-k <= maxL) = return $ S.Yield (TState s a b (ii:.PointL l) (oo:.o) (ee:.f k (l-k+1) v)) (tstate, z-1)
+          step (tstate@(TState s ii ee), z)
+            | z >= 0 && (l-k <= maxL) = return $ S.Yield (TState s (ii:.:RiPlO l o) (ee:.f k (l-k+1) v)) (tstate, z-1)
             | otherwise = return $ S.Done
-            where PointL k = getIndex a (Proxy :: Proxy (is:.PointL O))
-                  o        = getIndex b (Proxy :: Proxy (is:.PointL O))
-                  l        = i - z - d
+            where RiPlO k o = getIndex (getIdx s) (Proxy :: PRI is (PointL O))
+                  l         = i - z - d
           {-# Inline [0] mk   #-}
           {-# Inline [0] step #-}
   {-# Inline termStream #-}
diff --git a/ADP/Fusion/Term/Strng/Subword.hs b/ADP/Fusion/Term/Strng/Subword.hs
--- a/ADP/Fusion/Term/Strng/Subword.hs
+++ b/ADP/Fusion/Term/Strng/Subword.hs
@@ -20,27 +20,33 @@
   ( TmkCtx1 m ls (Strng v x) (Subword i)
   ) => MkStream m (ls :!: Strng v x) (Subword i) where
   mkStream (ls :!: strng) sv us is
-    = S.map (\(ss,ee,ii,oo) -> ElmStrng ee ii oo ss)
+    = S.map (\(ss,ee,ii) -> ElmStrng ee ii ss)
     . addTermStream1 strng sv us is
     $ mkStream ls (termStaticVar strng sv is) us (termStreamIndex strng sv is)
   {-# Inline mkStream #-}
 
 instance
-  ( TstCtx1 m ts a is (Subword I)
-  ) => TermStream m (TermSymbol ts (Strng v x)) a (is:.Subword I) where
+  ( TstCtx m ts s x0 i0 is (Subword I)
+  ) => TermStream m (TermSymbol ts (Strng v x)) s (is:.Subword I) where
   --
   termStream (ts:|Strng f minL maxL v) (cs:.IStatic d) (us:.Subword (ui:.uj)) (is:.Subword (i:.j))
-    = S.filter (\(TState _ a _ _ _ _) -> let Subword (k:.l) = getIndex a (Proxy :: Proxy (is:.Subword I)) in l-k <= maxL)
-    . S.map (\(TState s a b ii oo ee) ->
-                let Subword (_:.l) = getIndex a (Proxy :: Proxy (is:.Subword I))
-                    o              = getIndex b (Proxy :: Proxy (is:.Subword I))
-                in  TState s a b (ii:.subword l j) (oo:.o) (ee:.f l (j-l) v) )
+    = S.filter (\(TState s _ _) ->
+                    -- let Subword (k:.l) = getIndex a (Proxy :: Proxy (is:.Subword I))
+                    let RiSwI l = getIndex (getIdx s) (Proxy :: PRI is (Subword I))
+                        -- RiSwI k = getIndex (getIdx $ getElm s) (Proxy :: PRI is (Subword I))
+                        k = undefined
+                    in l-k <= maxL)
+    . S.map (\(TState s ii ee) ->
+                --let Subword (_:.l) = getIndex a (Proxy :: Proxy (is:.Subword I))
+                --    o              = getIndex b (Proxy :: Proxy (is:.Subword I))
+                let RiSwI l = getIndex (getIdx s) (Proxy :: PRI is (Subword I))
+                in  TState s (ii:.:RiSwI j) (ee:.f l (j-l) v) )
     . termStream ts cs us is
   --
   termStream (ts:|Strng f minL maxL v) (cs:.IVariable d) (us:._) (is:.Subword (i:.j))
     = S.flatten mk step . termStream ts cs us is
-    where mk (tstate@(TState s a b ii oo ee)) =
-            let Subword (_:.k) = getIndex a (Proxy :: Proxy (is:.Subword I))
+    where mk (tstate@(TState s ii ee)) =
+            let RiSwI k = getIndex (getIdx s) (Proxy :: PRI is (Subword I))
             in  return (tstate, k+minL, min j (k+maxL))
           step = undefined
           {-# Inline [0] mk   #-}
diff --git a/ADP/Fusion/Term/Strng/Type.hs b/ADP/Fusion/Term/Strng/Type.hs
--- a/ADP/Fusion/Term/Strng/Type.hs
+++ b/ADP/Fusion/Term/Strng/Type.hs
@@ -41,16 +41,14 @@
 instance
   ( Element ls i
   ) => Element (ls :!: Strng v x) i where
-  data Elm (ls :!: Strng v x) i = ElmStrng !(v x) !i !i !(Elm ls i)
+  data Elm (ls :!: Strng v x) i = ElmStrng !(v x) !(RunningIndex i) !(Elm ls i)
   type Arg (ls :!: Strng v x)   = Arg ls :. v x
-  getArg (ElmStrng x _ _ ls) = getArg ls :. x
-  getIdx (ElmStrng _ i _ _ ) = i
-  getOmx (ElmStrng _ _ o _ ) = o
+  getArg (ElmStrng x _ ls) = getArg ls :. x
+  getIdx (ElmStrng _ i _ ) = i
   {-# Inline getArg #-}
   {-# Inline getIdx #-}
-  {-# Inline getOmx #-}
 
-deriving instance (Show i, Show (v x), Show (Elm ls i)) => Show (Elm (ls :!: Strng v x) i)
+deriving instance (Show i, Show (RunningIndex i), Show (v x), Show (Elm ls i)) => Show (Elm (ls :!: Strng v x) i)
 
 type instance TermArg (Strng v x) = v x
 
diff --git a/ADPfusion.cabal b/ADPfusion.cabal
--- a/ADPfusion.cabal
+++ b/ADPfusion.cabal
@@ -1,7 +1,7 @@
 name:           ADPfusion
-version:        0.5.0.0
-author:         Christian Hoener zu Siederdissen, 2011-2015
-copyright:      Christian Hoener zu Siederdissen, 2011-2015
+version:        0.5.1.0
+author:         Christian Hoener zu Siederdissen, 2011-2016
+copyright:      Christian Hoener zu Siederdissen, 2011-2016
 homepage:       https://github.com/choener/ADPfusion
 bug-reports:    https://github.com/choener/ADPfusion/issues
 maintainer:     choener@bioinf.uni-leipzig.de
@@ -11,7 +11,7 @@
 build-type:     Simple
 stability:      experimental
 cabal-version:  >= 1.10.0
-tested-with:    GHC == 7.8.4, GHC == 7.10.2
+tested-with:    GHC == 7.8.4, GHC == 7.10.3
 synopsis:       Efficient, high-level dynamic programming.
 description:
                 <http://www.bioinf.uni-leipzig.de/Software/gADP/ generalized Algebraic Dynamic Programming>
@@ -59,23 +59,26 @@
   default:      False
   manual:       True
 
+flag spectest
+  description:  build the spec-ctor test case
+  default:      False
+  manual:       True
 
 
+
 library
   build-depends: base               >= 4.7      && < 4.9
                , bits               >= 0.4      && < 0.5
                , containers
                , mmorph             >= 1.0      && < 1.1
-               , monad-primitive    >= 0.1      && < 0.2
                , mtl                >= 2.0      && < 2.3
                , OrderedBits        >= 0.0.1.0  && < 0.0.2.0
                , primitive          >= 0.5.4    && < 0.7
                , PrimitiveArray     >= 0.7.0    && < 0.7.1
                , QuickCheck         >= 2.7      && < 2.9
-               , singletons         >= 1.1      && < 1.2
                , strict             >= 0.3      && < 0.4
                , template-haskell   >= 2.0      && < 3.0
-               , th-orphans         >= 0.12     && < 0.13
+               , th-orphans         >= 0.12     && < 0.14
                , transformers       >= 0.3      && < 0.5
                , tuple              >= 0.3      && < 0.4
                , vector             >= 0.11     && < 0.12
@@ -531,6 +534,48 @@
                , BenchmarkHistory   >= 0.0.0  && < 0.0.1
                , PrimitiveArray
                , vector
+
+
+
+-- 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
+  if flag(debug)
+    ghc-options:
+      -ddump-to-file
+      -ddump-simpl
+      -dsuppress-all
 
 
 
diff --git a/changelog.md b/changelog.md
--- a/changelog.md
+++ b/changelog.md
@@ -1,3 +1,9 @@
+0.5.1.0
+-------
+
+- improved table filling algorithm performance
+- some optimizations to terminal symbols
+
 0.5.0.0
 -------
 
diff --git a/src/Durbin.hs b/src/Durbin.hs
--- a/src/Durbin.hs
+++ b/src/Durbin.hs
@@ -31,6 +31,7 @@
 import qualified Data.Vector.Unboxed as VU
 import           System.Environment (getArgs)
 import           Text.Printf
+import           Data.Char (ord)
 
 -- Import PrimitiveArray for low-level tables and automatic table
 -- filling.
@@ -61,7 +62,7 @@
   { nil = \ ()    -> 0
   , lef = \ _  x  -> x
   , rig = \ x  _  -> x
-  , pai = \ c x d -> if pairs c d then x+1 else -999999
+  , pai = \ c x d -> x + pairs' c d -- if pairs c d then x+1 else -999999
   , spl = \ x y   -> x+y
   , h   = SM.foldl' max 0
   }
@@ -76,6 +77,16 @@
   || c=='U' && d=='G'
 {-# INLINE pairs #-}
 
+pairs' !c !d = lkup_pairs ! (Z:.ord c:.ord d)
+{-# Inline pairs' #-}
+
+lkup_pairs :: Unboxed (Z:.Int:.Int) Int
+lkup_pairs = PA.fromAssocs (Z:.0:.0) (Z:.mx:.mx) (-999999) $ Prelude.map (\[p1,p2] -> ((Z:.p1:.p2),1)) ps
+  where mx = maximum $ Prelude.map ord "ACGU"
+        ps :: [[Int]]
+        ps = Prelude.map (Prelude.map ord) [ "AU", "CG", "GC", "GU", "UA", "UG" ]
+{-# NoInline lkup_pairs #-}
+
 pretty :: Monad m => Durbin m Char () String [String]
 pretty = Durbin
   { nil = \ ()      -> ""
@@ -100,6 +111,8 @@
   in (Z:.t)
 {-# INLINE grammar #-}
 
+-- TODO need to re-enable epsilon checks!
+
 runDurbin :: Int -> String -> (Int,[String])
 runDurbin k inp = (d, take k . unId $ axiom b) where
   i = VU.fromList . Prelude.map toUpper $ inp
@@ -107,10 +120,9 @@
   !(Z:.t) = mutateTablesDefault
           $ grammar bpmax
               (chr i)
-              (ITbl 0 0 EmptyOk (PA.fromAssocs (subword 0 0) (subword 0 n) (-999999) [])) :: Z:.ITbl Id Unboxed (Subword I) Int
-  -- d = let (ITbl _ _ arr _) = t in arr PA.! subword 0 n
+              (ITbl 0 0 EmptyOk (PA.fromAssocs (subword 0 0) (subword 0 n) (-999999) [])) :: Z:.ITbl Id Unboxed EmptyOk (Subword I) Int
   d = iTblArray t PA.! subword 0 n
-  !(Z:.b) = grammar (bpmax <|| pretty) (chr i) (toBacktrack t (undefined :: Id a -> Id a))
+  !(Z:.b) = grammar (bpmax <|| pretty) (chr i) (toBacktrack t (undefined :: Id a -> Id a)) -- :: Z:.Backtrack (ITbl Id Unboxed EmptyOk (Subword I) Int) Id Id String
 {-# NoInline runDurbin #-}
 
 main = do
diff --git a/src/NeedlemanWunsch.hs b/src/NeedlemanWunsch.hs
--- a/src/NeedlemanWunsch.hs
+++ b/src/NeedlemanWunsch.hs
@@ -240,7 +240,7 @@
 -- For your own code, you can write as done here, or in the way of
 -- 'runOutsideNeedlemanWunsch'.
 
-nwInsideForward :: VU.Vector Char -> VU.Vector Char -> Z:.ITbl Id Unboxed (Z:.PointL I:.PointL I) Int
+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) []))
@@ -249,7 +249,7 @@
         n2 = VU.length i2
 {-# NoInline nwInsideForward #-}
 
-nwInsideBacktrack :: VU.Vector Char -> VU.Vector Char -> ITbl Id Unboxed (Z:.PointL I:.PointL I) Int -> [[String]]
+nwInsideBacktrack :: VU.Vector Char -> VU.Vector Char -> ITbl Id Unboxed (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
 {-# NoInline nwInsideBacktrack #-}
@@ -274,7 +274,7 @@
 -- | Again, to be able to observe performance, we have extracted the
 -- outside-table-filling part.
 
-nwOutsideForward :: VU.Vector Char -> VU.Vector Char -> Z:.ITbl Id Unboxed (Z:.PointL O:.PointL O) Int
+nwOutsideForward :: VU.Vector Char -> VU.Vector Char -> Z:.ITbl Id Unboxed (Z:.EmptyOk:.EmptyOk) (Z:.PointL O:.PointL O) Int
 nwOutsideForward i1 i2 = {-# SCC "nwOutsideForward" #-} mutateTablesDefault $
                            grammar sScore
                            (ITbl 0 0 (Z:.EmptyOk:.EmptyOk) (PA.fromAssocs (Z:.PointL 0:.PointL 0) (Z:.PointL n1:.PointL n2) (-999999) []))
diff --git a/src/Nussinov.hs b/src/Nussinov.hs
--- a/src/Nussinov.hs
+++ b/src/Nussinov.hs
@@ -108,7 +108,7 @@
   bs = runInsideBacktrack i t
 {-# NOINLINE runNussinov #-}
 
-runInsideForward :: VU.Vector Char -> Z:.ITbl Id Unboxed (Subword I) Int
+runInsideForward :: VU.Vector Char -> Z:.ITbl Id Unboxed EmptyOk (Subword I) Int
 runInsideForward i = mutateTablesDefault
                    $ grammar bpmax
                        (chr i)
@@ -116,7 +116,7 @@
   where n = VU.length i
 {-# NoInline runInsideForward #-}
 
-runInsideBacktrack :: VU.Vector Char -> ITbl Id Unboxed (Subword I) Int -> [String]
+runInsideBacktrack :: VU.Vector Char -> ITbl Id Unboxed EmptyOk (Subword I) Int -> [String]
 runInsideBacktrack i t = unId $ axiom b
   where !(Z:.b) = grammar (bpmax <|| pretty) (chr i) (toBacktrack t (undefined :: Id a -> Id a))
 {-# NoInline runInsideBacktrack #-}
diff --git a/src/OverlappingPalindromes.hs b/src/OverlappingPalindromes.hs
--- a/src/OverlappingPalindromes.hs
+++ b/src/OverlappingPalindromes.hs
@@ -140,8 +140,8 @@
         i
 {-# NoInline opForward #-}
 
-type X = ITbl Id Unboxed (Subword I) Int
-type T = ITbl Id Unboxed (Z:.Subword I:.Subword I) Int
+type X = ITbl Id Unboxed EmptyOk (Subword I) Int
+type T = ITbl Id Unboxed (Z:.EmptyOk:.EmptyOk) (Z:.Subword I:.Subword I) Int
 
 
 main :: IO ()
diff --git a/src/PartNussinov.hs b/src/PartNussinov.hs
--- a/src/PartNussinov.hs
+++ b/src/PartNussinov.hs
@@ -134,11 +134,11 @@
   -> NussinovEnsemble
         m
         (Log Double)
-        (Subword C:.Subword C)
+        (Subword C)
         (Subword C, Log Double)
         [(Subword C, Log Double)]
 ensemble z = NussinovEnsemble
-  { ens = \ x (Subword k:._) y -> ( Subword k , x * y / z )
+  { ens = \ x i y -> ( i , x * y / z )
   , hhh = SM.toList
   }
 {-# Inline ensemble #-}
@@ -202,8 +202,8 @@
             forM_ es $ \ (Subword (i:.j),v) -> printf "%3d %3d  %0.4f\n" i j (exp $ ln v)
             putStrLn ""
 
-type TblI = ITbl Id Unboxed (Subword I) (Log Double)
-type TblO = ITbl Id Unboxed (Subword O) (Log Double)
+type TblI = ITbl Id Unboxed EmptyOk (Subword I) (Log Double)
+type TblO = ITbl Id Unboxed EmptyOk (Subword O) (Log Double)
 
 runInsideForward :: VU.Vector Char -> Z:.TblI:.TblI
 runInsideForward i = mutateTablesDefault
@@ -229,7 +229,7 @@
   where (Z:.g) = ensembleGrammar (ensemble z)
                    i o
                    (IRec EmptyOk (Subword l) (Subword h))
-                 :: Z :. IRec Id (Subword C) [(Subword C, Log Double)]
+                 :: Z :. IRec Id EmptyOk (Subword C) [(Subword C, Log Double)]
         (Subword l,Subword h) = let (ITbl _ _ _ arr _) = i in bounds arr
 {-# NoInline runEnsembleForward #-}
 
diff --git a/src/Pseudoknot.hs b/src/Pseudoknot.hs
--- a/src/Pseudoknot.hs
+++ b/src/Pseudoknot.hs
@@ -115,8 +115,8 @@
   -}
 {-# NOINLINE runPseudoknot #-}
 
-type X = ITbl Id Unboxed (Subword I) Int
-type T = ITbl Id Unboxed (Z:.Subword I:.Subword I) Int
+type X = ITbl Id Unboxed EmptyOk (Subword I) Int
+type T = ITbl Id Unboxed (Z:.EmptyOk:.EmptyOk) (Z:.Subword I:.Subword I) Int
 
 runInsideForward :: VU.Vector Char -> Z:.X:.T:.T
 runInsideForward i = mutateTablesWithHints (Proxy :: Proxy MonotoneMCFG)
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
+
+
+
+
+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/src/SplitTests.hs b/src/SplitTests.hs
--- a/src/SplitTests.hs
+++ b/src/SplitTests.hs
@@ -120,8 +120,8 @@
         i
 {-# NoInline opForward #-}
 
-type X = ITbl Id Unboxed (Subword I) Int
-type T = ITbl Id Unboxed (Z:.Subword I:.Subword I) Int
+type X = ITbl Id Unboxed EmptyOk (Subword I) Int
+type T = ITbl Id Unboxed (Z:.EmptyOk:.EmptyOk) (Z:.Subword I:.Subword I) Int
 
 
 main :: IO ()
diff --git a/tests/QuickCheck/Point.hs b/tests/QuickCheck/Point.hs
--- a/tests/QuickCheck/Point.hs
+++ b/tests/QuickCheck/Point.hs
@@ -28,7 +28,7 @@
 
 -- * Epsilon cases
 
-prop_Epsilon ix@(PointL j) = zs == ls where
+prop_I_Epsilon ix@(PointL j) = zs == ls where
   zs = (id <<< Epsilon ... stoList) maxPLi ix
   ls = [ () | j == 0 ]
 
@@ -52,7 +52,7 @@
 
 -- * Deletion cases
 
-prop_ItNC ix@(PointL j) = zs == ls where
+prop_I_ItNC ix@(PointL j) = zs == ls where
   t = ITbl 0 0 EmptyOk xsP (\ _ _ -> Id 1)
   zs = ((,,) <<< t % Deletion % chr xs ... stoList) maxPLi ix
   ls = [ ( unsafeIndex xsP (PointL $ j-1)
@@ -85,7 +85,7 @@
          , Z:.xs VU.! (j+0):.()
          ) | j>=0, l>=0, j<=(maxI-1), l<=(maxI-1) ]
 
-prop_2dimIt_NC_CN ix@(Z:.PointL j:.PointL l) = zs == ls where
+prop_I_2dimIt_NC_CN ix@(Z:.PointL j:.PointL l) = zs == ls where
   t = ITbl 0 0 (Z:.EmptyOk:.EmptyOk) xsPP (\ _ _ -> Id 1)
   zs = ((,,) <<< t % (M:|Deletion:|chr xs) % (M:|chr xs:|Deletion) ... stoList) (Z:.maxPLi:.maxPLi) ix
   ls = [ ( unsafeIndex xsPP (Z:.PointL (j-1):.PointL (l-1))
@@ -99,7 +99,7 @@
 
 -- | A single character terminal
 
-prop_Tt ix@(Z:.PointL j) = zs == ls where
+prop_I_Tt ix@(Z:.PointL j) = zs == ls where
   zs = (id <<< (M:|chr xs) ... stoList) (Z:.maxPLi) ix
   ls = [ (Z:.xs VU.! (j-1)) | 1==j ]
 
@@ -109,13 +109,13 @@
 
 -- | Two single-character terminals
 
-prop_CC ix@(Z:.PointL i) = zs == ls where
+prop_I_CC ix@(Z:.PointL i) = zs == ls where
   zs = ((,) <<< (M:|chr xs) % (M:|chr xs) ... stoList) (Z:.maxPLi) ix
   ls = [ (Z:.xs VU.! (i-2), Z:.xs VU.! (i-1)) | 2==i ]
 
 -- | Just a table
 
-prop_It ix@(PointL j) = zs == ls where
+prop_I_It ix@(PointL j) = zs == ls where
   t = ITbl 0 0 EmptyOk xsP (\ _ _ -> Id 1)
   zs = (id <<< t ... stoList) maxPLi ix
   ls = [ unsafeIndex xsP ix | j>=0, j<=maxI ]
@@ -125,7 +125,7 @@
   zs = (id <<< t ... stoList) maxPLo ix
   ls = [ unsafeIndex xsPo ix | j>=0, j<=maxI ]
 
-prop_ZIt ix@(Z:.PointL j) = zs == ls where
+prop_I_ZIt ix@(Z:.PointL j) = zs == ls where
   t = ITbl 0 0 (Z:.EmptyOk) xsZP (\ _ _ -> Id 1)
   zs = (id <<< t ... stoList) (Z:.maxPLi) ix
   ls = [ unsafeIndex xsZP ix | j>=0, j<=maxI ]
@@ -137,7 +137,7 @@
 
 -- | Table, then single terminal
 
-prop_ItC ix@(PointL j) = zs == ls where
+prop_I_ItC ix@(PointL j) = zs == ls where
   t = ITbl 0 0 EmptyOk xsP (\ _ _ -> Id 1)
   zs = ((,) <<< t % chr xs ... stoList) maxPLi ix
   ls = [ ( unsafeIndex xsP (PointL $ j-1)
@@ -151,7 +151,7 @@
   zs = ((,) <<< t % chr xs ... stoList) maxPLo ix
   ls = [ ( unsafeIndex xsPo (PointL $ j+1)
          , xs VU.! (j+0)
-         ) | j >= 0, j < maxI ]
+         ) | j >= 0, j <= (maxI-1) ]
 
 prop_O_ItCC ix@(PointL j) = zs == ls where
   t = ITbl 0 0 EmptyOk xsPo (\ _ _ -> Id 1)
@@ -160,8 +160,16 @@
          , xs VU.! (j+0)
          , xs VU.! (j+1)
          ) | j >= 0, j <= (maxI-2) ]
-{-# Noinline prop_O_ItCC #-}
 
+prop_O_ItCCC ix@(PointL j) = zs == ls where
+  t = ITbl 0 0 EmptyOk xsPo (\ _ _ -> Id 1)
+  zs = ((,,,) <<< t % 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
   t = ITbl 0 0 (Z:.EmptyOk) xsZPo (\ _ _ -> Id 1)
   zs = ((,,) <<< t % (M:|chr xs) % (M:|chr xs) ... stoList) (Z:.maxPLo) ix
@@ -172,7 +180,7 @@
 
 -- | synvar followed by a 2-tape character terminal
 
-prop_2dimItCC ix@(Z:.PointL j:.PointL l) = zs == ls where
+prop_I_2dimItCC ix@(Z:.PointL j:.PointL l) = zs == ls where
   t = ITbl 0 0 (Z:.EmptyOk:.EmptyOk) xsPP (\ _ _ -> Id 1)
   zs = ((,,) <<< t % (M:|chr xs:|chr xs) % (M:|chr xs:|chr xs) ... stoList) (Z:.maxPLi:.maxPLi) ix
   ls = [ ( unsafeIndex xsPP (Z:.PointL (j-2):.PointL (l-2))
@@ -200,11 +208,11 @@
 
 -- ** Just the 'Strng' terminal
 
-prop_ManyS ix@(PointL j) = zs == ls where
+prop_I_ManyS ix@(PointL j) = zs == ls where
   zs = (id <<< manyS xs ... stoList) maxPLi ix
   ls = [ (VU.slice 0 j xs) ]
 
-prop_SomeS ix@(PointL j) = zs == ls where
+prop_I_SomeS ix@(PointL j) = zs == ls where
   zs = (id <<< someS xs ... stoList) maxPLi ix
   ls = [ (VU.slice 0 j xs) | j>0 ]
 
@@ -218,32 +226,32 @@
 
 -- ** Together with a syntactic variable.
 
-prop_Itbl_ManyS ix@(PointL i) = zs == ls where
+prop_I_Itbl_ManyS ix@(PointL i) = zs == ls where
   t = ITbl 0 0 EmptyOk xsP (\ _ _ -> Id 1)
   zs = ((,) <<< t % manyS xs ... stoList) maxPLi ix
   ls = [ (unsafeIndex xsP (PointL k), VU.slice k (i-k) xs) | k <- [0..i] ]
 
-prop_Itbl_SomeS ix@(PointL i) = zs == ls where
+prop_I_Itbl_SomeS ix@(PointL i) = zs == ls where
   t = ITbl 0 0 EmptyOk xsP (\ _ _ -> Id 1)
   zs = ((,) <<< t % someS xs ... stoList) maxPLi ix
   ls = [ (unsafeIndex xsP (PointL k), VU.slice k (i-k) xs) | k <- [0..i-1] ]
 
-prop_1dim_Itbl_ManyS ix@(Z:.PointL i) = zs == ls where
+prop_I_1dim_Itbl_ManyS ix@(Z:.PointL i) = zs == ls where
   t = ITbl 0 0 (Z:.EmptyOk) xsZP (\ _ _ -> Id 1)
   zs = ((,) <<< t % (M:|manyS xs) ... stoList) (Z:.maxPLi) ix
   ls = [ (unsafeIndex xsZP (Z:.PointL k), Z:. VU.slice k (i-k) xs) | k <- [0..i] ]
 
-prop_1dim_Itbl_SomeS ix@(Z:.PointL i) = zs == ls where
+prop_I_1dim_Itbl_SomeS ix@(Z:.PointL i) = zs == ls where
   t = ITbl 0 0 (Z:.EmptyOk) xsZP (\ _ _ -> Id 1)
   zs = ((,) <<< t % (M:|someS xs) ... stoList) (Z:.maxPLi) ix
   ls = [ (unsafeIndex xsZP (Z:.PointL k), Z:. VU.slice k (i-k) xs) | k <- [0..i-1] ]
 
-prop_2dim_Itbl_ManyS_ManyS ix@(Z:.PointL i:.PointL j) = zs == ls where
+prop_I_2dim_Itbl_ManyS_ManyS ix@(Z:.PointL i:.PointL j) = zs == ls where
   t = ITbl 0 0 (Z:.EmptyOk:.EmptyOk) xsPP (\ _ _ -> Id 1)
   zs = ((,) <<< t % (M:|manyS xs:|manyS xs) ... stoList) (Z:.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_2dim_Itbl_SomeS_SomeS ix@(Z:.PointL i:.PointL j) = zs == ls where
+prop_I_2dim_Itbl_SomeS_SomeS ix@(Z:.PointL i:.PointL j) = zs == ls where
   t = ITbl 0 0 (Z:.EmptyOk:.EmptyOk) xsPP (\ _ _ -> Id 1)
   zs = ((,) <<< t % (M:|someS xs:|someS xs) ... stoList) (Z:.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] ]
@@ -254,22 +262,6 @@
 
 infixl 8 >>>
 (>>>) f xs = \lu ij -> SM.map f . mkStream (build xs) (initialContext ij) lu $ ij
-
-class GetIxs x i where
-  type R x i :: *
-  getIxs :: Elm x i -> R x i
-
-instance GetIxs S i where
-  type R S i = Z:.(i,i)
-  getIxs e = Z:.(getIdx e, getOmx e)
-
-instance GetIxs ls i => GetIxs (ls :!: Chr a b) i where
-  type R (ls :!: Chr a b) i = R ls i :. (i,i)
-  getIxs (ElmChr _ i o s) = getIxs s :. (i,o)
-
-instance GetIxs ls i => GetIxs (ls :!: ITbl m a i x) i where
-  type R (ls :!: ITbl m a i x) i = R ls i :. (i,i)
-  getIxs (ElmITbl _ i o s) = getIxs s :. (i,o)
 
 xsP :: Unboxed (PointL I) Int
 xsP = fromList (PointL 0) maxPLi [0 ..]
diff --git a/tests/QuickCheck/Subword.hs b/tests/QuickCheck/Subword.hs
--- a/tests/QuickCheck/Subword.hs
+++ b/tests/QuickCheck/Subword.hs
@@ -36,7 +36,7 @@
 -- B*_ik -> A*_ij C_kj
 -- C*_kj -> B_ik  A*_ij
 
-prop_sv_OI ox@(Subword (i:.k)) = zs == ls where
+prop_O_sv_OI ox@(Subword (i:.k)) = zs === ls where
   toa = ITbl 0 0 EmptyOk xoS (\ _ _ -> Id (1,1))
   tic = ITbl 0 0 EmptyOk xsS (\ _ _ -> Id (1,1))
   zs = ((,) <<< toa % tic ... stoList) maxSWo ox
@@ -44,7 +44,7 @@
          , unsafeIndex xsS (subword k j) )
        | j <- [ k .. highest ] ]
 
-prop_sv_IO ox@(Subword (k:.j)) = zs == ls where
+prop_O_sv_IO ox@(Subword (k:.j)) = zs === ls where
   tib = ITbl 0 0 EmptyOk xsS (\ _ _ -> Id (1,1))
   toa = ITbl 0 0 EmptyOk xoS (\ _ _ -> Id (1,1))
   zs = ((,) <<< tib % toa ... stoList) maxSWo ox
@@ -61,7 +61,7 @@
 -- C*_kl -> B_ik  A*_ij D_lj
 -- D*_lj -> B_ik  C_kl  A*_ij
 
-prop_sv_OII ox@(Subword (i:.k)) = zs == ls where
+prop_O_sv_OII ox@(Subword (i:.k)) = zs === ls where
   toa = ITbl 0 0 EmptyOk xoS (\ _ _ -> Id (1,1))
   tic = ITbl 0 0 EmptyOk xsS (\ _ _ -> Id (1,1))
   tid = ITbl 0 0 EmptyOk xsS (\ _ _ -> Id (1,1))
@@ -71,7 +71,7 @@
          , unsafeIndex xsS (subword l j) )
        | j <- [ k .. highest ], l <- [ k .. j ] ]
 
-prop_sv_IOI ox@(Subword (k:.l)) = zs == ls where
+prop_O_sv_IOI ox@(Subword (k:.l)) = zs === ls where
   tib = ITbl 0 0 EmptyOk xsS (\ _ _ -> Id (1,1))
   toa = ITbl 0 0 EmptyOk xoS (\ _ _ -> Id (1,1))
   tid = ITbl 0 0 EmptyOk xsS (\ _ _ -> Id (1,1))
@@ -81,7 +81,7 @@
          , unsafeIndex xsS (subword l j) )
        | i <- [ 0 .. k ], j <- [ l .. highest ] ]
 
-prop_sv_IIO ox@(Subword (l:.j)) = zs == ls where
+prop_O_sv_IIO ox@(Subword (l:.j)) = zs === ls where
   tib = ITbl 0 0 EmptyOk xsS (\ _ _ -> Id (1,1))
   tic = ITbl 0 0 EmptyOk xsS (\ _ _ -> Id (1,1))
   toa = ITbl 0 0 EmptyOk xoS (\ _ _ -> Id (1,1))
@@ -97,7 +97,7 @@
 
 -- ** Non-terminal and terminal combinations
 
-prop_cOc ox@(Subword (i:.j)) = zs == ls where
+prop_O_cOc ox@(Subword (i:.j)) = zs === ls where
   toa = ITbl 0 0 EmptyOk xoS (\ _ _ -> Id (1,1))
   zs  = ((,,) <<< chr csS % toa % chr csS ... stoList) maxSWo ox
   ls  = [ ( csS VU.! (i-1)
@@ -105,7 +105,7 @@
           , csS VU.! (j  ) )
         | i > 0 && j < highest ]
 
-prop_ccOcc ox@(Subword (i:.j)) = zs == ls where
+prop_O_ccOcc ox@(Subword (i:.j)) = zs === ls where
   toa = ITbl 0 0 EmptyOk xoS (\ _ _ -> Id (1,1))
   zs  = ((,,,,) <<< chr csS % chr csS % toa % chr csS % chr csS ... stoList) maxSWo ox
   ls  = [ ( csS VU.! (i-2)
@@ -115,7 +115,7 @@
           , csS VU.! (j+1) )
         | i > 1 && j < highest -1 ]
 
-prop_cOccc ox@(Subword (i:.j)) = zs == ls where
+prop_O_cOccc ox@(Subword (i:.j)) = zs === ls where
   toa = ITbl 0 0 EmptyOk xoS (\ _ _ -> Id (1,1))
   zs  = ((,,,,) <<< chr csS % toa % chr csS % chr csS % chr csS ... stoList) maxSWo ox
   ls  = [ ( csS VU.! (i-1)
@@ -127,7 +127,7 @@
 
 -- ** Terminals, syntactic terminals, and non-terminals
 
-prop_cOcIc ox@(Subword (i:.k)) = zs == ls where
+prop_O_cOcIc ox@(Subword (i:.k)) = zs === ls where
   toa = ITbl 0 0 EmptyOk xoS (\ _ _ -> Id (1,1))
   tic = ITbl 0 0 EmptyOk xsS (\ _ _ -> Id (1,1))
   zs = ((,,,,) <<< chr csS % toa % chr csS % tic % chr csS ... stoList) maxSWo ox
@@ -138,7 +138,7 @@
          , csS VU.! (j-1) )
        | i > 0, j <- [ k+2 .. highest ] ]
 
-prop_cIcOc ox@(Subword (k:.j)) = zs == ls where
+prop_O_cIcOc ox@(Subword (k:.j)) = zs === ls where
   tib = ITbl 0 0 EmptyOk xsS (\ _ _ -> Id (1,1))
   toa = ITbl 0 0 EmptyOk xoS (\ _ _ -> Id (1,1))
   zs = ((,,,,) <<< chr csS % tib % chr csS % toa % chr csS ... stoList) maxSWo ox
@@ -151,19 +151,19 @@
 
 -- ** Epsilonness
 
-prop_Epsilon ox@(Subword (i:.j)) = zs == ls where
+prop_O_Epsilon ox@(Subword (i:.j)) = zs === ls where
   zs = (id <<< Epsilon ... stoList) (maxSWo) ox
   ls = [ () | i==0 && j==highest ]
 
 
 -- ** Multi-tape cases
 
-prop_2dimIt ix@(Z:.Subword (i:.j):.Subword (k:.l)) = zs == ls where
+prop_I_2dimIt ix@(Z:.Subword (i:.j):.Subword (k:.l)) = zs === ls where
   t = ITbl 0 0 (Z:.EmptyOk:.EmptyOk) xsSS (\ _ _ -> Id ((1,1),(1,1)))
   zs = (id <<< t ... stoList) (Z:.subword 0 highest:.subword 0 highest) ix
   ls = [ ( unsafeIndex xsSS ix ) | j<=highest && l<=highest ]
 
-prop_2dimcIt ix@(Z:.Subword(i:.j):.Subword(k:.l)) = {- traceShow (zs,ls) $ -} zs == ls where
+prop_I_2dimcIt ix@(Z:.Subword(i:.j):.Subword(k:.l)) = {- traceShow (zs,ls) $ -} zs === ls where
   t = ITbl 0 0 (Z:.EmptyOk:.EmptyOk) xsSS (\ _ _ -> Id ((1,1),(1,1)))
   zs = ((,) <<< (M:|chr csS:|chr csS) % t ... stoList) (Z:.subwordI 0 highest:.subwordI 0 highest) ix
   ls = [ ( Z :. (csS VU.! i) :. (csS VU.! k)
@@ -171,7 +171,7 @@
        | j<=highest && l<=highest
        , i+1<=j && k+1<=l ]
 
-prop_2dimItc ix@(Z:.Subword(i:.j):.Subword(k:.l)) = {- traceShow (zs,ls) $ -} zs == ls where
+prop_I_2dimItc ix@(Z:.Subword(i:.j):.Subword(k:.l)) = (j<=highest && l<=highest) ==> zs === ls where
   t = ITbl 0 0 (Z:.EmptyOk:.EmptyOk) xsSS (\ _ _ -> Id ((1,1),(1,1)))
   zs = ((,) <<< t % (M:|chr csS:|chr csS)  ... stoList) (Z:.subwordI 0 highest:.subwordI 0 highest) ix
   ls = [ ( unsafeIndex xsSS (Z :. subword i (j-1) :. subword k (l-1))
@@ -179,7 +179,7 @@
        | j<=highest && l<=highest
        , i+1<=j && k+1<=l ]
 
-prop_2dimcItc ix@(Z:.Subword(i:.j):.Subword(k:.l)) = {- traceShow (zs,ls) $ -} zs == ls where
+prop_I_2dimcItc ix@(Z:.Subword(i:.j):.Subword(k:.l)) = (j<=highest && l<=highest) ==> zs === ls where
   t = ITbl 0 0 (Z:.EmptyOk:.EmptyOk) xsSS (\ _ _ -> Id ((1,1),(1,1)))
   zs = ((,,) <<< (M:|chr csS:|chr csS) % t % (M:|chr csS:| chr csS) ... stoList) (Z:.subwordI 0 highest:.subwordI 0 highest) ix
   ls = [ ( Z :. (csS VU.! i) :. (csS VU.! k)
@@ -192,7 +192,7 @@
 
 stoList = unId . SM.toList
 
-highest = 10
+highest = 20
 
 maxSWi :: Subword I
 maxSWi = subword 0 highest
diff --git a/tests/performance.hs b/tests/performance.hs
--- a/tests/performance.hs
+++ b/tests/performance.hs
@@ -66,7 +66,7 @@
   d = unId $ axiom t
 {-# NoInline runLeft #-}
 
-runLeftForward :: VU.Vector Int -> Unboxed (Subword I) Int -> Z:.ITbl Id Unboxed (Subword I) Int
+runLeftForward :: VU.Vector Int -> Unboxed (Subword I) Int -> Z:.ITbl Id Unboxed EmptyOk (Subword I) Int
 runLeftForward !i !arr = mutateTablesDefault
                $ gLeft algMax
                    i