diff --git a/ADP/Fusion/Core/ForestAlign/PermuteRightLinear.hs b/ADP/Fusion/Core/ForestAlign/PermuteRightLinear.hs
new file mode 100644
--- /dev/null
+++ b/ADP/Fusion/Core/ForestAlign/PermuteRightLinear.hs
@@ -0,0 +1,1401 @@
+
+-- | Data structures and instances to combine efficient 'Forest' structures
+-- with @ADPfusion@.
+
+module ADP.Fusion.Core.ForestAlign.PermuteRightLinear where
+
+import qualified Data.List as L
+import           Control.Exception (assert)
+import           Data.Either (either)
+import           Data.Graph.Inductive.Basic
+import           Data.Strict.Tuple hiding (fst, snd)
+import           Data.Traversable (mapAccumL)
+import           Data.Vector.Fusion.Stream.Monadic hiding (flatten)
+import           Debug.Trace
+import           Prelude hiding (map)
+import qualified Data.Forest.Static as F
+import qualified Data.Tree as T
+import qualified Data.Vector as V
+import qualified Data.Vector.Unboxed as VU
+import qualified Data.Vector.Fusion.Stream.Monadic as SM
+import qualified Data.Vector.Generic as VG
+import qualified Data.Vector.Unboxed as VU
+import           Data.Vector.Instances
+import qualified Data.Vector.Algorithms.Intro as VI
+import qualified Data.HashMap.Strict as HM
+import qualified Data.Set as S
+import           Data.List (subsequences, permutations)
+import qualified Data.List as L
+import qualified Prelude as P
+
+import           ADP.Fusion.Core
+import           Data.Forest.Static
+import           Data.PrimitiveArray hiding (map)
+
+import           ADP.Fusion.Term.Node.Type
+
+-- HETEROGEN
+
+-- |
+
+data TreeIxR p v a t
+  -- | The @TreeIxR@ constructor holds the runtime information for the
+  -- current subforest we look at.
+  --
+  -- We have a pointer to the actual forest structure @Forest p v a@. Next,
+  -- we have @Lookup@, it gives a linear index from the set of ordered
+  -- subforests to the set @|N@.
+  --
+  -- The actual runtime position is held by @TFE@, which is an index
+  -- structure in the current substructure.
+  = TreeIxR !(Forest p v a) !LookUp !TFE
+
+instance Show (TreeIxR p v a t) where
+  show (TreeIxR _ i j) = show (i,j)
+
+minIx, maxIx :: Forest Pre v a -> TreeIxR Pre v a t
+minIx f = let l = mkLookUp f
+          in  TreeIxR f l (F (VU.fromList []))  -- $ roots f)
+
+maxIx f = let l = mkLookUp f
+          in  TreeIxR f l (E $ VU.length (parent f))
+{-# Inline minIx #-}
+{-# Inline maxIx #-}
+
+-- | For permutated trees, we need to know the order of the remaining
+-- children, given as a @VU.Vector Int@, yielding the next linearized
+-- index. The @LookUp@ data structure holds all possible such orderings of
+-- children.
+
+type LookUp = HM.HashMap (VU.Vector Int) Int
+
+-- | Given a static forest, we need to associate each possible ordered
+-- subset of children of each node with a linear index. The @mkLookUp@
+-- function generates this.
+--
+-- TODO use 'sortedSubForests' such that the partial order matches the
+-- linearized order.
+
+mkLookUp :: Forest Pre v a -> LookUp
+mkLookUp f = HM.fromList . flip P.zip [0..] $ sortedSubForests f
+{-
+mkLookUp f = HM.fromList . flip P.zip [0..] . go $ roots f : (VG.toList $ children f)
+  where go :: [VU.Vector Int] -> [VU.Vector Int]
+        go = P.map VG.fromList
+           . S.toList . S.fromList
+           . P.concatMap (P.tail . subsequences)
+           . P.concatMap permutations
+           . P.map VG.toList
+        -- @go@ generates all permutations (i.e. all orders of children),
+        -- then for each such order provides all possible subsequences.
+        -- This yields all ordered subsets. These are then made unique and
+        -- associated in the main body with linearized indices.
+-}
+
+-- | @TFE@ provides the three possible "states" of our system. @E@
+-- indicates that we have reached an indixed epsilon state. @T@ is the tree
+-- originating at a particular node. Finally @F@ is the subforest with an
+-- attached ordered set of subtrees.
+
+data TFE
+  -- | Forest with permutation. The vector holds the trees making up the
+  -- forest, and their order via the root node indices of the individual
+  -- trees.
+  --
+  -- TODO do we allow empty forests?
+  = F (VU.Vector Int)
+  -- | A single tree, represented by the index of the root node.
+  | T !Int
+  -- | An empty forest, BUT annotated with index for the subforest "to the
+  -- right of it".
+  | E !Int
+  deriving (Show,Eq,Ord)
+
+isTree (T _) = True
+isTree _     = False
+{-# Inline isTree #-}
+
+isEmpty (E _) = True
+isEmpty _ = False
+{-# Inline isEmpty #-}
+
+getTFEIx (T l) = l
+getTFEIx (E l) = l
+getTFEIx (F vs)
+  | VU.null vs = error "AlignPermuteRL: Forest empty" -- change!!!
+  | otherwise = VU.head vs
+
+
+-- | As usual, we need a running index. We only need the @TFE@ structure,
+-- since now (and compared to @AlignRL.hs@) we actually carry the node
+-- information in each @TFE@ ctor.
+
+data instance RunningIndex (TreeIxR p v a I) = RiTirI !TFE
+
+
+-- | The index function needs to provide a linearized representation of the
+-- @TFE@-based index.
+
+instance Index (TreeIxR p v a t) where
+  -- | trees @T@ are stored in the first line, i.e. @+0@, forests @F@ (with
+  -- @j==u@ are stored in the second line, i.e. @+u+1@ to each index.
+  -- Finally, all @F@ structures are looked up based on the linear index,
+  -- shifted by the base width of @2*m@.
+  linearIndex (TreeIxR _ _ ll) (TreeIxR _ _ uu) (TreeIxR _ lk tf)
+    | T k <- tf = 2*k
+    | E k <- tf = 2*k + 1
+    | F k <- tf = 2*(m+1) + HM.lookupDefault (error "AlignPermuteRL: invariant violated!") k lk
+    where E m = uu
+  {-# Inline linearIndex #-}
+  smallestLinearIndex _ = error "still needed?"
+  {-# Inline smallestLinearIndex #-}
+  largestLinearIndex (TreeIxR p lk (E u)) = 2 * (u+1) + HM.size lk
+  largestLinearIndex (TreeIxR p lk err) = error $ "non-legal largest index structure: " P.++ show err
+  {-# Inline largestLinearIndex #-}
+  size (TreeIxR _ l ll) (TreeIxR _ lk (E u)) = 2 * (u+1) + HM.size l + 1
+  {-# Inline size #-}
+  inBounds (TreeIxR _ l _) (TreeIxR _ u _) (TreeIxR _ k _) = error "inBounds: write me" -- l <= k && k <= u
+  {-# Inline inBounds #-}
+
+
+
+instance IndexStream z => IndexStream (z:.TreeIxR Pre v a I) where
+  streamUp   (ls:.TreeIxR p llk lf) (hs:.TreeIxR _ _ ht) = flatten (streamUpMk   p lf ht) (streamUpStep   p llk lf ht) $ streamUp ls hs
+--  streamDown (ls:.TreeIxR p llk lf) (hs:.TreeIxR _ _ ht) = flatten (streamUpMk   p lf ht) (streamUpStep   p llk lf ht) $ streamDown ls hs -- STUPID!!!
+  streamDown (ls:.TreeIxR p llk lf) (hs:.TreeIxR _ _ ht) = flatten (streamDownMk p lf ht) (streamDownStep p llk lf ht) $ streamDown ls hs
+  {-# Inline streamUp #-}
+  {-# Inline streamDown #-}
+
+-- cull from p the non-needed parts via lf ht
+streamUpMk p lf ht z =
+      -- all sorted subsets of subforests in the forest (have a beer).
+  let ssf = sortedSubForests p
+      -- extract the highest possible index, which by definition is an
+      -- @E index@.
+      E ht' = ht
+  in  {- trace ("XXX" P.++ show ssf) . -} return $ SE' ht' (z,ssf)
+{-# Inline [0] streamUpMk #-}
+
+streamDownMk p lf ht z =
+  let ssf = reverse $ VG.empty : sortedSubForests p
+  in  return $ Stp (z,ssf)
+{-# Inline [0] streamDownMk #-}
+
+-- |
+
+data StepTFE x
+  -- | @x@ is a set of size>=1, which will be turned into a forest.
+  = SF x
+  -- | @x@ is a set of size ==1, which will be turned into a tree.
+  | ST x
+  -- | Perform one step in @streamUpStep@. In case of trees, this will
+  -- actually yield both a tree and a forest.
+  | Stp x
+  -- | This encodes that we have an empty forest (@E@), but directly
+  -- encodes the highest @Int@-index given via @streamUpMk@.
+  | SE' Int x
+  -- | Only for outside calculations!
+  | SEout x
+
+-- | For each index @k@, we can easily first calculate @Epsilon k@. Then we
+-- want to know the tree at index @k@, but this needs knowledge of all
+-- subforests below it, hence we need to calculate this before @Tree k@.
+
+-- this one is called only once and creates an @E k@ element at the highest
+-- possible index.
+streamUpStep p lk lf ht (SE' k (z,xs))
+  = return $ SM.Yield (z:.TreeIxR p lk (E k)) (Stp (z,xs))
+-- there is no subforest left to work with. We are done.
+streamUpStep p lk lf ht (Stp (z,[]))
+  = return $ SM.Done
+-- We have at least one sorted subforest @x:@ to deal with. By definition,
+-- sets of size 0 do not happen. This is enforced by @sortedSubForests@
+-- which produces vectors of @size >= 1@.
+streamUpStep p lk lf ht (Stp (z,x:xs))
+  -- subsets of size one are trees. They first create an @E@psilon object.
+  -- Then they create a @T@ree object, followed by a @F@orest with one tree.
+  | sz == 1 = return $ SM.Yield (z:.TreeIxR p lk (E i)) (ST (z,x:xs))
+  -- subsets of size 2 or more just create forests and we jump directly to
+  -- forest creation.
+  | sz >= 2 = return $ SM.Skip (SF (z,x:xs))
+  where sz = VU.length x
+        i = VU.head x
+-- Here we deal with structures that are supposed to be a tree @T@, via
+-- @ST@. Seems stupid at first, but if the set size of @x@ is one, we first
+-- create a @T@ree @T i@, then we will produce a forest @F [i]@ one step
+-- later.
+-- Here, we only have subsets of size ==1. We build a tree (we have already
+-- built the @E@ part before), and continue on to build a forest with
+-- exactly one tree inside.
+streamUpStep p lk lf ht (ST (z,x:xs))
+  = return $ SM.Yield (z:.TreeIxR p lk (T i)) (SF (z,x:xs))
+  where i = VU.head x
+-- Create an ordered subforest @F x@. After that, we are done with @x@
+-- (indepedent of it being a tree or a forest), and continue with the
+-- remainder of the sets.
+streamUpStep p lk lf ht (SF (z,x:xs))
+  = return $ SM.Yield (z:.TreeIxR p lk (F x)) (Stp (z,xs))
+{-# Inline [0] streamUpStep #-}
+
+-- |
+
+-- this is the case of our artificially added size==0 set.
+streamDownStep p lk lf ht (Stp (z,[x]))
+  = let E k = ht
+    in  return $ SM.Yield (z:.TreeIxR p lk (E k)) (Stp (z,[]))
+streamDownStep p lk lf ht (Stp (z,[]))
+  = return $ SM.Done
+streamDownStep p lk lf ht (Stp (z,x:xs))
+  | sz == 1 = return $ SM.Yield (z:.TreeIxR p lk (F x)) (ST (z,x:xs))
+  | sz >= 2 = return $ SM.Yield (z:.TreeIxR p lk (F x)) (Stp (z,xs))
+  where sz = VG.length x
+streamDownStep p lk lf ht (ST (z,x:xs))
+  = return $ SM.Yield (z:.TreeIxR p lk (T i)) (SEout (z,x:xs))
+  where i = VG.head x
+streamDownStep p lk lf ht (SEout (z,x:xs))
+  = return $ SM.Yield (z:.TreeIxR p lk (E i)) (Stp (z,xs))
+  where i = VG.head x
+{-# Inline [0] streamDownStep #-}
+
+{-
+
+streamDownMk lf ht z = return (z,lf,minBound :: TF)
+{-# Inline [0] streamDownMk #-}
+
+streamDownStep p lf ht (z,k,tf)
+  | k > ht         = return $ SM.Done
+  | tf == maxBound = return $ SM.Yield (z:.TreeIxR p k tf) (z,k+1,minBound)
+  | otherwise      = return $ SM.Yield (z:.TreeIxR p k tf) (z,k,succ tf)
+{-# Inline [0] streamDownStep #-}
+
+-}
+
+instance IndexStream (Z:.TreeIxR p v a t) => IndexStream (TreeIxR p v a t)
+
+instance RuleContext (TreeIxR p v a I) where
+  type Context (TreeIxR p v a I) = InsideContext ()
+  initialContext _ = IStatic ()
+  {-# Inline initialContext #-}
+
+
+
+
+-- | Epsilon
+--
+-- X    -> ε
+-- i,E     i,E    ∀ i
+
+instance
+  ( TmkCtx1 m ls Epsilon (TreeIxR p v a t)
+  ) => MkStream m (ls :!: Epsilon) (TreeIxR p v a t) where
+  mkStream (ls :!: Epsilon) sv us is
+    = 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
+  ( TstCtx m ts s x0 i0 is (TreeIxR p v a I)
+  ) => TermStream m (TermSymbol ts Epsilon) s (is:.TreeIxR p v a I) where
+  termStream (ts:|Epsilon) (cs:.IStatic ()) (us:.TreeIxR _ ul utfe) (is:.TreeIxR frst il itfe)
+    = map (\(TState s ii ee) ->
+              let RiTirI ef = getIndex (getIdx s) (Proxy :: PRI is (TreeIxR p v a I))
+                  l         = case ef of {E l -> l ; F _ -> 0}
+              in  TState s (ii:.:RiTirI ef) (ee:.()) )
+    . termStream ts cs us is
+    . staticCheck ( (isEmpty itfe) || getTFEIx utfe == 0) --TODO: 2nd condition takes care of empty inputs
+  {-# Inline termStream #-}
+
+
+instance TermStaticVar Epsilon (TreeIxR p v a I) where
+  termStaticVar _ sv _ = sv
+  termStreamIndex _ _ i = i
+  {-# Inline [0] termStaticVar   #-}
+  {-# Inline [0] termStreamIndex #-}
+
+
+--deletion
+
+instance
+  ( TmkCtx1 m ls Deletion (TreeIxR p v a t)
+  ) => MkStream m (ls :!: Deletion) (TreeIxR p v a t) where
+  mkStream (ls :!: Deletion) sv us is
+    = 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 #-}
+
+
+instance
+  ( TstCtx m ts s x0 i0 is (TreeIxR p v a I)
+  ) => TermStream m (TermSymbol ts Deletion) s (is:.TreeIxR p v a I) where
+  termStream (ts:|Deletion) (cs:.IVariable ()) (us:.u) (is:.TreeIxR frst i ii)
+    = map (\(TState s ii ee) ->
+              let RiTirI tfe = getIndex (getIdx s) (Proxy :: PRI is (TreeIxR p v a I))
+              in  {- traceShow ("-"::String,l,tf) $ -} TState s (ii:.:RiTirI tfe) (ee:.()) )
+    . termStream ts cs us is
+--    . staticCheck (ii == T)
+  {-# Inline termStream #-}
+
+
+instance TermStaticVar Deletion (TreeIxR p v a I) where
+  termStaticVar _ sv _ = sv
+  termStreamIndex _ _ i = i
+  {-# Inline [0] termStaticVar   #-}
+  {-# Inline [0] termStreamIndex #-}
+
+
+-- Invisible starting symbol
+
+instance (Monad m) => MkStream m S (TreeIxR p v a I) where
+  mkStream S _ (TreeIxR frst ul utfe) (TreeIxR _ kl ktfe)
+    = staticCheck ((getTFEIx ktfe) >=0 && (getTFEIx ktfe) <= (getTFEIx utfe)) . singleton . ElmS $ RiTirI ktfe
+  {-# Inline mkStream #-}
+
+
+instance
+  ( Monad m
+  , MkStream m S is
+  ) => MkStream m S (is:.TreeIxR p v a I) where
+  mkStream S (vs:._) (lus:.TreeIxR frst ul utfe) (is:.TreeIxR _ kl ktfe)
+    = map (\(ElmS zi) -> ElmS $ zi :.: RiTirI ktfe)
+    . staticCheck ((getTFEIx ktfe) >=0 && (getTFEIx ktfe) <= (getTFEIx utfe))
+    $ mkStream S vs lus is
+  {-# INLINE mkStream #-}
+
+-- | When choosing tree and forest sizes, 
+
+data TFsize s
+  -- The tree shall have size epsilon, the forest be full. If @TF@ is @F@
+  -- then the forest is a real forest, if @TF@ is @T@ then the forest is
+  -- a tree.
+  = EpsFull TFE s
+  -- | The tree is full (and actually a forest), the remainder of the
+  -- forest is epsilon. This means that in the "tree" synvar, we can only
+  -- do indels.
+  | FullEpsFF s
+  -- | The tree is set, the remaining forest gets what is left.
+  | OneRemFT s
+  -- | The tree is set, the remaining forest is empty.
+  | OneEpsTT s
+  | Finis
+
+-- | Syntactic variables. Different variants on parsing.
+--
+-- In case we have @X -> Y@, no restrictions are placed.
+--
+-- We now need @X -> Y Z@:
+--
+-- @
+--
+-- X    ->  Y     Z
+-- i,E      i,E   i,E
+--
+--
+--
+-- X    ->  Y     Z       we do not split off the first tree
+-- i,F      i,E   i,F
+--
+-- X    ->  Y     Z
+-- i,F      i,T   k,F     k,E, if k==u ; 1st tree split off
+--          i_k
+--
+-- X    ->  Y     Z       move complete forest down
+-- i,F      i,F   u,E
+--
+--
+--
+-- When does this happen? If you have @T -> - F@ then @F@ will now actually
+-- be such a @T@.    T -> TF ; (1) T -> εT ; (2) T -> Tε
+--
+-- X    ->  Y     Z       do not hand i,T down
+-- i,T      i,E   i,T
+--
+-- X    ->  Y     Z       further hand down
+-- i,T      i,T   k,E
+--          i_k
+--
+-- @
+
+instance
+  ( IndexHdr s x0 i0 us (TreeIxR p v a I) cs c is (TreeIxR p v a I)
+  , MinSize c
+--  , Show a, VG.Vector v a -- TEMP!
+--  , a ~ Info
+  ) => AddIndexDense s (us:.TreeIxR p v a I) (cs:.c) (is:.TreeIxR p v a I) where
+  addIndexDenseGo (cs:._) (vs:.IStatic ()) (lbs:._) (ubs:._) (us:.TreeIxR frst ul utfe) (is:.TreeIxR _ jl jtfe)
+    = map go . addIndexDenseGo cs vs lbs ubs us is
+    where
+      go (SvS s tt ii) =
+        let RiTirI tfe = getIndex (getIdx s) (Proxy :: PRI is (TreeIxR p v a I))
+            -- TODO this will probably barf, because we need the index
+            -- "after the empty forest", which we can't get anymore.
+            tfe'       = if getTFEIx tfe == getTFEIx utfe then E (getTFEIx tfe) else tfe
+        in  tSI (glb) ('S',tfe,'.') $
+            SvS s (tt:.TreeIxR frst ul tfe') (ii:.:RiTirI utfe)
+  addIndexDenseGo (cs:._) (vs:.IVariable ()) (lbs:._) (ubs:._) (us:.TreeIxR frst ul utfe) (is:.TreeIxR _ jl jtfe)
+    = flatten mk step . addIndexDenseGo cs vs lbs ubs us is
+    where mk svS = return $ EpsFull jtfe svS
+          step Finis = return $ Done
+          -- nothing here
+          step (EpsFull (E _) svS@(SvS s tt ii))
+            = let j = getTFEIx jtfe
+              in  return $ Yield (SvS s (tt:.TreeIxR frst jl (E j)) (ii:.:RiTirI (E j))) Finis
+          -- _ -> TF , for forests: with T having size ε, F having full size
+          step (EpsFull (F ys) svS@(SvS s tt ii))
+            = do let RiTirI ktfe = getIndex (getIdx s) (Proxy :: PRI is (TreeIxR p v a I))
+                     k           = getTFEIx ktfe
+                 tSI (glb) ('V',ktfe) .
+                   return $ Yield (SvS s (tt:.TreeIxR frst jl (E k)) (ii:.:RiTirI ktfe)) (FullEpsFF svS)  -- @k Epsilon / full@
+          -- _ -> TF, for forests: with T having full size, F having size ε
+          step (FullEpsFF svS@(SvS s tt ii))
+            = do let RiTirI ktfe = getIndex (getIdx s) (Proxy :: PRI is (TreeIxR p v a I))
+                     u           = getTFEIx utfe
+                 tSI (glb) ('A',ktfe) .
+                   return $ Yield (SvS s (tt:.TreeIxR frst jl ktfe) (ii:.:RiTirI (E u))) (OneRemFT svS)   -- @full / u Epsilon@
+          -- _ -> TF for forests: with T having size 1, F having full - 1 size
+          step (OneRemFT (SvS s tt ii))
+            = do let RiTirI (F kcs) = getIndex (getIdx s) (Proxy :: PRI is (TreeIxR p v a I))
+                     k         = VU.head kcs
+                     cs        = VU.tail kcs
+                     ltfe      = if VU.null cs then (E $ getTFEIx utfe) else F cs
+                 tSI (glb) ('B') .
+                   return $ Yield (SvS s (tt:.TreeIxR frst jl (T k)) (ii:.:RiTirI ltfe)) Finis -- @1 / l ltf@
+          -- _ -> TF , for trees: with T having size ε, F having size 1 (or T)
+          step (EpsFull (T _) svS@(SvS s tt ii))
+            = do let RiTirI (T k)  = getIndex (getIdx s) (Proxy :: PRI is (TreeIxR p v a I))
+                 tSI (glb) ('Q') .
+                   return $ Yield (SvS s (tt:.TreeIxR frst ul (E k)) (ii:.:RiTirI (T k))) (OneEpsTT svS)
+          -- _ -> TF, for trees: with T having size 1, F having size ε
+          step (OneEpsTT (SvS s tt ii))
+            = do let RiTirI (T k) = getIndex (getIdx s) (Proxy :: PRI is (TreeIxR p v a I))
+                     l         = rbdef (getTFEIx utfe) frst k
+                 tSI (glb) ('W') .
+                   return $ Yield (SvS s (tt:.TreeIxR frst ul (T k)) (ii:.:RiTirI (E l))) Finis
+          {-# Inline [0] mk #-}
+          {-# Inline [0] step #-}
+  {-# Inline addIndexDenseGo #-}
+
+glb = True
+
+tSI cond s i = if cond then traceShow s i else i
+
+instance (MinSize c) => TableStaticVar u c (TreeIxR p v a I) where 
+  tableStaticVar _ _ _ _ = IVariable ()
+  tableStreamIndex _ c _ = id
+  {-# Inline [0] tableStaticVar #-}
+  {-# Inline [0] tableStreamIndex #-}
+
+getrbound frst k
+  | VG.length rs >= k = VG.length rs
+  | r < 0             = VG.length rs
+  | otherwise         = r
+  where rs = rsib frst ; r = rs VG.! k
+{-# Inline getrbound #-}
+
+trright frst k = rbdef (VG.length $ rsib frst) frst k
+
+-- | The next right sibling.
+
+rbdef d frst k = maybe d (\z -> if z<0 then d else z) $ rsib frst VG.!? k
+{-# Inline rbdef #-}
+
+-- | Give us the parent for node @k@ or @-1@ if there is no parent
+
+pardef frst k = maybe (-1) id $ parent frst VG.!? k
+{-# Inline pardef #-}
+
+
+-- Outside
+
+
+data instance RunningIndex (TreeIxR p v a O) = RiTirO !TFE
+
+
+
+instance IndexStream z => IndexStream (z:.TreeIxR Pre v a O) where
+  streamUp   (ls:.TreeIxR p llk lf) (hs:.TreeIxR _ _ ht) = flatten (streamDownMk   p lf ht) (streamDownStep   p llk lf ht) $ streamDown ls hs
+  streamDown (ls:.TreeIxR p llk lf) (hs:.TreeIxR _ _ ht) = flatten (streamUpMk p lf ht) (streamUpStep p llk lf ht) $ streamUp ls hs
+  {-# Inline streamUp #-}
+  {-# Inline streamDown #-}
+
+
+
+instance RuleContext (TreeIxR p v a O) where
+  type Context (TreeIxR p v a O) = OutsideContext ()
+  initialContext _ = OStatic ()
+  {-# Inline initialContext #-}
+
+
+-- | Node
+--
+-- Inside:
+-- @
+-- M     -> n     F
+-- i,T   -> i,T   <ls>,F
+--
+-- where ls = ordered subforest of all children of 'i'
+-- @
+--
+-- Outside:
+-- @
+-- F       -> n     M
+-- <ls>,F  -> i,T   i,T
+-- @
+--
+-- with the condition that the rule is active only if @<ls>@ is indeed the
+-- whole ordered subforest below @i@.
+
+instance
+  ( TstCtx m ts s x0 i0 is (TreeIxR p v a O)
+  , Show r
+  ) => TermStream m (TermSymbol ts (Node r x)) s (is:.TreeIxR p v a O) where
+  termStream (ts:|Node f nty xs) (cs:.OFirstLeft ()) (us:.TreeIxR _ ul utfe) (is:.TreeIxR frst il itfe)
+    = map (\(TState s ii ee) ->
+              let RiTirO l = getIndex (getIdx s) (Proxy :: PRI is (TreeIxR p v a O))
+                  p = case l of 
+                        E i  -> i 
+                        F cs -> parent frst VG.! VG.head cs
+              in  TState s (ii:.:RiTirO (T p)) (ee:.f xs p) )
+    . termStream ts cs us is
+    . staticCheck ({- itfe < utfe && -} isOrdfull frst itfe)
+  {-# Inline termStream #-}
+
+
+instance TermStaticVar (Node r x) (TreeIxR p v a O) where
+  termStaticVar _ sv _ = sv
+  termStreamIndex _ _ (TreeIxR frst i j) = TreeIxR frst i j
+  {-# Inline [0] termStaticVar   #-}
+  {-# Inline [0] termStreamIndex #-}
+
+
+
+isOrdfull:: (Forest p v a) -> TFE -> Bool 
+isOrdfull frst (F cs)
+  | Just c <- cs VG.!? 0
+  , let p = parent frst VG.! c 
+  , p >= 0
+  = children frst VG.! p == cs
+isOrdfull frst (E i) = VG.null $ children frst VG.! i
+isOrdfull _    _     = False
+{-# Inline isOrdfull   #-}
+
+
+
+-- PermNode
+
+instance
+  ( TstCtx m ts s x0 i0 is (TreeIxR p v a O)
+  , Show r
+  ) => TermStream m (TermSymbol ts (PermNode r x)) s (is:.TreeIxR p v a O) where
+  termStream (ts:|PermNode f xs) (cs:.OFirstLeft ()) (us:.TreeIxR _ ul utfe) (is:.TreeIxR frst il itfe)
+    = map (\(TState s ii ee) ->
+              let RiTirO l = getIndex (getIdx s) (Proxy :: PRI is (TreeIxR p v a O))
+                  p = case l of 
+                        E i  -> i 
+                        F cs -> parent frst VG.! VG.head cs
+              in  TState s (ii:.:RiTirO (T p)) (ee:.f xs p) )
+    . termStream ts cs us is
+    . staticCheck ({- itfe < utfe && -} isPermfull frst itfe) --instead of isTree ask if it is a full ordered vector of its siblings including itself 
+  {-# Inline termStream #-}
+
+
+instance TermStaticVar (PermNode r x) (TreeIxR p v a O) where
+  termStaticVar _ sv _ = sv
+  termStreamIndex _ _ (TreeIxR frst i j) = TreeIxR frst i j
+  {-# Inline [0] termStaticVar   #-}
+  {-# Inline [0] termStreamIndex #-}
+
+
+
+isPermfull:: (Forest p v a) -> TFE -> Bool 
+isPermfull frst (F cs)
+  | Just c <- cs VG.!? 0
+  , let p = parent frst VG.! c 
+  , p >= 0
+  = VG.length (children frst VG.! p) == VG.length cs  -- cs is a subset of the other vector
+isPermfull frst (E i) = VG.null $ children frst VG.! i
+isPermfull _    _     = False
+{-# Inline isPermfull #-}
+
+
+
+-- Epsilon
+
+
+instance
+  ( TstCtx m ts s x0 i0 is (TreeIxR p v a O)
+  ) => TermStream m (TermSymbol ts Epsilon) s (is:.TreeIxR p v a O) where
+  termStream (ts:|Epsilon) (cs:.OStatic ()) (us:.TreeIxR _ ul utfe) (is:.TreeIxR frst il itfe)
+    = map (\(TState s ii ee) ->
+              let RiTirO ef = getIndex (getIdx s) (Proxy :: PRI is (TreeIxR p v a O))
+              in  TState s (ii:.:RiTirO ef) (ee:.()) )
+    . termStream ts cs us is
+    . staticCheck (case itfe of {F cs -> cs == roots frst; _ -> False}) 
+  {-# Inline termStream #-}
+
+
+instance TermStaticVar Epsilon (TreeIxR p v a O) where
+  termStaticVar _ sv _ = sv
+  termStreamIndex _ _ i = i
+  {-# Inline [0] termStaticVar   #-}
+  {-# Inline [0] termStreamIndex #-}
+
+
+
+
+
+-- |
+--
+-- das wird deletion
+--
+-- Inside
+-- @
+-- T   -> - F
+-- i,? ->   i,?
+
+
+--Deletion
+
+
+instance
+  ( TstCtx m ts s x0 i0 is (TreeIxR p v a O)
+  ) => TermStream m (TermSymbol ts Deletion) s (is:.TreeIxR p v a O) where
+  termStream (ts:|Deletion) (cs:._) (us:.u) (is:.TreeIxR frst i ii)
+    = map (\(TState s ii ee) ->
+              let RiTirO tfe = getIndex (getIdx s) (Proxy :: PRI is (TreeIxR p v a O))
+              in  {- traceShow ("-"::String,l,tf) $ -} TState s (ii:.:RiTirO tfe) (ee:.()) )
+    . termStream ts cs us is
+--    . staticCheck (ii == T)
+  {-# Inline termStream #-}
+
+
+instance TermStaticVar Deletion (TreeIxR p v a O) where
+  termStaticVar _ sv _ = sv
+  termStreamIndex _ _ i = i
+  {-# Inline [0] termStaticVar   #-}
+  {-# Inline [0] termStreamIndex #-}
+
+
+-- Invisible starting symbol
+
+instance (Monad m) => MkStream m S (TreeIxR p v a O) where
+  mkStream S _ (TreeIxR frst ul utfe) (TreeIxR _ kl ktfe)
+    = staticCheck ((getTFEIx ktfe) >=0 && (getTFEIx ktfe) <= (getTFEIx utfe)) . singleton . ElmS $ RiTirO ktfe
+  {-# Inline mkStream #-}
+
+
+instance
+  ( Monad m
+  , MkStream m S is
+  ) => MkStream m S (is:.TreeIxR p v a O) where
+  mkStream S (vs:._) (lus:.TreeIxR frst ul utfe) (is:.TreeIxR _ kl ktfe)
+    = map (\(ElmS zi) -> ElmS $ zi :.: RiTirO ktfe)
+    . staticCheck ((getTFEIx ktfe) >=0 && (getTFEIx ktfe) <= (getTFEIx utfe))
+    $ mkStream S vs lus is
+  {-# INLINE mkStream #-}
+
+
+
+
+
+
+
+
+
+
+
+-- OOE for E and T
+
+data OOEFT x
+  = OOE x !TFE
+  | OOEF x [TFE]
+  | OOF x !TFE
+  | OOFinis
+
+
+
+
+instance
+  ( IndexHdr s x0 i0 us (TreeIxR p v a O) cs c is (TreeIxR p v a O)
+  , MinSize c
+  ) => AddIndexDense s (us:.TreeIxR p v a O) (cs:.c) (is:.TreeIxR p v a O) where
+  addIndexDenseGo (cs:._) (vs:.OStatic ()) (lbs:._) (ubs:._) (us:.TreeIxR frst ul utfe) (is:.TreeIxR _ jl jtfe)
+    = map go .addIndexDenseGo cs vs lbs ubs us is
+    where go (SvS s tt ii) =
+            let RiTirO ol = getIndex (getIdx s) (Proxy :: PRI is (TreeIxR p v a O))
+            in  SvS s (tt:.TreeIxR frst ul ol) (ii:.:RiTirO ol) -- TODO should set right boundary
+  addIndexDenseGo (cs:._) (vs:.ORightOf ()) (lbs:._) (ubs:._) (us:.TreeIxR frst ul utfe) (is:.TreeIxR _ jl jtfe)
+    = flatten mk step . addIndexDenseGo cs vs lbs ubs us is
+    where mk svS = return $ case jtfe of
+                    E _ -> OOE svS jtfe
+                    T _ -> OOE svS jtfe
+                    F _ -> OOF svS jtfe
+          step OOFinis = return Done
+          step (OOE svS@(SvS s tt ii) (E i)) | i < (getTFEIx utfe) = 
+            return $ Yield (SvS s (tt:.TreeIxR frst jl (E i)) (ii:.:RiTirO (E i))) (OOE svS (T i))
+          step (OOE svS@(SvS s tt ii) (T i)) | i < (getTFEIx utfe) = 
+            return $ Yield (SvS s (tt:.TreeIxR frst jl (T i)) (ii:.:RiTirO (T i))) (OOEF svS (genPerm frst i)) 
+          step (OOEF svS@(SvS s tt ii) []) = return Done
+          step (OOEF svS@(SvS s tt ii) (F i:is)) = 
+            return $ Yield (SvS s (tt:.TreeIxR frst jl (F i)) (ii:.:RiTirO (F i))) (OOEF svS is) 
+          step (OOF svS@(SvS s tt ii) (F i)) = 
+            return $ Yield (SvS s (tt:.TreeIxR frst jl (F i)) (ii:.:RiTirO (E (getTFEIx utfe)))) OOFinis 
+          {-# Inline [0] mk #-}
+          {-# Inline [0] step #-}
+  {-# Inline addIndexDenseGo #-}
+
+
+
+genPerm frst i
+  | let p = parent frst VG.! i
+  , p >= 0
+  , let cs = children frst VG.! p
+  = L.map (F. VG.fromList) . L.map (i:) . L.concatMap permutations . subsequences . L.delete i $ VG.toList cs 
+genPerm _ _ = []
+{-# Inline genPerm #-}
+
+
+
+
+data OIEFT x
+  = OIEE x !TFE
+  | OIET x !TFE
+  | OIEF x [TFE]
+  | OIT x !TFE
+  | OIFE x !TFE
+  | OIFT x !(VU.Vector Int) [Int]
+  | OIFinis
+
+
+instance
+  ( IndexHdr s x0 i0 us (TreeIxR p v a I) cs c is (TreeIxR p v a O)
+  , MinSize c
+  ) => AddIndexDense s (us:.TreeIxR p v a I) (cs:.c) (is:.TreeIxR p v a O) where
+  addIndexDenseGo (cs:._) (vs:.OStatic ()) (lbs:._) (ubs:._) (us:.TreeIxR frst ul utfe) (is:.TreeIxR _ jl jtfe)
+    = map go .addIndexDenseGo cs vs lbs ubs us is
+    where go (SvS s tt ii) =
+            let RiTirO lo = getIndex (getIdx s) (Proxy :: PRI is (TreeIxR p v a O))
+            in  SvS s (tt:.TreeIxR frst jl lo) (ii:.:RiTirO lo) -- TODO should set right boundary
+  addIndexDenseGo (cs:._) (vs:.OFirstLeft ()) (lbs:._) (ubs:._) (us:.TreeIxR frst ul utfe) (is:.TreeIxR _ jl jtfe)
+    = flatten mk step . addIndexDenseGo cs vs lbs ubs us is
+    where mk svS@(SvS s tt ii) =
+            let RiTirO lo = getIndex (getIdx s) (Proxy :: PRI is (TreeIxR p v a O))
+            in  return $ case lo of
+                  E _ -> OIEE svS lo
+                  F _ -> OIFE svS lo
+                  T _ -> OIT svS lo
+          step OIFinis = return Done
+          step (OIEE svS@(SvS s tt ii) (E i)) | i < (getTFEIx utfe) =
+            return $ Yield (SvS s (tt:.TreeIxR frst jl (E i)) (ii:.:RiTirO (E i))) (OIET svS (E i))
+          step (OIEE svS@(SvS s tt ii) (E i)) = return $ Skip (OIET svS (E i))
+          step (OIET svS@(SvS s tt ii) (E i)) | Just l <- leftSibling (rightMostLeaf frst (getTFEIx utfe)) frst i =
+            return $ Yield (SvS s (tt:.TreeIxR frst jl (T l)) (ii:.:RiTirO (T l))) 
+                           (OIEF svS $ if i == (getTFEIx utfe) then (L.map F $ sortedSubForests frst) else [])
+          step (OIET svS@(SvS s tt ii) (E i)) = return Done
+          step (OIEF svS@(SvS s tt ii) []) = return Done
+          step (OIEF svS@(SvS s tt ii) (x:xs)) =
+            return $ Yield (SvS s (tt:.TreeIxR frst jl x) (ii:.:RiTirO x)) (OIEF svS xs) 
+          step (OIT svS@(SvS s tt ii) (T i)) =
+            return $ Yield (SvS s (tt:.TreeIxR frst jl (E i)) (ii:.:RiTirO (T i))) OIFinis
+          step (OIFE svS@(SvS s tt ii) (F i)) =
+            return $ Yield (SvS s (tt:.TreeIxR frst jl (E $ VG.head i)) (ii:.:RiTirO (F i))) (OIFT svS i $ genTrees frst i) 
+          step (OIFT svS@(SvS s tt ii) ss []) = return Done
+          step (OIFT svS@(SvS s tt ii) ss (x:xs)) =
+            return $ Yield (SvS s (tt:.TreeIxR frst jl (T x)) (ii:.:RiTirO (F $ x `VG.cons` ss))) (OIFT svS ss xs) 
+          {-# Inline [0] mk #-}
+          {-# Inline [0] step #-}
+  {-# Inline addIndexDenseGo #-}
+
+
+
+genTrees frst is = rs
+  where 
+    i = VG.head is
+    p = parent frst VG.! i
+    cs = if p >= 0 then children frst VG.! p else roots frst
+    rs = VG.toList $ VG.filter (`VG.notElem` is) cs
+{-# Inline genTrees #-}
+
+
+leftSibling d frst k 
+  | k >= VG.length (children frst)  = Just d
+  | Just l <- lsib frst VG.!? k = Just l
+  | otherwise = Nothing
+{-# Inline leftSibling #-}
+
+
+
+
+
+-- * Complemented instances
+
+-- | Outside running index structure requires two local index structures.
+-- One is for the inside symbols, one for the outside symbol.
+
+data instance RunningIndex (TreeIxR p v a C) = RiTirC !TFE
+
+-- | Outside works in the opposite direction.
+--
+
+instance IndexStream z => IndexStream (z:.TreeIxR p v a C) where
+  streamUp   (ls:.TreeIxR p llk lf) (hs:.TreeIxR _ _ ht) = flatten (streamUpMk p lf ht) (streamUpStep   p llk lf ht) $ streamUp ls hs
+  streamDown (ls:.TreeIxR p llk lf) (hs:.TreeIxR _ _ ht) = flatten (streamDownMk p lf ht) (streamDownStep p llk lf ht) $ streamDown ls hs
+  {-# Inline streamUp #-}
+  {-# Inline streamDown #-}
+
+instance RuleContext (TreeIxR p v a C) where
+  type Context (TreeIxR p v a C) = ComplementContext
+  initialContext _ = Complemented
+  {-# Inline initialContext #-}
+
+
+
+-- Invisible starting symbol
+
+instance (Monad m) => MkStream m S (TreeIxR p v a C) where
+  mkStream S _ (TreeIxR frst lk uu) (TreeIxR _ _ kt)
+    = staticCheck (let k = getTFEIx kt;u = getTFEIx uu in k >=0 && k<= u) . singleton . ElmS $ RiTirC kt
+  {-# Inline mkStream #-}
+
+instance
+  ( Monad m
+  , MkStream m S is
+  ) => MkStream m S (is:.TreeIxR p v a C) where
+  mkStream S (vs:._) (lus:.TreeIxR frst lk uu) (is:.TreeIxR _ _ kt)
+    = map (\(ElmS zi) -> ElmS $ zi :.: RiTirC kt)
+    . staticCheck (let k = getTFEIx kt;u = getTFEIx uu in k >=0 && k<= u)
+    $ mkStream S vs lus is
+  {-# INLINE mkStream #-}
+
+
+
+instance
+  ( IndexHdr s x0 i0 us (TreeIxR p v a I) cs c is (TreeIxR p v a C)
+  , MinSize c
+  ) => AddIndexDense s (us:.TreeIxR p v a I) (cs:.c) (is:.TreeIxR p v a C) where
+  addIndexDenseGo (cs:._) (vs:.Complemented) (lbs:._) (ubs:._) (us:.TreeIxR frst lk v) (is:.TreeIxR _ _ j)
+    = map go .addIndexDenseGo cs vs lbs ubs us is
+    where go (SvS s tt ii) =
+            let RiTirC tf = getIndex (getIdx s) (Proxy :: PRI is (TreeIxR p v a C))
+            in  SvS s (tt:.TreeIxR frst lk tf) (ii:.:RiTirC tf)
+  {-# Inline addIndexDenseGo #-}
+
+instance
+  ( IndexHdr s x0 i0 us (TreeIxR p v a O) cs c is (TreeIxR p v a C)
+  , MinSize c
+  ) => AddIndexDense s (us:.TreeIxR p v a O) (cs:.c) (is:.TreeIxR p v a C) where
+  addIndexDenseGo (cs:._) (vs:.Complemented) (lbs:._) (ubs:._) (us:.TreeIxR frst lk v) (is:.TreeIxR _ _ j)
+    = map go .addIndexDenseGo cs vs lbs ubs us is
+    where go (SvS s tt ii) =
+            let RiTirC tf = getIndex (getIdx s) (Proxy :: PRI is (TreeIxR p v a C))
+            in  SvS s (tt:.TreeIxR frst lk tf) (ii:.:RiTirC tf)
+  {-# Inline addIndexDenseGo #-}
+
+
+
+
+
+
+{-
+-- * Outside instances
+
+-- | Outside running index structure requires two local index structures.
+-- One is for the inside symbols, one for the outside symbol.
+
+data instance RunningIndex (TreeIxR p v a O) = RiTirO !Int !TF !Int !TF -- I, I, O, O
+
+-- | Outside works in the opposite direction.
+--
+-- TODO check if the original @Up@ / @Down@ combination is ok.
+
+instance IndexStream z => IndexStream (z:.TreeIxR p v a O) where
+  streamUp   (ls:.TreeIxR p lf _) (hs:.TreeIxR _ ht _) = flatten (streamDownMk lf ht) (streamDownStep p lf ht) $ streamUp ls hs
+  streamDown (ls:.TreeIxR p lf _) (hs:.TreeIxR _ ht _) = flatten (streamUpMk   lf ht) (streamUpStep   p lf ht) $ streamDown ls hs
+  {-# Inline streamUp #-}
+  {-# Inline streamDown #-}
+
+instance RuleContext (TreeIxR p v a O) where
+  type Context (TreeIxR p v a O) = OutsideContext ()
+  initialContext _ = OStatic ()
+  {-# Inline initialContext #-}
+
+
+
+-- Node
+
+-- | We are a @F@orest at position @i@. Now we request the parent, who
+-- happens to be the root of a @T@ree.
+--
+-- TODO we should actually move the outside index via the @OFirstLeft@
+-- (etc) encoding
+--
+-- X    -> n    Y
+-- i,T  -> i,T  i+1,t     -- @t@ = if @i@ has no children, then @E@, else @F@.
+--
+-- Y'     ->  n       X'
+-- i+1,t      i,T     i,T   -- @t@ = if @i@ ...
+--
+-- Y'     ->  n       X'
+-- i,t        i-1,T   i-1,T -- @t@ = if @i-1@ has no children, then @E@ else @F@
+
+instance
+  ( TstCtx m ts s x0 i0 is (TreeIxR p v a O)
+  , Show r
+  ) => TermStream m (TermSymbol ts (Node r x)) s (is:.TreeIxR p v a O) where
+  termStream (ts:|Node f xs) (cs:.OFirstLeft ()) (us:.TreeIxR _ u ut) (is:.TreeIxR frst i it)
+    = map (\(TState s ii ee) ->
+              let RiTirO li tfi lo tfo = getIndex (getIdx s) (Proxy :: PRI is (TreeIxR p v a O))
+                  l' = li - 1
+              in  TState s (ii:.:RiTirO li T l' T) (ee:.f xs l') ) -- @li@, since we have now just 'eaten' @li -1 , li@
+    . termStream ts cs us is
+    -- @i>0@ so that we can actually have a parent
+    -- @it==E@ in case we @i-1@ has no children; @it==F@ in case @i-1@ has
+    -- children.
+    . staticCheck (let hc = not $ VG.null (children frst VG.! (i-1))
+                   in  i>0 && (not hc && it==E || hc && it==F))
+  {-# Inline termStream #-}
+
+instance TermStaticVar (Node r x) (TreeIxR p v a O) where
+  termStaticVar _ sv _ = sv
+  termStreamIndex _ _ (TreeIxR frst i j) = TreeIxR frst i j
+  {-# Inline [0] termStaticVar   #-}
+  {-# Inline [0] termStreamIndex #-}
+
+
+
+-- | Epsilon
+
+instance
+  ( TstCtx m ts s x0 i0 is (TreeIxR p v a O)
+  ) => TermStream m (TermSymbol ts Epsilon) s (is:.TreeIxR p v a O) where
+  termStream (ts:|Epsilon) (cs:.OStatic ()) (us:.TreeIxR _ u uu) (is:.TreeIxR frst i ii)
+    = map (\(TState s ii ee) ->
+              let RiTirO li tfi lo tfo = getIndex (getIdx s) (Proxy :: PRI is (TreeIxR p v a O))
+              in  TState s (ii:.:RiTirO li tfi lo tfo) (ee:.()) )
+    . termStream ts cs us is
+    . staticCheck ((i==0 && ii==F) || (i==0 && u==0 && ii==E))
+  {-# Inline termStream #-}
+
+
+instance TermStaticVar Epsilon (TreeIxR p v a O) where
+  termStaticVar _ sv _ = sv
+  termStreamIndex _ _ i = i
+  {-# Inline [0] termStaticVar   #-}
+  {-# Inline [0] termStreamIndex #-}
+
+
+
+-- | Deletion.
+--
+-- Has no conditions on when it is acceptable.
+
+instance
+  ( TstCtx m ts s x0 i0 is (TreeIxR p v a O)
+  ) => TermStream m (TermSymbol ts Deletion) s (is:.TreeIxR p v a O) where
+  termStream (ts:|Deletion) (cs:._) (us:.u) (is:.TreeIxR frst i ii)
+    = map (\(TState s ii ee) ->
+              let RiTirO li tfi lo tfo = getIndex (getIdx s) (Proxy :: PRI is (TreeIxR p v a O))
+              in  TState s (ii:.:RiTirO li tfi lo tfo) (ee:.()) )
+    . termStream ts cs us is
+  {-# Inline termStream #-}
+
+
+instance TermStaticVar Deletion (TreeIxR p v a O) where
+  termStaticVar _ sv _ = sv
+  termStreamIndex _ _ i = i
+  {-# Inline [0] termStaticVar   #-}
+  {-# Inline [0] termStreamIndex #-}
+
+
+
+-- Invisible starting symbol
+
+instance (Monad m) => MkStream m S (TreeIxR p v a O) where
+  mkStream S _ (TreeIxR frst u ut) (TreeIxR _ k kt)
+    = staticCheck (k>=0 && k<=u) . singleton . ElmS $ RiTirO k kt k kt
+  {-# Inline mkStream #-}
+
+instance
+  ( Monad m
+  , MkStream m S is
+  ) => MkStream m S (is:.TreeIxR p v a O) where
+  mkStream S (vs:._) (lus:.TreeIxR frst u ut) (is:.TreeIxR _ k kt)
+    = map (\(ElmS zi) -> ElmS $ zi :.: RiTirO k kt k kt)
+    . staticCheck (k>=0 && k<=u)
+    $ mkStream S vs lus is
+  {-# INLINE mkStream #-}
+
+-- For both, I / O and O / O systems, we need to consider a large number of
+-- cases. The general rule @X -> Y Z@ with all variants follows below.
+--
+--
+-- @
+--
+-- X    ->  Y     Z
+-- i,E      i,E   i,E
+--
+-- Y^   ->  X^    Z
+-- i,E      i,E   i,E
+--
+-- Z^   ->  Y     X^
+-- i,E      i,E   i,E
+--
+--
+--
+-- X    ->  Y     Z       we do not split off the first tree; down is empty
+-- i,F      i,E   i,F
+--
+-- Y^   ->  X^    Z
+-- i,E      i,F   i,F
+--
+-- Z^   ->  Y     X^
+-- i,F      i,E   i,F
+--
+--
+-- X    ->  Y     Z
+-- i,F      i,T   k,t     if k==u then E else F ; 1st tree split off
+--          i~k
+--
+-- Y^   ->  X^    Z
+-- i,T      i,F   k,t     if k==u then E else F
+-- i~k
+--
+-- Z^   ->  Y     X^
+-- u,E      i,T   i,F     ∀ i ;; for all trees [i,u) !
+--          i~u
+--
+-- Z^   ->  Y     X^
+-- k,F      i,T   i,F     i is left sibling of k
+--          i~k
+--
+--
+-- X    ->  Y     Z       move complete forest down
+-- i,F      i,F   u,E
+--
+-- Y^   ->  X^    Z
+-- i,F      i,F   u,E
+--
+-- Z^   ->  Y     X^      ∀ i ;; for u,E collect all possible splits.
+-- u,E      i,F   i,F
+--
+--
+--
+-- X    ->  Y     Z       do not hand i,T down
+-- i,T      i,E   i,T
+--
+-- Y^   ->  X^    Z
+-- i,E      i,T   i,T
+--
+-- Z^   ->  Y     X^
+-- i,T      i,E   i,T
+--
+--
+--
+-- X    ->  Y     Z       further hand down
+-- i,T      i,T   k,E
+--          i_k
+--
+-- Y^   ->  X^    Z
+-- i,T      i,T   k,E
+-- i_k
+--
+-- Z^   ->  Y     X^
+-- k,E      i,T   i,T
+--          i_k
+--
+--
+-- @
+
+data OIEFT x
+  = OIEFF x Int -- svS , forests starting at @i@
+  | OIETT x Int -- svS , parent index for trees with right boundary @j@
+  | OIETF x Int -- svS , parent index for trees with right boundary @u@
+  | OIEEE x     -- svS
+  | OIFEF x     -- svS
+  | OIFTF x     -- svS
+  | OITET x     -- svS
+  | OIFinis
+
+-- | The different cases for @O@ context with @O@ tables.
+
+data OOEFT x -- = OOE TF x | OOF x | OOT TF x | OOFinis
+  = OOE x TF  -- svS , all variants of T F E
+  | OOFFE x   -- svS
+  | OOTF  x   -- svS
+  | OOTT  x   -- svS
+  | OOFinis
+
+-- In principle, we are missing an extra boolean case on @j==u@ or @j==l,
+-- l/=u@ for tree-symbols, i.e. those that bind terminals. However, in
+-- these linear languages, there can be only one such symbol per rule. This
+-- in turn means they are never in outside mode on the r.h.s. and hence we
+-- have no ambiguity problems.
+
+-- synVar: @Table I@ with @Index O@ We only have two options: @X' -> Y' Z@
+-- with @Z@ being in @OStatic@ position or @X' -> Y Z'@ with @Y@ being in
+-- @OFirstLeft@ position.
+--
+-- @
+--
+-- Z^   ->  Y     X^      ∀ i ;; for u,E collect all possible splits.
+-- u,E      i,F   i,F     this is move complete forest down / inside
+--
+-- Z^   ->  Y     X^      further hand down
+-- k,E      i,T   i,T
+--          i_k
+--
+-- Z^   ->  Y     X^
+-- u,E      i,T   i,F     ∀ i ;; for all trees [i,u) !
+--          i~u
+--
+-- Z^   ->  Y     X^
+-- i,E      i,E   i,E
+--
+--
+--
+-- Z^   ->  Y     X^       we do not split off the first tree; down is empty
+-- i,F      i,E   i,F
+--
+-- Z^   ->  Y     X^
+-- k,F      i,T   i,F     ∀ i ;; for all trees [i,k) k/=u !
+--          i~k
+--
+--
+--
+-- Z^   ->  Y     X^      do not hand i,T down
+-- i,T      i,E   i,T
+--
+-- @
+
+instance
+  ( IndexHdr s x0 i0 us (TreeIxR p v a I) cs c is (TreeIxR p v a O)
+  , MinSize c
+  ) => AddIndexDense s (us:.TreeIxR p v a I) (cs:.c) (is:.TreeIxR p v a O) where
+  addIndexDenseGo (cs:._) (vs:.OStatic ()) (us:.TreeIxR frst u v) (is:.TreeIxR _ j jj)
+    = map go .addIndexDenseGo cs vs us is
+    where go (SvS s tt ii) =
+            let RiTirO li tfi lo tfo = getIndex (getIdx s) (Proxy :: PRI is (TreeIxR p v a O))
+            in  SvS s (tt:.TreeIxR frst li tfi) (ii:.:RiTirO j E lo tfo) -- TODO should set right boundary
+  addIndexDenseGo (cs:._) (vs:.OFirstLeft ()) (us:.TreeIxR frst u v) (is:.TreeIxR _ j jj)
+    = flatten mk step . addIndexDenseGo cs vs us is
+    where mk svS@(SvS s tt ii) =
+            let RiTirO li tfi lo tfo = getIndex (getIdx s) (Proxy :: PRI is (TreeIxR p v a O))
+            in  return $ case jj of
+                  E -> OIEFF svS 0
+                  F -> OIFEF svS
+                  T -> OITET svS
+          step OIFinis = return Done
+          -- Z^   ->  Y     X^      ∀ i ;; for u,E collect all possible splits.
+          -- u,E      i,F   i,F     this is move complete forest down / inside
+          step (OIEFF svS@(SvS s tt ii) k) | j==u && k<u
+            = return $ Yield (SvS s (tt:.TreeIxR frst k F) (ii:.:RiTirO u E k F)) (OIEFF svS (k+1))
+          step (OIEFF svS _)
+            = let pj = maybe (-1) id $ F.lsib frst VG.!? j
+              in  return $ Skip $ OIETT svS pj
+          -- Z^   ->  Y     X^      further hand down
+          -- k,E      i,T   i,T
+          --          i_k
+          step (OIETT svS@(SvS s tt ii) pj) | j<u && pj>=0
+            = let pj' = pardef frst pj
+                  tr  = if j==u then E else F
+              in  return $ Yield (SvS s (tt:.TreeIxR frst pj T) (ii:.:RiTirO j tr pj T)) (OIETT svS pj')
+          step (OIETT svS _)
+            = let pu = pardef frst $ u - 1
+              in  return $ Skip $ OIETF svS pu
+          -- Z^   ->  Y     X^
+          -- u,E      i,T   i,F     ∀ i ;; for all trees [i,u) !
+          --          i~u
+          step (OIETF svS@(SvS s tt ii) pu) | j==u && pu>=0
+            = let pu' = pardef frst pu
+              in  return $ Yield (SvS s (tt:.TreeIxR frst pu T) (ii:.:RiTirO u E pu F)) (OIETF svS pu')
+          step (OIETF svS _)
+            = return $ Skip $ OIEEE svS
+          -- Z^   ->  Y     X^
+          -- i,E      i,E   i,E
+          step (OIEEE svS@(SvS s tt ii))
+            = return $ Yield (SvS s (tt:.TreeIxR frst j E) (ii:.:RiTirO j E j E)) OIFinis
+          -- Z^   ->  Y     X^       we do not split off the first tree; down is empty
+          -- i,F      i,E   i,F
+          step (OIFEF svS@(SvS s tt ii))
+            = return $ Yield (SvS s (tt:.TreeIxR frst j E) (ii:.:RiTirO j E j F)) (OIFTF svS)
+          -- Z^   ->  Y     X^
+          -- k,F      i,T   i,F     i is left sibling of k
+          --          i~k
+          step (OIFTF svS@(SvS s tt ii)) | Just ls <- F.lsib frst VG.!? j, ls >= 0
+            = return $ Yield (SvS s (tt:.TreeIxR frst ls T) (ii:.:RiTirO j F ls F)) OIFinis
+          step (OIFTF _) = return $ Skip $ OIFinis
+          -- Z^   ->  Y     X^      do not hand i,T down
+          -- i,T      i,E   i,T
+          step (OITET svS@(SvS s tt ii))
+            = return $ Yield (SvS s (tt:.TreeIxR frst j E) (ii:.:RiTirO j E j T)) OIFinis
+          {-# Inline [0] mk #-}
+          {-# Inline [0] step #-}
+  {-# Inline addIndexDenseGo #-}
+
+--synVar: @Table O@   with @Index O@
+--
+-- @
+--
+-- Y^   ->  X^    Z
+-- i,E      i,E   i,E
+--
+-- Y^   ->  X^    Z       we do not split off the first tree; down is empty
+-- i,E      i,F   i,F
+--
+-- Y^   ->  X^    Z       do not hand i,T down
+-- i,E      i,T   i,T
+--
+--
+--
+-- Y^   ->  X^    Z
+-- i,T      i,F   k,t     if k==u then E else F ; 1st tree split off
+-- i_k
+--
+-- Y^   ->  X^    Z       further hand down ; k,E because @T@
+-- i,T      i,T   k,E
+-- i_k
+--
+--
+--
+-- Y^   ->  X^    Z       move complete forest down
+-- i,F      i,F   u,E
+--
+-- @
+
+instance
+  ( IndexHdr s x0 i0 us (TreeIxR p v a O) cs c is (TreeIxR p v a O)
+  , MinSize c
+  ) => AddIndexDense s (us:.TreeIxR p v a O) (cs:.c) (is:.TreeIxR p v a O) where
+  addIndexDenseGo (cs:._) (vs:.OStatic ()) (us:.TreeIxR frst u v) (is:.TreeIxR _ j _)
+    = map go .addIndexDenseGo cs vs us is
+    where go (SvS s tt ii) =
+            let RiTirO li tfi lo tfo = getIndex (getIdx s) (Proxy :: PRI is (TreeIxR p v a O))
+            in  SvS s (tt:.TreeIxR frst lo tfo) (ii:.:RiTirO li tfi j E) -- TODO should set right boundary
+  addIndexDenseGo (cs:._) (vs:.ORightOf ()) (us:.TreeIxR frst u v) (is:.TreeIxR _ j jj)
+    = flatten mk step . addIndexDenseGo cs vs us is
+    where mk svS = return $ case jj of
+                    E -> OOE   svS minBound
+                    F -> OOFFE svS
+                    T -> OOTF  svS
+          -- done
+          step OOFinis = return Done
+          -- Y^   ->  X^    Z
+          -- i,E      i,E   i,E
+          --
+          -- Y^   ->  X^    Z       we do not split off the first tree; down is empty
+          -- i,E      i,F   i,F
+          --
+          -- Y^   ->  X^    Z       do not hand i,T down
+          -- i,E      i,T   i,T
+          step (OOE svS@(SvS s tt ii) tf) | tf < maxBound
+            = return $ Yield (SvS s (tt:.TreeIxR frst j tf) (ii:.:RiTirO j tf j E)) (OOE svS (succ tf))
+          step (OOE svS@(SvS s tt ii) tf) | tf == maxBound
+            = return $ Yield (SvS s (tt:.TreeIxR frst j tf) (ii:.:RiTirO j tf j E)) OOFinis
+          -- Y^   ->  X^    Z       move complete forest down
+          -- i,F      i,F   u,E
+          step (OOFFE svS@(SvS s tt ii))
+            = return $ Yield (SvS s (tt:.TreeIxR frst j F) (ii:.:RiTirO u E j E)) OOFinis
+          -- Y^   ->  X^    Z
+          -- i,T      i,F   k,t     if k==u then E else F ; 1st tree split off
+          -- i_k
+          step (OOTF svS@(SvS s tt ii))
+            = let k = rbdef u frst j
+                  tf = if k==u then E else F
+              in  return $ Yield (SvS s (tt:.TreeIxR frst j F) (ii:.:RiTirO k tf j E)) (OOTT svS)
+          -- Y^   ->  X^    Z       further hand down ; k,E because @T@
+          -- i,T      i,T   k,E
+          -- i_k
+          step (OOTT svS@(SvS s tt ii))
+            = let k = rbdef u frst j
+              in  return $ Yield (SvS s (tt:.TreeIxR frst j T) (ii:.:RiTirO k E j E)) OOFinis
+          {-# Inline [0] mk #-}
+          {-# Inline [0] step #-}
+  {-# Inline addIndexDenseGo #-}
+
+instance (MinSize c) => TableStaticVar (u I) c (TreeIxR p v a O) where 
+  tableStaticVar _ _ (OStatic    d) _ = ORightOf d
+  tableStaticVar _ _ (ORightOf   d) _ = ORightOf d
+  tableStaticVar _ _ (OFirstLeft d) _ = OLeftOf  d
+  tableStaticVar _ _ (OLeftOf    d) _ = OLeftOf  d
+  tableStreamIndex _ c _ = id
+  {-# Inline [0] tableStaticVar #-}
+  {-# Inline [0] tableStreamIndex #-}
+
+instance (MinSize c) => TableStaticVar (u O) c (TreeIxR p v a O) where 
+  tableStaticVar _ _ (OStatic  d) _ = OFirstLeft d
+  tableStaticVar _ _ (ORightOf d) _ = OFirstLeft d
+  tableStreamIndex _ c _ = id
+  {-# Inline [0] tableStaticVar #-}
+  {-# Inline [0] tableStreamIndex #-}
+
+
+
+
+
+-- * Complemented instances
+
+-- | Outside running index structure requires two local index structures.
+-- One is for the inside symbols, one for the outside symbol.
+
+data instance RunningIndex (TreeIxR p v a C) = RiTirC !Int !TF
+
+-- | Outside works in the opposite direction.
+--
+-- TODO check if the original @Up@ / @Down@ combination is ok.
+
+instance IndexStream z => IndexStream (z:.TreeIxR p v a C) where
+  streamUp   (ls:.TreeIxR p lf _) (hs:.TreeIxR _ ht _) = flatten (streamUpMk   lf ht) (streamUpStep   p lf ht) $ streamUp ls hs
+  streamDown (ls:.TreeIxR p lf _) (hs:.TreeIxR _ ht _) = flatten (streamDownMk lf ht) (streamDownStep p lf ht) $ streamDown ls hs
+  {-# Inline streamUp #-}
+  {-# Inline streamDown #-}
+
+instance RuleContext (TreeIxR p v a C) where
+  type Context (TreeIxR p v a C) = ComplementContext
+  initialContext _ = Complemented
+  {-# Inline initialContext #-}
+
+
+
+-- Invisible starting symbol
+
+instance (Monad m) => MkStream m S (TreeIxR p v a C) where
+  mkStream S _ (TreeIxR frst u ut) (TreeIxR _ k kt)
+    = staticCheck (k>=0 && k<=u) . singleton . ElmS $ RiTirC k kt
+  {-# Inline mkStream #-}
+
+instance
+  ( Monad m
+  , MkStream m S is
+  ) => MkStream m S (is:.TreeIxR p v a C) where
+  mkStream S (vs:._) (lus:.TreeIxR frst u ut) (is:.TreeIxR _ k kt)
+    = map (\(ElmS zi) -> ElmS $ zi :.: RiTirC k kt)
+    . staticCheck (k>=0 && k<=u)
+    $ mkStream S vs lus is
+  {-# INLINE mkStream #-}
+
+
+
+instance
+  ( IndexHdr s x0 i0 us (TreeIxR p v a I) cs c is (TreeIxR p v a C)
+  , MinSize c
+  ) => AddIndexDense s (us:.TreeIxR p v a I) (cs:.c) (is:.TreeIxR p v a C) where
+  addIndexDenseGo (cs:._) (vs:.Complemented) (us:.TreeIxR frst u v) (is:.TreeIxR _ j _)
+    = map go .addIndexDenseGo cs vs us is
+    where go (SvS s tt ii) =
+            let RiTirC k tf = getIndex (getIdx s) (Proxy :: PRI is (TreeIxR p v a C))
+            in  SvS s (tt:.TreeIxR frst k tf) (ii:.:RiTirC k tf)
+
+instance
+  ( IndexHdr s x0 i0 us (TreeIxR p v a O) cs c is (TreeIxR p v a C)
+  , MinSize c
+  ) => AddIndexDense s (us:.TreeIxR p v a O) (cs:.c) (is:.TreeIxR p v a C) where
+  addIndexDenseGo (cs:._) (vs:.Complemented) (us:.TreeIxR frst u v) (is:.TreeIxR _ j _)
+    = map go .addIndexDenseGo cs vs us is
+    where go (SvS s tt ii) =
+            let RiTirC k tf = getIndex (getIdx s) (Proxy :: PRI is (TreeIxR p v a C))
+            in  SvS s (tt:.TreeIxR frst k tf) (ii:.:RiTirC k tf)
+
+-}
+
diff --git a/ADP/Fusion/Core/ForestAlign/RightLinear.hs b/ADP/Fusion/Core/ForestAlign/RightLinear.hs
new file mode 100644
--- /dev/null
+++ b/ADP/Fusion/Core/ForestAlign/RightLinear.hs
@@ -0,0 +1,220 @@
+
+-- | Data structures and instances to combine efficient 'Forest' structures
+-- with @ADPfusion@.
+
+module ADP.Fusion.Core.ForestAlign.RightLinear where
+
+import           Control.Exception (assert)
+import           Data.Either (either)
+import           Data.Graph.Inductive.Basic
+import           Data.Strict.Tuple hiding (fst, snd)
+import           Data.Traversable (mapAccumL)
+import           Data.Vector.Fusion.Stream.Monadic hiding (flatten)
+import           Debug.Trace
+import           Prelude hiding (map)
+import qualified Data.Forest.Static as F
+import qualified Data.Tree as T
+import qualified Data.Vector as V
+import qualified Data.Vector.Fusion.Stream.Monadic as SM
+import qualified Data.Vector.Generic as VG
+import qualified Data.Vector.Unboxed as VU
+
+import           ADP.Fusion.Core
+import           Data.Forest.Static
+import           Data.PrimitiveArray hiding (map)
+
+import           ADP.Fusion.Term.Node.Type
+
+
+
+data TreeIxR p v a t = TreeIxR !(Forest p v a) !Int !TF
+
+instance Show (TreeIxR p v a t) where
+  show (TreeIxR _ i j) = show (i,j)
+
+minIx, maxIx :: Forest p v a -> TreeIxR p v a t
+minIx f = TreeIxR f 0 minBound
+
+maxIx f = TreeIxR f (VU.length (parent f)) maxBound
+{-# Inline minIx #-}
+{-# Inline maxIx #-}
+
+data TF = F | T | E
+  deriving (Show,Eq,Ord,Enum,Bounded)
+
+instance Index TF where
+  linearIndex _ _ tf = fromEnum tf
+  {-# Inline linearIndex #-}
+  smallestLinearIndex _ = fromEnum (minBound :: TF)
+  {-# Inline smallestLinearIndex #-}
+  largestLinearIndex _ = fromEnum (maxBound :: TF)
+  {-# Inline largestLinearIndex #-}
+  size _ _ = fromEnum (maxBound :: TF) + 1
+  {-# Inline size #-}
+  inBounds _ u k = k <= u
+  {-# Inline inBounds #-}
+
+
+data instance RunningIndex (TreeIxR p v a I) = RiTirI !Int !TF
+
+instance Index (TreeIxR p v a t) where
+  -- | trees @T@ are stored in the first line, i.e. @+0@, forests @F@ (with
+  -- @j==u@ are stored in the second line, i.e. @+u+1@ to each index.
+  linearIndex (TreeIxR _ l ll) (TreeIxR _ u uu) (TreeIxR _ k tf)
+    = (fromEnum (maxBound :: TF) + 1) * k + fromEnum tf
+  {-# Inline linearIndex #-}
+  smallestLinearIndex _ = error "still needed?"
+  {-# Inline smallestLinearIndex #-}
+  largestLinearIndex (TreeIxR p u ut) = (fromEnum (maxBound :: TF) + 1) * u + fromEnum (maxBound :: TF)
+  {-# Inline largestLinearIndex #-}
+  size (TreeIxR _ l ll) (TreeIxR _ u uu) = (fromEnum (maxBound :: TF) + 1) * (u+1)
+  {-# Inline size #-}
+  inBounds (TreeIxR _ l _) (TreeIxR _ u _) (TreeIxR _ k _) = l <= k && k <= u
+  {-# Inline inBounds #-}
+
+
+instance IndexStream z => IndexStream (z:.TreeIxR p v a I) where
+  streamUp   (ls:.TreeIxR p lf _) (hs:.TreeIxR _ ht _) = flatten (streamUpMk   lf ht) (streamUpStep   p lf ht) $ streamUp ls hs
+  streamDown (ls:.TreeIxR p lf _) (hs:.TreeIxR _ ht _) = flatten (streamDownMk lf ht) (streamDownStep p lf ht) $ streamDown ls hs
+  {-# Inline streamUp #-}
+  {-# Inline streamDown #-}
+
+streamUpMk lf ht z = return (z,ht,maxBound :: TF)
+{-# Inline [0] streamUpMk #-}
+
+streamUpStep p lf ht (z,k,tf)
+  | k < lf         = return $ SM.Done
+  | tf == minBound = return $ SM.Yield (z:.TreeIxR p k tf) (z,k-1,maxBound)
+  | otherwise      = return $ SM.Yield (z:.TreeIxR p k tf) (z,k,pred tf)
+{-# Inline [0] streamUpStep #-}
+
+streamDownMk lf ht z = return (z,lf,minBound :: TF)
+{-# Inline [0] streamDownMk #-}
+
+streamDownStep p lf ht (z,k,tf)
+  | k > ht         = return $ SM.Done
+  | tf == maxBound = return $ SM.Yield (z:.TreeIxR p k tf) (z,k+1,minBound)
+  | otherwise      = return $ SM.Yield (z:.TreeIxR p k tf) (z,k,succ tf)
+{-# Inline [0] streamDownStep #-}
+
+
+instance IndexStream (Z:.TreeIxR p v a t) => IndexStream (TreeIxR p v a t)
+
+instance RuleContext (TreeIxR p v a I) where
+  type Context (TreeIxR p v a I) = InsideContext ()
+  initialContext _ = IStatic ()
+  {-# Inline initialContext #-}
+
+
+
+-- Invisible starting symbol
+
+instance (Monad m) => MkStream m S (TreeIxR p v a I) where
+  mkStream S _ (TreeIxR frst u ut) (TreeIxR _ k kt)
+    = staticCheck (k>=0 && k<=u) . singleton . ElmS $ RiTirI k kt
+  {-# Inline mkStream #-}
+
+
+instance
+  ( Monad m
+  , MkStream m S is
+  ) => MkStream m S (is:.TreeIxR p v a I) where
+  mkStream S (vs:._) (lus:.TreeIxR frst u ut) (is:.TreeIxR _ k kt)
+    = map (\(ElmS zi) -> ElmS $ zi :.: RiTirI k kt)
+    . staticCheck (k>=0 && k<=u)
+    $ mkStream S vs lus is
+  {-# INLINE mkStream #-}
+
+
+
+-- * Outside instances
+
+-- | Outside running index structure requires two local index structures.
+-- One is for the inside symbols, one for the outside symbol.
+
+data instance RunningIndex (TreeIxR p v a O) = RiTirO !Int !TF !Int !TF -- I, I, O, O
+
+-- | Outside works in the opposite direction.
+--
+-- TODO check if the original @Up@ / @Down@ combination is ok.
+
+instance IndexStream z => IndexStream (z:.TreeIxR p v a O) where
+  streamUp   (ls:.TreeIxR p lf _) (hs:.TreeIxR _ ht _) = flatten (streamDownMk lf ht) (streamDownStep p lf ht) $ streamUp ls hs
+  streamDown (ls:.TreeIxR p lf _) (hs:.TreeIxR _ ht _) = flatten (streamUpMk   lf ht) (streamUpStep   p lf ht) $ streamDown ls hs
+  {-# Inline streamUp #-}
+  {-# Inline streamDown #-}
+
+instance RuleContext (TreeIxR p v a O) where
+  type Context (TreeIxR p v a O) = OutsideContext ()
+  initialContext _ = OStatic ()
+  {-# Inline initialContext #-}
+
+
+
+
+
+
+
+-- Invisible starting symbol
+
+instance (Monad m) => MkStream m S (TreeIxR p v a O) where
+  mkStream S _ (TreeIxR frst u ut) (TreeIxR _ k kt)
+    = staticCheck (k>=0 && k<=u) . singleton . ElmS $ RiTirO k kt k kt
+  {-# Inline mkStream #-}
+
+instance
+  ( Monad m
+  , MkStream m S is
+  ) => MkStream m S (is:.TreeIxR p v a O) where
+  mkStream S (vs:._) (lus:.TreeIxR frst u ut) (is:.TreeIxR _ k kt)
+    = map (\(ElmS zi) -> ElmS $ zi :.: RiTirO k kt k kt)
+    . staticCheck (k>=0 && k<=u)
+    $ mkStream S vs lus is
+  {-# INLINE mkStream #-}
+
+
+
+
+-- * Complemented instances
+
+-- | Outside running index structure requires two local index structures.
+-- One is for the inside symbols, one for the outside symbol.
+
+data instance RunningIndex (TreeIxR p v a C) = RiTirC !Int !TF
+
+-- | Outside works in the opposite direction.
+--
+-- TODO check if the original @Up@ / @Down@ combination is ok.
+
+instance IndexStream z => IndexStream (z:.TreeIxR p v a C) where
+  streamUp   (ls:.TreeIxR p lf _) (hs:.TreeIxR _ ht _) = flatten (streamUpMk   lf ht) (streamUpStep   p lf ht) $ streamUp ls hs
+  streamDown (ls:.TreeIxR p lf _) (hs:.TreeIxR _ ht _) = flatten (streamDownMk lf ht) (streamDownStep p lf ht) $ streamDown ls hs
+  {-# Inline streamUp #-}
+  {-# Inline streamDown #-}
+
+instance RuleContext (TreeIxR p v a C) where
+  type Context (TreeIxR p v a C) = ComplementContext
+  initialContext _ = Complemented
+  {-# Inline initialContext #-}
+
+
+
+-- Invisible starting symbol
+
+instance (Monad m) => MkStream m S (TreeIxR p v a C) where
+  mkStream S _ (TreeIxR frst u ut) (TreeIxR _ k kt)
+    = staticCheck (k>=0 && k<=u) . singleton . ElmS $ RiTirC k kt
+  {-# Inline mkStream #-}
+
+instance
+  ( Monad m
+  , MkStream m S is
+  ) => MkStream m S (is:.TreeIxR p v a C) where
+  mkStream S (vs:._) (lus:.TreeIxR frst u ut) (is:.TreeIxR _ k kt)
+    = map (\(ElmS zi) -> ElmS $ zi :.: RiTirC k kt)
+    . staticCheck (k>=0 && k<=u)
+    $ mkStream S vs lus is
+  {-# INLINE mkStream #-}
+
+
+
diff --git a/ADP/Fusion/Core/ForestEdit/LeftLinear.hs b/ADP/Fusion/Core/ForestEdit/LeftLinear.hs
new file mode 100644
--- /dev/null
+++ b/ADP/Fusion/Core/ForestEdit/LeftLinear.hs
@@ -0,0 +1,243 @@
+
+module ADP.Fusion.Core.ForestEdit.LeftLinear where
+
+import           Data.Either (either)
+import           Data.Graph.Inductive.Basic
+import           Data.Strict.Tuple hiding (fst, snd)
+import           Data.Traversable (mapAccumL)
+import           Data.Vector.Fusion.Stream.Monadic hiding (flatten)
+import           Debug.Trace
+import           Prelude hiding (map)
+import qualified Data.Forest.Static as F
+import qualified Data.Tree as T
+import qualified Data.Vector as V
+import qualified Data.Vector.Fusion.Stream.Monadic as SM
+import qualified Data.Vector.Generic as VG
+import qualified Data.Vector.Unboxed as VU
+
+import           ADP.Fusion.Core
+import           Data.Forest.Static
+import           Data.PrimitiveArray hiding (map)
+import           Math.TriangularNumbers
+
+import           ADP.Fusion.Term.Node.Type
+
+
+
+-- | Index for editing purposes into a post-order tree structure
+--
+-- @
+--      6
+--    /   \
+--   2     5
+--  / \   / \
+-- 0  1  3   4
+-- @
+--
+-- Cf the tree rooted at @5@. Its bounded by @[3,6)@
+--
+-- The index @[0,7]@ includes the lower bound, but excludes the bound.
+-- Hence, this is the tree from the leaf @0@ to the local root @6@. It
+-- implicitly goes down to the leaf @4@ as well.
+--
+-- The index @[0.6]@ on the other hand describes a forest. This forest
+-- contains two full local trees, rooted at @2@ and @5@ respectively.
+--
+-- We index the left-most lower-most leaf, and the right-most, top-most
+-- root (actually the index is the first excluded element, hence @[0,6)@
+-- instead of @[0,5]@.
+--
+-- TODO need to fix @p ~ PostOrder@
+
+data TreeIxL p v a t
+  = TreeIxL
+      !(Forest p v a)   -- ^ the actual forest we operate on
+      !(VU.Vector Int)  -- ^ given a node, gives the index of the left-most leaf of the node
+      !Int              -- ^ left-most, lower-most index
+      !Int              -- ^ right-most, top-most index
+
+instance Show (TreeIxL p v a t) where
+  show (TreeIxL _ _ i j) = show (i,j)
+
+minIx, maxIx :: Forest p v a -> TreeIxL p v a t
+minIx f = TreeIxL f (leftMostLeaves f) 0 (VU.length (parent f))
+
+maxIx f = TreeIxL f (leftMostLeaves f) 0 (VU.length (parent f))
+{-# Inline minIx #-}
+{-# Inline maxIx #-}
+
+instance Index (TreeIxL p v a t) where
+  -- | trees @T@ are stored in the first line, i.e. @+0@, forests @F@ (with
+  -- @j==u@ are stored in the second line, i.e. @+u+1@ to each index.
+  linearIndex _ (TreeIxL _ _ l u) (TreeIxL _ _ i j)
+    = linearIndex (subword 0 0) (subword l u) (subword i j)
+  {-# Inline linearIndex #-}
+  smallestLinearIndex _ = error "still needed?"
+  {-# Inline smallestLinearIndex #-}
+  largestLinearIndex (TreeIxL _ _ _ u) = (triangularNumber $ u-0+1) - 1
+  {-# Inline largestLinearIndex #-}
+  size _ (TreeIxL _ _ _ u) = triangularNumber $ u-0+1
+  {-# Inline size #-}
+  inBounds _ (TreeIxL _ _ _ u) (TreeIxL _ _ i j) = 0 <= i && i <= j && j <= u
+  {-# Inline inBounds #-}
+
+streamUpMk l h z = return (z,0,0)  -- start with size 0 and smallest element 0
+{-# Inline [0] streamUpMk #-}
+
+-- 0,0 1,1 2,2 ...
+-- 0,1 1,2 2,3 ...
+-- 0,2 1,3 2,4 ...
+
+streamUpStep p c lf ht (z,s,i)  -- s=size, i=left border
+  | s > VG.length c     = return $ SM.Done
+  | i + s > VG.length c = return $ SM.Skip (z,s+1,0)
+  | otherwise = return $ SM.Yield (z:.TreeIxL p c i (i+s)) (z,s,i+1)
+{-# Inline [0] streamUpStep #-}
+
+streamDownMk lf ht z = return (z,ht,0)
+{-# Inline [0] streamDownMk #-}
+
+streamDownStep p c lf ht (z,s,i)
+  | s < 0     = return $ SM.Done
+  | i < 0     = return $ SM.Skip (z,s-1,ht-(s-1))
+  | otherwise = return $ SM.Yield (z:.TreeIxL p c i (i+s)) (z,s,i-1)
+{-# Inline [0] streamDownStep #-}
+
+instance IndexStream (Z:.TreeIxL p v a t) => IndexStream (TreeIxL p v a t)
+
+
+
+-- * Inside
+
+
+
+data instance RunningIndex (TreeIxL p v a I) = RiTilI !Int !Int
+
+instance IndexStream z => IndexStream (z:.TreeIxL p v a I) where
+  streamUp   (ls:.TreeIxL p c lf _) (hs:.TreeIxL _ _ _ ht) = flatten (streamUpMk lf  ht) (streamUpStep  p c lf ht) $ streamUp ls hs
+  streamDown (ls:.TreeIxL p c lf _) (hs:.TreeIxL _ _ _ ht) = flatten (streamDownMk lf ht) (streamDownStep p c lf ht) $ streamDown ls hs
+  {-# Inline streamUp #-}
+  {-# Inline streamDown #-}
+
+instance RuleContext (TreeIxL p v a I) where
+  type Context (TreeIxL p v a I) = InsideContext ()
+  initialContext _ = IStatic ()
+  {-# Inline initialContext #-}
+
+
+
+-- Invisible starting symbol
+
+instance (Monad m) => MkStream m S (TreeIxL p v a I) where
+  mkStream S (IStatic ()) (TreeIxL frst _ l u) (TreeIxL _ _ i j)
+    = staticCheck (i>=0 && i==j && j<=u) . singleton . ElmS $ RiTilI i i
+  mkStream S (IVariable ()) (TreeIxL frst _ l u) (TreeIxL _ _ i j)
+    = staticCheck (i>=0 && i<=j && j<=u) . singleton . ElmS $ RiTilI i i
+  {-# Inline mkStream #-}
+
+
+instance
+  ( Monad m
+  , MkStream m S is
+  ) => MkStream m S (is:.TreeIxL p v a I) where
+  mkStream S (vs:.IStatic()) (lus:.TreeIxL frst _ l u) (is:.TreeIxL _ _ i j)
+    = map (\(ElmS zi) -> ElmS $ zi :.: RiTilI i i)
+    . staticCheck (i>=0 && i==j && j<=u)
+    $ mkStream S vs lus is
+  mkStream S (vs:.IVariable()) (lus:.TreeIxL frst _ l u) (is:.TreeIxL _ _ i j)
+    = map (\(ElmS zi) -> ElmS $ zi :.: RiTilI i i)
+    . staticCheck (i>=0 && i<=j && j<=u)
+    $ mkStream S vs lus is
+  {-# INLINE mkStream #-}
+
+
+
+-- * Outside
+
+
+
+-- | Running index structure for outside tree-edit algorithms. We
+-- explicitly name the indices, to be more sure inside and outside
+-- are correctly assigned to.
+
+data instance RunningIndex (TreeIxL p v a O) = RiTilO { iLeft, iRight, oLeft, oRight :: !Int }
+
+instance IndexStream z => IndexStream (z:.TreeIxL Post v a O) where
+  streamUp   (ls:.TreeIxL p c lf _) (hs:.TreeIxL _ _ _ ht) = flatten (streamDownMk lf ht) (streamDownStep p c lf ht) $ streamUp ls hs
+  streamDown (ls:.TreeIxL p c lf _) (hs:.TreeIxL _ _ _ ht) = flatten (streamUpMk   lf ht) (streamUpStep   p c lf ht) $ streamDown ls hs
+  {-# Inline streamUp #-}
+  {-# Inline streamDown #-}
+
+instance RuleContext (TreeIxL Post v a O) where
+  type Context (TreeIxL Post v a O) = OutsideContext ()
+  initialContext _ = OStatic ()
+  {-# Inline initialContext #-}
+
+instance (Monad m) => MkStream m S (TreeIxL Post v a O) where
+  mkStream S (OStatic ()) (TreeIxL frst _ l u) (TreeIxL _ _ i j)
+    = staticCheck (i==0 && j==u) . singleton . ElmS $ RiTilO i j i j
+  mkStream S (ORightOf ()) (TreeIxL frst _ l u) (TreeIxL _ _ i j)
+    = error $ "mkStream S / ORightOf should not be happening!"
+  mkStream S (OFirstLeft ()) (TreeIxL frst _ l u) (TreeIxL _ _ i j)
+    = staticCheck True . singleton . ElmS $ RiTilO i i i j -- TODO ???
+  mkStream S (OLeftOf ()) (TreeIxL frst _ l u) (TreeIxL _ _ i j)
+    = staticCheck True . singleton . ElmS $ RiTilO 0 i 0 j
+  {-# Inline mkStream #-}
+
+instance
+  ( Monad m
+  , MkStream m S is
+  ) => MkStream m S (is:.TreeIxL Post v a O) where
+  mkStream S (vs:.OStatic ()) (us:.TreeIxL frst _ l u) (is:.TreeIxL _ _ i j)
+    = map (\(ElmS zi) -> ElmS $ zi:.:RiTilO i j i j)
+    . staticCheck (i==0 && j==u)
+    $ mkStream S vs us is
+  mkStream S (vs:.ORightOf ()) (us:.TreeIxL frst _ l u) (is:.TreeIxL _ _ i j)
+    = error $ "mkStream S / ORightOf should not be happening!"
+  mkStream S (vs:.OFirstLeft ()) (us:.TreeIxL frst _ l u) (is:.TreeIxL _ _ i j)
+    = map (\(ElmS zi) -> ElmS $ zi:.:RiTilO i i i j)
+    . staticCheck True
+    $ mkStream S vs us is
+  mkStream S (vs:.OLeftOf ()) (us:.TreeIxL frst _ l u) (is:.TreeIxL _ _ i j)
+    = map (\(ElmS zi) -> ElmS $ zi:.:RiTilO 0 i 0 j)
+    . staticCheck True
+    $ mkStream S vs us is
+  {-# Inline mkStream #-}
+
+
+
+-- * Complement
+
+data instance RunningIndex (TreeIxL p v a C) = RiTilC !Int !Int
+
+instance IndexStream z => IndexStream (z:.TreeIxL p v a C) where
+  streamUp   (ls:.TreeIxL p c lf _) (hs:.TreeIxL _ _ _ ht) = flatten (streamUpMk lf  ht) (streamUpStep  p c lf ht) $ streamUp ls hs
+  streamDown (ls:.TreeIxL p c lf _) (hs:.TreeIxL _ _ _ ht) = flatten (streamDownMk lf ht) (streamDownStep p c lf ht) $ streamDown ls hs
+  {-# Inline streamUp #-}
+  {-# Inline streamDown #-}
+
+instance RuleContext (TreeIxL p v a C) where
+  type Context (TreeIxL p v a C) = ComplementContext
+  initialContext _ = Complemented
+  {-# Inline initialContext #-}
+
+
+
+-- Invisible starting symbol
+
+instance (Monad m) => MkStream m S (TreeIxL p v a C) where
+  mkStream S Complemented (TreeIxL frst _ l u) (TreeIxL _ _ i j)
+    = staticCheck (i>=0 && i==j && j<=u) . singleton . ElmS $ RiTilC i j
+  {-# Inline mkStream #-}
+
+
+instance
+  ( Monad m
+  , MkStream m S is
+  ) => MkStream m S (is:.TreeIxL p v a C) where
+  mkStream S (vs:.Complemented) (lus:.TreeIxL frst _ l u) (is:.TreeIxL _ _ i j)
+    = map (\(ElmS zi) -> ElmS $ zi :.: RiTilC i j)
+    . staticCheck (i>=0 && i==j && j<=u)
+    $ mkStream S vs lus is
+  {-# INLINE mkStream #-}
+
diff --git a/ADP/Fusion/Forest/Align/PRL.hs b/ADP/Fusion/Forest/Align/PRL.hs
new file mode 100644
--- /dev/null
+++ b/ADP/Fusion/Forest/Align/PRL.hs
@@ -0,0 +1,13 @@
+
+module ADP.Fusion.Forest.Align.PRL
+  ( module ADP.Fusion.Core
+  , module ADP.Fusion.Core.ForestAlign.PermuteRightLinear
+  , module ADP.Fusion.Term.Node.ForestAlign.RightLinear
+  , module ADP.Fusion.Term.Node.Type
+  ) where
+
+import ADP.Fusion.Core
+import ADP.Fusion.Core.ForestAlign.PermuteRightLinear
+import ADP.Fusion.Term.Node.ForestAlign.RightLinear
+import ADP.Fusion.Term.Node.Type
+
diff --git a/ADP/Fusion/Forest/Align/RL.hs b/ADP/Fusion/Forest/Align/RL.hs
new file mode 100644
--- /dev/null
+++ b/ADP/Fusion/Forest/Align/RL.hs
@@ -0,0 +1,19 @@
+
+module ADP.Fusion.Forest.Align.RL
+  ( module ADP.Fusion.Core
+  , module ADP.Fusion.Core.ForestAlign.RightLinear
+  , module ADP.Fusion.SynVar.Indices.ForestAlign.RightLinear
+  , module ADP.Fusion.Term.Deletion.ForestAlign.RightLinear
+  , module ADP.Fusion.Term.Epsilon.ForestAlign.RightLinear
+  , module ADP.Fusion.Term.Node.ForestAlign.RightLinear
+  , module ADP.Fusion.Term.Node.Type
+  ) where
+
+import ADP.Fusion.Core
+import ADP.Fusion.Core.ForestAlign.RightLinear
+import ADP.Fusion.SynVar.Indices.ForestAlign.RightLinear
+import ADP.Fusion.Term.Deletion.ForestAlign.RightLinear
+import ADP.Fusion.Term.Epsilon.ForestAlign.RightLinear
+import ADP.Fusion.Term.Node.ForestAlign.RightLinear
+import ADP.Fusion.Term.Node.Type
+
diff --git a/ADP/Fusion/Forest/Edit/LL.hs b/ADP/Fusion/Forest/Edit/LL.hs
new file mode 100644
--- /dev/null
+++ b/ADP/Fusion/Forest/Edit/LL.hs
@@ -0,0 +1,19 @@
+
+module ADP.Fusion.Forest.Edit.LL
+  ( module ADP.Fusion.Core
+  , module ADP.Fusion.Core.ForestEdit.LeftLinear
+  , module ADP.Fusion.SynVar.Indices.ForestEdit.LeftLinear
+  , module ADP.Fusion.Term.Deletion.ForestEdit.LeftLinear
+  , module ADP.Fusion.Term.Epsilon.ForestEdit.LeftLinear
+  , module ADP.Fusion.Term.Node.ForestEdit.LeftLinear
+  , module ADP.Fusion.Term.Node.Type
+  ) where
+
+import ADP.Fusion.Core
+import ADP.Fusion.Core.ForestEdit.LeftLinear
+import ADP.Fusion.SynVar.Indices.ForestEdit.LeftLinear
+import ADP.Fusion.Term.Deletion.ForestEdit.LeftLinear
+import ADP.Fusion.Term.Epsilon.ForestEdit.LeftLinear
+import ADP.Fusion.Term.Node.ForestEdit.LeftLinear
+import ADP.Fusion.Term.Node.Type
+
diff --git a/ADP/Fusion/SynVar/Indices/ForestAlign/RightLinear.hs b/ADP/Fusion/SynVar/Indices/ForestAlign/RightLinear.hs
new file mode 100644
--- /dev/null
+++ b/ADP/Fusion/SynVar/Indices/ForestAlign/RightLinear.hs
@@ -0,0 +1,515 @@
+
+-- |
+--
+-- TODO finding major simplifications here would be very useful
+
+module ADP.Fusion.SynVar.Indices.ForestAlign.RightLinear where
+
+import           Data.Vector.Fusion.Stream.Monadic hiding (flatten)
+import           Debug.Trace
+import           Prelude hiding (map)
+import qualified Data.Forest.Static as F
+import qualified Data.Vector.Generic as VG
+
+import           ADP.Fusion.Core
+import           Data.Forest.Static
+import           Data.PrimitiveArray hiding (map)
+
+import           ADP.Fusion.Core.ForestAlign.RightLinear
+
+
+
+-- * Inside
+
+
+
+-- | When choosing tree and forest sizes:
+--
+-- Syntactic variables. Different variants on parsing.
+--
+-- In case we have @X -> Y@, no restrictions are placed.
+--
+-- We now need @X -> Y Z@:
+--
+-- @
+--
+-- X    ->  Y     Z
+-- i,E      i,E   i,E
+--
+--
+--
+-- X    ->  Y     Z       we do not split off the first tree
+-- i,F      i,E   i,F
+--
+-- X    ->  Y     Z
+-- i,F      i,T   k,F     k,E, if k==u ; 1st tree split off
+--          i_k
+--
+-- X    ->  Y     Z       move complete forest down
+-- i,F      i,F   u,E
+--
+--
+--
+-- When does this happen? If you have @T -> - F@ then @F@ will now actually
+-- be such a @T@.
+--
+-- X    ->  Y     Z       do not hand i,T down
+-- i,T      i,E   i,T
+--
+-- X    ->  Y     Z       further hand down
+-- i,T      i,T   k,E
+--          i_k
+--
+-- @
+
+data TFsize s
+  -- The tree shall have size epsilon, the forest be full. If @TF@ is @F@
+  -- then the forest is a real forest, if @TF@ is @T@ then the forest is
+  -- a tree.
+  = EpsFull TF s
+  -- | The tree is full (and actually a forest), the remainder of the
+  -- forest is epsilon. This means that in the "tree" synvar, we can only
+  -- do indels.
+  | FullEpsFF s
+  -- | The tree is set, the remaining forest gets what is left.
+  | OneRemFT s
+  -- | The tree is set, the remaining forest is empty.
+  | OneEpsTT s
+  | Finis
+
+
+
+instance
+  ( IndexHdr s x0 i0 us (TreeIxR p v a I) cs c is (TreeIxR p v a I)
+  , MinSize c
+--  , Show a, VG.Vector v a -- TEMP!
+--  , a ~ Info
+  ) => AddIndexDense s (us:.TreeIxR p v a I) (cs:.c) (is:.TreeIxR p v a I) where
+  addIndexDenseGo (cs:._) (vs:.IStatic ()) (lbs:._) (ubs:._) (us:.TreeIxR frst u v) (is:.TreeIxR _ j _)
+    = map go . addIndexDenseGo cs vs lbs ubs us is
+    where
+      go (SvS s tt ii) =
+        let RiTirI l tf = getIndex (getIdx s) (Proxy :: PRI is (TreeIxR p v a I))
+            tf'         = if l==u then E else tf
+        in -- tSI (glb) ('S',u,l,tf,'.',distance $ F.label frst VG.! 0) $
+            SvS s (tt:.TreeIxR frst l tf') (ii:.:RiTirI u E)
+  addIndexDenseGo (cs:._) (vs:.IVariable ()) (lbs:._) (ubs:._) (us:.TreeIxR frst u v) (is:.TreeIxR _ j jj)
+    = flatten mk step . addIndexDenseGo cs vs lbs ubs us is
+    where mk svS = return $ EpsFull jj svS
+          step Finis = return $ Done
+          -- nothing here
+          step (EpsFull E svS@(SvS s tt ii)) = return $ Yield (SvS s (tt:.TreeIxR frst j E) (ii:.:RiTirI j E)) Finis
+          -- _ -> TF , for forests: with T having size ε, F having full size
+          step (EpsFull F svS@(SvS s tt ii))
+            = do let RiTirI k tf = getIndex (getIdx s) (Proxy :: PRI is (TreeIxR p v a I))
+                 --tSI (glb) ('V',u,k,F,'.',distance $ F.label frst VG.! 0) .
+                 return $ Yield (SvS s (tt:.TreeIxR frst k E) (ii:.:RiTirI k F)) (FullEpsFF svS)  -- @k Epsilon / full@
+          -- _ -> TF, for forests: with T having full size, F having size ε
+          step (FullEpsFF svS@(SvS s tt ii))
+            = do let RiTirI k tf = getIndex (getIdx s) (Proxy :: PRI is (TreeIxR p v a I))
+                 --tSI (glb) ('W',u,k,T,'.',distance $ F.label frst VG.! 0) .
+                 return $ Yield (SvS s (tt:.TreeIxR frst k F) (ii:.:RiTirI u E)) (OneRemFT svS)   -- @full / u Epsilon@
+          -- _ -> TF for forests: with T having size 1, F having full - 1 size
+          step (OneRemFT (SvS s tt ii))
+            = do let RiTirI k tf = getIndex (getIdx s) (Proxy :: PRI is (TreeIxR p v a I))
+                     l         = rbdef u frst k
+                     ltf       = if l==u then E else F
+                 --tSI (glb) ('W',u,k,l,T,'.',distance $ F.label frst VG.! 0) .
+                 return $ Yield (SvS s (tt:.TreeIxR frst k T) (ii:.:RiTirI l ltf)) Finis -- @1 / l ltf@
+          -- _ -> TF , for trees: with T having size ε, F having size 1 (or T)
+          step (EpsFull T svS@(SvS s tt ii))
+            = do let RiTirI k tf = getIndex (getIdx s) (Proxy :: PRI is (TreeIxR p v a I))
+                 --tSI (glb) ('V',u,k,F,'.',distance $ F.label frst VG.! 0) .
+                 return $ Yield (SvS s (tt:.TreeIxR frst k E) (ii:.:RiTirI k T)) (OneEpsTT svS)
+          -- _ -> TF, for trees: with T having size 1, F having size ε
+          step (OneEpsTT (SvS s tt ii))
+            = do let RiTirI k tf = getIndex (getIdx s) (Proxy :: PRI is (TreeIxR p v a I))
+                     l         = rbdef u frst k
+                 --tSI (glb) ('W',u,k,l,T,'.',distance $ F.label frst VG.! 0) .
+                 return $ Yield (SvS s (tt:.TreeIxR frst k T) (ii:.:RiTirI l E)) Finis
+          {-# Inline [0] mk #-}
+          {-# Inline [0] step #-}
+  {-# Inline addIndexDenseGo #-}
+
+glb = False
+
+tSI cond s i = if cond then traceShow s i else i
+
+instance (MinSize c) => TableStaticVar u c (TreeIxR p v a I) where 
+  tableStaticVar _ _ _ _ = IVariable ()
+  tableStreamIndex _ c _ = id
+  {-# Inline [0] tableStaticVar #-}
+  {-# Inline [0] tableStreamIndex #-}
+
+getrbound frst k
+  | VG.length rs >= k = VG.length rs
+  | r < 0             = VG.length rs
+  | otherwise         = r
+  where rs = rsib frst ; r = rs VG.! k
+{-# Inline getrbound #-}
+
+trright frst k = rbdef (VG.length $ rsib frst) frst k
+
+-- | The next right sibling.
+
+rbdef d frst k = maybe d (\z -> if z<0 then d else z) $ rsib frst VG.!? k
+{-# Inline rbdef #-}
+
+-- | Give us the parent for node @k@ or @-1@ if there is no parent
+
+pardef frst k = maybe (-1) id $ parent frst VG.!? k
+{-# Inline pardef #-}
+
+
+
+-- * Outside
+--
+-- For both, I / O and O / O systems, we need to consider a large number of
+-- cases. The general rule @X -> Y Z@ with all variants follows below.
+--
+--
+-- @
+--
+-- X    ->  Y     Z
+-- i,E      i,E   i,E
+--
+-- Y^   ->  X^    Z
+-- i,E      i,E   i,E
+--
+-- Z^   ->  Y     X^
+-- i,E      i,E   i,E
+--
+--
+--
+-- X    ->  Y     Z       we do not split off the first tree; down is empty
+-- i,F      i,E   i,F
+--
+-- Y^   ->  X^    Z
+-- i,E      i,F   i,F
+--
+-- Z^   ->  Y     X^
+-- i,F      i,E   i,F
+--
+--
+-- X    ->  Y     Z
+-- i,F      i,T   k,t     if k==u then E else F ; 1st tree split off
+--          i~k
+--
+-- Y^   ->  X^    Z
+-- i,T      i,F   k,t     if k==u then E else F
+-- i~k
+--
+-- Z^   ->  Y     X^
+-- u,E      i,T   i,F     ∀ i ;; for all trees [i,u) !
+--          i~u
+--
+-- Z^   ->  Y     X^
+-- k,F      i,T   i,F     i is left sibling of k
+--          i~k
+--
+--
+-- X    ->  Y     Z       move complete forest down
+-- i,F      i,F   u,E
+--
+-- Y^   ->  X^    Z
+-- i,F      i,F   u,E
+--
+-- Z^   ->  Y     X^      ∀ i ;; for u,E collect all possible splits.
+-- u,E      i,F   i,F
+--
+--
+--
+-- X    ->  Y     Z       do not hand i,T down
+-- i,T      i,E   i,T
+--
+-- Y^   ->  X^    Z
+-- i,E      i,T   i,T
+--
+-- Z^   ->  Y     X^
+-- i,T      i,E   i,T
+--
+--
+--
+-- X    ->  Y     Z       further hand down
+-- i,T      i,T   k,E
+--          i_k
+--
+-- Y^   ->  X^    Z
+-- i,T      i,T   k,E
+-- i_k
+--
+-- Z^   ->  Y     X^
+-- k,E      i,T   i,T
+--          i_k
+--
+--
+-- @
+
+
+
+-- |
+--
+-- (where does this block of comments belong?)
+--
+-- In principle, we are missing an extra boolean case on @j==u@ or @j==l,
+-- l/=u@ for tree-symbols, i.e. those that bind terminals. However, in
+-- these linear languages, there can be only one such symbol per rule. This
+-- in turn means they are never in outside mode on the r.h.s. and hence we
+-- have no ambiguity problems.
+--
+-- synVar: @Table I@ with @Index O@ We only have two options: @X' -> Y'
+-- Z@ with @Z@ being in @OStatic@ position or @X' -> Y Z'@ with @Y@ being
+-- in @OFirstLeft@ position.
+--
+-- @
+--
+-- Z^   ->  Y     X^      ∀ i ;; for u,E collect all possible splits.
+-- u,E      i,F   i,F     this is move complete forest down / inside
+--
+-- Z^   ->  Y     X^      further hand down
+-- k,E      i,T   i,T
+--          i_k
+--
+-- Z^   ->  Y     X^
+-- u,E      i,T   i,F     ∀ i ;; for all trees [i,u) !
+--          i~u
+--
+-- Z^   ->  Y     X^
+-- i,E      i,E   i,E
+--
+--
+--
+-- Z^   ->  Y     X^       we do not split off the first tree; down is empty
+-- i,F      i,E   i,F
+--
+-- Z^   ->  Y     X^
+-- k,F      i,T   i,F     ∀ i ;; for all trees [i,k) k/=u !
+--          i~k
+--
+--
+--
+-- Z^   ->  Y     X^      do not hand i,T down
+-- i,T      i,E   i,T
+--
+-- @
+
+data OIEFT x
+  = OIEFF x Int -- svS , forests starting at @i@
+  | OIETT x Int -- svS , parent index for trees with right boundary @j@
+  | OIETF x Int -- svS , parent index for trees with right boundary @u@
+  | OIEEE x     -- svS
+  | OIFEF x     -- svS
+  | OIFTF x     -- svS
+  | OITET x     -- svS
+  | OIFinis
+
+
+
+instance
+  ( IndexHdr s x0 i0 us (TreeIxR p v a I) cs c is (TreeIxR p v a O)
+  , MinSize c
+  ) => AddIndexDense s (us:.TreeIxR p v a I) (cs:.c) (is:.TreeIxR p v a O) where
+  addIndexDenseGo (cs:._) (vs:.OStatic ()) (lbs:._) (ubs:._) (us:.TreeIxR frst u v) (is:.TreeIxR _ j jj)
+    = map go .addIndexDenseGo cs vs lbs ubs us is
+    where go (SvS s tt ii) =
+            let RiTirO li tfi lo tfo = getIndex (getIdx s) (Proxy :: PRI is (TreeIxR p v a O))
+            in  SvS s (tt:.TreeIxR frst li tfi) (ii:.:RiTirO j E lo tfo) -- TODO should set right boundary
+  addIndexDenseGo (cs:._) (vs:.OFirstLeft ()) (lbs:._) (ubs:._) (us:.TreeIxR frst u v) (is:.TreeIxR _ j jj)
+    = flatten mk step . addIndexDenseGo cs vs lbs ubs us is
+    where mk svS@(SvS s tt ii) =
+            let RiTirO li tfi lo tfo = getIndex (getIdx s) (Proxy :: PRI is (TreeIxR p v a O))
+            in  return $ case jj of
+                  E -> OIEFF svS 0
+                  F -> OIFEF svS
+                  T -> OITET svS
+          step OIFinis = return Done
+          -- Z^   ->  Y     X^      ∀ i ;; for u,E collect all possible splits.
+          -- u,E      i,F   i,F     this is move complete forest down / inside
+          step (OIEFF svS@(SvS s tt ii) k) | j==u && k<u
+            = return $ Yield (SvS s (tt:.TreeIxR frst k F) (ii:.:RiTirO u E k F)) (OIEFF svS (k+1))
+          step (OIEFF svS _)
+            = let pj = maybe (-1) id $ F.lsib frst VG.!? j
+              in  return $ Skip $ OIETT svS pj
+          -- Z^   ->  Y     X^      further hand down
+          -- k,E      i,T   i,T
+          --          i_k
+          step (OIETT svS@(SvS s tt ii) pj) | j<u && pj>=0
+            = let pj' = pardef frst pj
+                  tr  = if j==u then E else F
+              in  return $ Yield (SvS s (tt:.TreeIxR frst pj T) (ii:.:RiTirO j tr pj T)) (OIETT svS pj')
+          step (OIETT svS _)
+            = let pu = pardef frst $ u - 1
+              in  return $ Skip $ OIETF svS pu
+          -- Z^   ->  Y     X^
+          -- u,E      i,T   i,F     ∀ i ;; for all trees [i,u) !
+          --          i~u
+          step (OIETF svS@(SvS s tt ii) pu) | j==u && pu>=0
+            = let pu' = pardef frst pu
+              in  return $ Yield (SvS s (tt:.TreeIxR frst pu T) (ii:.:RiTirO u E pu F)) (OIETF svS pu')
+          step (OIETF svS _)
+            = return $ Skip $ OIEEE svS
+          -- Z^   ->  Y     X^
+          -- i,E      i,E   i,E
+          step (OIEEE svS@(SvS s tt ii))
+            = return $ Yield (SvS s (tt:.TreeIxR frst j E) (ii:.:RiTirO j E j E)) OIFinis
+          -- Z^   ->  Y     X^       we do not split off the first tree; down is empty
+          -- i,F      i,E   i,F
+          step (OIFEF svS@(SvS s tt ii))
+            = return $ Yield (SvS s (tt:.TreeIxR frst j E) (ii:.:RiTirO j E j F)) (OIFTF svS)
+          -- Z^   ->  Y     X^
+          -- k,F      i,T   i,F     i is left sibling of k
+          --          i~k
+          step (OIFTF svS@(SvS s tt ii)) | Just ls <- F.lsib frst VG.!? j, ls >= 0
+            = return $ Yield (SvS s (tt:.TreeIxR frst ls T) (ii:.:RiTirO j F ls F)) OIFinis
+          step (OIFTF _) = return $ Skip $ OIFinis
+          -- Z^   ->  Y     X^      do not hand i,T down
+          -- i,T      i,E   i,T
+          step (OITET svS@(SvS s tt ii))
+            = return $ Yield (SvS s (tt:.TreeIxR frst j E) (ii:.:RiTirO j E j T)) OIFinis
+          {-# Inline [0] mk #-}
+          {-# Inline [0] step #-}
+  {-# Inline addIndexDenseGo #-}
+
+
+
+-- | The different cases for @O@ context with @O@ tables.
+--
+-- synVar: @Table O@   with @Index O@
+--
+-- @
+--
+-- Y^   ->  X^    Z
+-- i,E      i,E   i,E
+--
+-- Y^   ->  X^    Z       we do not split off the first tree; down is empty
+-- i,E      i,F   i,F
+--
+-- Y^   ->  X^    Z       do not hand i,T down
+-- i,E      i,T   i,T
+--
+--
+--
+-- Y^   ->  X^    Z
+-- i,T      i,F   k,t     if k==u then E else F ; 1st tree split off
+-- i_k
+--
+-- Y^   ->  X^    Z       further hand down ; k,E because @T@
+-- i,T      i,T   k,E
+-- i_k
+--
+--
+--
+-- Y^   ->  X^    Z       move complete forest down
+-- i,F      i,F   u,E
+--
+-- @
+
+data OOEFT x -- = OOE TF x | OOF x | OOT TF x | OOFinis
+  = OOE x TF  -- svS , all variants of T F E
+  | OOFFE x   -- svS
+  | OOTF  x   -- svS
+  | OOTT  x   -- svS
+  | OOFinis
+
+
+
+instance
+  ( IndexHdr s x0 i0 us (TreeIxR p v a O) cs c is (TreeIxR p v a O)
+  , MinSize c
+  ) => AddIndexDense s (us:.TreeIxR p v a O) (cs:.c) (is:.TreeIxR p v a O) where
+  addIndexDenseGo (cs:._) (vs:.OStatic ()) (lbs:._) (ubs:._) (us:.TreeIxR frst u v) (is:.TreeIxR _ j _)
+    = map go .addIndexDenseGo cs vs lbs ubs us is
+    where go (SvS s tt ii) =
+            let RiTirO li tfi lo tfo = getIndex (getIdx s) (Proxy :: PRI is (TreeIxR p v a O))
+            in  SvS s (tt:.TreeIxR frst lo tfo) (ii:.:RiTirO li tfi j E) -- TODO should set right boundary
+  addIndexDenseGo (cs:._) (vs:.ORightOf ()) (lbs:._) (ubs:._) (us:.TreeIxR frst u v) (is:.TreeIxR _ j jj)
+    = flatten mk step . addIndexDenseGo cs vs lbs ubs us is
+    where mk svS = return $ case jj of
+                    E -> OOE   svS minBound
+                    F -> OOFFE svS
+                    T -> OOTF  svS
+          -- done
+          step OOFinis = return Done
+          -- Y^   ->  X^    Z
+          -- i,E      i,E   i,E
+          --
+          -- Y^   ->  X^    Z       we do not split off the first tree; down is empty
+          -- i,E      i,F   i,F
+          --
+          -- Y^   ->  X^    Z       do not hand i,T down
+          -- i,E      i,T   i,T
+          step (OOE svS@(SvS s tt ii) tf) | tf < maxBound
+            = return $ Yield (SvS s (tt:.TreeIxR frst j tf) (ii:.:RiTirO j tf j E)) (OOE svS (succ tf))
+          step (OOE svS@(SvS s tt ii) tf) | tf == maxBound
+            = return $ Yield (SvS s (tt:.TreeIxR frst j tf) (ii:.:RiTirO j tf j E)) OOFinis
+          -- Y^   ->  X^    Z       move complete forest down
+          -- i,F      i,F   u,E
+          step (OOFFE svS@(SvS s tt ii))
+            = return $ Yield (SvS s (tt:.TreeIxR frst j F) (ii:.:RiTirO u E j E)) OOFinis
+          -- Y^   ->  X^    Z
+          -- i,T      i,F   k,t     if k==u then E else F ; 1st tree split off
+          -- i_k
+          step (OOTF svS@(SvS s tt ii))
+            = let k = rbdef u frst j
+                  tf = if k==u then E else F
+              in  return $ Yield (SvS s (tt:.TreeIxR frst j F) (ii:.:RiTirO k tf j E)) (OOTT svS)
+          -- Y^   ->  X^    Z       further hand down ; k,E because @T@
+          -- i,T      i,T   k,E
+          -- i_k
+          step (OOTT svS@(SvS s tt ii))
+            = let k = rbdef u frst j
+              in  return $ Yield (SvS s (tt:.TreeIxR frst j T) (ii:.:RiTirO k E j E)) OOFinis
+          {-# Inline [0] mk #-}
+          {-# Inline [0] step #-}
+  {-# Inline addIndexDenseGo #-}
+
+
+
+instance (MinSize c) => TableStaticVar (u I) c (TreeIxR p v a O) where 
+  tableStaticVar _ _ (OStatic    d) _ = ORightOf d
+  tableStaticVar _ _ (ORightOf   d) _ = ORightOf d
+  tableStaticVar _ _ (OFirstLeft d) _ = OLeftOf  d
+  tableStaticVar _ _ (OLeftOf    d) _ = OLeftOf  d
+  tableStreamIndex _ c _ = id
+  {-# Inline [0] tableStaticVar #-}
+  {-# Inline [0] tableStreamIndex #-}
+
+
+
+instance (MinSize c) => TableStaticVar (u O) c (TreeIxR p v a O) where 
+  tableStaticVar _ _ (OStatic  d) _ = OFirstLeft d
+  tableStaticVar _ _ (ORightOf d) _ = OFirstLeft d
+  tableStreamIndex _ c _ = id
+  {-# Inline [0] tableStaticVar #-}
+  {-# Inline [0] tableStreamIndex #-}
+
+
+
+-- * Complemented
+
+
+
+instance
+  ( IndexHdr s x0 i0 us (TreeIxR p v a I) cs c is (TreeIxR p v a C)
+  , MinSize c
+  ) => AddIndexDense s (us:.TreeIxR p v a I) (cs:.c) (is:.TreeIxR p v a C) where
+  addIndexDenseGo (cs:._) (vs:.Complemented) (lbs:._) (ubs:._) (us:.TreeIxR frst u v) (is:.TreeIxR _ j _)
+    = map go .addIndexDenseGo cs vs lbs ubs us is
+    where go (SvS s tt ii) =
+            let RiTirC k tf = getIndex (getIdx s) (Proxy :: PRI is (TreeIxR p v a C))
+            in  SvS s (tt:.TreeIxR frst k tf) (ii:.:RiTirC k tf)
+  {-# Inline addIndexDenseGo #-}
+
+
+
+instance
+  ( IndexHdr s x0 i0 us (TreeIxR p v a O) cs c is (TreeIxR p v a C)
+  , MinSize c
+  ) => AddIndexDense s (us:.TreeIxR p v a O) (cs:.c) (is:.TreeIxR p v a C) where
+  addIndexDenseGo (cs:._) (vs:.Complemented) (lbs:._) (ubs:._) (us:.TreeIxR frst u v) (is:.TreeIxR _ j _)
+    = map go .addIndexDenseGo cs vs lbs ubs us is
+    where go (SvS s tt ii) =
+            let RiTirC k tf = getIndex (getIdx s) (Proxy :: PRI is (TreeIxR p v a C))
+            in  SvS s (tt:.TreeIxR frst k tf) (ii:.:RiTirC k tf)
+  {-# Inline addIndexDenseGo #-}
+
diff --git a/ADP/Fusion/SynVar/Indices/ForestEdit/LeftLinear.hs b/ADP/Fusion/SynVar/Indices/ForestEdit/LeftLinear.hs
new file mode 100644
--- /dev/null
+++ b/ADP/Fusion/SynVar/Indices/ForestEdit/LeftLinear.hs
@@ -0,0 +1,217 @@
+
+module ADP.Fusion.SynVar.Indices.ForestEdit.LeftLinear where
+
+import           Data.Vector.Fusion.Stream.Monadic hiding (flatten)
+import           Prelude hiding (map)
+import qualified Data.Vector.Generic as VG
+import           Debug.Trace
+import           Data.List (sort,nub)
+
+import           ADP.Fusion.Core
+import           Data.Forest.Static
+import           Data.PrimitiveArray hiding (map)
+
+import           ADP.Fusion.Core.ForestEdit.LeftLinear
+
+
+
+-- * Inside indices, Inside object
+
+instance
+  ( IndexHdr s x0 i0 us (TreeIxL p v a I) cs c is (TreeIxL p v a I)
+  , MinSize c
+  ) => AddIndexDense s (us:.TreeIxL p v a I) (cs:.c) (is:.TreeIxL p v a I) where
+  addIndexDenseGo (cs:._) (vs:.IStatic ()) (lbs:._) (ubs:._) (us:.TreeIxL frst lc l u) (is:.TreeIxL _ _ i j)  -- static = rechts!
+    = map go . addIndexDenseGo cs vs lbs ubs us is
+    where
+      go (SvS s tt ii) =
+        let RiTilI _ k = getIndex (getIdx s) (Proxy :: PRI is (TreeIxL p v a I))
+        in SvS s (tt:.TreeIxL frst lc k j) (ii:.:RiTilI k j)
+  addIndexDenseGo (cs:._) (vs:.IVariable ()) (lbs:._) (ubs:._) (us:.TreeIxL frst lc l u) (is:.TreeIxL _ _ i j) --variable = links!
+    = map go . addIndexDenseGo cs vs lbs ubs us is . staticCheck (i<j)
+    where
+      go (SvS s tt ii) =
+        let RiTilI _ k = getIndex (getIdx s) (Proxy :: PRI is (TreeIxL p v a I))
+            l = lc VG.! (j-1)
+        in SvS s (tt:.TreeIxL frst lc k l) (ii:.:RiTilI k l)
+  {-# Inline addIndexDenseGo #-}
+
+instance (MinSize c) => TableStaticVar u c (TreeIxL p v a I) where 
+  tableStaticVar _ _ _ _ = IVariable ()
+  tableStreamIndex _ c _ = id
+  {-# Inline [0] tableStaticVar #-}
+  {-# Inline [0] tableStreamIndex #-}
+
+
+
+-- * Grammar: Outside; Table: Outside
+
+instance
+  ( IndexHdr s x0 i0 us (TreeIxL Post v a O) cs c is (TreeIxL Post v a O)
+  , MinSize c
+  ) => AddIndexDense s (us:.TreeIxL Post v a O) (cs:.c) (is:.TreeIxL Post v a O) where
+  --
+  -- \hat{T} -> F      \hat{F}
+  -- [i,j)   -> [0,i)  [0,j)
+  -- @
+  --
+  -- TODO in case this is a @Tree@, not a @Forest@, then we should only
+  -- return some value, if @i,j@ is proper.
+  --
+  addIndexDenseGo (cs:._) (vs:.OStatic ()) (lbs:._) (ubs:._) (us:.TreeIxL frst lc l u) (is:.TreeIxL _ _ i j)  -- static = rechts!
+    = map go . addIndexDenseGo cs vs lbs ubs us is
+    where
+      go (SvS s tt ii) =
+        let RiTilO iii iij ooi ooj = getIndex (getIdx s) (Proxy :: PRI is (TreeIxL Post v a O))
+        in  -- traceShowIf True (ss "O/O/st",(i,j),(ooi,j)) $
+            SvS s (tt:.TreeIxL frst lc ooi ooj) (ii:.:RiTilO iii iij ooi ooj)
+  -- TODO do we need to filter out everything that is not "almost
+  -- right-most", where only a single tree will then be? This will go into
+  -- the territory of linear vs. context-free languages for tree-editing.
+  --
+  -- \hat{F} -> \hat{F} T
+  -- [0,i)   -> [0,j)   [i,j)
+  -- @
+  --
+  -- TODO use ooi, ooj instead of i,j for CFG-style grammars
+  addIndexDenseGo (cs:._) (vs:.ORightOf ()) (lbs:._) (ubs:._) (us:.TreeIxL frst lc l u) (is:.TreeIxL _ _ i j) --variable = links!
+    = flatten mk step . addIndexDenseGo cs vs lbs ubs us is
+    where mk svs = return (svs, Prelude.filter (\z -> j == lc VG.! z) $ toRoot frst j)
+          -- ^ the @filter@ makes sure that we only build trees whose
+          -- left-most leaf is @j@. Since then forest and tree fit next to
+          -- each other.
+          step (_,[]) = return Done
+          -- a tree we can place to the right of us: @[j,k+1)@
+          -- we ourselves make a whole @[i,k+1)@ in which to place said
+          -- tree.
+          step (SvS s tt ii,k:ks) = do
+            let RiTilO iii iij ooi ooj = getIndex (getIdx s) (Proxy :: PRI is (TreeIxL Post v a O))
+            -- traceShow (ss "OOvar",i,j,(i,k+1),(j,k+1)) .
+            return $ Yield (SvS s (tt:.TreeIxL frst lc i (k+1)) (ii:.:RiTilO j (k+1) i (k+1))) (SvS s tt ii, ks)
+          {-# Inline [0] mk   #-}
+          {-# Inline [0] step #-}
+--          blub = if False -- (i,j) == (0,1)
+--                 then traceShow (ss "blub",i,j, let rs = toRoot frst j in (rs, [r | r <- rs, j == lc VG.! r]))
+--                 else id
+  {-# Inline addIndexDenseGo #-}
+
+toRoot frst k = goR k
+  where goR (-1) = []
+        goR k | k >= VG.length (parent frst) = []
+        goR k    = k : goR (parent frst VG.! k)
+
+ss :: String -> String
+ss = id
+
+instance (MinSize c) => TableStaticVar (u O) c (TreeIxL Post v a O) where 
+  tableStaticVar _ _ (OStatic  ()) _ = OFirstLeft ()
+  tableStaticVar _ _ (ORightOf ()) _ = OFirstLeft ()
+  tableStaticVar _ _ z             _ = z
+  tableStreamIndex _ c _ = id
+  {-# Inline [0] tableStaticVar #-}
+  {-# Inline [0] tableStreamIndex #-}
+
+
+
+-- * Grammar: Outside; Table: Inside
+
+instance
+  ( IndexHdr s x0 i0 us (TreeIxL Post v a I) cs c is (TreeIxL Post v a O)
+  , MinSize c
+  ) => AddIndexDense s (us:.TreeIxL Post v a I) (cs:.c) (is:.TreeIxL Post v a O) where
+  --
+  -- \hat{F} -> \hat{F} T
+  -- [0,i)   -> [0,j)   [i,j)
+  -- @
+  --
+  addIndexDenseGo (cs:._) (vs:.OStatic ()) (lbs:._) (ubs:._) (us:.TreeIxL frst lc l u) (is:.TreeIxL _ _ i j)  -- static = rechts!
+    = map go . addIndexDenseGo cs vs lbs ubs us is -- . staticCheck (j>0 && rt>=0)
+    where
+      go (SvS s tt ii) =
+        let RiTilO iii iij ooi ooj = getIndex (getIdx s) (Proxy :: PRI is (TreeIxL Post v a O))
+        in  if (iij>0 && j == iii && iii == lc VG.! (iij-1))
+            then SvS s (tt:.TreeIxL frst lc iii iij) (ii:.:RiTilO iii iij ooi ooj)
+            else error $ show (i,j,iii,iij, lc VG.! (iij-1), toRoot frst (j-1))
+  -- TODO do we need to filter out everything that is not "almost
+  -- right-most", where only a single tree will then be? This will go into
+  -- the territory of linear vs. context-free languages for tree-editing.
+  --
+  -- \hat{T} -> F      \hat{F}
+  -- [i,j)   -> [0,i)  [0,j)
+  -- @
+  --
+  addIndexDenseGo (cs:._) (vs:.OFirstLeft ()) (lbs:._) (ubs:._) (us:.TreeIxL frst lc l u) (is:.TreeIxL _ _ i j) --variable = links!
+    = flatten mk step . addIndexDenseGo cs vs lbs ubs us is -- . staticCheck isValidTree -- . blub
+    where mk svs = return (svs, [0..j-1]) -- allLeftBoundForests frst lc (j-1))
+          step (s,[]) = return Done
+          step (SvS s tt ii,k:ks) = do
+            let RiTilO iii iij ooi ooj = getIndex (getIdx s) (Proxy :: PRI is (TreeIxL Post v a O))
+            -- traceShowIf True (ss "OIvar",(i,j),(k,i)) .
+            return $ Yield (SvS s (tt:.TreeIxL frst lc k i) (ii:.:RiTilO k i k j)) (SvS s tt ii,ks) -- j or ooj ???
+          {-# Inline [0] mk   #-}
+          {-# Inline [0] step #-}
+          !isValidTree = j>0 && j<=u
+--          blub = if (i,j) == (3,4)
+--                 then traceShow ((i,j),let zs = allLeftBoundForests frst lc (j-1) in (zs,[ ((k,i),(k,j)) | k <- zs] ))
+--                 else id
+  addIndexDenseGo _ (vs:.bang) _ _ _ _ = error $ show bang
+  {-# Inline addIndexDenseGo #-}
+
+traceShowIf cond s = if cond then traceShow s else id
+
+lboundary frst lc k = go k $ lsib frst VG.! k
+  where go now next | next == -1 = lc VG.! now
+                    | otherwise  = go next (lsib frst VG.! now)
+
+allLeftBoundForests frst lc k = ls
+  where rs = goR k
+        ls = nub $ sort [ lc VG.! z | z <- rs ]
+        goR (-1) = []
+        goR k    = k : goR (parent frst VG.! k)
+
+instance (MinSize c) => TableStaticVar (u I) c (TreeIxL Post v a O) where 
+  tableStaticVar _ _ (OStatic  ())   _ = ORightOf   ()
+  tableStaticVar _ _ (ORightOf ())   _ = OFirstLeft ()
+  tableStaticVar _ _ (OFirstLeft ()) _ = OLeftOf    ()
+  tableStreamIndex _ c _ = id
+  {-# Inline [0] tableStaticVar #-}
+  {-# Inline [0] tableStreamIndex #-}
+
+
+
+-- * Complement
+
+instance
+  ( IndexHdr s x0 i0 us (TreeIxL Post v a I) cs c is (TreeIxL Post v a C)
+  , MinSize c
+  ) => AddIndexDense s (us:.TreeIxL Post v a I) (cs:.c) (is:.TreeIxL Post v a C) where
+  addIndexDenseGo (cs:._) (vs:.Complemented) (lbs:._) (ubs:._) (us:.TreeIxL frst lc l u) (is:.TreeIxL _ _ i j)  -- static = rechts!
+    = map go . addIndexDenseGo cs vs lbs ubs us is
+    where
+      go (SvS s tt ii) = SvS s (tt:.TreeIxL frst lc i j) (ii:.:RiTilC i j)
+  {-# Inline addIndexDenseGo #-}
+
+instance
+  ( IndexHdr s x0 i0 us (TreeIxL Post v a O) cs c is (TreeIxL Post v a C)
+  , MinSize c
+  ) => AddIndexDense s (us:.TreeIxL Post v a O) (cs:.c) (is:.TreeIxL Post v a C) where
+  addIndexDenseGo (cs:._) (vs:.Complemented) (lbs:._) (ubs:._) (us:.TreeIxL frst lc l u) (is:.TreeIxL _ _ i j)  -- static = rechts!
+    = map go . addIndexDenseGo cs vs lbs ubs us is
+    where
+      go (SvS s tt ii) = SvS s (tt:.TreeIxL frst lc i j) (ii:.:RiTilC i j)
+  {-# Inline addIndexDenseGo #-}
+
+
+
+instance (MinSize c) => TableStaticVar (u I) c (TreeIxL Post v a C) where 
+  tableStaticVar _ _ z             _ = z
+  tableStreamIndex _ c _ = id
+  {-# Inline [0] tableStaticVar #-}
+  {-# Inline [0] tableStreamIndex #-}
+
+instance (MinSize c) => TableStaticVar (u O) c (TreeIxL Post v a C) where 
+  tableStaticVar _ _ z             _ = z
+  tableStreamIndex _ c _ = id
+  {-# Inline [0] tableStaticVar #-}
+  {-# Inline [0] tableStreamIndex #-}
+
diff --git a/ADP/Fusion/Term/Deletion/ForestAlign/RightLinear.hs b/ADP/Fusion/Term/Deletion/ForestAlign/RightLinear.hs
new file mode 100644
--- /dev/null
+++ b/ADP/Fusion/Term/Deletion/ForestAlign/RightLinear.hs
@@ -0,0 +1,76 @@
+
+module ADP.Fusion.Term.Deletion.ForestAlign.RightLinear where
+
+import Data.Strict.Tuple hiding (fst, snd)
+import Data.Vector.Fusion.Stream.Monadic hiding (flatten)
+import Prelude hiding (map)
+
+import ADP.Fusion.Core
+import Data.PrimitiveArray hiding (map)
+
+import ADP.Fusion.Core.ForestAlign.RightLinear
+
+
+
+-- * Inside
+
+
+
+instance
+  ( TmkCtx1 m ls Deletion (TreeIxR p v a t)
+  ) => MkStream m (ls :!: Deletion) (TreeIxR p v a t) where
+  mkStream (ls :!: Deletion) sv us is
+    = 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 #-}
+
+
+
+instance
+  ( TstCtx m ts s x0 i0 is (TreeIxR p v a I)
+  ) => TermStream m (TermSymbol ts Deletion) s (is:.TreeIxR p v a I) where
+  termStream (ts:|Deletion) (cs:.IVariable ()) (us:.u) (is:.TreeIxR frst i ii)
+    = map (\(TState s ii ee) ->
+              let RiTirI l tf = getIndex (getIdx s) (Proxy :: PRI is (TreeIxR p v a I))
+              in  {- traceShow ("-"::String,l,tf) $ -} TState s (ii:.:RiTirI l tf) (ee:.()) )
+    . termStream ts cs us is
+--    . staticCheck (ii == T)
+  {-# Inline termStream #-}
+
+
+
+instance TermStaticVar Deletion (TreeIxR p v a I) where
+  termStaticVar _ sv _ = sv
+  termStreamIndex _ _ i = i
+  {-# Inline [0] termStaticVar   #-}
+  {-# Inline [0] termStreamIndex #-}
+
+
+
+-- * Outside
+--
+-- Has no conditions on when it is acceptable.
+--
+-- TODO missing single tape instance?
+
+
+
+instance
+  ( TstCtx m ts s x0 i0 is (TreeIxR p v a O)
+  ) => TermStream m (TermSymbol ts Deletion) s (is:.TreeIxR p v a O) where
+  termStream (ts:|Deletion) (cs:._) (us:.u) (is:.TreeIxR frst i ii)
+    = map (\(TState s ii ee) ->
+              let RiTirO li tfi lo tfo = getIndex (getIdx s) (Proxy :: PRI is (TreeIxR p v a O))
+              in  TState s (ii:.:RiTirO li tfi lo tfo) (ee:.()) )
+    . termStream ts cs us is
+  {-# Inline termStream #-}
+
+
+
+instance TermStaticVar Deletion (TreeIxR p v a O) where
+  termStaticVar _ sv _ = sv
+  termStreamIndex _ _ i = i
+  {-# Inline [0] termStaticVar   #-}
+  {-# Inline [0] termStreamIndex #-}
+
diff --git a/ADP/Fusion/Term/Deletion/ForestEdit/LeftLinear.hs b/ADP/Fusion/Term/Deletion/ForestEdit/LeftLinear.hs
new file mode 100644
--- /dev/null
+++ b/ADP/Fusion/Term/Deletion/ForestEdit/LeftLinear.hs
@@ -0,0 +1,68 @@
+
+module ADP.Fusion.Term.Deletion.ForestEdit.LeftLinear where
+
+import Data.Strict.Tuple hiding (fst, snd)
+import Data.Vector.Fusion.Stream.Monadic hiding (flatten)
+import Prelude hiding (map)
+
+import ADP.Fusion.Core
+import Data.Forest.Static
+import Data.PrimitiveArray hiding (map)
+
+import ADP.Fusion.Core.ForestEdit.LeftLinear
+
+
+
+-- * Common
+
+instance
+  ( TmkCtx1 m ls Deletion (TreeIxL p v a t)
+  ) => MkStream m (ls :!: Deletion) (TreeIxL p v a t) where
+  mkStream (ls :!: Deletion) sv us is
+    = 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 #-}
+
+
+
+-- * Inside
+
+instance
+  ( TstCtx m ts s x0 i0 is (TreeIxL p v a I)
+  ) => TermStream m (TermSymbol ts Deletion) s (is:.TreeIxL p v a I) where
+  termStream (ts:|Deletion) (cs:.IStatic ()) (us:.u) (is:.TreeIxL frst _ i j)
+    = map (\(TState s ii ee) ->
+              let RiTilI k l = getIndex (getIdx s) (Proxy :: PRI is (TreeIxL p v a I))
+              in  {- traceShow ("-"::String,l,tf) $ -} TState s (ii:.:RiTilI k l) (ee:.()) )
+    . termStream ts cs us is
+  {-# Inline termStream #-}
+
+
+instance TermStaticVar Deletion (TreeIxL p v a I) where
+  termStaticVar _ sv _ = sv
+  termStreamIndex _ _ i = i
+  {-# Inline [0] termStaticVar   #-}
+  {-# Inline [0] termStreamIndex #-}
+
+
+
+-- * Outside
+
+instance
+  ( TstCtx m ts s x0 i0 is (TreeIxL Post v a O)
+  ) => TermStream m (TermSymbol ts Deletion) s (is:.TreeIxL Post v a O) where
+  termStream (ts:|Deletion) (cs:.OStatic ()) (us:.u) (is:.TreeIxL frst _ i j)
+    = map (\(TState s ii ee) ->
+              let RiTilO _ k oi oj = getIndex (getIdx s) (Proxy :: PRI is (TreeIxL Post v a O))
+              in  TState s (ii:.:RiTilO k k oi oj) (ee:.()) )
+    . termStream ts cs us is
+  {-# Inline termStream #-}
+
+
+instance TermStaticVar Deletion (TreeIxL Post v a O) where
+  termStaticVar _ sv _ = sv
+  termStreamIndex _ _ i = i
+  {-# Inline [0] termStaticVar   #-}
+  {-# Inline [0] termStreamIndex #-}
+
diff --git a/ADP/Fusion/Term/Epsilon/ForestAlign/PermuteRightLinear.hs b/ADP/Fusion/Term/Epsilon/ForestAlign/PermuteRightLinear.hs
new file mode 100644
--- /dev/null
+++ b/ADP/Fusion/Term/Epsilon/ForestAlign/PermuteRightLinear.hs
@@ -0,0 +1,3 @@
+
+module ADP.Fusion.Term.Epsilon.ForestAlign.PermuteRightLinear where
+
diff --git a/ADP/Fusion/Term/Epsilon/ForestAlign/RightLinear.hs b/ADP/Fusion/Term/Epsilon/ForestAlign/RightLinear.hs
new file mode 100644
--- /dev/null
+++ b/ADP/Fusion/Term/Epsilon/ForestAlign/RightLinear.hs
@@ -0,0 +1,78 @@
+
+-- | Epsilon
+--
+-- X    -> ε
+-- i,E     i,E    ∀ i
+
+module ADP.Fusion.Term.Epsilon.ForestAlign.RightLinear where
+
+import           Data.Strict.Tuple hiding (fst, snd)
+import           Data.Vector.Fusion.Stream.Monadic hiding (flatten)
+import           Prelude hiding (map)
+
+import           ADP.Fusion.Core
+import           Data.PrimitiveArray hiding (map)
+
+import           ADP.Fusion.Core.ForestAlign.RightLinear
+
+
+
+-- * Inside
+
+
+
+instance
+  ( TmkCtx1 m ls Epsilon (TreeIxR p v a t)
+  ) => MkStream m (ls :!: Epsilon) (TreeIxR p v a t) where
+  mkStream (ls :!: Epsilon) sv us is
+    = 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
+  ( TstCtx m ts s x0 i0 is (TreeIxR p v a I)
+  ) => TermStream m (TermSymbol ts Epsilon) s (is:.TreeIxR p v a I) where
+  termStream (ts:|Epsilon) (cs:.IStatic ()) (us:.TreeIxR _ u uu) (is:.TreeIxR frst i ii)
+    = map (\(TState s ii ee) ->
+              let RiTirI l tf = getIndex (getIdx s) (Proxy :: PRI is (TreeIxR p v a I))
+              in  TState s (ii:.:RiTirI l tf) (ee:.()) )
+    . termStream ts cs us is
+    . staticCheck ( (ii==E) || (u==0 && uu==F) ) -- 2nd condition takes care of empty inputs
+  {-# Inline termStream #-}
+
+
+
+instance TermStaticVar Epsilon (TreeIxR p v a I) where
+  termStaticVar _ sv _ = sv
+  termStreamIndex _ _ i = i
+  {-# Inline [0] termStaticVar   #-}
+  {-# Inline [0] termStreamIndex #-}
+
+
+
+-- * Outside
+
+
+
+instance
+  ( TstCtx m ts s x0 i0 is (TreeIxR p v a O)
+  ) => TermStream m (TermSymbol ts Epsilon) s (is:.TreeIxR p v a O) where
+  termStream (ts:|Epsilon) (cs:.OStatic ()) (us:.TreeIxR _ u uu) (is:.TreeIxR frst i ii)
+    = map (\(TState s ii ee) ->
+              let RiTirO li tfi lo tfo = getIndex (getIdx s) (Proxy :: PRI is (TreeIxR p v a O))
+              in  TState s (ii:.:RiTirO li tfi lo tfo) (ee:.()) )
+    . termStream ts cs us is
+    . staticCheck ((i==0 && ii==F) || (i==0 && u==0 && ii==E))
+  {-# Inline termStream #-}
+
+
+
+instance TermStaticVar Epsilon (TreeIxR p v a O) where
+  termStaticVar _ sv _ = sv
+  termStreamIndex _ _ i = i
+  {-# Inline [0] termStaticVar   #-}
+  {-# Inline [0] termStreamIndex #-}
+
diff --git a/ADP/Fusion/Term/Epsilon/ForestEdit/LeftLinear.hs b/ADP/Fusion/Term/Epsilon/ForestEdit/LeftLinear.hs
new file mode 100644
--- /dev/null
+++ b/ADP/Fusion/Term/Epsilon/ForestEdit/LeftLinear.hs
@@ -0,0 +1,68 @@
+
+module ADP.Fusion.Term.Epsilon.ForestEdit.LeftLinear where
+
+import Data.Strict.Tuple hiding (fst, snd)
+import Data.Vector.Fusion.Stream.Monadic hiding (flatten)
+import Prelude hiding (map)
+
+import ADP.Fusion.Core
+import Data.Forest.Static
+import Data.PrimitiveArray hiding (map)
+
+import ADP.Fusion.Core.ForestEdit.LeftLinear
+
+
+
+-- * Common
+
+instance
+  ( TmkCtx1 m ls Epsilon (TreeIxL p v a t)
+  ) => MkStream m (ls :!: Epsilon) (TreeIxL p v a t) where
+  mkStream (ls :!: Epsilon) sv us is
+    = 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 #-}
+
+
+
+-- * Inside
+
+instance
+  ( TstCtx m ts s x0 i0 is (TreeIxL p v a I)
+  ) => TermStream m (TermSymbol ts Epsilon) s (is:.TreeIxL p v a I) where
+  termStream (ts:|Epsilon) (cs:.IStatic ()) (us:.TreeIxL _ _ l u) (is:.TreeIxL frst _ i j)
+    = map (\(TState s ii ee) -> TState s (ii:.:RiTilI i j) (ee:.()) )
+    . termStream ts cs us is
+    . staticCheck (i==j)
+  {-# Inline termStream #-}
+
+
+instance TermStaticVar Epsilon (TreeIxL p v a I) where
+  termStaticVar _ sv _ = sv
+  termStreamIndex _ _ i = i
+  {-# Inline [0] termStaticVar   #-}
+  {-# Inline [0] termStreamIndex #-}
+
+
+
+-- * Outside
+
+instance
+  ( TstCtx m ts s x0 i0 is (TreeIxL Post v a O)
+  ) => TermStream m (TermSymbol ts Epsilon) s (is:.TreeIxL Post v a O) where
+  termStream (ts:|Epsilon) (cs:.OStatic ()) (us:.TreeIxL _ _ l u) (is:.TreeIxL frst _ i j)
+    = map (\(TState s ii ee) ->
+              let oo = getIndex (getIdx s) (Proxy :: PRI is (TreeIxL Post v a O))
+              in  TState s (ii:.:oo) (ee:.()) )
+    . termStream ts cs us is
+    . staticCheck (l==i && u==j)
+  {-# Inline termStream #-}
+
+
+instance TermStaticVar Epsilon (TreeIxL Post v a O) where
+  termStaticVar _ sv _ = sv
+  termStreamIndex _ _ i = i
+  {-# Inline [0] termStaticVar   #-}
+  {-# Inline [0] termStreamIndex #-}
+
diff --git a/ADP/Fusion/Term/Node/ForestAlign/PermuteRightLinear.hs b/ADP/Fusion/Term/Node/ForestAlign/PermuteRightLinear.hs
new file mode 100644
--- /dev/null
+++ b/ADP/Fusion/Term/Node/ForestAlign/PermuteRightLinear.hs
@@ -0,0 +1,114 @@
+
+-- |
+--
+-- TODO outside costs
+
+module ADP.Fusion.Term.Node.ForestAlign.PermuteRightLinear where
+
+import           Data.List (permutations)
+import           Data.Strict.Tuple hiding (fst, snd)
+import           Data.Vector.Fusion.Stream.Monadic hiding (flatten)
+import           Prelude hiding (map)
+import qualified Data.Vector.Generic as VG
+import qualified Data.Vector.Unboxed as VU
+import qualified Prelude as P
+
+import           ADP.Fusion.Core
+import           Data.Forest.Static
+import           Data.PrimitiveArray hiding (map)
+
+import           ADP.Fusion.Core.ForestAlign.PermuteRightLinear
+import           ADP.Fusion.Term.Node.Type
+
+
+
+-- Node: parse a local root
+
+instance
+  ( TmkCtx1 m ls (Node r x) (TreeIxR p v a t)
+  ) => MkStream m (ls :!: Node r x) (TreeIxR p v a t) where
+  mkStream (ls :!: Node f nty xs) sv us is
+    = map (\(ss,ee,ii) -> ElmNode ee ii ss)
+    . addTermStream1 (Node f nty xs) sv us is
+    $ mkStream ls (termStaticVar (Node f nty xs) sv is) us (termStreamIndex (Node f nty xs) sv is)
+  {-# Inline mkStream #-}
+
+
+
+-- |
+--
+-- X    -> n    Y
+-- i,T  -> i,T  (i+1),t    -- @t@ = if @i@ has no children, then @E@, else @F@.
+
+instance
+  ( TstCtx m ts s x0 i0 is (TreeIxR p v a I)
+--  , Show r
+  ) => TermStream m (TermSymbol ts (Node r x)) s (is:.TreeIxR p v a I) where
+  termStream (ts:|Node f nty xs) (cs:.IVariable ()) (us:.TreeIxR _ ul utfe) (is:.TreeIxR frst il itfe)
+    = map (\(TState s ii ee) ->
+              let RiTirI (T l) = getIndex (getIdx s) (Proxy :: PRI is (TreeIxR p v a I))
+                  cs = children frst VG.! l
+                  fe = if VG.null cs then E l else F cs
+              in  -- traceShow ("N"::String,cs,fe, f xs l) $
+                  TState s (ii:.:RiTirI fe) (ee:.f xs l) )
+    . termStream ts cs us is
+    . staticCheck ({- itfe < utfe && -} isTree itfe)
+  {-# Inline termStream #-}
+
+
+instance TermStaticVar (Node r x) (TreeIxR p v a I) where
+  termStaticVar _ sv _ = sv
+  termStreamIndex _ _ (TreeIxR frst i j) = TreeIxR frst i j
+  {-# Inline [0] termStaticVar   #-}
+  {-# Inline [0] termStreamIndex #-}
+
+
+
+-- PermNode: parse a local root and permute the local forest
+
+instance
+  ( TmkCtx1 m ls (PermNode r x) (TreeIxR p v a t)
+  ) => MkStream m (ls :!: PermNode r x) (TreeIxR p v a t) where
+  mkStream (ls :!: PermNode f xs) sv us is
+    = map (\(ss,ee,ii) -> ElmPermNode ee ii ss)
+    . addTermStream1 (PermNode f xs) sv us is
+    $ mkStream ls (termStaticVar (PermNode f xs) sv is) us (termStreamIndex (PermNode f xs) sv is)
+  {-# Inline mkStream #-}
+
+
+
+-- |
+--
+-- X    -> n    Y
+-- i,T  -> i,T  (i+1),t    -- @t@ = if @i@ has no children, then @E@, else @F@.
+
+instance
+  ( TstCtx m ts s x0 i0 is (TreeIxR p v a I)
+  ) => TermStream m (TermSymbol ts (PermNode r x)) s (is:.TreeIxR p v a I) where
+  termStream (ts:|PermNode f xs) (cs:.IVariable ()) (us:.TreeIxR _ ul utfe) (is:.TreeIxR frst il itfe)
+    = flatten mk step
+    . termStream ts cs us is
+    . staticCheck ({- itfe < utfe && -} isTree itfe)
+    where mk (TState s ii ee) =
+            let RiTirI (T l) = getIndex (getIdx s) (Proxy :: PRI is (TreeIxR p v a I))
+                cs = children frst VG.! l
+                fe = if VG.null cs then Nothing else (Just $ permutations $ VU.toList cs)
+            in  return (s, ii, ee, fe)
+          step (s, _ , _ , Just [])
+            = return $ Done
+          step (s, ii, ee,  Nothing)
+            = let RiTirI (T l) = getIndex (getIdx s) (Proxy :: PRI is (TreeIxR p v a I))
+              in  return $ Yield (TState s (ii:.:RiTirI (E l)) (ee:.f xs l)) (s, ii, ee, Just [])
+          step (s, ii, ee, Just (y:ys))
+            = let RiTirI (T l) = getIndex (getIdx s) (Proxy :: PRI is (TreeIxR p v a I))
+              in  return $ Yield (TState s (ii:.:RiTirI (F $ VU.fromList y)) (ee:.f xs l)) (s, ii, ee, Just ys)
+  {-# Inline termStream #-}
+
+
+
+instance TermStaticVar (PermNode r x) (TreeIxR p v a I) where
+  termStaticVar _ sv _ = sv
+  termStreamIndex _ _ (TreeIxR frst i j) = TreeIxR frst i j
+  {-# Inline [0] termStaticVar   #-}
+  {-# Inline [0] termStreamIndex #-}
+
diff --git a/ADP/Fusion/Term/Node/ForestAlign/RightLinear.hs b/ADP/Fusion/Term/Node/ForestAlign/RightLinear.hs
new file mode 100644
--- /dev/null
+++ b/ADP/Fusion/Term/Node/ForestAlign/RightLinear.hs
@@ -0,0 +1,97 @@
+
+module ADP.Fusion.Term.Node.ForestAlign.RightLinear where
+
+import           Data.Strict.Tuple hiding (fst, snd)
+import           Data.Vector.Fusion.Stream.Monadic hiding (flatten)
+import           Prelude hiding (map)
+import qualified Data.Vector.Generic as VG
+
+import           ADP.Fusion.Core
+import           Data.Forest.Static
+import           Data.PrimitiveArray hiding (map)
+
+import           ADP.Fusion.Core.ForestAlign.RightLinear
+import           ADP.Fusion.Term.Node.Type
+
+
+
+-- * Inside
+
+instance
+  ( TmkCtx1 m ls (Node r x) (TreeIxR p v a t)
+  ) => MkStream m (ls :!: Node r x) (TreeIxR p v a t) where
+  mkStream (ls :!: Node f nty xs) sv us is
+    = map (\(ss,ee,ii) -> ElmNode ee ii ss)
+    . addTermStream1 (Node f nty xs) sv us is
+    $ mkStream ls (termStaticVar (Node f nty xs) sv is) us (termStreamIndex (Node f nty xs) sv is)
+  {-# Inline mkStream #-}
+
+-- |
+--
+-- X    -> n    Y
+-- i,T  -> i,T  (i+1),t    -- @t@ = if @i@ has no children, then @E@, else @F@.
+
+instance
+  ( TstCtx m ts s x0 i0 is (TreeIxR p v a I)
+  ) => TermStream m (TermSymbol ts (Node r x)) s (is:.TreeIxR p v a I) where
+  termStream (ts:|Node f nty xs) (cs:.IVariable ()) (us:.TreeIxR _ u ut) (is:.TreeIxR frst i it)
+    = map (\(TState s ii ee) ->
+              let RiTirI l tf = getIndex (getIdx s) (Proxy :: PRI is (TreeIxR p v a I))
+                  l'  = l+1
+                  tf'  = if VG.null (children frst VG.! l) then E else F
+              in  {- traceShow ("N"::String,l,tf) $ -} TState s (ii:.:RiTirI l' tf') (ee:.f xs l) )
+    . termStream ts cs us is
+    . staticCheck (i<u && it == T)
+  {-# Inline termStream #-}
+
+
+instance TermStaticVar (Node r x) (TreeIxR p v a I) where
+  termStaticVar _ sv _ = sv
+  termStreamIndex _ _ (TreeIxR frst i j) = TreeIxR frst i j
+  {-# Inline [0] termStaticVar   #-}
+  {-# Inline [0] termStreamIndex #-}
+
+
+
+-- * Outside
+
+-- | We are a @F@orest at position @i@. Now we request the parent, who
+-- happens to be the root of a @T@ree.
+--
+-- TODO we should actually move the outside index via the @OFirstLeft@
+-- (etc) encoding
+--
+-- X    -> n    Y
+-- i,T  -> i,T  i+1,t     -- @t@ = if @i@ has no children, then @E@, else @F@.
+--
+-- Y'     ->  n       X'
+-- i+1,t      i,T     i,T   -- @t@ = if @i@ ...
+--
+-- Y'     ->  n       X'
+-- i,t        i-1,T   i-1,T -- @t@ = if @i-1@ has no children, then @E@ else @F@
+
+instance
+  ( TstCtx m ts s x0 i0 is (TreeIxR p v a O)
+  , Show r
+  ) => TermStream m (TermSymbol ts (Node r x)) s (is:.TreeIxR p v a O) where
+  termStream (ts:|Node f nty xs) (cs:.OFirstLeft ()) (us:.TreeIxR _ u ut) (is:.TreeIxR frst i it)
+    = map (\(TState s ii ee) ->
+              let RiTirO li tfi lo tfo = getIndex (getIdx s) (Proxy :: PRI is (TreeIxR p v a O))
+                  l' = li - 1
+              in  TState s (ii:.:RiTirO li T l' T) (ee:.f xs l') ) -- @li@, since we have now just 'eaten' @li -1 , li@
+    . termStream ts cs us is
+    -- @i>0@ so that we can actually have a parent
+    -- @it==E@ in case we @i-1@ has no children; @it==F@ in case @i-1@ has
+    -- children.
+    . staticCheck (let hc = not $ VG.null (children frst VG.! (i-1))
+                   in  i>0 && (not hc && it==E || hc && it==F))
+  {-# Inline termStream #-}
+
+instance TermStaticVar (Node r x) (TreeIxR p v a O) where
+  termStaticVar _ sv _ = sv
+  termStreamIndex _ _ (TreeIxR frst i j) = TreeIxR frst i j
+  {-# Inline [0] termStaticVar   #-}
+  {-# Inline [0] termStreamIndex #-}
+
+
+
diff --git a/ADP/Fusion/Term/Node/ForestEdit/LeftLinear.hs b/ADP/Fusion/Term/Node/ForestEdit/LeftLinear.hs
new file mode 100644
--- /dev/null
+++ b/ADP/Fusion/Term/Node/ForestEdit/LeftLinear.hs
@@ -0,0 +1,93 @@
+
+-- | 'Node' handling for tree-editing.
+--
+-- TODO outside
+
+module ADP.Fusion.Term.Node.ForestEdit.LeftLinear where
+
+import           Data.Strict.Tuple hiding (fst, snd)
+import           Data.Vector.Fusion.Stream.Monadic hiding (flatten)
+import           Prelude hiding (map)
+import qualified Prelude as P
+import qualified Data.Vector.Generic as VG
+
+import           ADP.Fusion.Core
+import           Data.PrimitiveArray hiding (map)
+import           Data.Forest.Static
+
+import           ADP.Fusion.Core.ForestEdit.LeftLinear
+import           ADP.Fusion.Term.Node.Type
+
+
+
+-- * Common
+
+instance
+  ( TmkCtx1 m ls (Node r x) (TreeIxL p v a t)
+  ) => MkStream m (ls :!: Node r x) (TreeIxL p v a t) where
+  mkStream (ls :!: Node f nty xs) sv us is
+    = map (\(ss,ee,ii) -> ElmNode ee ii ss)
+    . addTermStream1 (Node f nty xs) sv us is
+    $ mkStream ls (termStaticVar (Node f nty xs) sv is) us (termStreamIndex (Node f nty xs) sv is)
+  {-# Inline mkStream #-}
+
+
+
+-- * Inside
+
+instance
+  ( TstCtx m ts s x0 i0 is (TreeIxL p v a I)
+  ) => TermStream m (TermSymbol ts (Node r x)) s (is:.TreeIxL p v a I) where
+  termStream (ts:|Node f nty xs) (cs:.IStatic ()) (us:.TreeIxL _ _ l u) (is:.TreeIxL frst lc i j)
+    = map (\(TState s ii ee) -> {-traceShow ('n',i,j) $-} TState s (ii:.:RiTilI (j-1) j) (ee:.f xs (j-1)) )
+    . termStream ts cs us is
+    . staticCheck (i < j && (nty == NTany || i == lc VG.! (j-1)) )
+    -- TODO this check should only be @i<j@, but we want to test more with
+    -- SingleEdit where only have this for actual trees
+  {-# Inline termStream #-}
+
+
+instance TermStaticVar (Node r x) (TreeIxL p v a I) where
+  termStaticVar _ sv _ = sv
+  termStreamIndex _ _ (TreeIxL frst c i j) = TreeIxL frst c i $ j-1
+  {-# Inline [0] termStaticVar   #-}
+  {-# Inline [0] termStreamIndex #-}
+
+
+
+-- * Outside
+--
+-- basically, we have a missing forest (@-0@ and @-1@) and if we have this
+-- and an existing (@2@) node, then before we had a missing tree. So
+-- @\hat{F} -> \hat{T} x@, for example.
+--
+-- @
+--              2         -2
+--   / \    +       =     / \
+--  -0 -1                -0 -1
+-- @
+
+instance
+  ( TstCtx m ts s x0 i0 is (TreeIxL Post v a O)
+  ) => TermStream m (TermSymbol ts (Node r x)) s (is:.TreeIxL Post v a O) where
+  termStream (ts:|Node f nty xs) (cs:.OStatic ()) (us:.TreeIxL _ _ l u) (is:.TreeIxL frst lc i j)
+    = map (\(TState s ii ee) -> let RiTilO _ _ oi oj = getIndex (getIdx s) (Proxy :: PRI is (TreeIxL Post v a O))
+            -- given an index @[i,j)@ of "missing" structure, we add a new
+            -- node at @[j,j+1)@.
+            in TState s (ii:.:RiTilO j (j+1) oi oj) (ee:.f xs j) )
+    . termStream ts cs us is
+    . staticCheck (i <= j && j < u && (nty == NTany || j < u && i == lc VG.! j) )
+    -- TODO same here, check is only for SingleEdit. If this works out,
+    -- we'll actually need special tree-root nodes for Tree-Editing.
+  {-# Inline termStream #-}
+
+
+
+instance TermStaticVar (Node r x) (TreeIxL Post v a O) where
+  termStaticVar _ sv _ = sv -- context doesn't change
+  termStreamIndex _ _ (TreeIxL frst c i j) = TreeIxL frst c i $ j+1
+  {-# Inline [0] termStaticVar   #-}
+  {-# Inline [0] termStreamIndex #-}
+
+
+
diff --git a/ADP/Fusion/Term/Node/Type.hs b/ADP/Fusion/Term/Node/Type.hs
new file mode 100644
--- /dev/null
+++ b/ADP/Fusion/Term/Node/Type.hs
@@ -0,0 +1,77 @@
+
+module ADP.Fusion.Term.Node.Type where
+
+import           Data.Strict.Tuple
+import qualified Data.Vector.Generic as VG
+
+import           ADP.Fusion.Core
+import           Data.PrimitiveArray
+
+
+
+data NodeType = NTany | NTroot
+  deriving (Eq,Show)
+
+data Node r x where
+  Node :: VG.Vector v x
+       => (v x -> Int -> r)
+       -> NodeType
+       -> !(v x)
+       -> Node r x
+
+node :: VG.Vector v x => NodeType -> v x -> Node x x
+node = Node (VG.!)
+{-# Inline node #-}
+
+instance Build (Node r x)
+
+instance
+  ( Element ls i
+  ) => Element (ls :!: Node r x) i where
+    data Elm (ls :!: Node r x) i = ElmNode !r !(RunningIndex i) !(Elm ls i)
+    type Arg (ls :!: Node r x)   = Arg ls :. r
+    getArg (ElmNode x _ ls) = getArg ls :. x
+    getIdx (ElmNode _ i _ ) = i
+    {-# Inline getArg #-}
+    {-# Inline getIdx #-}
+
+
+type instance TermArg (Node r x) = r
+
+
+
+-- | TODO Should return permutation being used as well This means we have
+-- a vector @v@ and a permutation @p@ on @[1 .. |v|]@. We should apply @p@
+-- to @v@ yielding @v'@, the permutation of @v@. @PermNode@ should then
+-- hold on to the pair @(v',p)@. This allows us to observe the permutation
+-- directly via @v'@, but also consider the applied @p@. This is useful for
+-- considering what the "cost" of @p@ should be. Say, given @[1,2,3,4]@
+-- then the identity permutation is cost-free, while @[2,1,3,4]@ could be
+-- less costly than @[4,1,3,2]@, but more costly than @[4,3,2,1]@. This
+-- will depend on the user but should be supported.
+
+data PermNode r x where
+  PermNode :: VG.Vector v x
+       => (v x -> Int -> r)
+       -> !(v x)
+       -> PermNode r x
+
+permNode :: VG.Vector v x => v x -> PermNode x x
+permNode = PermNode (VG.!)
+{-# Inline permNode #-}
+
+instance Build (PermNode r x)
+
+instance
+  ( Element ls i
+  ) => Element (ls :!: PermNode r x) i where
+    data Elm (ls :!: PermNode r x) i = ElmPermNode !r !(RunningIndex i) !(Elm ls i)
+    type Arg (ls :!: PermNode r x)   = Arg ls :. r
+    getArg (ElmPermNode x _ ls) = getArg ls :. x
+    getIdx (ElmPermNode _ i _ ) = i
+    {-# Inline getArg #-}
+    {-# Inline getIdx #-}
+
+
+type instance TermArg (PermNode r x) = r
+
diff --git a/ADPfusionForest.cabal b/ADPfusionForest.cabal
new file mode 100644
--- /dev/null
+++ b/ADPfusionForest.cabal
@@ -0,0 +1,426 @@
+name:           ADPfusionForest
+version:        0.0.0.1
+author:         Christian Hoener zu Siederdissen, Sarah Berkemer, 2016-2017
+copyright:      Christian Hoener zu Siederdissen, 2016-2017
+homepage:       https://github.com/choener/ADPfusionForest
+bug-reports:    https://github.com/choener/ADPfusionForest/issues
+maintainer:     choener@bioinf.uni-leipzig.de
+category:       Formal Languages, Bioinformatics
+license:        BSD3
+license-file:   LICENSE
+build-type:     Simple
+stability:      experimental
+cabal-version:  >= 1.10.0
+tested-with:    GHC == 8.0.2
+synopsis:       Dynamic programming on tree and forest structures
+description:
+                ADPfusion for formal languages on tree and forest structures.
+                This library connects
+                <http://hackage.haskell.org/package/ForestStructures @ForestStructures@>,
+                a library which defines efficient, tree-like structures and
+                <http://hackage.haskell.org/package/ADPfusion @ADPfusion@>.
+                The result is the ability to easily write formal grammars which
+                act on input trees (as compared to the more common input
+                strings).
+                .
+                Build this library with GHC-8.0.2
+
+
+
+Extra-Source-Files:
+  changelog.md
+  README.md
+  stack.yaml
+  examples/t1.nwk
+  examples/t2.nwk
+
+
+
+flag examples
+  description: build the examples
+  default:     False
+  manual:      True
+
+
+
+library
+  build-depends: base                   >= 4.7      &&  < 5.0
+               , containers             >= 0.5
+               , fgl                    >= 5.5
+               , strict                 >= 0.3
+               , text                   >= 1.2
+               , unordered-containers   >= 0.2
+               , vector                 >= 0.10
+               -- >= 3.4 for Hashable (Vector a)
+               , vector-instances       >= 3.4
+               , vector-th-unbox        >= 0.2
+               , vector-algorithms      >= 0.7
+               --
+               , ADPfusion              == 0.5.2.*
+               , DPutils                == 0.0.1.*
+               , ForestStructures       == 0.0.0.*
+               , GrammarProducts        == 0.1.*
+               , PrimitiveArray         == 0.8.0.*
+
+  exposed-modules:
+    ADP.Fusion.Forest.Align.PRL
+    ADP.Fusion.Forest.Align.RL
+    ADP.Fusion.Forest.Edit.LL
+    -- done
+    ADP.Fusion.Core.ForestEdit.LeftLinear
+    ADP.Fusion.SynVar.Indices.ForestEdit.LeftLinear
+    ADP.Fusion.Term.Deletion.ForestEdit.LeftLinear
+    ADP.Fusion.Term.Epsilon.ForestEdit.LeftLinear
+    ADP.Fusion.Term.Node.ForestEdit.LeftLinear
+    ADP.Fusion.Term.Node.Type
+    -- wip
+    ADP.Fusion.Core.ForestAlign.PermuteRightLinear
+    ADP.Fusion.Term.Epsilon.ForestAlign.PermuteRightLinear
+    ADP.Fusion.Term.Node.ForestAlign.PermuteRightLinear
+    -- current
+    ADP.Fusion.Core.ForestAlign.RightLinear
+    ADP.Fusion.Term.Epsilon.ForestAlign.RightLinear
+    ADP.Fusion.Term.Deletion.ForestAlign.RightLinear
+    ADP.Fusion.Term.Node.ForestAlign.RightLinear
+    ADP.Fusion.SynVar.Indices.ForestAlign.RightLinear
+  default-language:
+    Haskell2010
+  default-extensions: AllowAmbiguousTypes
+                    , BangPatterns
+                    , DataKinds
+                    , FlexibleContexts
+                    , FlexibleInstances
+                    , GADTs
+                    , KindSignatures
+                    , MultiParamTypeClasses
+                    , OverloadedStrings
+                    , RankNTypes
+                    , ScopedTypeVariables
+                    , StandaloneDeriving
+                    , TypeFamilies
+                    , TypeOperators
+                    , UndecidableInstances
+  ghc-options:
+    -O2
+    -funbox-strict-fields
+
+
+
+executable AlignNewickTrees
+  if flag(examples)
+    buildable:
+      True
+    build-depends: base
+                 , cmdargs                >= 0.10
+                 , containers
+                 , filepath
+                 , log-domain             >= 0.10
+                 , text
+                 , vector
+                 --
+                 , ADPfusion
+                 , ADPfusionForest
+                 , BiobaseNewick          >= 0.0.0.1
+                 , ForestStructures
+                 , FormalGrammars         >= 0.3
+                 , PrimitiveArray
+                 , PrimitiveArray-Pretty  >= 0.0
+  else
+    buildable:
+      False
+  hs-source-dirs:
+    src
+  main-is:
+    AlignNewickTrees.hs
+  default-language:
+    Haskell2010
+  default-extensions: BangPatterns
+                    , DataKinds
+                    , DeriveDataTypeable
+                    , FlexibleContexts
+                    , GADTs
+                    , MultiParamTypeClasses
+                    , OverloadedStrings
+                    , QuasiQuotes
+                    , RecordWildCards
+                    , TemplateHaskell
+                    , TypeFamilies
+                    , TypeOperators
+  ghc-options:
+    -O2
+    -funbox-strict-fields
+
+
+
+executable AffineAlignNewickTreesSmall
+  if flag(examples)
+    buildable:
+      True
+    build-depends: base
+                 , cmdargs                >= 0.10
+                 , containers
+                 , filepath
+                 , log-domain             >= 0.10
+                 , text
+                 , vector
+                 --
+                 , ADPfusion
+                 , ADPfusionForest
+                 , BiobaseNewick          >= 0.0.0.1
+                 , ForestStructures
+                 , FormalGrammars         >= 0.3
+                 , PrimitiveArray
+                 , PrimitiveArray-Pretty  >= 0.0
+  else
+    buildable:
+      False
+  hs-source-dirs:
+    src
+  main-is:
+    AffineAlignNewickTreesSmall.hs
+  default-language:
+    Haskell2010
+  default-extensions: BangPatterns
+                    , DataKinds
+                    , DeriveDataTypeable
+                    , FlexibleContexts
+                    , GADTs
+                    , MultiParamTypeClasses
+                    , OverloadedStrings
+                    , QuasiQuotes
+                    , RecordWildCards
+                    , TemplateHaskell
+                    , TypeFamilies
+                    , TypeOperators
+  ghc-options:
+    -O2
+    -funbox-strict-fields
+
+
+-- AffineAlignNewickTrees too  big, use AffineAlignNewickTreesSmall
+
+-- executable EditNewickTrees
+--   if flag(examples)
+--     buildable:
+--       True
+--     build-depends: base
+--                  , cmdargs                >= 0.10
+--                  , containers
+--                  , filepath
+--                  , log-domain             >= 0.10
+--                  , text
+--                  , vector
+--                  --
+--                  , ADPfusion
+--                  , ADPfusionForest
+--                  , BiobaseNewick          >= 0.0.0.1
+--                  , ForestStructures
+--                  , FormalGrammars         >= 0.3
+--                  , PrimitiveArray
+--                  , PrimitiveArray-Pretty  >= 0.0
+--   else
+--     buildable:
+--       False
+--   hs-source-dirs:
+--     src
+--   main-is:
+--     EditNewickTrees.hs
+--   default-language:
+--     Haskell2010
+--   default-extensions: BangPatterns
+--                     , DataKinds
+--                     , DeriveDataTypeable
+--                     , FlexibleContexts
+--                     , GADTs
+--                     , MultiParamTypeClasses
+--                     , OverloadedStrings
+--                     , QuasiQuotes
+--                     , RecordWildCards
+--                     , TemplateHaskell
+--                     , TypeFamilies
+--                     , TypeOperators
+--   ghc-options:
+--     -O2
+--     -funbox-strict-fields
+
+-- executable AffineEditNewickTrees
+--   if flag(examples)
+--     buildable:
+--       True
+--     build-depends: base
+--                  , cmdargs                >= 0.10
+--                  , containers
+--                  , filepath
+--                  , log-domain             >= 0.10
+--                  , text
+--                  , vector
+--                  --
+--                  , ADPfusion
+--                  , ADPfusionForest
+--                  , BiobaseNewick          >= 0.0.0.1
+--                  , ForestStructures
+--                  , FormalGrammars         >= 0.3
+--                  , PrimitiveArray
+--                  , PrimitiveArray-Pretty  >= 0.0
+--   else
+--     buildable:
+--       False
+--   hs-source-dirs:
+--     src
+--   main-is:
+--     AffineEditNewickTrees.hs
+--   default-language:
+--     Haskell2010
+--   default-extensions: BangPatterns
+--                     , DataKinds
+--                     , DeriveDataTypeable
+--                     , FlexibleContexts
+--                     , GADTs
+--                     , MultiParamTypeClasses
+--                     , OverloadedStrings
+--                     , QuasiQuotes
+--                     , RecordWildCards
+--                     , TemplateHaskell
+--                     , TypeFamilies
+--                     , TypeOperators
+--   ghc-options:
+--     -O2
+--     -funbox-strict-fields
+
+
+
+-- executable EditNew
+--   if flag(examples)
+--     buildable:
+--       True
+--     build-depends: base
+--                  , cmdargs                >= 0.10
+--                  , containers
+--                  , filepath
+--                  , log-domain             >= 0.10
+--                  , text
+--                  , vector
+--                  --
+--                  , ADPfusion
+--                  , ADPfusionForest
+--                  , BiobaseNewick          >= 0.0.0.1
+--                  , ForestStructures
+--                  , FormalGrammars         >= 0.3
+--                  , PrimitiveArray
+--                  , PrimitiveArray-Pretty  >= 0.0
+--   else
+--     buildable:
+--       False
+--   hs-source-dirs:
+--     src
+--   main-is:
+--     EditNew.hs
+--   default-language:
+--     Haskell2010
+--   default-extensions: BangPatterns
+--                     , DataKinds
+--                     , DeriveDataTypeable
+--                     , FlexibleContexts
+--                     , GADTs
+--                     , MultiParamTypeClasses
+--                     , OverloadedStrings
+--                     , QuasiQuotes
+--                     , RecordWildCards
+--                     , TemplateHaskell
+--                     , TypeFamilies
+--                     , TypeOperators
+--   ghc-options:
+--     -O2
+--     -funbox-strict-fields
+
+
+
+-- executable SingleEdit
+--   if flag(examples)
+--     buildable:
+--       True
+--     build-depends: base
+--                  , cmdargs                >= 0.10
+--                  , containers
+--                  , filepath
+--                  , log-domain             >= 0.10
+--                  , text
+--                  , vector
+--                  --
+--                  , ADPfusion
+--                  , ADPfusionForest
+--                  , BiobaseNewick          >= 0.0.0.1
+--                  , ForestStructures
+--                  , FormalGrammars         >= 0.3
+--                  , PrimitiveArray
+--                  , PrimitiveArray-Pretty  >= 0.0
+--   else
+--     buildable:
+--       False
+--   hs-source-dirs:
+--     src
+--   main-is:
+--     SingleEdit.hs
+--   default-language:
+--     Haskell2010
+--   default-extensions: BangPatterns
+--                     , DataKinds
+--                     , DeriveDataTypeable
+--                     , FlexibleContexts
+--                     , GADTs
+--                     , MultiParamTypeClasses
+--                     , OverloadedStrings
+--                     , QuasiQuotes
+--                     , RecordWildCards
+--                     , TemplateHaskell
+--                     , TypeFamilies
+--                     , TypeOperators
+--   ghc-options:
+--     -O2
+--     -funbox-strict-fields
+
+
+
+test-suite properties
+  type:
+    exitcode-stdio-1.0
+  main-is:
+    properties.hs
+  ghc-options:
+    -threaded -rtsopts -with-rtsopts=-N -O2 -funbox-strict-fields
+  hs-source-dirs:
+    tests
+  default-language:
+    Haskell2010
+  default-extensions: BangPatterns
+  build-depends: base
+               , QuickCheck
+               , tasty              >= 0.11
+               , tasty-quickcheck   >= 0.8
+               , tasty-th           >= 0.1
+               --
+               , ADPfusionForest
+
+
+
+benchmark benchmark
+  build-depends:  base
+               ,  criterion   >=  1.0.2
+               ,  ForestStructures
+  default-language:
+    Haskell2010
+  hs-source-dirs:
+    tests
+  main-is:
+    benchmark.hs
+  type:
+    exitcode-stdio-1.0
+  ghc-options:
+    -O2
+
+
+
+source-repository head
+  type: git
+  location: git://github.com/choener/ADPfusionForest
+
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright Christian Hoener zu Siederdissen 2016
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Christian Hoener zu Siederdissen nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -0,0 +1,18 @@
+[![Build Status](https://travis-ci.org/choener/ADPfusionForest.svg?branch=master)](https://travis-ci.org/choener/ADPfusionForest)
+
+# ADPfusionForest: Dynamic and static tree and forest structures
+
+This library extents ADPfusion to accept input in the form of trees and
+forests.
+
+WARNING: Building with examples will leading to somewhat long compilation
+times.
+
+
+#### Contact
+
+Christian Hoener zu Siederdissen  
+Leipzig University, Leipzig, Germany  
+choener@bioinf.uni-leipzig.de  
+http://www.bioinf.uni-leipzig.de/~choener/  
+
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/changelog.md b/changelog.md
new file mode 100644
--- /dev/null
+++ b/changelog.md
@@ -0,0 +1,6 @@
+0.0.0.1
+-------
+
+- initial checkin
+- stack.yaml file
+
diff --git a/examples/t1.nwk b/examples/t1.nwk
new file mode 100644
--- /dev/null
+++ b/examples/t1.nwk
@@ -0,0 +1,1 @@
+(((a,f)x,(a,e,f)w)t,((a,f)v,(g,h)u)s)r;
diff --git a/examples/t2.nwk b/examples/t2.nwk
new file mode 100644
--- /dev/null
+++ b/examples/t2.nwk
@@ -0,0 +1,1 @@
+(((a,b,c),(d,e,f)),(g,h))r;
diff --git a/src/AffineAlignNewickTreesSmall.hs b/src/AffineAlignNewickTreesSmall.hs
new file mode 100644
--- /dev/null
+++ b/src/AffineAlignNewickTreesSmall.hs
@@ -0,0 +1,387 @@
+
+module Main where
+
+import           Control.Monad(forM_,unless)
+import           Data.Char (toLower)
+import           Data.List (nub,tails)
+import           Data.List (sortBy)
+import           Data.Ord (comparing)
+import           Data.Vector.Fusion.Util
+import           Debug.Trace
+import           Numeric.Log
+import qualified Data.Text as Text
+import qualified Data.Tree as T
+import qualified Data.Vector as V
+import qualified Data.Vector.Fusion.Stream.Monadic as SM
+import qualified Data.Vector.Generic as VG
+import           System.Console.CmdArgs
+import           System.Exit (exitFailure)
+import           System.FilePath
+import           Text.Printf
+import           Unsafe.Coerce
+
+import           ADP.Fusion.Core
+import           Biobase.Newick
+import           Data.Forest.Static (TreeOrder(..),Forest)
+import           Data.PrimitiveArray as PA hiding (map)
+import qualified Diagrams.TwoD.ProbabilityGrid as PG
+import           FormalLanguage.CFG
+import qualified Data.Forest.Static as F
+
+import           ADP.Fusion.Forest.Align.RL
+
+
+
+[formalLanguage|
+Verbose
+
+Grammar: Global
+N: T -- tree
+N: F -- forest
+N: Z -- tree for gaps
+N: Q -- sibling gap mode
+N: R -- parent gap mode
+N: E
+T: n
+S: [F,F]
+[F,F] -> iter    <<< [T,T] [F,F]
+[F,F] -> fgap    <<< [T,Z] [Q,Q]
+[F,F] -> fgap    <<< [Z,T] [Q,Q]
+[Z,T] -> indel   <<< [-,n] [R,R]
+[T,Z] -> delin   <<< [n,-] [R,R]
+[T,T] -> align   <<< [n,n] [F,F]
+[F,F] -> done    <<< [E,E]
+[R,R] -> done    <<< [E,E]
+[R,R] -> pgap <<< [T,T] [R,R]
+[R,R] -> pgap <<< [T,Z] [R,R]
+[R,R] -> pgap <<< [Z,T] [R,R]
+[Q,Q] -> done    <<< [E,E]
+[Q,Q] -> siter <<< [T,T] [F,F]
+[Q,Q] -> sgap <<< [T,Z] [Q,Q]
+[Q,Q] -> sgap <<< [Z,T] [Q,Q]
+[E,E] -> finalDone <<< [e,e]
+//
+Outside: Labolg
+Source: Global
+//
+
+Emit: Global
+Emit: Labolg
+|]
+
+makeAlgebraProduct ''SigGlobal
+
+resig :: Monad m => SigGlobal m a b c d -> SigLabolg m a b c d
+resig (SigGlobal gdo git gsi gal gin gde gfg gpg gsg gfi gh) = SigLabolg gdo git gsi gal gin gde gfg gpg gsg gfi gh
+{-# Inline resig #-}
+
+
+score :: Monad m => Int -> Int -> Int -> Int -> SigGlobal m Int Int Info Info
+score matchSc notmatchSc delinSc affinSc = SigGlobal -- match affine deletion 
+  { gDone  = \ f -> f --  (Z:.():.()) -> 0 -- traceShow "EEEEEEEEEEEEE" 0
+  , gFinalDone  = \ (Z:.():.()) -> 0 -- traceShow "EEEEEEEEEEEEE" 0
+  , gIter  = \ t f -> t+f
+  , gSiter  = \ t f -> t+f
+  , gAlign = \ (Z:.c:.b) f -> tSI glb ("ALIGN",f,c,b) $ f + if label c == label b then matchSc else notmatchSc
+  , gIndel = \ (Z:.():.b) f -> tSI glb ("INDEL",f,b) $ f
+  , gDelin = \ (Z:.c:.()) f -> tSI glb ("DELIN",f,c) $ f
+  , gFgap = \ t f -> tSI glb ("gap",f+t,delinSc) $ t + f + delinSc --gap open
+  , gPgap = \ t f -> tSI glb ("gap",f+t,affinSc) $ t + f + affinSc --gap extension
+  , gSgap = \ t f -> tSI glb ("gap",f+t,affinSc) $ t + f + affinSc --gap extension
+  , gH     = SM.foldl' max (-88888)
+  }
+{-# Inline score #-}
+
+part :: Monad m => Log Double -> Log Double -> Log Double -> Log Double -> Log Double -> SigGlobal m (Log Double) (Log Double) Info Info
+part matchSc mismatchSc delinSc affinSc temp = SigGlobal
+  { gDone  = \ f -> f 
+  , gIter  = \ t f -> tSI glb ("TFTFTFTFTF",t,f) $ t * f
+  , gFinalDone  = \ (Z:.():.()) -> 1
+  , gSiter  = \ t f -> tSI glb ("TFTFTFTFTF",t,f) $ t * f
+  , gAlign = \ (Z:.a:.b) f -> tSI glb ("ALIGN",f,a,b) $ f * if label a == label b then matchSc else mismatchSc
+  , gIndel = \ (Z:.():.b) f -> tSI glb ("INDEL",f,b) $ f
+  , gDelin = \ (Z:.a:.()) f -> tSI glb ("DELIN",f,a) $ f
+  , gFgap = \ t f -> t * f * delinSc
+  , gPgap = \ t f -> t * f * affinSc
+  , gSgap = \ t f -> t * f * affinSc
+  , gH     = SM.foldl' (+) 0.000000
+  }
+{-# Inline part #-}
+
+
+
+type Pretty' = [[T.Tree (Info,Info)]]
+pretty' :: Monad m => SigGlobal m [T.Tree (Info,Info)] [[T.Tree ((Info,Info))]] Info Info
+pretty' = SigGlobal
+  { gDone  = \ f -> f -- (Z:.():.()) -> []
+  , gFinalDone  = \ (Z:.():.()) -> []
+  , gIter  = \ t f -> t++f
+  , gSiter  = \ t f -> t++f
+  , gAlign = \ (Z:.a:.b) f -> [T.Node (a,b) f]
+  , gIndel = \ (Z:.():.b) f -> [T.Node (Info "-" 0,b) f]
+  , gDelin = \ (Z:.a:.()) f -> [T.Node (a,Info "-" 0) f]
+  , gPgap = \ t f -> t ++ f
+  , gSgap = \ t f -> t ++ f
+  , gFgap = \ t f -> t ++ f
+  , gH     = SM.toList
+  }
+{-# Inline pretty' #-}
+
+
+
+type Trix = TreeIxR Pre V.Vector Info I
+type Tbl x = TwITbl Id Unboxed (Z:.EmptyOk:.EmptyOk) (Z:.Trix:.Trix) x
+type Frst = Forest Pre V.Vector Info
+type TblBt x = TwITblBt Unboxed (Z:.EmptyOk:.EmptyOk) (Z:.Trix:.Trix) Int Id Id [x]
+type B = T.Tree (Info,Info)
+
+
+-- | likelihood part
+--
+--NOTE for an explanation which ITbl gets @0@ or @1@ check @runInside@,
+--they have the same order requirements.
+
+runForward :: Frst -> Frst -> Int -> Int -> Int -> Int -> Z:.Tbl Int:.Tbl Int:.Tbl Int:.Tbl Int:.Tbl Int:.Tbl Int:.Tbl Int
+runForward f1 f2 matchSc notmatchSc delinSc affinSc = let
+                         in
+                           mutateTablesST $
+                           gGlobal (score matchSc notmatchSc delinSc affinSc) -- costs
+                           (ITbl 0 0 (Z:.EmptyOk:.EmptyOk) (PA.fromAssocs (Z:.minIx f1:.minIx f2) (Z:.maxIx f1:.maxIx f2) (-99999) [] ))
+                           (ITbl 1 1 (Z:.EmptyOk:.EmptyOk) (PA.fromAssocs (Z:.minIx f1:.minIx f2) (Z:.maxIx f1:.maxIx f2) (-99999) [] ))
+                           (ITbl 1 1 (Z:.EmptyOk:.EmptyOk) (PA.fromAssocs (Z:.minIx f1:.minIx f2) (Z:.maxIx f1:.maxIx f2) (-99999) [] ))
+                           (ITbl 1 1 (Z:.EmptyOk:.EmptyOk) (PA.fromAssocs (Z:.minIx f1:.minIx f2) (Z:.maxIx f1:.maxIx f2) (-99999) [] ))
+                           (ITbl 1 0 (Z:.EmptyOk:.EmptyOk) (PA.fromAssocs (Z:.minIx f1:.minIx f2) (Z:.maxIx f1:.maxIx f2) (-99999) [] ))
+                           (ITbl 1 0 (Z:.EmptyOk:.EmptyOk) (PA.fromAssocs (Z:.minIx f1:.minIx f2) (Z:.maxIx f1:.maxIx f2) (-99999) [] ))
+                           (ITbl 1 0 (Z:.EmptyOk:.EmptyOk) (PA.fromAssocs (Z:.minIx f1:.minIx f2) (Z:.maxIx f1:.maxIx f2) (-99999) [] ))
+                           (node NTany $ F.label f1)
+                           (node NTany $ F.label f2)
+{-# NoInline runForward #-}
+
+
+-- |inside part
+--
+-- NOTE : Each @ITbl@ has a big-order (1st index) and a little-order index.
+-- We need these indices because we operate on unboxed tables internally
+-- for efficiency reasons.
+--
+-- The big-order index is for full table calculations. All @ITbl@s with
+-- smaller "big order" are fully calculated before any @ITbl@s with larger
+-- big orders.
+--
+-- The little-order influences per-cell calculations. Cells with the same
+-- index are sorted by order and those with a smaller index calculated
+-- first.
+--
+-- For this calculation we have the following:
+--
+-- @EE@ has only one rule: @EE -> ε@, the full table is filled before any
+-- other table and has big order @0@.
+--
+-- Now, we only have tables with big order @1@ left.
+--
+-- @TT@, @TZ@, and @ZT@ have only rules that each have at least one
+-- non-empty terminal in play. @TZ@ for example has @TZ -> [n,-] RR@.
+-- They are executed first for a given index, because they are guaranteed
+-- to get "smaller" during recursion. Hence little order @0@.
+--
+-- Finally, @FF@, @QQ@, @RR@ all combine *only* syntactic symbols on the
+-- right-hand side. In addition these symbols can be empty. They need to
+-- come last and have little order @1@.
+
+runInside :: Frst -> Frst -> Log Double -> Log Double -> Log Double -> Log Double -> Log Double -> Z:.Tbl (Log Double):.Tbl (Log Double):.Tbl (Log Double):.Tbl (Log Double):.Tbl (Log Double):.Tbl (Log Double):.Tbl (Log Double)
+runInside f1 f2 matchSc notmatchSc delinSc affinSc temperature = let
+                         in
+                           mutateTablesDefault $
+                           gGlobal (part matchSc notmatchSc delinSc affinSc temperature) -- costs
+                           (ITbl 0 0 (Z:.EmptyOk:.EmptyOk) (PA.fromAssocs (Z:.minIx f1:.minIx f2) (Z:.maxIx f1:.maxIx f2) (0) [] ))   -- EE
+                           (ITbl 1 1 (Z:.EmptyOk:.EmptyOk) (PA.fromAssocs (Z:.minIx f1:.minIx f2) (Z:.maxIx f1:.maxIx f2) (0) [] ))   -- FF
+                           (ITbl 1 1 (Z:.EmptyOk:.EmptyOk) (PA.fromAssocs (Z:.minIx f1:.minIx f2) (Z:.maxIx f1:.maxIx f2) (0) [] ))   -- QQ
+                           (ITbl 1 1 (Z:.EmptyOk:.EmptyOk) (PA.fromAssocs (Z:.minIx f1:.minIx f2) (Z:.maxIx f1:.maxIx f2) (0) [] ))   -- RR
+                           (ITbl 1 0 (Z:.EmptyOk:.EmptyOk) (PA.fromAssocs (Z:.minIx f1:.minIx f2) (Z:.maxIx f1:.maxIx f2) (0) [] ))   -- TT
+                           (ITbl 1 0 (Z:.EmptyOk:.EmptyOk) (PA.fromAssocs (Z:.minIx f1:.minIx f2) (Z:.maxIx f1:.maxIx f2) (0) [] ))   -- TZ
+                           (ITbl 1 0 (Z:.EmptyOk:.EmptyOk) (PA.fromAssocs (Z:.minIx f1:.minIx f2) (Z:.maxIx f1:.maxIx f2) (0) [] ))   -- ZT
+                           (node NTany $ F.label f1)
+                           (node NTany $ F.label f2)
+{-# NoInline runInside #-}
+
+
+
+-- outside part
+type Trox = TreeIxR Pre V.Vector Info O
+type OTbl x = TwITbl Id Unboxed (Z:.EmptyOk:.EmptyOk) (Z:.Trox:.Trox) x
+
+-- | Actual outside calculations.
+--
+-- NOTE: The big and little order indices are reversed compared to
+-- @runInside@. We need to evaluate the tables outside in now.
+
+runOutside :: Frst -> Frst -> Log Double -> Log Double -> Log Double -> Log Double -> Log Double -> Z:.Tbl (Log Double):.Tbl (Log Double):.Tbl (Log Double):.Tbl (Log Double):.Tbl (Log Double):.Tbl (Log Double):.Tbl (Log Double) -> Z:.OTbl (Log Double):.OTbl (Log Double):.OTbl (Log Double):.OTbl (Log Double):.OTbl (Log Double):.OTbl (Log Double):.OTbl (Log Double)
+runOutside f1 f2 matchSc mismatchSc indelSc affinSc temperature (Z:.iE:.iF:.iQ:.iR:.iT:.iS:.iZ)
+  = mutateTablesDefault $
+    gLabolg (resig (part matchSc mismatchSc indelSc affinSc temperature))
+    (ITbl 1 1 (Z:.EmptyOk:.EmptyOk) (PA.fromAssocs (Z:.minIx f1:.minIx f2) (Z:.maxIx f1:.maxIx f2) (0) [] ))
+    (ITbl 0 0 (Z:.EmptyOk:.EmptyOk) (PA.fromAssocs (Z:.minIx f1:.minIx f2) (Z:.maxIx f1:.maxIx f2) (0) [] ))
+    (ITbl 0 0 (Z:.EmptyOk:.EmptyOk) (PA.fromAssocs (Z:.minIx f1:.minIx f2) (Z:.maxIx f1:.maxIx f2) (0) [] ))
+    (ITbl 0 0 (Z:.EmptyOk:.EmptyOk) (PA.fromAssocs (Z:.minIx f1:.minIx f2) (Z:.maxIx f1:.maxIx f2) (0) [] ))
+    (ITbl 0 1 (Z:.EmptyOk:.EmptyOk) (PA.fromAssocs (Z:.minIx f1:.minIx f2) (Z:.maxIx f1:.maxIx f2) (0) [] ))
+    (ITbl 0 1 (Z:.EmptyOk:.EmptyOk) (PA.fromAssocs (Z:.minIx f1:.minIx f2) (Z:.maxIx f1:.maxIx f2) (0) [] ))
+    (ITbl 0 1 (Z:.EmptyOk:.EmptyOk) (PA.fromAssocs (Z:.minIx f1:.minIx f2) (Z:.maxIx f1:.maxIx f2) (0) [] ))
+    iF
+    iQ
+    iR
+    iT
+    iS
+    iZ
+    (node NTany $ F.label f1)
+    (node NTany $ F.label f2)
+{-# NoInline runOutside #-}
+
+
+
+-- inside part
+run :: Frst -> Frst -> Int -> Int -> Int -> Int -> (Z:.Tbl Int:.Tbl Int:.Tbl Int:.Tbl Int:.Tbl Int:.Tbl Int:.Tbl Int,Int,Pretty')
+run f1 f2 matchSc notmatchSc delinSc affinSc = (fwd,unId $ axiom a2, unId $ axiom b2)
+  where fwd@(Z:.a1:.a2:.a3:.a4:.a5:.a6:.a7) = runForward f1 f2 matchSc notmatchSc delinSc affinSc
+        Z:.b1:.b2:.b3:.b4:.b5:.b6:.b7 
+                    = gGlobal ((score matchSc notmatchSc delinSc affinSc) <|| pretty') 
+                    (toBacktrack a1 (undefined :: Id a -> Id a)) 
+                    (toBacktrack a2 (undefined :: Id a -> Id a))  
+                    (toBacktrack a3 (undefined :: Id a -> Id a))  
+                    (toBacktrack a4 (undefined :: Id a -> Id a))  
+                    (toBacktrack a5 (undefined :: Id a -> Id a))  
+                    (toBacktrack a6 (undefined :: Id a -> Id a))  
+                    (toBacktrack a7 (undefined :: Id a -> Id a))  
+                    (node NTany $ F.label f1) (node NTany $ F.label f2)
+                    :: Z:.TblBt B:.TblBt B:.TblBt B:.TblBt B:.TblBt B:.TblBt B:.TblBt B
+{-# NoInline run #-}
+
+
+
+-- outside part
+
+runIO f1 f2 matchSc mismatchSc indelSc affinSc temperature = (fwd,out,unId $ axiom f)
+  where fwd@(Z:.e:.f:.q:.r:.t:.s:.z) = runInside f1 f2 matchSc mismatchSc indelSc affinSc temperature
+        out@(Z:.oet:.oft:.oqt:.ort:.ott:.ost:.ozt) = runOutside f1 f2 matchSc mismatchSc indelSc affinSc temperature fwd
+{-# NoInline runIO #-}
+
+--         a            a
+--        / \          / \
+--       e   d        b   f
+--      / \              / \
+--     b   c            c   d
+--
+--                  (a,a)                 100
+--              /          \
+--         (e,-)            (-,f)         (-3) (-5)
+--        /     \          /     \
+--   (b,b)       (c,-) (-,c)      (d,d)   100  (-3) (-5) 100
+--
+--
+--
+--             (a,a)                          100
+--            /     \
+--       (e,-)       (d,-)                    (-3) (-3)
+--      /     \
+-- (b,b)       (-,f)                          100  (-5)
+--            /     \
+--       (c,c)       (-,d)                    100  (-5)
+
+-- all new from here
+
+data PFT = SVG | EPS
+  deriving (Show,Data,Typeable)
+
+data Options = Options
+  { inputFiles  :: [String]
+  , probFile    :: String
+  , probFileTy  :: PFT
+  , linearScale :: Bool
+  , matchSc     :: Double
+  , notmatchSc  :: Double
+  , delinSc     :: Double
+  , affinSc     :: Double
+  , temperature :: Double
+  }
+  deriving (Show,Data,Typeable)
+
+oOptions = Options
+  { inputFiles  = def &= args
+  , probFile    = def &= help "probability file prefix" -- &= explicit &= name "probfile" &= name "p" --to not guessing names 
+  , probFileTy  = EPS &= help "svg, eps; def=eps "
+  , linearScale = False &= help "use linear, not logarithmic scaling; def=false"
+  , matchSc     = 10   &= help "score for match cases, positive number; def=10"
+  , notmatchSc  = -30 &= help "score for mismatches, negative number; def=-30"
+  , delinSc     = -10 &= help "score for deletions and insertions, negative number; def=-10"
+  , affinSc     = -1 &= help "score for affine gap costs, negative number; def=-1"
+  , temperature = 0.1 &= help "'temperature', strict (0.001) to less strict (0.99); def=0.1"
+  }
+
+main :: IO ()
+main = do
+  o@Options{..} <- cmdArgs oOptions
+  unless (length inputFiles >= 2) $ do
+    putStrLn "give at least two Newick files on the command line"
+    exitFailure
+  let ts = init $ init $ tails inputFiles
+      f z = Exp $ z/temperature 
+  forM_ ts $ \(n1:hs) -> do
+    forM_ hs $ \n2 -> do
+      putStrLn n1
+      putStrLn n2
+      f1 <- readFile n1
+      f2 <- readFile n2
+      runAlignS f1 f2 (round matchSc) (round notmatchSc) (round delinSc) (round affinSc)
+      unless (null probFile) $ do
+        runAlignIO (if linearScale then PG.FWlinear else PG.FWlog) probFileTy (probFile ++ "-" ++ takeBaseName n1 ++ "-" ++ takeBaseName n2 ++ "." ++ (map toLower $ show probFileTy)) f1 f2 (f matchSc) (f notmatchSc) (f delinSc) (f affinSc) (Exp temperature)
+
+
+test n1 n2 = do
+  f1 <- readFile n1
+  f2 <- readFile n2
+  runAlignS f1 f2 10 (-30) (-10) (-1)
+{-# NoInline test #-}
+
+runAlignS t1' t2' matchSc notmatchSc delinSc affinSc = do
+  let f x = either error (F.forestPre . map getNewickTree) $ newicksFromText x
+      t1 = f $ Text.pack t1'
+      t2 = f $ Text.pack t2'
+  let (fwd,sc,bt') = run t1 t2 matchSc notmatchSc delinSc affinSc
+  let (Z:.TW (ITbl _ _ _ iet) _ :.TW (ITbl _ _ _ ift) _ :.TW (ITbl _ _ _ iqt) _ :.TW (ITbl _ _ _ irt) _ :.TW (ITbl _ _ _ itt) _ :.TW (ITbl _ _ _ ist) _ :.TW (ITbl _ _ _ izt) _) = fwd
+  let bt = take 1 bt' -- nub bt'
+  printf "Score: %10d\n" sc
+--  forM_ bt $ \b -> do
+--    putStrLn ""
+--    forM_ b $ \x -> putStrLn $ T.drawTree $ fmap show x
+{-# NoInline runAlignS #-}
+
+runAlignIO fw probFileTy probFile t1' t2' matchSc mismatchSc indelSc affinSc temperature = do
+  let f x = either error (F.forestPre . map getNewickTree) $ newicksFromText x
+      t1 = f $ Text.pack t1'
+      t2 = f $ Text.pack t2'
+  let (inn,out,_) = runIO t1 t2 matchSc mismatchSc indelSc affinSc temperature -- (t2 {F.lsib = VG.fromList [-1,-1], F.rsib = VG.fromList [-1,-1]})
+  let (Z:.TW (ITbl _ _ _ iet) _ :.TW (ITbl _ _ _ ift) _ :.TW (ITbl _ _ _ iqt) _ :.TW (ITbl _ _ _ irt) _ :.TW (ITbl _ _ _ itt) _ :.TW (ITbl _ _ _ ist) _ :.TW (ITbl _ _ _ izt) _) = inn
+  let (Z:.TW (ITbl _ _ _ iet) _ :.TW (ITbl _ _ _ oft) _ :.TW (ITbl _ _ _ oqt) _ :.TW (ITbl _ _ _ ort) _ :.TW (ITbl _ _ _ ott) _ :.TW (ITbl _ _ _ ost) _ :.TW (ITbl _ _ _ ozt) _) = out
+  let (Z:.(TreeIxR frst1 lb1 _):.(TreeIxR frst2 lb2 _), Z:.(TreeIxR _ ub1 _):.(TreeIxR _ ub2 _)) = bounds oft
+  let ix = (Z:.TreeIxR frst1 lb1 F:.TreeIxR frst2 lb2 F)
+  let sc = ift ! ix
+  print sc
+  let ps = map (\(k,k1,k2) ->
+            let k' = unsafeCoerce k
+            in  ( k1
+                , k2
+                , ((itt!k) * (ott!k') / sc)
+                , (maybe "-" label $ F.label t1 VG.!? k1)
+                , (maybe "-" label $ F.label t2 VG.!? k2)
+                )) [ (Z:.TreeIxR frst1 k1 T:.TreeIxR frst2 k2 T,k1,k2) | k1 <- [lb1 .. ub1 - 1], k2 <- [lb2 .. ub2 - 1] ]
+  --
+  let gsc = map (\(k1,k2,sc,l1,l2) -> sc) ps
+  let fillText [] = " "
+      fillText xs = xs
+  mapM_ print gsc
+  let gl1 = map (\k1 -> fillText . Text.unpack $ (maybe "-" label $ F.label t1 VG.!? k1)) [lb1 .. ub1 - 1]
+  let gl2 = map (\k2 -> fillText . Text.unpack $ (maybe "-" label $ F.label t2 VG.!? k2)) [lb2 .. ub2 - 1]
+  case probFileTy of
+         SVG -> PG.svgGridFile probFile fw PG.FSfull ub1 ub2 gl1 gl2 gsc
+         EPS -> PG.epsGridFile probFile fw PG.FSfull ub1 ub2 gl1 gl2 gsc
+{-# NoInline runAlignIO #-}
+
diff --git a/src/AlignNewickTrees.hs b/src/AlignNewickTrees.hs
new file mode 100644
--- /dev/null
+++ b/src/AlignNewickTrees.hs
@@ -0,0 +1,286 @@
+
+module Main where
+
+import           Control.Monad(forM_, unless)
+import           Data.Char (toLower)
+import           Data.List (nub, tails)
+import           Data.List (sortBy)
+import           Data.Ord (comparing)
+import           Data.Vector.Fusion.Util
+import           Debug.Trace
+import           Numeric.Log
+import qualified Data.Text as Text
+import qualified Data.Tree as T
+import qualified Data.Vector as V
+import qualified Data.Vector.Fusion.Stream.Monadic as SM
+import qualified Data.Vector.Generic as VG
+import           System.Console.CmdArgs
+import           System.Exit (exitFailure)
+import           System.FilePath
+import           Text.Printf
+import           Unsafe.Coerce
+
+import           ADP.Fusion.Core
+import           Biobase.Newick
+import           Data.Forest.Static (TreeOrder(..),Forest)
+import           Data.PrimitiveArray as PA hiding (map)
+import qualified Diagrams.TwoD.ProbabilityGrid as PG
+import           FormalLanguage.CFG
+import qualified Data.Forest.Static as F
+
+import           ADP.Fusion.Forest.Align.RL
+
+
+
+[formalLanguage|
+Verbose
+
+Grammar: Global
+N: T
+N: F
+N: M
+T: n
+S: [F,F]
+[F,F] -> iter  <<< [T,T] [F,F]
+[F,F] -> iter  <<< [M,M] [F,F]
+[T,T] -> indel <<< [-,n] [F,F]
+[T,T] -> delin <<< [n,-] [F,F]
+[M,M] -> align <<< [n,n] [F,F]
+[F,F] -> done  <<< [e,e]
+//
+Outside: Labolg
+Source: Global
+//
+
+Emit: Global
+Emit: Labolg
+|]
+
+makeAlgebraProduct ''SigGlobal
+
+resig :: Monad m => SigGlobal m a b c d -> SigLabolg m a b c d
+resig (SigGlobal gdo git gal gin gde gh) = SigLabolg gdo git gal gin gde gh
+{-# Inline resig #-}
+
+score :: Monad m => Int -> Int -> Int -> SigGlobal m Int Int Info Info
+score matchSc notmatchSc delinSc = SigGlobal
+  { gDone  = \ (Z:.():.()) -> 0 -- traceShow "EEEEEEEEEEEEE" 0
+  , gIter  = \ t f -> tSI glb ("TFTFTFTFTF",t,f) $ t+f
+  , gAlign = \ (Z:.a:.b) f -> tSI glb ("ALIGN",f,a,b) $ f + if label a == label b then matchSc else notmatchSc
+  , gIndel = \ (Z:.():.b) f -> tSI glb ("INDEL",f,b) $ f + delinSc
+  , gDelin = \ (Z:.a:.()) f -> tSI glb ("DELIN",f,a) $ f + delinSc
+  , gH     = SM.foldl' max (-88888)
+  }
+{-# Inline score #-}
+
+part :: Monad m => Log Double -> Log Double -> Log Double -> Log Double -> SigGlobal m (Log Double) (Log Double) Info Info
+part matchSc mismatchSc indelSc temp = SigGlobal
+  { gDone  = \ (Z:.():.()) -> 1
+  , gIter  = \ t f -> tSI glb ("TFTFTFTFTF",t,f) $ t * f
+  , gAlign = \ (Z:.a:.b) f -> tSI glb ("ALIGN",f,a,b) $ f * if label a == label b then matchSc else mismatchSc
+  , gIndel = \ (Z:.():.b) f -> tSI glb ("INDEL",f,b) $ f * indelSc --exp(-indelSc/temp)
+  , gDelin = \ (Z:.a:.()) f -> tSI glb ("DELIN",f,a) $ f * indelSc --exp(-indelSc/temp)
+  , gH     = SM.foldl' (+) 0.0000001
+  }
+{-# Inline part #-}
+
+type Pretty = [[T.Tree (Info,Info)]]
+pretty :: Monad m => SigGlobal m [T.Tree (Info,Info)] [[T.Tree ((Info,Info))]] Info Info
+pretty = SigGlobal
+  { gDone  = \ (Z:.():.()) -> []
+  , gIter  = \ t f -> t++f
+  , gAlign = \ (Z:.a:.b) f -> [T.Node (a,b) f]
+  , gIndel = \ (Z:.():.b) f -> [T.Node (Info "-" 0,b) f]
+  , gDelin = \ (Z:.a:.()) f -> [T.Node (a,Info "-" 0) f]
+  , gH     = SM.toList
+  }
+{-# Inline pretty #-}
+
+
+
+type Trix = TreeIxR Pre V.Vector Info I
+type Tbl x = TwITbl Id Unboxed (Z:.EmptyOk:.EmptyOk) (Z:.Trix:.Trix) x
+type Frst = Forest Pre V.Vector Info
+type TblBt x = TwITblBt Unboxed (Z:.EmptyOk:.EmptyOk) (Z:.Trix:.Trix) Int Id Id [x]
+type B = T.Tree (Info,Info)
+
+runForward :: Frst -> Frst -> Int -> Int -> Int -> Z:.Tbl Int :.Tbl Int:.Tbl Int
+runForward f1 f2 matchSc notmatchSc delinSc = mutateTablesDefault $
+                   gGlobal (score matchSc notmatchSc delinSc)
+                   (ITbl 0 1 (Z:.EmptyOk:.EmptyOk) (PA.fromAssocs (Z:.minIx f1:.minIx f2) (Z:.maxIx f1:.maxIx f2) (-99999) [] ))
+                   (ITbl 0 0 (Z:.EmptyOk:.EmptyOk) (PA.fromAssocs (Z:.minIx f1:.minIx f2) (Z:.maxIx f1:.maxIx f2) (-99999) [] ))
+                   (ITbl 0 0 (Z:.EmptyOk:.EmptyOk) (PA.fromAssocs (Z:.minIx f1:.minIx f2) (Z:.maxIx f1:.maxIx f2) (-99999) [] ))
+                   (node NTany $ F.label f1)
+                   (node NTany $ F.label f2)
+{-# NoInline runForward #-}
+
+runInside :: Frst -> Frst -> Log Double -> Log Double -> Log Double -> Log Double -> Z:.Tbl (Log Double):.Tbl (Log Double):.Tbl (Log Double)
+runInside f1 f2 matchSc mismatchSc indelSc temperature = mutateTablesDefault $
+                   gGlobal (part matchSc mismatchSc indelSc temperature)
+                   (ITbl 0 1 (Z:.EmptyOk:.EmptyOk) (PA.fromAssocs (Z:.minIx f1:.minIx f2) (Z:.maxIx f1:.maxIx f2) (0) [] ))
+                   (ITbl 0 0 (Z:.EmptyOk:.EmptyOk) (PA.fromAssocs (Z:.minIx f1:.minIx f2) (Z:.maxIx f1:.maxIx f2) (0) [] ))
+                   (ITbl 0 0 (Z:.EmptyOk:.EmptyOk) (PA.fromAssocs (Z:.minIx f1:.minIx f2) (Z:.maxIx f1:.maxIx f2) (0) [] ))
+                   (node NTany $ F.label f1)
+                   (node NTany $ F.label f2)
+{-# NoInline runInside #-}
+
+type Trox = TreeIxR Pre V.Vector Info O
+type OTbl x = TwITbl Id Unboxed (Z:.EmptyOk:.EmptyOk) (Z:.Trox:.Trox) x
+
+runOutside :: Frst -> Frst -> Log Double -> Log Double -> Log Double -> Log Double -> Z:.Tbl (Log Double):.Tbl (Log Double):.Tbl (Log Double) -> Z:.OTbl (Log Double):.OTbl (Log Double):.OTbl (Log Double)
+runOutside f1 f2 matchSc mismatchSc indelSc temperature (Z:.iF:.iM:.iT)
+  = mutateTablesDefault $
+    gLabolg (resig (part matchSc mismatchSc indelSc temperature))
+    (ITbl 0 0 (Z:.EmptyOk:.EmptyOk) (PA.fromAssocs (Z:.minIx f1:.minIx f2) (Z:.maxIx f1:.maxIx f2) (0) [] ))
+    (ITbl 0 1 (Z:.EmptyOk:.EmptyOk) (PA.fromAssocs (Z:.minIx f1:.minIx f2) (Z:.maxIx f1:.maxIx f2) (0) [] ))
+    (ITbl 0 1 (Z:.EmptyOk:.EmptyOk) (PA.fromAssocs (Z:.minIx f1:.minIx f2) (Z:.maxIx f1:.maxIx f2) (0) [] ))
+    iF
+    iM
+    iT
+    (node NTany $ F.label f1)
+    (node NTany $ F.label f2)
+{-# NoInline runOutside #-}
+
+runS :: Frst -> Frst -> Int -> Int -> Int -> (Z:.Tbl Int :.Tbl Int:.Tbl Int, Int ,[[T.Tree (Info, Info)]] )
+runS f1 f2 matchSc notmatchSc delinSc = (fwd,unId $ axiom f, unId $ axiom fb)
+  where fwd@(Z:.f:.m:.t) = runForward f1 f2 matchSc notmatchSc delinSc
+        Z:.fb:.fm:.tb = gGlobal ((score matchSc notmatchSc delinSc) <|| pretty) (toBacktrack f (undefined :: Id a -> Id a)) (toBacktrack m (undefined :: Id a -> Id a)) (toBacktrack t (undefined :: Id a -> Id a))
+                        (node NTany $ F.label f1) (node NTany $ F.label f2)
+                        :: Z:.TblBt B:.TblBt B:.TblBt B
+
+runIO f1 f2 matchSc mismatchSc indelSc temperature = (fwd,out,unId $ axiom f)
+  where fwd@(Z:.f:.m:.t) = runInside f1 f2 matchSc mismatchSc indelSc temperature
+        out@(Z:.oft:.omt:.ott) = runOutside f1 f2 matchSc mismatchSc indelSc temperature fwd
+
+
+--         a            a
+--        / \          / \
+--       e   d        b   f
+--      / \              / \
+--     b   c            c   d
+--
+--                  (a,a)                 100
+--              /          \
+--         (e,-)            (-,f)         (-3) (-5)
+--        /     \          /     \
+--   (b,b)       (c,-) (-,c)      (d,d)   100  (-3) (-5) 100
+--
+--
+--
+--             (a,a)                          100
+--            /     \
+--       (e,-)       (d,-)                    (-3) (-3)
+--      /     \
+-- (b,b)       (-,f)                          100  (-5)
+--            /     \
+--       (c,c)       (-,d)                    100  (-5)
+
+t11 = "a;"
+t12 = "a;"
+t21 = "(b,c)a;"
+t22 = "(b,c)a;"
+t31 = "((d,e,f)b,(z)c)a;"  --
+t32 = "(((d,e)y,f)b,(c,(x)i)g)a;"  --
+t41 = "d;(b)e;" -- (b,c)e;"    -- '-3'
+t42 = "(d)f;b;" -- b;"
+t51 = "(b:1,c:1)a:1;"
+t52 = "b:2;c:2;"
+t61 = "((b,c)e,d)a;"
+t62 = "(b,(c,d)f)a;"
+t71 = "(b)a;"
+t72 = "(b)a;"
+
+data PFT = SVG | EPS
+  deriving (Show,Data,Typeable)
+
+data Options = Options
+  { inputFiles  :: [String]
+  , probFile    :: String
+  , probFileTy  :: PFT
+  , linearScale :: Bool
+  , matchSc     :: Double
+  , notmatchSc  :: Double
+  , delinSc     :: Double
+  , temperature :: Double
+  }
+  deriving (Show,Data,Typeable)
+
+oOptions = Options
+  { inputFiles  = def &= args
+  , probFile    = def &= help "probability file prefix" -- &= explicit &= name "probfile" &= name "p" --to not guessing names 
+  , probFileTy  = EPS &= help "svg, eps; def=eps"
+  , linearScale = False &= help "use linear, not logarithmic scaling; def=false"
+  , matchSc     = 10  &= help "score for match cases, positive number; def=10"
+  , notmatchSc  = -30 &= help "score for mismatches, negative number; def=-30"
+  , delinSc     = -10 &= help "score for deletions and insertions, negative number; def=-10"
+  , temperature = 0.1 &= help "'temperature', strict (0.001) to less strict (0.99); def=0.1"
+  }
+
+main :: IO ()
+main = do
+  o@Options{..} <- cmdArgs oOptions
+  unless (length inputFiles >= 2) $ do
+    putStrLn "give at least two Newick files on the command line"
+    exitFailure
+  let ts = init $ init $ tails inputFiles
+      f z = Exp $ z/temperature 
+  forM_ ts $ \(n1:hs) -> do
+    forM_ hs $ \n2 -> do
+      putStrLn n1
+      putStrLn n2
+      f1 <- readFile n1
+      f2 <- readFile n2
+      runAlignS f1 f2 (round matchSc) (round notmatchSc) (round delinSc)
+      unless (null probFile) $ do
+        runAlignIO (if linearScale then PG.FWlinear else PG.FWlog) probFileTy (probFile ++ "-" ++ takeBaseName n1 ++ "-" ++ takeBaseName n2 ++ "." ++ (map toLower $ show probFileTy)) f1 f2 (f matchSc) (f notmatchSc) (f delinSc) (Exp temperature)
+
+
+
+
+runAlignS t1' t2' matchSc notmatchSc delinSc = do
+  let f x = either error (F.forestPre . map getNewickTree) $ newicksFromText x
+      t1 = f $ Text.pack t1'
+      t2 = f $ Text.pack t2'
+  let (fwd,sc,bt') = runS t1 t2 matchSc notmatchSc delinSc
+  let (Z:.TW (ITbl _ _ _ ift) _ :. TW (ITbl _ _ _ imt) _ :. TW (ITbl _ _ _ itt) _) = fwd
+  let bt = take 1 bt' -- TODO make nice !!! nub bt'
+  printf "Score: %10d\n" sc
+  forM_ bt $ \b -> do
+    putStrLn ""
+    forM_ b $ \x -> putStrLn $ T.drawTree $ fmap show x
+
+runAlignIO fw probFileTy probFile t1' t2' matchSc mismatchSc indelSc temperature = do
+  let f x = either error (F.forestPre . map getNewickTree) $ newicksFromText x
+      t1 = f $ Text.pack t1'
+      t2 = f $ Text.pack t2'
+  let (inn,out,_) = runIO t1 t2 matchSc mismatchSc indelSc temperature -- (t2 {F.lsib = VG.fromList [-1,-1], F.rsib = VG.fromList [-1,-1]})
+  let (Z:.TW (ITbl _ _ _ ift) _ :. TW (ITbl _ _ _ imt) _ :. TW (ITbl _ _ _ itt) _) = inn
+  let (Z:.TW (ITbl _ _ _ oft) _ :. TW (ITbl _ _ _ omt) _ :. TW (ITbl _ _ _ ott) _) = out
+  let (Z:.(TreeIxR frst1 lb1 _):.(TreeIxR frst2 lb2 _), Z:.(TreeIxR _ ub1 _):.(TreeIxR _ ub2 _)) = bounds oft
+  let ix = (Z:.TreeIxR frst1 lb1 F:.TreeIxR frst2 lb2 F)
+  let scift = ift ! ix
+  print scift
+  let scoft = Prelude.sum [ oft ! (Z:.TreeIxR frst1 b1 F :. TreeIxR frst2 b2 F) | b1 <- [lb1 .. ub1], b2 <- [lb2 .. ub2] ]
+  print scoft
+  let scimt = Prelude.sum [ imt ! (Z:.TreeIxR frst1 b1 T :. TreeIxR frst2 b2 T) | b1 <- [lb1 .. ub1], b2 <- [lb2 .. ub2] ]
+  print scimt
+  let scomt = Prelude.sum [ omt ! (Z:.TreeIxR frst1 b1 T :. TreeIxR frst2 b2 T) | b1 <- [lb1 .. ub1], b2 <- [lb2 .. ub2] ]
+  print scomt
+  let ps = map (\(k,k1,k2) ->
+            let k' = unsafeCoerce k
+            in  ( k1
+                , k2
+                , ((imt!k) * (omt!k') / scift)
+                , (maybe "-" label $ F.label t1 VG.!? k1)
+                , (maybe "-" label $ F.label t2 VG.!? k2)
+                )) [ (Z:.TreeIxR frst1 k1 T:.TreeIxR frst2 k2 T,k1,k2) | k1 <- [lb1 .. ub1 - 1], k2 <- [lb2 .. ub2 - 1] ]
+  --
+  let gsc = map (\(k1,k2,sc,l1,l2) -> sc) ps
+  let fillText [] = " "
+      fillText xs = xs
+  let gl1 = map (\k1 -> fillText . Text.unpack $ (maybe "-" label $ F.label t1 VG.!? k1)) [lb1 .. ub1 - 1]
+  let gl2 = map (\k2 -> fillText . Text.unpack $ (maybe "-" label $ F.label t2 VG.!? k2)) [lb2 .. ub2 - 1]
+  case probFileTy of
+         SVG -> PG.svgGridFile probFile fw PG.FSfull ub1 ub2 gl1 gl2 gsc
+         EPS -> PG.epsGridFile probFile fw PG.FSfull ub1 ub2 gl1 gl2 gsc
+
diff --git a/stack.yaml b/stack.yaml
new file mode 100644
--- /dev/null
+++ b/stack.yaml
@@ -0,0 +1,25 @@
+resolver: lts-5.2
+
+packages:
+- '.'
+
+extra-deps:
+- ADPfusion-0.5.1.0
+- BiobaseNewick-0.0.0.1
+- cereal-text-0.1.0.1
+- ForestStructures-0.0.0.1
+- FormalGrammars-0.3.0.0
+- GrammarProducts-0.1.1.2
+- hybrid-vectors-0.2.1
+- OneTuple-0.2.1
+- OrderedBits-0.0.1.0
+- PrimitiveArray-0.7.0.1
+- PrimitiveArray-Pretty-0.0.0.1
+- tuple-0.3.0.2
+
+flags:
+  ADPfusionForest:
+    examples: true
+
+extra-package-dbs: []
+
diff --git a/tests/benchmark.hs b/tests/benchmark.hs
new file mode 100644
--- /dev/null
+++ b/tests/benchmark.hs
@@ -0,0 +1,8 @@
+
+module Main where
+
+
+
+main :: IO ()
+main = return ()
+
diff --git a/tests/properties.hs b/tests/properties.hs
new file mode 100644
--- /dev/null
+++ b/tests/properties.hs
@@ -0,0 +1,8 @@
+
+module Main where
+
+
+
+main :: IO ()
+main = return ()
+