diff --git a/adp-multi.cabal b/adp-multi.cabal
--- a/adp-multi.cabal
+++ b/adp-multi.cabal
@@ -1,5 +1,5 @@
 name:           adp-multi
-version:        0.2.2
+version:        0.2.3
 cabal-version:  >= 1.8
 build-type:     Simple
 author:         Maik Riechert
@@ -96,6 +96,8 @@
                    ADP.Tests.RGExampleDim2,
                    ADP.Tests.RGExampleStar,
                    ADP.Tests.TermExample,
+                   ADP.Tests.ThesisExample,
+                   ADP.Tests.TreeAlignExample,
                    ADP.Tests.ZeroStructureTwoBackbonesExample,
                    MCFG.MCFG
   main-is:         ADP/Tests/Suite.hs
diff --git a/src/ADP/Multi/Combinators.hs b/src/ADP/Multi/Combinators.hs
--- a/src/ADP/Multi/Combinators.hs
+++ b/src/ADP/Multi/Combinators.hs
@@ -18,7 +18,6 @@
 import ADP.Multi.Rewriting
 
 
-
 eval :: (b -> c) -> Parser a b -> ([SubwordTree] -> Parser a c)
 eval f parser [] z subword = map f (parser z subword) 
 
diff --git a/src/ADP/Multi/Rewriting/Explicit.hs b/src/ADP/Multi/Rewriting/Explicit.hs
--- a/src/ADP/Multi/Rewriting/Explicit.hs
+++ b/src/ADP/Multi/Rewriting/Explicit.hs
@@ -26,11 +26,9 @@
             parserCount = length infos
             remainingParsers = [parserCount,parserCount-1..1] `zip` infos
             rangeDesc = [(i,j,rewritten)]
-            rangeDescFiltered = filterEmptyRanges rangeDesc
         in trace ("f " ++ show symbolIDs ++ " = " ++ show rewritten) $
            assert (length rewritten == Map.size yieldSizeMap && all (`elem` rewritten) symbolIDs) $
-           if any (\(m,n,d) -> null d && m /= n) rangeDesc then []
-           else constructSubwordsRec yieldSizeMap remainingParsers rangeDescFiltered
+           constructSubwordsRec yieldSizeMap remainingParsers rangeDesc
 
 constructSubwords2 :: SubwordConstructionAlgorithm Dim2
 constructSubwords2 _ _ b | trace ("constructSubwords2 " ++ show b) False = undefined
@@ -41,81 +39,79 @@
             (left,right) = f symbolIDs
             parserCount = length infos
             remainingParsers = [parserCount,parserCount-1..1] `zip` infos
-            rangeDesc = [(i,j,left),(k,l,right)]
-            rangeDescFiltered = filterEmptyRanges rangeDesc
+            rangeDescs = [(i,j,left),(k,l,right)]
         in trace ("f " ++ show symbolIDs ++ " = (" ++ show left ++ "," ++ show right ++ ")") $
-           assert (length left + length right == Map.size yieldSizeMap && all (`elem` (left ++ right)) symbolIDs) $
-           if any (\(m,n,d) -> null d && m /= n) rangeDesc then []
-           else constructSubwordsRec yieldSizeMap remainingParsers rangeDescFiltered
+           assert (length left + length right == Map.size yieldSizeMap && 
+                   all (`elem` (left ++ right)) symbolIDs &&
+                   not (null left) && not (null right)) $
+           constructSubwordsRec yieldSizeMap remainingParsers rangeDescs
 
 
 
 constructSubwordsRec :: YieldSizeMap -> [(Int,ParserInfo)] -> [RangeDesc] -> [SubwordTree]
-constructSubwordsRec a b c | trace ("constructRangesRec " ++ show a ++ " " ++ show b ++ " " ++ show c) False = undefined
-constructSubwordsRec _ [] [] = []
+constructSubwordsRec a b c | trace ("constructSubwordsRec " ++ show a ++ " " ++ show b ++ " " ++ show c) False = undefined
+constructSubwordsRec _ [] _ = []
 constructSubwordsRec yieldSizeMap ((current,ParserInfo1 {}):rest) rangeDescs =
-        let symbolLoc = findSymbol1 current rangeDescs
-            subwords = calcSubwords1 yieldSizeMap symbolLoc
+        let symbolPos = findSymbol1 current rangeDescs
+            subwords = calcSubwords1 yieldSizeMap symbolPos
         in trace ("calc subwords for dim1") $
            trace ("subwords: " ++ show subwords) $
            [ SubwordTree [i,j] restTrees |
              (i,j) <- subwords,
-             let newDescs = constructNewRangeDescs1 rangeDescs symbolLoc (i,j),
+             let newDescs = constructNewRangeDescs1 rangeDescs symbolPos (i,j),
              let restTrees = constructSubwordsRec yieldSizeMap rest newDescs
            ]
 constructSubwordsRec yieldSizeMap ((current,ParserInfo2 {}):rest) rangeDescs =
-        let symbolLocs = findSymbol2 current rangeDescs
-            subwords = calcSubwords2 yieldSizeMap symbolLocs
+        let symbolPositions = findSymbol2 current rangeDescs
+            subwords = calcSubwords2 yieldSizeMap symbolPositions
         in trace ("calc subwords for dim2") $
            trace ("subwords: " ++ show subwords) $
            [ SubwordTree [i,j,k,l] restTrees |
              (i,j,k,l) <- subwords,
-             let newDescs = constructNewRangeDescs2 rangeDescs symbolLocs (i,j,k,l),
+             let newDescs = constructNewRangeDescs2 rangeDescs symbolPositions (i,j,k,l),
              let restTrees = constructSubwordsRec yieldSizeMap rest newDescs
            ]
-constructSubwordsRec _ [] r@(_:_) = error ("programming error " ++ show r)
 
 
 
--- Subword construction doesn't yet take the maximum yield sizes into account.
--- This will further decrease the number of generated subwords and thus increase performance.
-calcSubwords2 :: YieldSizeMap -> ((RangeDesc,Int),(RangeDesc,Int)) -> [Subword2]
+-- The maximum yield sizes are only used in some cases at the moment.
+-- They are not used in: 
+--  1. last case of 'calcSubwords1'
+--  2. 'calcSubwords2Dependent'
+-- Considering maximum yield sizes in all cases will further decrease
+-- the number of generated subwords and thus increase performance.
+calcSubwords2 :: YieldSizeMap -> (SymbolPos,SymbolPos) -> [Subword2]
 calcSubwords2 a b | trace ("calcSubwords2 " ++ show a ++ " " ++ show b) False = undefined
-calcSubwords2 yieldSizeMap (left@((i,j,r),a1Idx),right@((m,n,r'),a2Idx))
-  | r == r' = calcSubwords2Dependent yieldSizeMap (i,j,r) a1Idx a2Idx
+calcSubwords2 yieldSizeMap (left@((i,j,r),sym1Idx),right@((m,n,r'),sym2Idx))
+  | r == r' = calcSubwords2Dependent yieldSizeMap (i,j,r) sym1Idx sym2Idx
   | length r == 1 && length r' == 1 = [(i,j,m,n)]
-  | length r == 1  = [ (i',j',k',l') |
-                        let (i',j') = (i,j)
-                     , (k',l') <- calcSubwords1 yieldSizeMap right
+  | length r == 1  = [ (i,j,k',l') |
+                       (k',l') <- calcSubwords1 yieldSizeMap right
                      ]
-  | length r' == 1 = [ (i',j',k',l') |
-                       let (k',l') = (m,n)
-                     , (i',j') <- calcSubwords1 yieldSizeMap left
+  | length r' == 1 = [ (i',j',m,n) |
+                       (i',j') <- calcSubwords1 yieldSizeMap left
                      ]
   | otherwise = [ (i',j',k',l') |
                   (i',j') <- calcSubwords1 yieldSizeMap left
                 , (k',l') <- calcSubwords1 yieldSizeMap right
                 ]
 
--- assumes that other component is in a different part
-calcSubwords1 :: YieldSizeMap -> (RangeDesc,Int) -> [Subword1]
+calcSubwords1 :: YieldSizeMap -> SymbolPos -> [Subword1]
 calcSubwords1 _ b | trace ("calcSubwords1 " ++ show b) False = undefined
-calcSubwords1 yieldSizeMap pos@((i,j,r),axIdx)
-  | axIdx == 0 =
-         [ (k,l) |
+calcSubwords1 yieldSizeMap pos@((i,j,r),symIdx)
+  | symIdx == 0 =
+         [ (i,l) |
            Just (minY',minYRight') <- [adjustMinYield (i,j) (minY,maxY) (minYRight,maxYRight)]
-         , let k = i
          , l <- [i+minY'..j-minYRight']
          ]
-  | axIdx == length r - 1 =
-         [ (k,l) |
+  | symIdx == length r - 1 =
+         [ (k,j) |
            Just (minYLeft',minY') <- [adjustMinYield (i,j) (minYLeft,maxYLeft) (minY,maxY)]
-         , let l = j
          , k <- [i+minYLeft'..j-minY']
          ]
   | otherwise =
         [ (k,l) |
-          k <- [i+minYLeft..j-minY]
+          k <- [i+minYLeft..j-minY-minYRight]
         , l <- [k+minY..j-minYRight]
         ]
   where (minY,maxY) = yieldSizeOf yieldSizeMap pos
@@ -126,7 +122,7 @@
 adjustMinYield (i,j) (minl,maxl) (minr,maxr) =
         let len = j-i
             adjust oldMinY maxY = let x = maybe oldMinY (\m -> len - m) maxY
-                                  in if x > oldMinY then x else oldMinY
+                                  in max x oldMinY
             minrAdj = adjust minr maxl
             minlAdj = adjust minl maxr
         in do
@@ -134,89 +130,83 @@
            minrRes <- maybe (Just minrAdj) (\m -> if minrAdj > m then Nothing else Just minrAdj) maxr
            Just (minlRes,minrRes)
 
--- assumes that other component is in the same part
+-- assumes that other nonterminal component is in the same part
 calcSubwords2Dependent :: YieldSizeMap -> RangeDesc -> Int -> Int -> [Subword2]
 calcSubwords2Dependent _ b c d | trace ("calcSubwords2Dependent " ++ show b ++ " " ++ show c ++ " " ++ show d) False = undefined
-calcSubwords2Dependent yieldSizeMap (i,j,r) a1Idx a2Idx =
-        let a1Idx' = if a1Idx < a2Idx then a1Idx else a2Idx
-            a2Idx' = if a1Idx < a2Idx then a2Idx else a1Idx
-            subs = doCalcSubwords2Dependent yieldSizeMap (i,j,r) a1Idx' a2Idx'
-        in if a1Idx < a2Idx then subs
+calcSubwords2Dependent yieldSizeMap (i,j,r) sym1Idx sym2Idx =
+        let sym1Idx' = if sym1Idx < sym2Idx then sym1Idx else sym2Idx
+            sym2Idx' = if sym1Idx < sym2Idx then sym2Idx else sym1Idx
+            subs = doCalcSubwords2Dependent yieldSizeMap (i,j,r) sym1Idx' sym2Idx'
+        in if sym1Idx < sym2Idx then subs
            else [ (k,l,m,n) | (m,n,k,l) <- subs ]
 
 doCalcSubwords2Dependent :: YieldSizeMap -> RangeDesc -> Int -> Int -> [Subword2]
-doCalcSubwords2Dependent yieldSizeMap desc@(i,j,r) a1Idx a2Idx =
-   assert (a1Idx < a2Idx) $
+doCalcSubwords2Dependent yieldSizeMap desc@(i,j,r) sym1Idx sym2Idx =
+   assert (sym1Idx < sym2Idx) $
    trace ("min yields: " ++ show minY1 ++ " " ++ show minY2 ++ " " ++ show minYLeft1 ++ " " ++
           show minYLeft2 ++ " " ++ show minYRight1 ++ " " ++ show minYRight2 ++ " " ++ show minYBetween) $
    trace ("max yields: " ++ show maxY1 ++ " " ++ show maxY2 ++ " " ++ show maxYLeft1 ++ " " ++
           show maxYLeft2 ++ " " ++ show maxYRight1 ++ " " ++ show maxYRight2 ++ " " ++ show maxYBetween) $
    result where
 
-   (minY1,maxY1) = yieldSizeOf yieldSizeMap (desc,a1Idx)
-   (minY2,maxY2) = yieldSizeOf yieldSizeMap (desc,a2Idx)
-   (minYLeft1,maxYLeft1) = combinedYieldSizeLeftOf yieldSizeMap (desc,a1Idx)
-   (minYLeft2,maxYLeft2) = combinedYieldSizeLeftOf yieldSizeMap (desc,a2Idx)
-   (minYRight1,maxYRight1) = combinedYieldSizeRightOf yieldSizeMap (desc,a1Idx)
-   (minYRight2,maxYRight2) = combinedYieldSizeRightOf yieldSizeMap (desc,a2Idx)
+   (minY1,maxY1) = yieldSizeOf yieldSizeMap (desc,sym1Idx)
+   (minY2,maxY2) = yieldSizeOf yieldSizeMap (desc,sym2Idx)
+   (minYLeft1,maxYLeft1) = combinedYieldSizeLeftOf yieldSizeMap (desc,sym1Idx)
+   (minYLeft2,maxYLeft2) = combinedYieldSizeLeftOf yieldSizeMap (desc,sym2Idx)
+   (minYRight1,maxYRight1) = combinedYieldSizeRightOf yieldSizeMap (desc,sym1Idx)
+   (minYRight2,maxYRight2) = combinedYieldSizeRightOf yieldSizeMap (desc,sym2Idx)
    minYBetween = minYRight1 - minYRight2 - minY2
    maxYBetween = if isNothing maxYRight1
                  then Nothing
                  else Just $ fromJust maxYRight1 - fromJust maxYRight2 - fromJust maxY2
 
-   neighbors = a1Idx + 1 == a2Idx
+   neighbors = sym1Idx + 1 == sym2Idx
 
-   result | a1Idx == 0 && a2Idx == length r - 1 && neighbors =
-                [ (k,l,l,n) |
-                  let (k,n) = (i,j)
-                , l <- [i+minY1..j-minY2]
+   result | sym1Idx == 0 && sym2Idx == length r - 1 && neighbors =
+                [ (i,l,l,j) |
+                  l <- [i+minY1..j-minY2]
                 ]
 
-          | a1Idx == 0 && a2Idx == length r - 1 =
-                [ (k,l,m,n) |
-                  let (k,n) = (i,j)
-                , l <- [i+minY1..j-minYRight1]
+          | sym1Idx == 0 && sym2Idx == length r - 1 =
+                [ (i,l,m,j) |
+                  l <- [i+minY1..j-minYRight1]
                 , m <- [l+minYBetween..j-minY2]
                 ]
 
-          | a1Idx == 0 && neighbors =
-                [ (k,l,l,n) |
-                  let k = i
-                , l <- [i+minY1..j-minYRight1]
+          | sym1Idx == 0 && neighbors =
+                [ (i,l,l,n) |
+                  l <- [i+minY1..j-minYRight1]
                 , n <- [l+minY2..j-minYRight2]
                 ]
 
-          | a1Idx == 0 =
-                [ (k,l,m,n) |
-                  let k = i
-                , l <- [i+minY1..j-minYRight1]
+          | sym1Idx == 0 =
+                [ (i,l,m,n) |
+                  l <- [i+minY1..j-minYRight1]
                 , m <- [l+minYBetween..j-minY2-minYRight2]
                 , n <- [m+minY2..j-minYRight2]
                 ]
 
-          | a2Idx == length r - 1 && neighbors =
-                [ (k,m,m,n) |
-                  let n = j
-                , m <- [i+minYLeft2..j-minY2]
+          | sym2Idx == length r - 1 && neighbors =
+                [ (k,m,m,j) |
+                  m <- [i+minYLeft2..j-minY2]
                 , k <- [i+minYLeft1..m-minY1]
                 ]
 
-          | a2Idx == length r - 1 =
-                [ (k,l,m,n) |
-                  let n = j
-                , m <- [i+minYLeft2..j-minY2]
+          | sym2Idx == length r - 1 =
+                [ (k,l,m,j) |
+                  m <- [i+minYLeft2..j-minY2]
                 , l <- [i+minY1+minYLeft1..m-minYBetween]
                 , k <- [i+minYLeft1..l-minY1]
                 ]
 
-          | a1Idx > 0 && a2Idx < length r - 1 && neighbors =
+          | sym1Idx > 0 && sym2Idx < length r - 1 && neighbors =
                 [ (k,l,l,n) |
                   k <- [i+minYLeft1..j-minY1-minYRight1]
                 , l <- [k+minY1..j-minYRight1]
                 , n <- [l+minY2..j-minYRight2]
                 ]
 
-          | a1Idx > 0 && a2Idx < length r - 1 =
+          | sym1Idx > 0 && sym2Idx < length r - 1 =
                 [ (k,l,m,n) |
                   k <- [i+minYLeft1..j-minY1-minYRight1]
                 , l <- [k+minY1..j-minYRight1]
@@ -224,4 +214,4 @@
                 , n <- [m+minY2..j-minYRight2]
                 ]
 
-          | otherwise = error "invalid conditions, e.g. a1Idx == a2Idx == 0"
+          | otherwise = error "invalid conditions, e.g. sym1Idx == sym2Idx == 0"
diff --git a/src/ADP/Multi/Rewriting/Model.hs b/src/ADP/Multi/Rewriting/Model.hs
--- a/src/ADP/Multi/Rewriting/Model.hs
+++ b/src/ADP/Multi/Rewriting/Model.hs
@@ -26,13 +26,14 @@
 type Dim1 = [SymbolID] -> [SymbolID] 
 
 -- | 2-dimensional rewriting function
+--   Note: every dimension must contain at least one element
 type Dim2 = [SymbolID] -> ([SymbolID], [SymbolID])
 
--- | Convenience rewriting function for one or more dim1 symbols
+-- | Convenience rewriting function for one or more dim1 parsers
 id1 :: Dim1
 id1 = id
 
--- | Convenience rewriting function for one dim2 symbol
+-- | Convenience rewriting function for one dim2 parser
 id2 :: Dim2
 id2 [c1,c2] = ([c1],[c2])
-id2 _ = error "Only use id2 for single symbols! Write your own rewrite function instead."
+id2 _ = error "Only use id2 for single parsers! Write your own rewriting function instead."
diff --git a/src/ADP/Multi/Rewriting/RangesHelper.hs b/src/ADP/Multi/Rewriting/RangesHelper.hs
--- a/src/ADP/Multi/Rewriting/RangesHelper.hs
+++ b/src/ADP/Multi/Rewriting/RangesHelper.hs
@@ -21,110 +21,108 @@
 --         that name very much, but haven't found a good alternative.
 type RangeDesc = (Int,Int,[SymbolID])
 
+-- | The list index position of a SymbolID in a RangeDesc.
+type SymbolPos = (RangeDesc,Int) 
+
 -- | Searches for the given SymbolID in a list of RangeDesc's
---   and returns its index in the RangeDesc where it was found.  
-findSymbol :: SymbolID -> [RangeDesc] -> (RangeDesc,Int)
-findSymbol (s,idx) r | trace ("findSymbol " ++ show s ++ "," ++ show idx ++ " " ++ show r) False = undefined
-findSymbol (s,idx) rangeDesc =
-         let Just (i,j,r) = find (\(_,_,l') -> any (\(s',i') -> s' == s && i' == idx) l') rangeDesc
-             Just aIdx = elemIndex (s,idx) r
-         in ((i,j,r),aIdx)
+--   and returns its position.  
+findSymbol :: SymbolID -> [RangeDesc] -> SymbolPos
+findSymbol symId r | trace ("findSymbol " ++ show symId ++ " " ++ show r) False = undefined
+findSymbol symId rangeDescs =
+         let Just (i,j,r) = find (\(_,_,l) -> symId `elem` l) rangeDescs
+             Just symIdx = elemIndex symId r
+         in ((i,j,r),symIdx)
 
-findSymbol1 :: Int -> [RangeDesc] -> (RangeDesc,Int)
+findSymbol1 :: Int -> [RangeDesc] -> SymbolPos
 findSymbol1 s = findSymbol (s,1)
 
-findSymbol2 :: Int -> [RangeDesc] -> ((RangeDesc,Int),(RangeDesc,Int))
-findSymbol2 s rangeDesc = (findSymbol (s,1) rangeDesc, findSymbol (s,2) rangeDesc)
+findSymbol2 :: Int -> [RangeDesc] -> (SymbolPos,SymbolPos)
+findSymbol2 s rangeDescs = (findSymbol (s,1) rangeDescs, findSymbol (s,2) rangeDescs)
 
-constructNewRangeDescs1 :: [RangeDesc] -> (RangeDesc,Int) -> Subword1 -> [RangeDesc]
+constructNewRangeDescs1 :: [RangeDesc] -> SymbolPos -> Subword1 -> [RangeDesc]
 constructNewRangeDescs1 d p s | trace ("constructNewRangeDescs1 " ++ show d ++ " " ++ show p ++ " " ++ show s) False = undefined
 constructNewRangeDescs1 descs symbolPosition subword =
         let newDescs = [ newDesc |
                          desc <- descs
                        , newDesc <- processRangeDesc1 desc symbolPosition subword
                        ]
-            count = foldr (\(_,_,l) r -> r + length l) 0
-        in assert (count descs > count newDescs) $
+            countSymbols = foldr (\(_,_,l) r -> r + length l) 0
+        in assert (countSymbols descs > countSymbols newDescs) $
            trace (show newDescs) $
            newDescs
 
-constructNewRangeDescs2 :: [RangeDesc] -> ((RangeDesc,Int),(RangeDesc,Int)) -> Subword2 -> [RangeDesc]
+constructNewRangeDescs2 :: [RangeDesc] -> (SymbolPos,SymbolPos) -> Subword2 -> [RangeDesc]
 constructNewRangeDescs2 d p s | trace ("constructNewRangeDescs2 " ++ show d ++ " " ++ show p ++ " " ++ show s) False = undefined
 constructNewRangeDescs2 descs symbolPositions subword =
         let newDescs = [ newDesc |
                          desc <- descs
                        , newDesc <- processRangeDesc2 desc symbolPositions subword
                        ]
-            count = foldr (\(_,_,l) r -> r + length l) 0
-        in assert (count descs > count newDescs) $
+            countSymbols = foldr (\(_,_,l) r -> r + length l) 0
+        in assert (countSymbols descs > countSymbols newDescs) $
            trace (show newDescs) $
            newDescs
 
-processRangeDesc1 :: RangeDesc -> (RangeDesc,Int) -> Subword1 -> [RangeDesc]
+processRangeDesc1 :: RangeDesc -> SymbolPos -> Subword1 -> [RangeDesc]
 processRangeDesc1 a b c | trace ("processRangeDesc1 " ++ show a ++ " " ++ show b ++ " " ++ show c) False = undefined
-processRangeDesc1 inp (desc,aIdx) (m,n)
+processRangeDesc1 inp (desc,symIdx) (m,n)
   | inp /= desc = [inp]
-  | otherwise = processRangeDescSingle desc aIdx (m,n)
+  | otherwise = processRangeDescSingle desc symIdx (m,n)
 
-processRangeDesc2 :: RangeDesc -> ((RangeDesc,Int),(RangeDesc,Int)) -> Subword2 -> [RangeDesc]
+processRangeDesc2 :: RangeDesc -> (SymbolPos,SymbolPos) -> Subword2 -> [RangeDesc]
 processRangeDesc2 a b c | trace ("processRangeDesc2 " ++ show a ++ " " ++ show b ++ " " ++ show c) False = undefined
-processRangeDesc2 inp ((left,a1Idx),(right,a2Idx)) (m,n,o,p)
+processRangeDesc2 inp ((left,sym1Idx),(right,sym2Idx)) (m,n,o,p)
   | inp /= left && inp /= right = [inp]
   | inp == left && inp == right =
         -- at this point it doesn't matter what the actual ordering is
         -- so we just swap if necessary to make it easier for processRangeDescDouble
-        let (a1Idx',a2Idx',m',n',o',p') =
-                if a1Idx < a2Idx then
-                    (a1Idx,a2Idx,m,n,o,p)
+        let (sym1Idx',sym2Idx',m',n',o',p') =
+                if sym1Idx < sym2Idx then
+                    (sym1Idx,sym2Idx,m,n,o,p)
                 else
-                    (a2Idx,a1Idx,o,p,m,n)
-        in processRangeDescDouble inp a1Idx' a2Idx' (m',n',o',p')
-  | inp == left = processRangeDescSingle left a1Idx (m,n)
-  | inp == right = processRangeDescSingle right a2Idx (o,p)
-
-filterEmptyRanges :: [RangeDesc] -> [RangeDesc]
-filterEmptyRanges l =
-        let f (i,j,d) = not $ null d && i == j
-        in filter f l
+                    (sym2Idx,sym1Idx,o,p,m,n)
+        in processRangeDescDouble inp sym1Idx' sym2Idx' (m',n',o',p')
+  | inp == left = processRangeDescSingle left sym1Idx (m,n)
+  | inp == right = processRangeDescSingle right sym2Idx (o,p)
 
 processRangeDescSingle :: RangeDesc -> Int -> Subword1 -> [RangeDesc]
 processRangeDescSingle a b c | trace ("processRangeDescSingle " ++ show a ++ " " ++ show b ++ " " ++ show c) False = undefined
-processRangeDescSingle (i,j,r) aIdx (k,l)
-  | aIdx == 0 = filterEmptyRanges [(l,j,tail r)]
-  | aIdx == length r - 1 = [(i,k,init r)]
-  | otherwise = [(i,k,take aIdx r),(l,j,drop (aIdx + 1) r)]
+processRangeDescSingle (i,j,r) symIdx (k,l)
+  | symIdx == 0 = [(l,j,tail r)]
+  | symIdx == length r - 1 = [(i,k,init r)]
+  | otherwise = [(i,k,take symIdx r),(l,j,drop (symIdx + 1) r)]
 
--- assumes that a1Idx < a2Idx, see processRangeDesc
+-- assumes that sym1Idx < sym2Idx, see processRangeDesc
 processRangeDescDouble :: RangeDesc -> Int -> Int -> Subword2 -> [RangeDesc]
 processRangeDescDouble a b c d | trace ("processRangeDescDouble " ++ show a ++ " " ++ show b ++ " " ++ show c ++ " " ++ show d) False = undefined
-processRangeDescDouble (i,j,r) a1Idx a2Idx (k,l,m,n) =
-  assert (a1Idx < a2Idx) result where
-  result | a1Idx == 0 && a2Idx == length r - 1 = filterEmptyRanges [(l,m,init (tail r))]
-         | a1Idx == 0 = filterEmptyRanges [(l,m,slice 1 (a2Idx-1) r),(n,j,drop (a2Idx+1) r)]
-         | a2Idx == length r - 1 = filterEmptyRanges [(i,k,take a1Idx r),(l,m,slice (a1Idx+1) (a2Idx-1) r)]
-         | otherwise = filterEmptyRanges [(i,k,take a1Idx r),(l,m,slice (a1Idx+1) (a2Idx-1) r),(n,j,drop (a2Idx+1) r)]
+processRangeDescDouble (i,j,r) sym1Idx sym2Idx (k,l,m,n) =
+  assert (sym1Idx < sym2Idx) result where
+  result | sym1Idx == 0 && sym2Idx == length r - 1 = [(l,m,init (tail r))]
+         | sym1Idx == 0 = [(l,m,slice 1 (sym2Idx-1) r),(n,j,drop (sym2Idx+1) r)]
+         | sym2Idx == length r - 1 = [(i,k,take sym1Idx r),(l,m,slice (sym1Idx+1) (sym2Idx-1) r)]
+         | otherwise = [(i,k,take sym1Idx r),(l,m,slice (sym1Idx+1) (sym2Idx-1) r),(n,j,drop (sym2Idx+1) r)]
     where slice from to xs = take (to - from + 1) (drop from xs)
 
 
 -- | Returns the yield size of the symbol at the given index in
 --   the given RangeDesc. 
-yieldSizeOf :: YieldSizeMap -> (RangeDesc,Int) -> YieldSize
-yieldSizeOf yieldSizeMap ((_,_,r),aIdx) =
+yieldSizeOf :: YieldSizeMap -> SymbolPos -> YieldSize
+yieldSizeOf yieldSizeMap ((_,_,r),symIdx) =
         -- TODO !! might be expensive as it's a list
-        yieldSizeMap Map.! (r !! aIdx)
+        yieldSizeMap Map.! (r !! symIdx)
 
 -- | calculates the combined yield size of all symbols left of the given one
-combinedYieldSizeLeftOf :: YieldSizeMap -> (RangeDesc,Int) -> YieldSize
-combinedYieldSizeLeftOf yieldSizeMap (desc,axIdx)
-  | axIdx == 0 = (0, Just 0)
+combinedYieldSizeLeftOf :: YieldSizeMap -> SymbolPos -> YieldSize
+combinedYieldSizeLeftOf yieldSizeMap (desc,symIdx)
+  | symIdx == 0 = (0, Just 0)
   | otherwise =
-        let leftYieldSizes = map (\i -> yieldSizeOf yieldSizeMap (desc,i)) [0..axIdx-1]
+        let leftYieldSizes = map (\i -> yieldSizeOf yieldSizeMap (desc,i)) [0..symIdx-1]
         in combineYields leftYieldSizes
 
 -- | calculates the combined yield size of all symbols right of the given one
-combinedYieldSizeRightOf :: YieldSizeMap -> (RangeDesc,Int) -> YieldSize
-combinedYieldSizeRightOf yieldSizeMap (desc@(_,_,r),axIdx)
-  | axIdx == length r - 1 = (0, Just 0)
+combinedYieldSizeRightOf :: YieldSizeMap -> SymbolPos -> YieldSize
+combinedYieldSizeRightOf yieldSizeMap (desc@(_,_,r),symIdx)
+  | symIdx == length r - 1 = (0, Just 0)
   | otherwise =
-        let rightYieldSizes = map (\i -> yieldSizeOf yieldSizeMap (desc,i)) [axIdx+1..length r - 1]
+        let rightYieldSizes = map (\i -> yieldSizeOf yieldSizeMap (desc,i)) [symIdx+1..length r - 1]
         in combineYields rightYieldSizes
diff --git a/tests/ADP/Tests/AlignmentExample.hs b/tests/ADP/Tests/AlignmentExample.hs
--- a/tests/ADP/Tests/AlignmentExample.hs
+++ b/tests/ADP/Tests/AlignmentExample.hs
@@ -1,4 +1,4 @@
--- Needleman/Wunsch global alignment
+-- | Needleman/Wunsch global alignment of two sequences
 module ADP.Tests.AlignmentExample where
 
 import ADP.Debug
diff --git a/tests/ADP/Tests/CopyExample.hs b/tests/ADP/Tests/CopyExample.hs
--- a/tests/ADP/Tests/CopyExample.hs
+++ b/tests/ADP/Tests/CopyExample.hs
@@ -1,4 +1,4 @@
--- Copy language L = { ww | w € {a,b}^* }
+-- | Copy language L = { ww | w in {a,b}^* }
 module ADP.Tests.CopyExample where
 
 import ADP.Multi.All
diff --git a/tests/ADP/Tests/CopyTwoTrackExample.hs b/tests/ADP/Tests/CopyTwoTrackExample.hs
--- a/tests/ADP/Tests/CopyTwoTrackExample.hs
+++ b/tests/ADP/Tests/CopyTwoTrackExample.hs
@@ -1,4 +1,4 @@
--- Copy language L = { (w,w) | w € {a,b}^* }
+-- | Copy language L = { (w,w) | w in {a,b}^* }
 module ADP.Tests.CopyTwoTrackExample where
 
 import ADP.Debug
diff --git a/tests/ADP/Tests/Main.hs b/tests/ADP/Tests/Main.hs
--- a/tests/ADP/Tests/Main.hs
+++ b/tests/ADP/Tests/Main.hs
@@ -40,7 +40,6 @@
             -- struc = "..((((..[[[[)))).....]]]]..."
             -- inp = map toLower "ACCGUCGUUCCCGACGUAAAAGGGAUGU"
             
-            -- https://github.com/neothemachine/rna/wiki/Example
             inp = "agcgu"
 
             --inp = map toLower "ACGAUUCAACGU"
diff --git a/tests/ADP/Tests/OneStructureExample.hs b/tests/ADP/Tests/OneStructureExample.hs
--- a/tests/ADP/Tests/OneStructureExample.hs
+++ b/tests/ADP/Tests/OneStructureExample.hs
@@ -7,28 +7,28 @@
 import ADP.Multi.All
 import ADP.Multi.Rewriting.All
                           
-type OneStructure_Algebra alphabet answer = (
-  EPS -> answer,                              -- nil
-  answer -> answer -> answer,               -- left
-  answer -> answer -> answer -> answer,     -- pair
-  (alphabet, alphabet) -> answer,             -- basepair
-  alphabet -> answer,                         -- base
-  answer -> answer,                           -- i1
-  answer -> answer,                           -- i2
-  answer -> answer -> answer -> answer -> answer, -- tstart
-  answer -> answer -> answer -> answer -> answer -> answer -> answer -> answer, -- knotH
-  answer -> answer -> answer -> answer -> answer -> answer -> answer -> answer -> answer -> answer -> answer, -- knotK
-  answer -> answer -> answer -> answer -> answer -> answer -> answer -> answer -> answer -> answer -> answer, -- knotL
-  answer -> answer -> answer -> answer -> answer -> answer -> answer -> answer -> answer -> answer -> answer -> answer -> answer -> answer, -- knotM
-  answer -> answer -> answer -> answer -> answer, -- aknot1
-  answer -> answer,                               -- aknot2
-  answer -> answer -> answer -> answer -> answer, -- bknot1
-  answer -> answer,                               -- bknot2
-  answer -> answer -> answer -> answer -> answer, -- cknot1
-  answer -> answer,                               -- cknot2
-  answer -> answer -> answer -> answer -> answer, -- dknot1
-  answer -> answer,                               -- dknot2
-  [answer] -> [answer]                        -- h
+type OneStructure_Algebra alphabet ans = (
+  EPS -> ans,                        -- nil
+  ans -> ans -> ans,                 -- left
+  ans -> ans -> ans -> ans,          -- pair
+  (alphabet, alphabet) -> ans,       -- basepair
+  alphabet -> ans,                   -- base
+  ans -> ans,                        -- i1
+  ans -> ans,                        -- i2
+  ans -> ans -> ans -> ans -> ans,   -- tstart
+  ans -> ans -> ans -> ans -> ans -> ans -> ans -> ans, -- knotH
+  ans -> ans -> ans -> ans -> ans -> ans -> ans -> ans -> ans -> ans -> ans, -- knotK
+  ans -> ans -> ans -> ans -> ans -> ans -> ans -> ans -> ans -> ans -> ans, -- knotL
+  ans -> ans -> ans -> ans -> ans -> ans -> ans -> ans -> ans -> ans -> ans -> ans -> ans -> ans, -- knotM
+  ans -> ans -> ans -> ans -> ans,   -- aknot1
+  ans -> ans,                        -- aknot2
+  ans -> ans -> ans -> ans -> ans,   -- bknot1
+  ans -> ans,                        -- bknot2
+  ans -> ans -> ans -> ans -> ans,   -- cknot1
+  ans -> ans,                        -- cknot2
+  ans -> ans -> ans -> ans -> ans,   -- dknot1
+  ans -> ans,                        -- dknot2
+  [ans] -> [ans]                     -- h
   )
   
 data T = Nil
@@ -80,7 +80,8 @@
    dknot1 _ = xknot1 "<" ">"
    dknot2 _ = [ "<" , ">" ]
    
-   xknot1 parenL parenR i1 i2 [x1,x2] = [concat $ [parenL] ++ i1 ++ [x1], concat $ [x2] ++ i2 ++ [parenR]]
+   xknot1 parenL parenR i1 i2 [x1,x2] = 
+        [concat $ [parenL] ++ i1 ++ [x1], concat $ [x2] ++ i2 ++ [parenR]]
       
    h = id
    
@@ -123,13 +124,13 @@
    and a convenience function which actually runs the grammar on a given input (oneStructure).
    It is reused in ZeroStructureTwoBackbonesExample.hs
 -}
-oneStructure :: OneStructure_Algebra Char answer -> String -> [answer]
+oneStructure :: OneStructure_Algebra Char ans -> String -> [ans]
 oneStructure algebra inp =
     let z = mk inp
         grammar = oneStructureGrammar algebra z
     in axiom z grammar
 
-oneStructureGrammar :: OneStructure_Algebra Char answer -> Array Int Char -> RichParser Char answer
+oneStructureGrammar :: OneStructure_Algebra Char ans -> Array Int Char -> RichParser Char ans
 oneStructureGrammar algebra z =
   let  
   (nil,left,pair,basepair,base,i1,i2,tstart,knotH,knotK,knotL,knotM,
@@ -150,18 +151,21 @@
       pair <<< p ~~~ s ~~~ s >>> rewritePair
       
   rewriteTStart [p1,p2,i,t,s] = [i,p1,t,p2,s]
-  rewriteKnotH [s,i1,i2,i3,i4,x11,x12,x21,x22] = [i1,x11,i2,x21,i3,x12,i4,x22,s]
-  rewriteKnotK [s,i1,i2,i3,i4,i5,i6,x11,x12,x21,x22,x31,x32] = [i1,x11,i2,x21,i3,x12,i4,x31,i5,x22,i6,x32,s]
-  rewriteKnotL [s,i1,i2,i3,i4,i5,i6,x11,x12,x21,x22,x31,x32] = [i1,x11,i2,x21,i3,x31,i4,x12,i5,x22,i6,x32,s]
+  rewriteKnotH [s,i1,i2,i3,i4,x11,x12,x21,x22] =
+        [i1,x11,i2,x21,i3,x12,i4,x22,s]
+  rewriteKnotK [s,i1,i2,i3,i4,i5,i6,x11,x12,x21,x22,x31,x32] = 
+        [i1,x11,i2,x21,i3,x12,i4,x31,i5,x22,i6,x32,s]
+  rewriteKnotL [s,i1,i2,i3,i4,i5,i6,x11,x12,x21,x22,x31,x32] = 
+        [i1,x11,i2,x21,i3,x31,i4,x12,i5,x22,i6,x32,s]
   rewriteKnotM [s,i1,i2,i3,i4,i5,i6,i7,i8,x11,x12,x21,x22,x31,x32,x41,x42] =
-          [i1,x11,i2,x21,i3,x31,i4,x12,i5,x41,i6,x22,i7,x32,i8,x42,s]
+        [i1,x11,i2,x21,i3,x31,i4,x12,i5,x41,i6,x22,i7,x32,i8,x42,s]
   t = tabulated1 $
       yieldSize1 (2, Nothing) $
       tstart <<< p ~~~ i ~~~ t ~~~ s >>> rewriteTStart |||
-      knotH <<< s ~~~ i ~~~ i ~~~ i ~~~ i ~~~ xa ~~~ xb >>> rewriteKnotH |||
-      knotK <<< s ~~~ i ~~~ i ~~~ i ~~~ i ~~~ i ~~~ i ~~~ xa ~~~ xb ~~~ xc >>> rewriteKnotK |||
-      knotL <<< s ~~~ i ~~~ i ~~~ i ~~~ i ~~~ i ~~~ i ~~~ xa ~~~ xb ~~~ xc >>> rewriteKnotL |||
-      knotM <<< s ~~~ i ~~~ i ~~~ i ~~~ i ~~~ i ~~~ i ~~~ i ~~~ i ~~~ xa ~~~ xb ~~~ xc ~~~ xd >>> rewriteKnotM
+      knotH  <<< s ~~~ i ~~~ i ~~~ i ~~~ i ~~~ xa ~~~ xb >>> rewriteKnotH |||
+      knotK  <<< s ~~~ i ~~~ i ~~~ i ~~~ i ~~~ i ~~~ i ~~~ xa ~~~ xb ~~~ xc >>> rewriteKnotK |||
+      knotL  <<< s ~~~ i ~~~ i ~~~ i ~~~ i ~~~ i ~~~ i ~~~ xa ~~~ xb ~~~ xc >>> rewriteKnotL |||
+      knotM  <<< s ~~~ i ~~~ i ~~~ i ~~~ i ~~~ i ~~~ i ~~~ i ~~~ i ~~~ xa ~~~ xb ~~~ xc ~~~ xd >>> rewriteKnotM
       
   rewriteXKnot1 :: Dim2      
   rewriteXKnot1 [p1,p2,i1,i2,x1,x2] = ([p1,i1,x1],[x2,i2,p2])
diff --git a/tests/ADP/Tests/RGExample.hs b/tests/ADP/Tests/RGExample.hs
--- a/tests/ADP/Tests/RGExample.hs
+++ b/tests/ADP/Tests/RGExample.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE DeriveDataTypeable #-}
 
-{-
+{- |
 Example using the Reeder&Giegerich class of pseudoknots.
 (with only the first canonization rule applied)
 
@@ -22,14 +22,14 @@
 import ADP.Multi.Rewriting.All
                                 
 type RG_Algebra alphabet answer = (
-  EPS -> answer,                               -- nil
+  EPS -> answer,                              -- nil
   answer   -> answer -> answer,               -- left
   answer   -> answer -> answer -> answer,     -- pair
   answer   -> answer -> answer -> answer -> answer -> answer -> answer, -- knot
   answer   -> answer -> answer,               -- knot1
   answer   -> answer,                         -- knot2
   (alphabet, alphabet) -> answer,             -- basepair
-  alphabet -> answer,                  -- base
+  alphabet -> answer,                         -- base
   [answer] -> [answer]                        -- h
   )
   
diff --git a/tests/ADP/Tests/RGExampleDim2.hs b/tests/ADP/Tests/RGExampleDim2.hs
--- a/tests/ADP/Tests/RGExampleDim2.hs
+++ b/tests/ADP/Tests/RGExampleDim2.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE DeriveDataTypeable #-}
 
-{-
+{- |
 The same as RGExample.hs but all 1-dim nonterminals are encoded
 as 2-dim nonterminals.
 -}
@@ -13,10 +13,10 @@
 import ADP.Multi.Rewriting.All
                                  
 type RG_Algebra alphabet answer = (
-  (EPS,EPS) -> answer,                               -- nil
-  answer   -> answer -> answer,               -- left
-  answer   -> answer -> answer -> answer,     -- pair
-  answer   -> answer -> answer -> answer -> answer -> answer -> answer, -- knot
+  (EPS,EPS) -> answer,                        -- nil
+  EPS -> answer   -> answer -> answer,               -- left
+  EPS -> answer   -> answer -> answer -> answer,     -- pair
+  EPS -> answer   -> answer -> answer -> answer -> answer -> answer -> answer, -- knot
   answer   -> answer -> answer,               -- knot1
   answer   -> answer,                         -- knot2
   (alphabet, alphabet) -> answer,             -- basepair
@@ -31,10 +31,10 @@
    (nil'',left'',pair'',knot'',knot1'',knot2'',basepair'',base'',h'') = alg2
 
    nil a = (nil' a, nil'' a)
-   left (b1,b2) (s1,s2) = (left' b1 s1, left'' b2 s2)
-   pair (p1,p2) (s11,s21) (s12,s22) = (pair' p1 s11 s12, pair'' p2 s21 s22)
-   knot (k11,k21) (k12,k22) (s11,s21) (s12,s22) (s13,s23) (s14,s24) =
-        (knot' k11 k12 s11 s12 s13 s14, knot'' k21 k22 s21 s22 s23 s24)
+   left e (b1,b2) (s1,s2) = (left' e b1 s1, left'' e b2 s2)
+   pair e (p1,p2) (s11,s21) (s12,s22) = (pair' e p1 s11 s12, pair'' e p2 s21 s22)
+   knot e (k11,k21) (k12,k22) (s11,s21) (s12,s22) (s13,s23) (s14,s24) =
+        (knot' e k11 k12 s11 s12 s13 s14, knot'' e k21 k22 s21 s22 s23 s24)
    knot1 (p1,p2) (k1,k2) = (knot1' p1 k1, knot1'' p2 k2)
    knot2 (p1,p2) = (knot2' p1, knot2'' p2)
    basepair a = (basepair' a,  basepair'' a)
@@ -51,9 +51,9 @@
 -- As an additional (programming) error check, a second debug enum algebra checks
 -- the types via pattern-matching.
 data Start = Nil
-           | Left' Start Start
-           | Pair Start Start Start
-           | Knot Start Start Start Start Start Start
+           | Left' EPS Start Start
+           | Pair EPS Start Start Start
+           | Knot EPS Start Start Start Start Start Start
            | Knot1 Start Start
            | Knot2 Start
            | BasePair (Char, Char)
@@ -72,14 +72,14 @@
    k' = [Knot1 {}, Knot2 {}]
 
    nil _ = Nil
-   left  b@(Base _) s 
-        | s `isOf` s' = Left' b s
+   left e b@(Base _) s 
+        | s `isOf` s' = Left' e b s
         
-   pair  p@(BasePair _) s1 s2 
-        | [s1,s2] `areOf` s' = Pair p s1 s2
+   pair e p@(BasePair _) s1 s2 
+        | [s1,s2] `areOf` s' = Pair e p s1 s2
         
-   knot k1 k2 s1 s2 s3 s4 
-        | [k1,k2] `areOf` k' && [s1,s2,s3,s4] `areOf` s' = Knot k1 k2 s1 s2 s3 s4
+   knot e k1 k2 s1 s2 s3 s4 
+        | [k1,k2] `areOf` k' && [s1,s2,s3,s4] `areOf` s' = Knot e k1 k2 s1 s2 s3 s4
         
    knot1 p@(BasePair _) k 
         | k `isOf` k' = Knot1 p k
@@ -95,9 +95,9 @@
 maxBasepairs :: RG_Algebra Char Int
 maxBasepairs = (nil,left,pair,knot,knot1,knot2,basepair,base,h) where
    nil _            = 0
-   left a b         = a + b
-   pair a b c       = a + b + c
-   knot a b c d e f = a + b + c + d + e + f
+   left _ a b         = a + b
+   pair _ a b c       = a + b + c
+   knot _ a b c d e f = a + b + c + d + e + f
    knot1 a b        = a + b
    knot2 a          = a
    basepair _       = 1
@@ -108,9 +108,9 @@
 maxKnots :: RG_Algebra Char Int
 maxKnots = (nil,left,pair,knot,knot1,knot2,basepair,base,h) where
    nil _            = 0
-   left _ b         = b
-   pair _ b c       = b + c
-   knot _ _ c d e f = 1 + c + d + e + f
+   left _ _ b         = b
+   pair _ _ b c       = b + c
+   knot _ _ _ c d e f = 1 + c + d + e + f
    knot1 _ _        = 0
    knot2 _          = 0
    basepair _       = 0
@@ -118,22 +118,21 @@
    h []             = []
    h xs             = [maximum xs]
 
--- TODO don't need [String] here as it's all dim2, use (String,String) instead
 -- The left part is the structure and the right part the reconstructed input.
 prettyprint :: RG_Algebra Char ([String],[String])
 prettyprint = (nil,left,pair,knot,knot1,knot2,basepair,base,h) where
    nil _ = ([""],[""])
-   left (bl,br) (sl,sr) = 
+   left _ (bl,br) (sl,sr) = 
         (
              [concat $ bl ++ sl],
              [concat $ br ++ sr]
         )
-   pair ([p1l,p2l],[p1r,p2r]) (s1l,s1r) (s2l,s2r) = 
+   pair _ ([p1l,p2l],[p1r,p2r]) (s1l,s1r) (s2l,s2r) = 
         (
              [concat $ [p1l] ++ s1l ++ [p2l] ++ s2l],
              [concat $ [p1r] ++ s1r ++ [p2r] ++ s2r]
         )
-   knot ([k11l,k12l],[k11r,k12r]) ([k21l,k22l],[k21r,k22r]) (s1l,s1r) (s2l,s2r) (s3l,s3r) (s4l,s4r) =
+   knot _ ([k11l,k12l],[k11r,k12r]) ([k21l,k22l],[k21r,k22r]) (s1l,s1r) (s2l,s2r) (s3l,s3r) (s4l,s4r) =
         let (k11l',k12l') = square k11l k12l
         in
         (
@@ -157,28 +156,27 @@
   let  
   (nil,left,pair,knot,knot1,knot2,basepair,base,h) = algebra
   
-  s1,s2,s3,s4,p',k1,k2 :: Dim2
+  s2,s3,s4,p',k1,k2 :: Dim2
     
   -- all s are 1-dim simulated as 2-dim
-  s1 [c1,c2] = ([],[c1,c2])
-  s2 [b1,b2,s1,s2] = ([],[b1,b2,s1,s2])
-  s3 [p1,p2,s11,s12,s21,s22] = ([],[p1,s11,s12,p2,s21,s22])
-  s4 [k11,k12,k21,k22,s11,s12,s21,s22,s31,s32,s41,s42] = 
-        ([],[k11,s11,s12,k21,s21,s22,k12,s31,s32,k22,s41,s42])
+  s2 [e,b1,b2,s1,s2] = ([e],[b1,b2,s1,s2])
+  s3 [e,p1,p2,s11,s12,s21,s22] = ([e],[p1,s11,s12,p2,s21,s22])
+  s4 [e,k11,k12,k21,k22,s11,s12,s21,s22,s31,s32,s41,s42] = 
+        ([e],[k11,s11,s12,k21,s21,s22,k12,s31,s32,k22,s41,s42])
   
   s = tabulated2 $
       yieldSize2 (0,Nothing) (0,Nothing) $
-      nil <<< (EPS,EPS) >>> s1 |||
-      left <<< b ~~~ s >>> s2 |||
-      pair <<< p ~~~ s ~~~ s >>> s3 |||
-      knot <<< k ~~~ k ~~~ s ~~~ s ~~~ s ~~~ s >>> s4 
+      nil <<< (EPS,EPS) >>> id2 |||
+      left <<< EPS ~~~ b ~~~ s >>> s2 |||
+      pair <<< EPS ~~~ p ~~~ s ~~~ s >>> s3 |||
+      knot <<< EPS ~~~ k ~~~ k ~~~ s ~~~ s ~~~ s ~~~ s >>> s4 
       ... h
       
   b = tabulated2 $
-      base <<< (EPS, 'a') >>> s1 |||
-      base <<< (EPS, 'u') >>> s1 |||
-      base <<< (EPS, 'c') >>> s1 |||
-      base <<< (EPS, 'g') >>> s1
+      base <<< (EPS, 'a') >>> id2 |||
+      base <<< (EPS, 'u') >>> id2 |||
+      base <<< (EPS, 'c') >>> id2 |||
+      base <<< (EPS, 'g') >>> id2
   
   p' [c1,c2] = ([c1],[c2])
   p = tabulated2 $
diff --git a/tests/ADP/Tests/RGExampleStar.hs b/tests/ADP/Tests/RGExampleStar.hs
--- a/tests/ADP/Tests/RGExampleStar.hs
+++ b/tests/ADP/Tests/RGExampleStar.hs
@@ -1,24 +1,14 @@
-{-
+{- |
 This example is a copy of RGExample with the difference that
-(A^*)^i is used in the signature instead of just A or (A,A).
+(A^*)^i is used in the signature instead of just A^i.
 Also, the empty string is used instead of EPS.
 
 The purpose is to have a better relation to the examples in the thesis.
 -}
 module ADP.Tests.RGExampleStar where
 
-{-
-S -> € | BS | P_1 S P_2 S | K_1^1 S K_1^2 S K_2^1 S K_2^2 S
-[K_1,K_2] -> [K_1 P_1, P_2 K_2] | [P_1, P_2]
-[P_1,P_2] -> [a,u] | [u,a] | [g,c] | [c,g] | [g,u] | [u,g]
-B -> a | u | c | g
--}
-
-import qualified Control.Arrow as A
-import Data.Typeable
-import Data.Data
 import ADP.Multi.All
-import ADP.Multi.Rewriting.All
+import ADP.Multi.Rewriting.All 
                  
               
 type RG_Algebra alphabet answer = (
diff --git a/tests/ADP/Tests/Suite.hs b/tests/ADP/Tests/Suite.hs
--- a/tests/ADP/Tests/Suite.hs
+++ b/tests/ADP/Tests/Suite.hs
@@ -10,6 +10,7 @@
 import Test.QuickCheck
 
 import Data.Char (toLower)
+import Data.List (sort)
 
 import qualified ADP.Tests.RGExample as RG
 import qualified ADP.Tests.RGExampleDim2 as RGDim2
@@ -18,6 +19,7 @@
 import qualified ADP.Tests.CopyTwoTrackExample as CopyTT
 import qualified MCFG.MCFG as MCFG
 import qualified ADP.Tests.NestedExample as Nested
+import qualified ADP.Tests.Nussinov as Nussinov
 import qualified ADP.Tests.OneStructureExample as One
 import qualified ADP.Tests.ZeroStructureTwoBackbonesExample as ZeroTT
 
@@ -26,7 +28,7 @@
 main :: IO ()
 main = defaultMainWithOpts
             [
-                testGroup "Property tests" [
+                testGroup "Internal tests" [
                     testGroup "Yield size" [
                         testProperty "map size" prop_yieldSizeMapSize,
                         testProperty "map elements" prop_yieldSizeMapElements,
@@ -34,14 +36,15 @@
                         ]
                     ],
                 testGroup "System tests" [
-                        testCase "finds all reference structures" testRgSimpleCompleteness,
+                        testCase "find all reference structures for 'agcgu'" testRgSimpleCompleteness,
                       -- the following is commented out as it takes quite long
                       --testCase "finds pseudoknot reference structure" testRgRealPseudoknot,
-                        testCase "tests associative function with max basepairs" testRgSimpleBasepairs,
+                        testCase "test if max base pairs of 'agcgu' is 2" testRgSimpleBasepairs,
                         testProperty "produces copy language" prop_copyLanguage,
                         testProperty "produces same derivation trees for copy language grammar" prop_copyLanguageDerivation,
                         testProperty "produces copy language (two track)" prop_copyLanguageTT,
                         testProperty "produces nested rna" prop_nestedRna,
+                        testProperty "algebra product consistency" prop_nestedRna2,
                         testProperty "produces 1-structure rna" prop_oneStructureRna,
                         testProperty "produces RG rna" prop_rgRna,
                         testProperty "produces RG (dim2) rna" prop_rgDim2Rna,
@@ -124,6 +127,16 @@
 prop_nestedRna (RNAString w) =
     let results = Nested.nested Nested.prettyprint w
     in not (null results) && all (\(_,result) -> result == w) results
+
+-- checks if NestedExample.hs and Nussinov.hs produce the same results
+-- this also tests the user-defined *** product operation
+prop_nestedRna2 (RNAString w) =
+    let results1 = Nested.nested (Nested.prettyprint Nested.*** Nested.maxBasepairs) w
+        results2 = Nussinov.nussinov78' (Nussinov.prettyprint Nussinov.*** Nussinov.pairmax) w
+        results3 = Nested.nested (Nested.maxBasepairs Nested.*** Nested.prettyprint) w
+        results4 = Nussinov.nussinov78' (Nussinov.pairmax Nussinov.*** Nussinov.prettyprint) w
+    in sort results1 == sort results2 &&
+       sort results3 == sort results4
 
 -- checks if input sequence can be reconstructed    
 prop_oneStructureRna (RNAString w) =
diff --git a/tests/ADP/Tests/TermExample.hs b/tests/ADP/Tests/TermExample.hs
--- a/tests/ADP/Tests/TermExample.hs
+++ b/tests/ADP/Tests/TermExample.hs
@@ -6,14 +6,14 @@
 import ADP.Multi.Rewriting.All
                                  
 type Term_Algebra alphabet answer = (
-  answer -> answer,
-  answer -> answer,                              -- sym
-  alphabet -> answer -> answer, -- sym1
-  alphabet -> answer, -- sym2
-  alphabet -> alphabet -> alphabet -> alphabet, -- escape
-  answer   -> alphabet -> answer -> alphabet -> answer,               -- fun
-  answer   -> answer,               -- single
-  answer   -> alphabet -> answer -> answer               -- split
+  answer -> answer,                                     -- wrap
+  answer -> answer,                                     -- sym
+  alphabet -> answer -> answer,                         -- sym1
+  alphabet -> answer,                                   -- sym2
+  alphabet -> alphabet -> alphabet -> alphabet,         -- escape
+  answer   -> alphabet -> answer -> alphabet -> answer, -- fun
+  answer   -> answer,                                   -- single
+  answer   -> alphabet -> answer -> answer              -- split
   )
    
 prettyprint :: Term_Algebra Char String
diff --git a/tests/ADP/Tests/ThesisExample.hs b/tests/ADP/Tests/ThesisExample.hs
new file mode 100644
--- /dev/null
+++ b/tests/ADP/Tests/ThesisExample.hs
@@ -0,0 +1,87 @@
+-- | Example code corresponding to section 6.1 of the thesis.
+--   The same but using signatures, products, and more algebras
+--   can be found in RGExample*.hs (variable names are different).
+module ADP.Tests.ThesisExample where
+
+import ADP.Multi.All
+import ADP.Multi.Rewriting.All hiding (id1,id2)
+
+-- rewriting functions
+id1,r0,r1,r2,r3 :: Dim1
+id2,r4          :: Dim2
+
+id1 [x]                          = [x]
+id2 [x1,x2]                      = ([x1],[x2])
+r0 [e]                           = [e]
+r1 [b,z]                         = [b,z]
+r2 [p1,p2,z1,z2]                 = [p1,z1,p2,z2]
+r3 [m11,m12,m21,m22,z1,z2,z3,z4] = [m11,z1,m21,z2,m12,z3,m22,z4]
+r4 [p1,p2,m1,m2]                 = ([m1,p1],[p2,m2])
+
+-- evaluation algebra for terms
+data Term  = F1 Term Term
+           | F2 Term Term Term
+           | F3 String
+           | F4 Term Term Term Term Term Term
+           | F5 Term Term
+           | F6 Term
+           | F7 (String,String)
+           | F8 String
+           deriving (Eq, Show)
+(f1,f2,f3,f4,f5,f6,f7,f8) = (F1,F2,F3,F4,F5,F6,F7,F8)
+h = id
+
+-- or alternatively: evaluation algebra for counting base pairs
+--f1 b z               = z
+--f2 p z1 z2           = p + z1 + z2
+--f3 _                 = 0
+--f4 m1 m2 z1 z2 z3 z4 = m1 + m2 + z1 + z2 + z3 + z4
+--f5 m p               = m + p
+--f6 p                 = p
+--f7 _                 = 1
+--f8 _                 = 0
+--h [] = []
+--h xs = [maximum xs]
+
+-- input
+w = "agcguu"
+w' = mk w
+
+-- memoization
+tabulated1 = table1 w'
+tabulated2 = table2 w'
+
+-- grammar productions
+z = tabulated1 $
+    yieldSize1 (0, Nothing) $
+    f1 <<< b ~~~ z                          >>> r1 |||
+    f2 <<< p ~~~ z ~~~ z                    >>> r2 |||
+    f3 <<< ""                               >>> r0 |||
+    f4 <<< m ~~~  m ~~~ z ~~~ z ~~~ z ~~~ z >>> r3
+    ... h
+        
+m = tabulated2 $
+    yieldSize2 (1, Nothing) (1, Nothing) $
+    f5 <<< m ~~~ p >>> r4  |||
+    f6 <<< p       >>> id2
+    ... h
+
+p = tabulated2 $
+    f7 <<< ("a","u") >>> id2 |||
+    f7 <<< ("u","a") >>> id2 |||
+    f7 <<< ("c","g") >>> id2 |||
+    f7 <<< ("g","c") >>> id2 |||
+    f7 <<< ("g","u") >>> id2 |||
+    f7 <<< ("u","g") >>> id2
+    ... h
+            
+b = tabulated1 $
+    f8 <<< "a" >>> id1 |||
+    f8 <<< "u" >>> id1 |||
+    f8 <<< "c" >>> id1 |||
+    f8 <<< "g" >>> id1
+    ... h
+
+-- result
+(staticInfoZ,parserZ) = z
+result = parserZ w' [0,length w]
diff --git a/tests/ADP/Tests/TreeAlignExample.hs b/tests/ADP/Tests/TreeAlignExample.hs
new file mode 100644
--- /dev/null
+++ b/tests/ADP/Tests/TreeAlignExample.hs
@@ -0,0 +1,109 @@
+-- | Alignment of trees / terms (Jiang et al., 1995)
+module ADP.Tests.TreeAlignExample where
+
+{-
+In ADP-MCFL notation:
+
+X -> (rep,r0)(L,L,X) |
+     (del,r1)(L,X)   |
+     (ins,r2)(L,X)   |
+     (mty,r3)()      |
+     (concat,r4)(X,X)
+L -> f | g
+
+r0(l1,l2,(x1,x2))   = (l1(x1),l2(x2))
+r1(l,(x1,x2))       = (l(x1),x2)
+r2(l,(x1,x2))       = (x1,l(x2))
+r3()                = (,)
+r4((x1,x2),(x3,x4)) = ( x1,x3 , x2,x4 )
+
+In adp-multi, terminals in rewriting functions (here parentheses)
+are moved to the productions.
+-}
+
+import ADP.Multi.All
+import ADP.Multi.Rewriting.All
+                 
+           
+type TreeAlign_Algebra alphabet answer = (
+  alphabet -> alphabet -> answer -> alphabet -> alphabet -> alphabet -> alphabet -> answer,   -- rep
+  alphabet -> answer -> alphabet -> alphabet -> answer,                                       -- del
+  alphabet -> answer -> alphabet -> alphabet -> answer,                                       -- ins
+  (EPS,EPS) -> answer,                                                                        -- mty
+  answer -> answer -> alphabet -> alphabet -> answer,                                         -- concat
+  [answer] -> [answer]                                                                        -- h
+  )
+  
+infixl ***
+(***) :: (Eq b, Eq c) => TreeAlign_Algebra a b -> TreeAlign_Algebra a c -> TreeAlign_Algebra a (b,c)
+alg1 *** alg2 = (rep,del,ins,mty,concat,h) where
+   (rep',del',ins',mty',concat',h') = alg1
+   (rep'',del'',ins'',mty'',concat'',h'') = alg2
+   
+   rep l1 l2 (x1,x2) po1 pc1 po2 pc2 = (rep' l1 l2 x1 po1 pc1 po2 pc2, rep'' l1 l2 x2 po1 pc1 po2 pc2)
+   del l (x1,x2) po pc = (del' l x1 po pc, del'' l x2 po pc)
+   ins l (x1,x2) po pc = (ins' l x1 po pc, ins'' l x2 po pc)
+   mty e = (mty' e, mty'' e)
+   concat (x1,x2) (x3,x4) c1 c2 = (concat' x1 x3 c1 c2, concat'' x2 x4 c1 c2)
+   h xs = [ (x1,x2) |
+            x1 <- h'  [ y1 | (y1,_)  <- xs]
+          , x2 <- h'' [ y2 | (y1,y2) <- xs, y1 == x1]
+          ]
+  
+data Term = Rep Char Char Term
+          | Del Char Term
+          | Ins Char Term
+          | Mty
+          | Concat Term Term
+          deriving (Eq, Show)
+          
+term :: TreeAlign_Algebra Char Term
+term = (rep,del,ins,mty,concat,h) where
+   rep l1 l2 x _ _ _ _  = Rep l1 l2 x
+   del l x _ _          = Del l x 
+   ins l x _ _          = Ins l x
+   mty _                = Mty
+   concat x1 x2 _ _     = Concat x1 x2
+   h                    = id
+
+treeSimilarity :: TreeAlign_Algebra Char Int
+treeSimilarity = (rep,del,ins,mty,concat,h) where
+   rep l1 l2 x _ _ _ _  = x + (if l1 == l2 then 1 else 0)
+   del _ x _ _          = x - 1
+   ins _ x _ _          = x - 1
+   mty _                = 0
+   concat x1 x2 _ _     = x1 + x2
+   h []                 = []
+   h xs                 = [maximum xs]
+
+treeAlign :: TreeAlign_Algebra Char answer -> (String,String) -> [answer]
+treeAlign algebra (inp1,inp2) =
+  let  
+  (rep,del,ins,mty,concat,h) = algebra
+   
+  rRep, rDel, rIns, rConcat :: Dim2
+  
+  rRep [l1,l2,x1,x2,po1,pc1,po2,pc2] = ([l1,po1,x1,pc1],[l2,po2,x2,pc2])
+  rDel [l,x1,x2,po,pc] = ([l,po,x1,pc],[x2])
+  rIns [l,x1,x2,po,pc] = ([x1],[l,po,x2,pc])
+  rConcat [x1,x2,x3,x4,c1,c2] = ([x1,c1,x3],[x2,c2,x4])
+  
+  x = tabulated2 $
+      yieldSize2 (0,Nothing) (0,Nothing) $
+      rep    <<< l ~~~ l ~~~ x ~~~ '(' ~~~ ')' ~~~ '(' ~~~ ')' >>> rRep |||
+      del    <<< l ~~~ x ~~~ '(' ~~~ ')'                       >>> rDel |||
+      ins    <<< l ~~~ x ~~~ '(' ~~~ ')'                       >>> rIns |||
+      mty    <<< (EPS,EPS)                                     >>> id2  |||
+      concat <<< x ~~~ x ~~~ ',' ~~~ ','                       >>> rConcat
+      ... h
+  
+  l = char 'f' |||
+      char 'g'
+      
+  z = mkTwoTrack inp1 inp2
+  tabulated2 = table2 z
+  
+  in axiomTwoTrack z inp1 inp2 x
+  
+test = treeAlign (treeSimilarity *** term) ("f(f(),g(f()))","f(f(),g(f()))")
+test2 = treeAlign (treeSimilarity *** term) ("f(f(),g())","f(f(),g(f()))")
diff --git a/tests/ADP/Tests/ZeroStructureTwoBackbonesExample.hs b/tests/ADP/Tests/ZeroStructureTwoBackbonesExample.hs
--- a/tests/ADP/Tests/ZeroStructureTwoBackbonesExample.hs
+++ b/tests/ADP/Tests/ZeroStructureTwoBackbonesExample.hs
@@ -1,4 +1,5 @@
-{- This example implements the grammar for 0-structures over two backbones from
+{- |
+   This example implements the grammar for 0-structures over two backbones from
    "Topology of RNA-RNA interaction structures" by Andersen et al., 2012
    
    It uses the 1-structure grammar from
@@ -13,31 +14,34 @@
 import ADP.Multi.Rewriting.All
 import qualified ADP.Tests.OneStructureExample as One
 
--- there are two answer types so that the enum algebra can be written (because ADTs aren't extensible)
--- for algebras with numeric answer types it wouldn't matter and we'd only need one type 
-type ZeroStructureTwoBackbones_Algebra alphabet answerOne answer = (
-  One.OneStructure_Algebra alphabet answerOne,
-  answer    -> answerOne -> answerOne -> answer,        -- i1
-  answerOne -> answerOne -> answer,                     -- i2
-  answer -> answer -> answer,                           -- pt1
-  answer -> answer -> answer,                           -- pt2
-  answerOne -> answerOne -> answer -> answer -> answer, -- t1
-  answerOne -> answerOne -> answer -> answer -> answer, -- t2
-  answerOne -> answerOne -> answer -> answer -> answer, -- t3
-  answerOne -> answerOne -> answerOne -> answerOne -> answer -> answer -> answer -> answer, -- t4
-  answerOne -> answerOne -> answerOne -> answerOne -> answerOne -> answerOne -> answer -> answer -> answer -> answer -> answer, -- t5
-  answerOne -> answerOne -> answerOne -> answerOne -> answer -> answer -> answer -> answer, -- t6
-  answerOne -> answerOne -> answerOne -> answerOne -> answer -> answer -> answer -> answer, -- t7
-  answerOne -> answerOne -> answer -> answer -> answer, -- hs2
-  answer -> answer -> answer -> answer -> answer,       -- h1
-  answer -> answer,                                     -- h2
-  answer -> answerOne -> answerOne -> answer -> answer, -- g1
-  answer -> answer,                                     -- g2
-  answer -> answer -> answer,                           -- ub1
-  EPS -> answer,                                        -- ub2
-  alphabet -> answer,                                   -- base
-  (alphabet, alphabet) -> answer,                       -- basepair
-  [answer] -> [answer]                                  -- h
+{- There are two ans types so that the enum
+   algebra can be written (because ADTs aren't extensible).
+   For algebras with numeric ans types it wouldn't matter
+   and we'd only need one type.
+-} 
+type ZeroStructureTwoBackbones_Algebra alphabet ansOne ans = (
+  One.OneStructure_Algebra alphabet ansOne,
+  ans    -> ansOne -> ansOne -> ans,     -- i1
+  ansOne -> ansOne -> ans,               -- i2
+  ans    -> ans    -> ans,               -- pt1
+  ans    -> ans    -> ans,               -- pt2
+  ansOne -> ansOne -> ans -> ans -> ans, -- t1
+  ansOne -> ansOne -> ans -> ans -> ans, -- t2
+  ansOne -> ansOne -> ans -> ans -> ans, -- t3
+  ansOne -> ansOne -> ansOne -> ansOne -> ans -> ans -> ans -> ans,   -- t4
+  ansOne -> ansOne -> ansOne -> ansOne -> ansOne -> ansOne -> ans -> ans -> ans -> ans -> ans, -- t5
+  ansOne -> ansOne -> ansOne -> ansOne -> ans -> ans -> ans -> ans,   -- t6
+  ansOne -> ansOne -> ansOne -> ansOne -> ans -> ans -> ans -> ans,   -- t7
+  ansOne -> ansOne -> ans -> ans -> ans, -- hs2
+  ans -> ans -> ans -> ans -> ans,       -- h1
+  ans -> ans,                            -- h2
+  ans -> ansOne -> ansOne -> ans -> ans, -- g1
+  ans -> ans,                            -- g2
+  ans -> ans -> ans,                     -- ub1
+  EPS -> ans,                            -- ub2
+  alphabet -> ans,                       -- base
+  (alphabet, alphabet) -> ans,           -- basepair
+  [ans] -> [ans]                         -- h
   )
 
 data T = OneStructure One.T
@@ -64,22 +68,28 @@
        deriving (Eq, Show)
 
 enum :: ZeroStructureTwoBackbones_Algebra Char One.T T
-enum = (One.enum,I1,I2,PT1,PT2,T1,T2,T3,T4,T5,T6,T7,Hs2,H1,H2,G1,G2,Ub1,\_->Ub2,Base,BasePair,id)
+enum = (One.enum,I1,I2,PT1,PT2,T1,T2,T3,T4,T5,T6,T7
+       ,Hs2,H1,H2,G1,G2,Ub1,\_->Ub2,Base,BasePair,id)
 
-{- To make the grammar reusable, its definition has been split up into the
-   actual grammar which exposes the start symbol as a parser (zeroStructureTwoBackbonesGrammar)
-   and a convenience function which actually runs the grammar on a given input (zeroStructureTwoBackbones).
+{- To make the grammar reusable, its definition has been split
+   up into the actual grammar which exposes the start symbol
+   as a parser (zeroStructureTwoBackbonesGrammar) and a
+   convenience function which actually runs the grammar on
+   a given input (zeroStructureTwoBackbones).
 -}
-zeroStructureTwoBackbones :: ZeroStructureTwoBackbones_Algebra Char answerOne answer -> (String,String) -> [answer]
+zeroStructureTwoBackbones :: ZeroStructureTwoBackbones_Algebra Char ansOne ans 
+                          -> (String,String) -> [ans]
 zeroStructureTwoBackbones algebra (inp1,inp2) =
     let z = mkTwoTrack inp1 inp2
         grammar = zeroStructureTwoBackbonesGrammar algebra z
     in axiomTwoTrack z inp1 inp2 grammar
 
-zeroStructureTwoBackbonesGrammar :: ZeroStructureTwoBackbones_Algebra Char answerOne answer -> Array Int Char -> RichParser Char answer
+zeroStructureTwoBackbonesGrammar :: ZeroStructureTwoBackbones_Algebra Char ansOne ans 
+                                 -> Array Int Char -> RichParser Char ans
 zeroStructureTwoBackbonesGrammar algebra z =
   let  
-  (oneStructureAlgebra,i1,i2,pt1,pt2,t1,t2,t3,t4,t5,t6,t7,hs2,h1,h2,g1,g2,ub1,ub2,base,basepair,h') = algebra
+  (oneStructureAlgebra,i1,i2,pt1,pt2,t1,t2,t3,t4,t5,
+   t6,t7,hs2,h1,h2,g1,g2,ub1,ub2,base,basepair,h') = algebra
   
   one = One.oneStructureGrammar oneStructureAlgebra z
   
@@ -103,11 +113,14 @@
   rewriteT1 [one1,one2,hs11,hs12,hs21,hs22] = ([hs11,one1,hs21],[hs12,one2,hs22])
   rewriteT2 [one1,one2,g1,g2,hs1,hs2] = ([g1,one1,hs1,one2,g2],[hs2])
   rewriteT3 [one1,one2,hs1,hs2,g1,g2] = ([hs1],[g1,one1,hs2,one2,g2])
-  rewriteT4 [one1,one2,one3,one4,g11,g12,hs1,hs2,g21,g22] = ([g11,one1,hs1,one2,g12],[g21,one3,hs2,one4,g22])
+  rewriteT4 [one1,one2,one3,one4,g11,g12,hs1,hs2,g21,g22]
+        = ([g11,one1,hs1,one2,g12],[g21,one3,hs2,one4,g22])
   rewriteT5 [one1,one2,one3,one4,one5,one6,g11,g12,hs11,hs12,hs21,hs22,g21,g22]
         = ([g11,one1,hs11,one2,hs21,one3,g12],[g21,one4,hs12,one5,hs22,one6,g22])
-  rewriteT6 [one1,one2,one3,one4,g1,g2,hs11,hs12,hs21,hs22] = ([g1,one1,hs11,one2,hs21,one3,g2],[hs12,one4,hs22])
-  rewriteT7 [one1,one2,one3,one4,hs11,hs12,hs21,hs22,g1,g2] = ([hs11,one1,hs21],[g1,one2,hs12,one3,hs22,one4,g2])
+  rewriteT6 [one1,one2,one3,one4,g1,g2,hs11,hs12,hs21,hs22] 
+        = ([g1,one1,hs11,one2,hs21,one3,g2],[hs12,one4,hs22])
+  rewriteT7 [one1,one2,one3,one4,hs11,hs12,hs21,hs22,g1,g2] 
+        = ([hs11,one1,hs21],[g1,one2,hs12,one3,hs22,one4,g2])  
   t = tabulated2 $
       t1 <<< one ~~~ one ~~~ hs  ~~~ hs >>> rewriteT1 |||
       t2 <<< one ~~~ one ~~~ g   ~~~ hs >>> rewriteT2 |||