diff --git a/FormalLanguage/GrammarProduct.hs b/FormalLanguage/GrammarProduct.hs
--- a/FormalLanguage/GrammarProduct.hs
+++ b/FormalLanguage/GrammarProduct.hs
@@ -7,61 +7,10 @@
 -- TODO Later on we probably will be able to multiply without restrictions.
 
 module FormalLanguage.GrammarProduct
-  ( (><)
-  , gAdd
-  , gSubtract
-  , gPower
+  ( module FormalLanguage.GrammarProduct.QQ
   ) where
 
-import Data.Monoid
-
-import FormalLanguage.CFG.Grammar
-
-import FormalLanguage.GrammarProduct.Op.Greibach as Greibach
-import FormalLanguage.GrammarProduct.Op.Chomsky  as Chomsky
-import FormalLanguage.GrammarProduct.Op.Linear   as Linear
-import FormalLanguage.GrammarProduct.Op.Add
-import FormalLanguage.GrammarProduct.Op.Subtract as S
-import FormalLanguage.GrammarProduct.Op.Power as P
-
-
-
--- |
-
-gAdd g h = runAdd $ (Add g) <> (Add h)
-
-gSubtract g h = S.subtract g h
-
-gPower = P.power
-
-
-
--- | The product of two grammars.
---
--- In general, it is quite hard to define the product of two context-free
--- grammars in a way that keeps associativity and also "does what we want it to
--- do" (see paper). For linear grammars it is much easier. Also, for grammars
--- in certain normal forms, a simpler definition is possible. Due to this, we
--- make the choice of the actual way on how to multiply based on the type of
--- grammars given. This, however, should only affect the resulting rules, not
--- the (multi-tape) language that the operations yields.
---
--- TODO I think, left-linear could reasonably be expanded to both, left- and
--- right-linear and maybe linear in general.
---
--- NOTE A proof for associativity is possible, but generally hard, so we prefer
--- to let the framework perform the proof for us.
-
-(><) :: Grammar -> Grammar -> Grammar
-g >< h
-  | isLeftLinear g && isLeftLinear h = runLinear $ Linear g <> Linear h
---  | isChomskyNF  g && isChomskyNF  h = runCNF $ CNF g <> CNF h
---  | isGreibachNF g && isGreibachNF h = runTwoGNF $ TwoGNF g <> TwoGNF h
-  | otherwise                        = error "Grammars in general CFG form are not handled. You need to convert into either Greibach- or Chomsky normal form. This might change in the future"
-
--- | The addition operation defined for two grammars of the same dimension. It
--- forms a monoid under the 'Add' newtype.
-
-(.+) :: Grammar -> Grammar -> Grammar
-g .+ h = runAdd $ Add g <> Add h
+{-
+-}
+import FormalLanguage.GrammarProduct.QQ (grammarProduct)
 
diff --git a/FormalLanguage/GrammarProduct/Op.hs b/FormalLanguage/GrammarProduct/Op.hs
new file mode 100644
--- /dev/null
+++ b/FormalLanguage/GrammarProduct/Op.hs
@@ -0,0 +1,55 @@
+
+module FormalLanguage.GrammarProduct.Op where
+
+import Data.Monoid
+
+import FormalLanguage.CFG.Grammar
+
+import FormalLanguage.GrammarProduct.Op.Greibach as Greibach
+import FormalLanguage.GrammarProduct.Op.Chomsky  as Chomsky
+import FormalLanguage.GrammarProduct.Op.Linear   as Linear
+import FormalLanguage.GrammarProduct.Op.Add
+import FormalLanguage.GrammarProduct.Op.Subtract as S
+import FormalLanguage.GrammarProduct.Op.Power as P
+
+
+
+-- |
+
+gAdd g h = runAdd $ (Add g) <> (Add h)
+
+gSubtract g h = S.subtract g h
+
+gPower = P.power
+
+
+
+-- | The product of two grammars.
+--
+-- In general, it is quite hard to define the product of two context-free
+-- grammars in a way that keeps associativity and also "does what we want it to
+-- do" (see paper). For linear grammars it is much easier. Also, for grammars
+-- in certain normal forms, a simpler definition is possible. Due to this, we
+-- make the choice of the actual way on how to multiply based on the type of
+-- grammars given. This, however, should only affect the resulting rules, not
+-- the (multi-tape) language that the operations yields.
+--
+-- TODO I think, left-linear could reasonably be expanded to both, left- and
+-- right-linear and maybe linear in general.
+--
+-- NOTE A proof for associativity is possible, but generally hard, so we prefer
+-- to let the framework perform the proof for us.
+
+(><) :: Grammar -> Grammar -> Grammar
+g >< h
+  | isLeftLinear g && isLeftLinear h = runLinear $ Linear g <> Linear h
+--  | isChomskyNF  g && isChomskyNF  h = runCNF $ CNF g <> CNF h
+--  | isGreibachNF g && isGreibachNF h = runTwoGNF $ TwoGNF g <> TwoGNF h
+  | otherwise                        = error "Grammars in general CFG form are not handled. You need to convert into either Greibach- or Chomsky normal form. This might change in the future"
+
+-- | The addition operation defined for two grammars of the same dimension. It
+-- forms a monoid under the 'Add' newtype.
+
+(.+) :: Grammar -> Grammar -> Grammar
+g .+ h = runAdd $ Add g <> Add h
+
diff --git a/FormalLanguage/GrammarProduct/Op/Add.hs b/FormalLanguage/GrammarProduct/Op/Add.hs
--- a/FormalLanguage/GrammarProduct/Op/Add.hs
+++ b/FormalLanguage/GrammarProduct/Op/Add.hs
@@ -1,8 +1,7 @@
-{-# LANGUAGE FlexibleInstances #-}
 
 module FormalLanguage.GrammarProduct.Op.Add where
 
-import Control.Lens
+import Control.Lens hiding (outside)
 import Control.Lens.Fold
 import Control.Newtype
 import Data.List (genericReplicate)
@@ -10,11 +9,19 @@
 import Data.Semigroup
 import qualified Data.Set as S
 import Text.Printf
+import Data.Default
 
 import FormalLanguage.CFG.Grammar
 
+import FormalLanguage.GrammarProduct.Op.Common
 
 
+
+-- |
+
+add :: Grammar -> Grammar -> Grammar
+add l r = runAdd $ Add l <> Add r
+
 -- | Add two grammars. Implemented as the union of production rules without any
 -- renaming.
 
@@ -28,32 +35,23 @@
 
 instance Semigroup (Add Grammar) where
   (Add l) <> (Add r)
-    | gDim l /= gDim r
-    = error $ printf "ERROR: grammars \n%s\n and \n%s\n have different dimensions, cannot unify. (add %d %d)"
-                (show l)
-                (show r)
-                (gDim l)
-                (gDim r)
-    | otherwise = Add $ Grammar (l^.tsyms <> r^.tsyms)
-                                (l^.nsyms <> r^.nsyms) -- TODO add the newly created symbol to the non-terminals (or maybe just run ``fix T+N 's from the rules?'')
-                                (l^.epsis <> r^.epsis)
-                                (l^.rules <> r^.rules <> t)
+    | Left err <- opCompatible l r = error err
+    | otherwise = Add $ Grammar (l^.synvars  <> r^.synvars)
+                                (l^.synterms <> r^.synterms) -- TODO add the newly created symbol to the non-terminals (or maybe just run ``fix T+N 's from the rules?'')
+                                (l^.termvars <> r^.termvars)
+                                (l^.outside)
+                                (l^.rules <> r^.rules) -- 
                                 s
-                                (l^.name  <> r^.name)
-    where s = case (l^.start,r^.start) of
-                (Nothing, Nothing) -> Nothing
-                (Nothing, Just k ) -> Just k
-                (Just k , Nothing) -> Just k
-                (Just k , Just l ) -> if k==l then Just k else error "need to create new symbol, see note on Semigroup (Add Grammar)"
-          t = case (l^.start,r^.start) of
-                (Just k , Just l ) -> if k==l then S.empty else error "this will create the new rule"
-                _                  -> S.empty
-                                --(if l^.start == r^.start
-                                --  then l^.start
-                                --  else error "maybe add another rule and a unique start symbol?")
+                                (l^.params <> r^.params)
+                                (l^.grammarName <> r^.grammarName)
+                                False
+    where s | l^.start == r^.start = l^.start
+            | l^.start /= mempty && r^.start /= mempty = error "add new start symbol"
+            | l^.start == mempty                       = r^.start
+            |                       r^.start == mempty = l^.start
 
 instance Monoid (Add Grammar) where
-  mempty = Add $ Grammar S.empty S.empty S.empty S.empty Nothing ""
+  mempty = Add def
   mappend = (<>)
 
 -- idempotency is not made explicit here
diff --git a/FormalLanguage/GrammarProduct/Op/Chomsky.hs b/FormalLanguage/GrammarProduct/Op/Chomsky.hs
--- a/FormalLanguage/GrammarProduct/Op/Chomsky.hs
+++ b/FormalLanguage/GrammarProduct/Op/Chomsky.hs
@@ -1,6 +1,3 @@
-{-# LANGUAGE UnicodeSyntax #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE PatternGuards #-}
 
 module FormalLanguage.GrammarProduct.Op.Chomsky where
 
@@ -25,6 +22,8 @@
 
 
 
+{-
+
 newtype CNF = CNF { runCNF :: Grammar }
 
 instance Semigroup CNF where
@@ -93,7 +92,7 @@
       printDoc $ rulesDoc $ S.singleton $ Rule l f rs
       printDoc $ rulesDoc $ S.singleton $ Rule a g bs
       fail "cannot handle (rule is not CNF):"
-  -- | otherwise = error $ "cannot handle (rule is not CNF): " ++ show (printDoc $ rulesDoc $ S.singleton $ Rule l f rs, Rule a g bs)
+  -- \| otherwise = error $ "cannot handle (rule is not CNF): " ++ show (printDoc $ rulesDoc $ S.singleton $ Rule l f rs, Rule a g bs)
 
 {-
 -- | Extend mixed rules and rederive CNF
@@ -125,11 +124,11 @@
   -- the new non-terminal for the terminal symbol, with terms replaced by non-term symbols
   -- TODO we can't just replace all N here with eps, tome could have been created from other prods.
   trmN = Symb . map (\case (T s) -> N ("T"++s) Singular ; N _ _ -> eps; z -> z) $ x^.symb
-  -- finally the terminal 
+  -- finally the terminal
   epsT = Symb . map (\case (N _ _) -> eps               ; z -> z) $ x^.symb
 -}
 
--- | 
+-- |
 
 symbToRules :: Symb -> Symb -> (Symb, [Rule])
 symbToRules u' l'
@@ -154,4 +153,6 @@
 
 genTermStar :: Symb -> [TN]
 genTermStar s = map (\case (T s) -> N ("S"++s) Singular ; z -> z) $ s^.symb
+
+-}
 
diff --git a/FormalLanguage/GrammarProduct/Op/Chomsky/Proof.hs b/FormalLanguage/GrammarProduct/Op/Chomsky/Proof.hs
--- a/FormalLanguage/GrammarProduct/Op/Chomsky/Proof.hs
+++ b/FormalLanguage/GrammarProduct/Op/Chomsky/Proof.hs
@@ -30,6 +30,8 @@
 
 
 
+{-
+
 -- * Proof of associativity of the 2-GNF.
 
 -- | Run the 2-gnf grammar with the TwoGNF monoid which observes the 2 star
@@ -73,4 +75,6 @@
 --    , "Sa -> oneT <<< a"
     , "//"
     ]
+
+-}
 
diff --git a/FormalLanguage/GrammarProduct/Op/Common.hs b/FormalLanguage/GrammarProduct/Op/Common.hs
--- a/FormalLanguage/GrammarProduct/Op/Common.hs
+++ b/FormalLanguage/GrammarProduct/Op/Common.hs
@@ -1,9 +1,9 @@
-{-# LANGUAGE LambdaCase #-}
 
 module FormalLanguage.GrammarProduct.Op.Common where
 
 import qualified Data.Set as S
-import Control.Lens
+import Control.Lens hiding (outside)
+import Data.Set (Set)
 
 import FormalLanguage.CFG.Grammar
 
@@ -15,23 +15,49 @@
 --
 -- TODO i guess, this collects multidim stuff for now!!!
 
-collectTerminals :: S.Set Rule -> S.Set Symb
-collectTerminals = S.fromList . filter isSymbT . concatMap _rhs . S.toList
+collectTerminals :: S.Set Rule -> S.Set Symbol
+collectTerminals = error "collectTerminals" -- S.fromList . filter isSymbT . concatMap _rhs . S.toList
 
 -- | Collect all non-terminal symbols from a set of rules.
 --
 -- TODO move to FormalGrammars library
 
-collectNonTerminals :: S.Set Rule -> S.Set Symb
-collectNonTerminals = S.fromList . filter isSymbN . concatMap (\r -> r^.lhs : r^.rhs) . S.toList
+collectNonTerminals :: Set Rule -> Set Symbol -- S.Set Rule -> S.Set Symb
+collectNonTerminals = error "collectNonTerminals" -- S.fromList . _ . view (folded.rhs) -- S.fromList . filter isSymbN . concatMap (\r -> r^.lhs : r^.rhs) . S.toList
 
-collectEpsilons :: S.Set Rule -> S.Set TN
+-- |
+--
+-- TODO not needed anymore ?!
+
+collectEpsilons :: S.Set Rule -> S.Set SynTermEps -- TN
+collectEpsilons = error "collectEpsilons"
+{-
 collectEpsilons = S.fromList
                 . filter (\case E -> True ; z -> False)
                 . concatMap (view symb)
                 . concatMap _rhs
                 . S.toList
+-}
 
-genEps :: Symb -> [TN]
-genEps s = replicate (length $ s^.symb) E
+-- | Generate a multidim epsilon symbol of the same length as the given
+-- symbol.
+
+genEps :: Symbol -> Symbol -- Symb -> [TN]
+genEps s = Symbol $ replicate (length $ s^.getSymbolList) Epsilon -- replicate (length $ s^.symb) E
+
+-- | Generate a multidim @Deletion@ symbol of the same length as the given
+-- symbol.
+
+genDel :: Symbol -> Symbol -- Symb -> [TN]
+genDel s = Symbol $ replicate (length $ s^.getSymbolList) Deletion -- replicate (length $ s^.symb) E
+
+-- | Checks if two grammars are compatible.
+--
+-- TODO different inside/outside status might not be a big problem!
+
+opCompatible :: Grammar -> Grammar -> Either String ()
+opCompatible l r
+  | dim l /= dim r            = Left "Grammars have different dimensions"
+  | l^.outside /= r^.outside  = Left "Grammars have incompatible inside/outside status"
+  | otherwise                 = Right ()
 
diff --git a/FormalLanguage/GrammarProduct/Op/Greibach.hs b/FormalLanguage/GrammarProduct/Op/Greibach.hs
--- a/FormalLanguage/GrammarProduct/Op/Greibach.hs
+++ b/FormalLanguage/GrammarProduct/Op/Greibach.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE ParallelListComp #-}
 
 module FormalLanguage.GrammarProduct.Op.Greibach where
 
@@ -28,6 +27,8 @@
 
 
 
+{-
+
 -- * Proof of associativity of the 2-GNF.
 
 -- | Wrap a grammar in 2-GNF form.
@@ -131,5 +132,7 @@
     | length lls  > length rrs = undefined
   epsR ls = map (\(Symb s) -> Symb $ s ++ replicate dr (T "")) ls
   epsL rs = map (\(Symb s) -> Symb $ replicate dl (T "") ++ s) rs
+-}
+
 -}
 
diff --git a/FormalLanguage/GrammarProduct/Op/Greibach/Proof.hs b/FormalLanguage/GrammarProduct/Op/Greibach/Proof.hs
--- a/FormalLanguage/GrammarProduct/Op/Greibach/Proof.hs
+++ b/FormalLanguage/GrammarProduct/Op/Greibach/Proof.hs
@@ -1,5 +1,3 @@
-{-# LANGUAGE PatternGuards #-}
-{-# LANGUAGE ParallelListComp #-}
 
 module FormalLanguage.GrammarProduct.Op.Greibach.Proof where
 
@@ -33,6 +31,8 @@
 
 
 
+{-
+
 -- * Proof of associativity of the 2-GNF.
 
 -- | Run the 2-gnf grammar with the TwoGNF monoid which observes the 2 star
@@ -158,4 +158,6 @@
     , "A -> one   <<< c"
     , "//"
     ]
+
+-}
 
diff --git a/FormalLanguage/GrammarProduct/Op/Linear.hs b/FormalLanguage/GrammarProduct/Op/Linear.hs
--- a/FormalLanguage/GrammarProduct/Op/Linear.hs
+++ b/FormalLanguage/GrammarProduct/Op/Linear.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE FlexibleInstances #-}
 
 -- | Direct product of two grammars.
 --
@@ -8,12 +7,15 @@
 
 module FormalLanguage.GrammarProduct.Op.Linear where
 
+import Control.Arrow ((&&&))
 import Data.Semigroup
-import Control.Lens
+import Control.Lens hiding (outside)
 import Control.Applicative
 import qualified Data.Set as S
-import Data.List (groupBy)
+import Data.List (groupBy,nub)
 import Data.Function (on)
+import Data.Default
+import qualified Data.Map as M
 
 import FormalLanguage.CFG.Grammar
 
@@ -21,27 +23,38 @@
 
 
 
+directProduct l r = runLinear $ Linear l <> Linear r
+
 newtype Linear a = Linear {runLinear :: a}
 
 
 
 instance Semigroup (Linear Grammar) where
-  (Linear g) <> (Linear h) = Linear $ Grammar ts ns es rs s (g^.name <> h^.name) where
+  (Linear g) <> (Linear h) = Linear $ Grammar sv st tv io rs s p (g^.grammarName ++ h^.grammarName) False where -- ts ns es rs s (g^.name <> h^.name) where
+    sv = M.fromList . nub . map (_name &&& id) . concatMap _getSymbolList . uniqueSyntacticSymbols $ set rules rs def -- build a temporary @def@ grammar, extract symbols from that one
+    st = g^.synterms <> h^.synterms
+    tv = g^.termvars <> h^.termvars
+    io = g^.outside
+    rs = S.fromList [ direct l r | l <- g^..rules.folded, r <- h^..rules.folded ]
+    s  = (g^.start) <> (h^.start)
+    p  = (g^.params) <> (h^.params)
+    direct l r = Rule (l^.lhs <> r^.lhs) (l^.attr <> r^.attr) (mergeRHS (l^.rhs) (r^.rhs))
+    {-
     ts = g^.tsyms <> h^.tsyms
     ns = collectNonTerminals rs
-    es = g^.epsis <> h^.epsis
     rs = S.fromList [ direct l r | l <- g^..rules.folded, r <- h^..rules.folded ]
-    s  = liftA2 (\l r -> Symb $ l^.symb ++ r^.symb) (g^.start) (h^.start)
-    direct (Rule l f rs) (Rule a g bs) = Rule (Symb $ l^.symb ++ a^.symb) (f++g) (mergeRHS rs bs)
+    s  = liftA2 (<>) (g^.start) (h^.start)
+    direct (Rule l f rs) (Rule a g bs) = Rule (l <> a) (f++g) (mergeRHS rs bs)
+    -}
 
 instance Monoid (Linear Grammar) where
-  mempty = Linear $ Grammar S.empty S.empty S.empty (S.singleton $ Rule (Symb []) [] []) Nothing ""
+  mempty = Linear $ set rules (S.singleton $ Rule (Symbol []) [] []) def
   mappend = (<>)
 
 -- | Merges right-hand sides in a linear direct product. For full-fledged CFGs
 -- in different normal forms, see the GNF and CNF implementations.
 
-mergeRHS :: [Symb] -> [Symb] -> [Symb]
+mergeRHS :: [Symbol] -> [Symbol] -> [Symbol]
 mergeRHS [] rs = rs -- neutral element
 mergeRHS ls [] = ls -- neutral element
 mergeRHS ls' rs' = concat $ go (groupRHS ls') (groupRHS rs') where
@@ -49,25 +62,26 @@
   dr = head rs'
   go [] [] = []
   go [] (r:rs)
-    | all isSymbT r = map (\(Symb z) -> Symb $ genEps dl ++ z) r : go [] rs
-    | all isSymbN r = let [Symb z] = r
-                      in  [Symb $ genEps dl ++ z] : go [] rs
+    | all isTerminal  r = map (genDel dl <>) r : go [] rs
+    | all isSyntactic r = let [z] = r
+                          in  [genDel dl <> z] : go [] rs
   go (l:ls) []
-    | all isSymbT l = map (\(Symb z) -> Symb $ z ++ genEps dr) l : go ls []
-    | all isSymbN l = let [Symb z] = l
-                      in  [Symb $ z ++ genEps dr] : go ls []
+    | all isTerminal  l = map (<> genDel dr) l : go ls []
+    | all isSyntactic l = let [z] = l
+                          in  [z <> genDel dr] : go ls []
   go (l:ls) (r:rs)
-    | all isSymbT l && all isSymbT r = goT l r : go ls rs
-    | all isSymbN l && all isSymbN r = let [Symb y] = l
-                                           [Symb z] = r
-                                       in  [Symb $ y++z] : go ls rs
-    | all isSymbN l = go [l] []  ++ go ls     (r:rs)
-    | all isSymbN r = go []  [r] ++ go (l:ls) rs
+    | all isTerminal  l && all isTerminal  r = goT l r : go ls rs
+    | all isSyntactic l && all isSyntactic r = let [Symbol y] = l
+                                                   [Symbol z] = r
+                                               in  [Symbol $ y++z] : go ls rs
+    | all isSyntactic l = go [l] []  ++ go ls     (r:rs)
+    | all isSyntactic r = go []  [r] ++ go (l:ls) rs
     | otherwise     = go [l] []  ++ go [] [r] ++ go ls rs
-  goT []            []            = []
-  goT []            (Symb t : rs) = Symb (genEps dl ++ t) : goT [] rs
-  goT (Symb t : ls) []            = Symb (t ++ genEps dr) : goT ls []
-  goT (Symb u : ls) (Symb v : rs) = Symb (u++v)           : goT ls rs
+  go ls rs          = error $ "unhandled (Lib-FormalLanguage, FormalLanguage.GrammarProduct.Op.Linear): " ++ show (ls,rs)
+  goT []       []       = []
+  goT []       (t : rs) = (genDel dl <> t) : goT [] rs
+  goT (t : ls) []       = (t <> genDel dr) : goT ls []
+  goT (u : ls) (v : rs) = (u<>v)           : goT ls rs
 
-groupRHS = groupBy ((==) `on` isSymbT)
+groupRHS = groupBy ((==) `on` isTerminal)
 
diff --git a/FormalLanguage/GrammarProduct/Op/Power.hs b/FormalLanguage/GrammarProduct/Op/Power.hs
--- a/FormalLanguage/GrammarProduct/Op/Power.hs
+++ b/FormalLanguage/GrammarProduct/Op/Power.hs
@@ -1,10 +1,11 @@
 
 module FormalLanguage.GrammarProduct.Op.Power where
 
-import Control.Newtype
+--import Control.Newtype
 import Data.Semigroup
 import Control.Lens
 import Control.Lens.Fold
+import Data.Set.Lens
 import qualified Data.Set as S
 import Data.List (genericReplicate)
 import Text.Printf
@@ -16,6 +17,19 @@
 -- |
 
 power :: Grammar -> Integer -> Grammar
+power g k
+  | k < 1     = error $ "Op.Power.power: power " ++ show k ++ " < 1"
+  | otherwise = over (rules . setmapped . attr) kAttr
+              . over (rules . setmapped . rhs . traverse) kDim
+              . over (rules . setmapped . lhs) kDim
+              . over start kDim
+              $ g
+  where kDim :: Symbol -> Symbol
+        kDim = Symbol . concat . genericReplicate k . _getSymbolList
+        kAttr :: [AttributeFunction] -> [AttributeFunction]
+        kAttr = concat . genericReplicate k
+
+{-
 power g k = Grammar ts ns es rs s nm where
   ts = g^.tsyms
   ns = S.map go $ g^.nsyms
@@ -24,4 +38,5 @@
   s  = fmap go $ g^.start
   nm = concat . genericReplicate k $ g^.name
   go (Symb z) = Symb . concat $ genericReplicate k z
+-}
 
diff --git a/FormalLanguage/GrammarProduct/Op/Subtract.hs b/FormalLanguage/GrammarProduct/Op/Subtract.hs
--- a/FormalLanguage/GrammarProduct/Op/Subtract.hs
+++ b/FormalLanguage/GrammarProduct/Op/Subtract.hs
@@ -1,18 +1,19 @@
-{-# LANGUAGE FlexibleInstances #-}
 
 module FormalLanguage.GrammarProduct.Op.Subtract where
 
-import Control.Newtype
-import Data.Semigroup
-import Control.Lens
-import Control.Lens.Fold
+import           Control.Arrow ((&&&))
+import           Control.Lens.Fold
+import           Control.Lens hiding (outside)
+import           Control.Newtype
+import           Data.List (genericReplicate)
+import           Data.Semigroup
+import qualified Data.Map as M
 import qualified Data.Set as S
-import Data.List (genericReplicate)
-import Text.Printf
+import           Text.Printf
 
-import FormalLanguage.CFG.Grammar
+import           FormalLanguage.CFG.Grammar
 
-import FormalLanguage.GrammarProduct.Op.Common
+import           FormalLanguage.GrammarProduct.Op.Common
 
 
 
@@ -20,7 +21,20 @@
 
 subtract :: Grammar -> Grammar -> Grammar
 subtract l r
-    | gDim l /= gDim r = error $ printf "grammars %s and %s have different dimensions, cannot unify. (subtract)" (show l) (show r)
+    | dim l /= dim r           = error $ printf "grammars %s and %s have different dimensions, cannot unify. (subtract)" (show l) (show r)
+    | l^.outside /= r^.outside = error $ printf "grammars %s and %s have different inside/outside annotation." (show l) (show r)
+    | otherwise                = g
+    where sv = M.fromList . map ((_name &&& id) . fst) . uniqueSynVarsWithTape       $ g
+          st = M.fromList . map ((_name &&& id) . fst) . uniqueSynTermsWithTape      $ g
+          tv = M.fromList . map ((_name &&& id) . fst) . uniqueBindableTermsWithTape $ g
+          io = l^.outside
+          rs = (l^.rules) S.\\ (r^.rules)
+          s  = if (anyOf (folded . lhs) ((l^.start) ==) rs) then l^.start else Symbol []
+          p  = M.union (l^.params) (r^.params)
+          g  = Grammar sv st tv io rs s p (l^.grammarName ++ r^.grammarName) False
+
+{-
+subtract l r
     | otherwise        = Grammar ts ns es rs s (l^.name ++ r^.name) where
         ts = collectTerminals rs
         ns = collectNonTerminals rs
@@ -31,4 +45,5 @@
                Just s' -> if anyOf (rules.folded.lhs) (==s') l
                             then l^.start
                             else Nothing
+-}
 
diff --git a/FormalLanguage/GrammarProduct/Parser.hs b/FormalLanguage/GrammarProduct/Parser.hs
--- a/FormalLanguage/GrammarProduct/Parser.hs
+++ b/FormalLanguage/GrammarProduct/Parser.hs
@@ -1,13 +1,8 @@
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE NoMonomorphismRestriction #-}
-{-# LANGUAGE OverloadedStrings #-}
 
 -- | This parser extends the @FormalLanguage.Parser@ parser of single- and
 -- multi-dim grammars to accept grammar product definitions as well.
+--
+-- TODO display function names like this: <fun,fun,fun>
 
 module FormalLanguage.GrammarProduct.Parser where
 
@@ -40,39 +35,91 @@
 --import Numeric.Natural.Internal
 import Prelude hiding (subtract)
 import Control.Monad
+import Data.Char (isUpper)
+import Data.Data.Lens
+import System.IO.Unsafe (unsafePerformIO)
 
 import FormalLanguage.CFG.Grammar
 import FormalLanguage.CFG.Parser
+import FormalLanguage.CFG.PrettyPrint.ANSI
 
-import FormalLanguage.GrammarProduct
+import FormalLanguage.GrammarProduct.Op
 
 
 
--- | Parse a product grammar.
+-- TODO can remove, done via better FormalGrammars
 
-parseProduct :: String -> String -> Result [Grammar]
-parseProduct fname cnts = parseString
-  ((evalStateT . runGrammarP) productParser def)
-  (Directed (B.pack fname) 0 0 0 0)
-  cnts
+-- -- | Parse a product grammar.
+-- 
+-- parseProduct :: String -> String -> Result [Grammar]
+-- parseProduct fname cnts = parseString
+--   ((evalStateT . runGrammarP) productParser def)
+--   (Directed (B.pack fname) 0 0 0 0)
+--   cnts
+-- 
+-- -- | Parse all grammars and grammar products, prepending to the list.
+-- 
+-- productParser = go [] <* eof where
+--   go gs = do
+--     whiteSpace
+--     g' <- option Nothing $ Just <$> (try grammar <|> grammarProduct gs)
+--     case g' of
+--       Nothing -> return gs
+--       Just g  -> go (g:gs)
 
--- | Parse all grammars and grammar products, prepending to the list.
+-- | The top-level parser for a grammar product. It can be used as one of the
+-- additional parser arguments, the formal grammars parser accepts.
 
-productParser = go [] <* eof where
-  go gs = do
-    whiteSpace
-    g' <- option Nothing $ Just <$> (try grammar <|> grammarProduct gs)
-    case g' of
-      Nothing -> return gs
-      Just g  -> go (g:gs)
+parseGrammarProduct :: Parse m ()
+parseGrammarProduct = do
+  reserve fgIdents "Product:"
+  n <- newGrammarName
+  current <~ parseProductString
+  current.grammarName .= n -- need to set here, otherwise the underlying combinator produces a combined name (funny but useless ;-)
+  reserve fgIdents "//"
+  v <- use verbose
+  g <- use current
+  seq (unsafePerformIO $ if v then (printDoc $ genGrammarDoc g) else return ())
+    $ env %= M.insert n g
 
+{-
 grammarProduct gs = do
   reserveGI "Product:"
   n <- identGI
+  r <- option Nothing $ Just <$> braces renameSymbols
   e <- getGrammar <$> expr (M.fromList [(g^.name,g) | g<-gs])
   reserveGI "//"
-  return $ over (name) (const n) e
+  return $ over (name) (const n) $ transformRenamed r e
+-}
 
+-- | Performs the actual parsing of a product string. Uses an expression parser
+-- internally.
+
+parseProductString :: Parse m Grammar
+parseProductString = getGrammar <$> expr
+  where expr :: Parse m ExprGrammar
+        expr = buildExpressionParser table term
+        table = [ [ binary "><"  exprDirect AssocLeft
+                  , binary "*"   exprPower  AssocLeft
+                  ]
+                , [ binary "+"   exprPlus   AssocLeft
+                  , binary "-"   exprMinus  AssocLeft
+                  ]
+                ]
+        term =   parens expr
+             <|> (ExprGrammar <$> knownGrammarName <?> "grammar not available in environment")
+             <|> (ExprNumber  <$> natural <?> "integral power of grammar")
+        binary n f a = Infix (f <$ reserve fgIdents n) a
+        exprDirect l r = ExprGrammar (getGrammar l ><          getGrammar r)
+        exprPlus   l r = ExprGrammar (getGrammar l `gAdd`      getGrammar r)
+        exprMinus  l r = ExprGrammar (getGrammar l `gSubtract` getGrammar r)
+        exprPower  l r = ExprGrammar (getGrammar l `gPower`    getNumber  r)
+
+data ExprGrammar
+  = ExprGrammar { getGrammar :: Grammar }
+  | ExprNumber  { getNumber  :: Integer }
+
+{-
 expr :: Map String Grammar -> Parse ExprGrammar
 expr g = e where
   e = buildExpressionParser table term
@@ -96,12 +143,63 @@
   exprPower  l r = ExprGrammar $ gPower (getGrammar l) (getNumber r)
   highDirect l r = error "highDirect (not active)!" -- ExprGrammar . unDirect $ times1p (Natural $ getNumber r -1) (Direct $ getGrammar l)
 
-data ExprGrammar
-  = ExprGrammar { getGrammar :: Grammar }
-  | ExprNumber  { getNumber  :: Integer }
-
 gterm :: (String,Grammar) -> Parse Grammar
 gterm (s,g) = g <$ reserveGI s
+-}
+
+{-
+transformRenamed Nothing  e = e
+transformRenamed (Just r) e = go r e where
+  go []     e = e
+  go (RTN    f t:rs) e = go rs (e & tinplate %~ repTN   f t)
+  go (RSymb  f t:rs) e = go rs (e & tinplate %~ repSymb f t)
+  go (RFun   f t:rs) e = go rs (e & tinplate %~ repFun  f t)
+  go (RStart s  :rs) e = go rs (repStart s e)
+  repTN :: String -> String -> TN -> TN
+  repTN f t r | r^.tnName == f = set tnName t r
+  repTN _ _ r                  = r
+  repSymb :: [String] -> [String] -> Symb -> Symb
+  repSymb f t r | r^..symb.folded.tnName == f = Symb . map fixTN . zipWith (set tnName) t $ getSymbs r
+  repSymb _ _ r = r
+  fixTN r | r^.tnName == "ε" = E
+  fixTN r = r
+  repFun  f t r | r^.fun == f = set fun t r
+  repFun  _ _ r               = r
+  repStart [] e = set start Nothing         e
+  repStart s  e = set start (Just . Symb . map (\z -> N z Singular) $ s) e
+
+data Rename
+  = RTN    String String -- one-dim term / non-term
+  | RSymb  [String] [String] -- multi-dim symbol
+  | RFun   [String] [String] -- replace function names
+  | RStart [String] -- set or delete a start symbol
+
+renameSymbols = (try rtn <|> rsymb <|> rfun <|> rstart) `sepBy` (symbol ",") where
+  rtn    = RTN    <$> identGI <* string "->" <*> identGI
+  rsymb  = RSymb  <$> (brackets $ identGI `sepBy` comma) <* string "->" <*> (brackets $ identGI `sepBy` comma)
+  rfun   = RFun   <$> (angles   $ identGI `sepBy` comma) <* string "->" <*> (angles   $ identGI `sepBy` comma)
+  rstart = RStart <$ string "S:" <*> (brackets $ identGI `sepBy` comma)
+
+-}
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
 
 {-
 data GS = GS
diff --git a/FormalLanguage/GrammarProduct/QQ.hs b/FormalLanguage/GrammarProduct/QQ.hs
new file mode 100644
--- /dev/null
+++ b/FormalLanguage/GrammarProduct/QQ.hs
@@ -0,0 +1,52 @@
+
+module FormalLanguage.GrammarProduct.QQ where
+
+import           Language.Haskell.TH
+import           Language.Haskell.TH.Quote
+import           Text.Trifecta.Delta (Delta (Directed))
+import           Text.Trifecta (parseString)
+import           Text.Trifecta.Result (Result (..))
+import           Control.Monad.Trans.State.Strict (evalStateT)
+import           Data.Default (def)
+import           Data.ByteString.Char8 (pack)
+import           Control.Lens
+
+import           FormalLanguage.CFG.QQ (trim, parseFormalLanguage)
+import           FormalLanguage.CFG.PrettyPrint.ANSI
+import           FormalLanguage.CFG.Parser
+import           FormalLanguage.CFG.TH
+import           FormalLanguage.CFG.Grammar
+
+import FormalLanguage.GrammarProduct.Parser (parseGrammarProduct)
+
+
+
+grammarProductF = quoteFile grammarProduct
+
+grammarProduct = QuasiQuoter
+  { quoteDec  = parseFormalLanguage parseGrammarProduct
+  , quoteExp  = err
+  , quotePat  = err
+  , quoteType = err
+  } where err = error "there is only a Dec quoter"
+
+{-
+parseGrammarProduct :: String -> Q [Dec]
+parseGrammarProduct s = do
+  loc <- location
+  let (lpos,cpos) = loc_start loc
+  let r = parseString
+            ((evalStateT . runGrammarP) P.productParser def)
+            (Directed (pack "via QQ") (fromIntegral lpos) 0 0 0)
+              $ trim s
+  case r of
+    (Failure f) -> do
+      runIO . printDoc $ f
+      fail "aborting parseGrammarProduct"
+    (Success g') -> do
+      let g = reverse g'
+      runIO . mapM_ (printDoc . grammarDoc) $ g
+      zs <- thCodeGen $ last g
+      return zs
+-}
+
diff --git a/GramProd.hs b/GramProd.hs
deleted file mode 100644
--- a/GramProd.hs
+++ /dev/null
@@ -1,130 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-
--- | The @GramProd@ executable reads a grammatical description (from stdin or a
--- file) and produces a set of grammars, each written into a separate file.
---
--- It is possible to both, produce @LaTeX@ and @Haskell@ output. The Haskell
--- grammars require "ADPfusion" to be useful -- and you have to provide
--- algebras that actually evaluate parses.
-
-module Main where
-
-import Control.Lens
-import Control.Monad
-import Control.Monad.IO.Class
-import Control.Monad.Trans.State.Strict
-import Data.Default
-import Data.Semigroup
-import qualified Text.LaTeX.Base.Render as Latex
-import System.Console.CmdArgs hiding (def)
-import System.IO
-import Text.PrettyPrint.ANSI.Leijen as Pretty hiding (line, (<>), (<$>))
-import Text.Printf
-import Text.Trifecta
-import Text.Trifecta.Delta
-
-import FormalLanguage.CFG.Grammar
-import FormalLanguage.CFG.PrettyPrint.ANSI
-import FormalLanguage.CFG.PrettyPrint.LaTeX
-import FormalLanguage.CFG.PrettyPrint.Haskell
-import FormalLanguage.GrammarProduct.Parser
-
-
-
-data Options
-  = LaTeX
-    { inFile :: String
-    , outFile ::String
-    }
-  | Ansi
-    { inFile :: String
-    }
-  | Haskell
-    { inFile :: String
-    , outFile :: String
-    }
-  deriving (Show,Data,Typeable)
-
-optionLatex = LaTeX
-  { inFile = ""
-  , outFile = ""
-  }
-
-optionAnsi = Ansi
-  { inFile = ""
-  }
-
-optionHaskell = Haskell
-  { inFile = ""
-  , outFile = ""
-  }
-
-main = do
-  o <- cmdArgs $ modes [optionLatex,optionAnsi,optionHaskell]
-  pr <- case (inFile o) of
-          "" -> getContents >>= return . parseProduct "stdin"
-          fn -> readFile fn >>= return . parseProduct fn
-  case pr of
-    Failure f -> putStrLn "failed:" >> printDoc f
-    Success [] -> error "you did provide input?!"
-    Success (s:ss) -> case o of
-      LaTeX{..} -> case outFile of
-        "" -> error "need to set output file name"
-        fn -> renderFile fn $ renderLaTeX 2 s
-      Ansi {..} -> printDoc $ grammarDoc s
-      Haskell{..} -> case outFile of
-        "" -> printDoc $ grammarHaskell s
-        fn -> do h <- openFile fn WriteMode
-                 hPutDoc h $ grammarHaskell s
-                 hClose h
-
-
-
-{-
-main :: IO ()
-main = do
-  o <- cmdArgs $ modes [optionLatex, optionHaskell]
-  let g = runGrammarLang $ flip evalStateT def $ parseDesc
-  r <- case infile o of
-    "" -> getContents >>= return . parseString g (Directed "stdin" 0 0 0 0)
-    fn -> parseFromFileEx g fn
-  case r of
-    Failure e -> liftIO $ displayIO stdout $ renderPretty 0.8 80 $ e <> linebreak
-    Success (gs,ps) -> case o of
-      Latex{..} -> do
-        let latex g = Latex.renderFile (printf "%s/%s.tex" outdir (g^.gname)) . renderGrammarLaTeX columns $ g
-        when withatoms $ mapM_ latex gs
-        mapM_ latex ps
-      Haskell{..} -> do
-        let s = renderGrammarHaskell (if withatoms then gs else [] ++ ps)
-        -- writeFile (printf "%s/%s.hs" outdir (g^.gname)) s
-        putStrLn s
-
-data Options
-  = Latex
-    { infile    :: String
-    , outdir    :: String
-    , withatoms :: Bool
-    , columns   :: Int
-    }
-  | Haskell
-    { infile    :: String
---    , outdir    :: String
-    , withatoms :: Bool
-    }
-  deriving (Show,Data,Typeable)
-
-optionLatex = Latex
-  { infile    = ""    &= help "grammar file to read (stdin if not given)"
-  , outdir    = "."   &= help "directory to put grammars in (./ if not given)"
-  , withatoms = False &= help "if set, source grammars (atoms) are written to target, too"
-  , columns   = 1     &= help "align grammar to 1 or 2 columns?"
-  }
-
-optionHaskell = Haskell
-  {
-  }
--}
-
diff --git a/GrammarProducts.cabal b/GrammarProducts.cabal
--- a/GrammarProducts.cabal
+++ b/GrammarProducts.cabal
@@ -1,17 +1,17 @@
 name:           GrammarProducts
-version:        0.0.0.4
-author:         Christian Hoener zu Siederdissen, 2013
-copyright:      Christian Hoener zu Siederdissen, Ivo L. Hofacker, Peter F. Stadler, 2013
-homepage:       http://www.tbi.univie.ac.at/~choener/gramprod
-maintainer:     choener@tbi.univie.ac.at
+version:        0.1.0.0
+author:         Christian Hoener zu Siederdissen, 2013-2015
+copyright:      Christian Hoener zu Siederdissen, 2013-2015
+homepage:       http://www.bioinf.uni-leipzig.de/gADP/
+maintainer:     choener@bioinf.uni-leipzig.de
 category:       Formal Languages, Bioinformatics
 license:        GPL-3
 license-file:   LICENSE
 build-type:     Simple
 stability:      experimental
-cabal-version:  >= 1.6.0
-synopsis:
-                Grammar products and higher-dimensional grammars
+cabal-version:  >= 1.10.0
+tested-with:    GHC == 7.8.4, GHC == 7.10.1
+synopsis:       Grammar products and higher-dimensional grammars
 description:
                 An algebra of liner and context-free grammars.
                 .
@@ -26,7 +26,10 @@
                 .
                 An efficient implementation of the resulting grammars is
                 possible via the ADPfusion framework. The @FormalGrammars@
-                library provides the required "Template Haskell" machinary.
+                library provides the required "Template Haskell" machinery.
+                GramarProducts can be integrated as a plugin into the existing
+                transformation from DSL to ADPfusion. Haskell users can just
+                use the QQ function provided in the .QQ module.
                 .
                 Alternatively, the resulting grammars can also be
                 pretty-printed in various ways (LaTeX, ANSI, Haskell module
@@ -37,9 +40,10 @@
                 Formal background can be found in two papers:
                 .
                 @
-                Christian Höner zu Siederdissen, Ivo L. Hofacker, and Peter F. Stadler
-                Product Grammars for Alignment and Folding
-                submitted
+                Christian Höner zu Siederdissen, Ivo L. Hofacker, and Peter F. Stadler.
+                Product Grammars for Alignment and Folding.
+                2014. IEEE/ACM Transactions on Computational Biology and Bioinformatics. 99.
+                <http://ieeexplore.ieee.org/xpl/articleDetails.jsp?arnumber=6819790>
                 @
                 .
                 and
@@ -50,31 +54,45 @@
                 Brazilian Symposium on Bioinformatics (BSB 2013)
                 Lecture Notes in Bioinformatics 8213, Springer, Heidelberg
                 @
+                .
 
 
 
 Extra-Source-Files:
-  changelog
+  changelog.md
+  README.md
 
+
+
+flag examples
+  description:  build the examples (only Needleman-Wunsch for now)
+  default:      False
+  manual:       True
+
+flag llvm
+  description:  build using LLVM
+  default:      False
+  manual:       True
+
+
+
 library
-  build-depends:
-    base >= 4 && < 5          ,
-    ADPfusion      >= 0.2.0   ,
-    ansi-wl-pprint            ,
-    bytestring                ,
-    containers                ,
-    data-default              ,
-    FormalGrammars >= 0.0.0.2 ,
-    HaTeX                     ,
-    lens                      ,
-    newtype                   ,
-    parsers                   ,
-    PrimitiveArray >= 0.5.1.0 ,
-    semigroups                ,
-    transformers              ,
-    trifecta
+  build-depends: base               >= 4.7      && < 4.9
+               , ansi-wl-pprint     >= 0.6      && < 0.7
+               , bytestring         >= 0.10     && < 0.11
+               , containers         >= 0.5      && < 0.6
+               , data-default       >= 0.5      && < 0.6
+               , FormalGrammars     == 0.2.0.*
+               , lens               >= 4        && < 5
+               , newtype            >= 0.2      && < 0.3
+               , parsers            >= 0.12     && < 0.13
+               , semigroups         >= 0.15     && < 0.17
+               , template-haskell   >= 2        && < 3
+               , transformers       >= 0.4      && < 0.5
+               , trifecta           >= 1.5      && < 1.6
   exposed-modules:
     FormalLanguage.GrammarProduct
+    FormalLanguage.GrammarProduct.Op
     FormalLanguage.GrammarProduct.Op.Add
     FormalLanguage.GrammarProduct.Op.Chomsky
     FormalLanguage.GrammarProduct.Op.Chomsky.Proof
@@ -85,26 +103,93 @@
     FormalLanguage.GrammarProduct.Op.Power
     FormalLanguage.GrammarProduct.Op.Subtract
     FormalLanguage.GrammarProduct.Parser
---    BioInf.GrammarProducts
---    BioInf.GrammarProducts.Grammar
---    BioInf.GrammarProducts.Haskell
---    BioInf.GrammarProducts.Helper
---    BioInf.GrammarProducts.LaTeX
---    BioInf.GrammarProducts.Tools
---    BioInf.GrammarProducts.TH
+    FormalLanguage.GrammarProduct.QQ
+  default-language:
+    Haskell2010
+  default-extensions: FlexibleContexts
+                    , FlexibleInstances
+                    , GeneralizedNewtypeDeriving
+                    , LambdaCase
+                    , NoMonomorphismRestriction
+                    , OverloadedStrings
+                    , ParallelListComp
+                    , PatternGuards
+                    , RankNTypes
+                    , ScopedTypeVariables
+                    , StandaloneDeriving
+                    , TemplateHaskell
+                    , UnicodeSyntax
   ghc-options:
     -O2
+    -funbox-strict-fields
 
+
+
 -- With grammar products, we need a refined way of turning input source files
 -- into LaTeX and Haskell modules.
 
-executable GrammarProductPP
-  build-depends:
-    cmdargs == 0.10.*
+--executable GrammarProductPP
+--  build-depends: base             >= 4.7    && < 4.9
+--               , ansi-wl-pprint
+--               , cmdargs          >= 0.10   && < 0.11
+--               , data-default
+--               , FormalGrammars
+--               , GrammarProducts
+--               , HaTeX            >= 3.16   && < 4
+--               , lens
+--               , semigroups
+--               , transformers
+--               , trifecta
+--  hs-source-dirs:
+--    src
+--  main-is:
+--    GramProd.hs
+--  default-language:
+--    Haskell2010
+--  default-extensions:
+--  ghc-options:
+--    -O2
+
+executable AlignGlobal
+  if flag(examples)
+    build-depends: base               >= 4.7      && < 4.9
+                 , ADPfusion          == 0.4.0.*
+                 , containers
+                 , FormalGrammars
+                 , GrammarProducts
+                 , PrimitiveArray     == 0.6.0.*
+                 , template-haskell
+                 , vector             == 0.10.*
+    buildable: True
+  else
+    buildable: False
+  hs-source-dirs:
+    src
   main-is:
-    GramProd.hs
+    AlignGlobal.hs
+  default-language:
+    Haskell2010
+  default-extensions: BangPatterns
+                    , FlexibleContexts
+                    , FlexibleInstances
+                    , MultiParamTypeClasses
+                    , QuasiQuotes
+                    , TemplateHaskell
+                    , TypeFamilies
+                    , TypeOperators
   ghc-options:
     -O2
+    -fcpr-off
+    -funbox-strict-fields
+    -funfolding-use-threshold1000
+    -funfolding-keeness-factor1000
+  if flag(llvm)
+    ghc-options:
+      -fllvm
+      -optlo-O3
+      -fllvm-tbaa
+
+
 
 source-repository head
   type: git
diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -0,0 +1,17 @@
+Grammar Products
+================
+
+[![Build Status](https://travis-ci.org/choener/GrammarProducts.svg?branch=master)](https://travis-ci.org/choener/GrammarProducts)
+
+[*generalized ADPfusion Homepage*](http://www.bioinf.uni-leipzig.de/Software/gADP/)
+
+An algebra of liner and context-free grammars.
+
+
+
+#### Contact
+
+Christian Hoener zu Siederdissen
+choener@bioinf.uni-leipzig.de
+Leipzig University, Leipzig, Germany
+
diff --git a/changelog b/changelog
deleted file mode 100644
--- a/changelog
+++ /dev/null
@@ -1,9 +0,0 @@
-0.0.0.4
--------
-
-Version bump for new TH stuff
-
-0.0.0.3
--------
-
-Products of linear and context-free grammars
diff --git a/changelog.md b/changelog.md
new file mode 100644
--- /dev/null
+++ b/changelog.md
@@ -0,0 +1,29 @@
+0.1.0.0
+-------
+
+- major version bump
+- updated dependencies
+- using ADPfusion 0.4.0.0 now
+- rewritten as 'plugin' of FormalGrammars
+- QQ here combines FormalGrammars + GrammarProducts
+- travis-ci integration
+
+0.0.1.0
+-------
+
+- fixed dependencies
+
+0.0.0.5
+-------
+
+- the parser now comes with a very ad-hoc TN and Symb renaming system for products
+
+0.0.0.4
+-------
+
+- Version bump for new TH stuff
+
+0.0.0.3
+-------
+
+- Products of linear and context-free grammars
diff --git a/src/AlignGlobal.hs b/src/AlignGlobal.hs
new file mode 100644
--- /dev/null
+++ b/src/AlignGlobal.hs
@@ -0,0 +1,110 @@
+
+-- | The Nussinov RNA secondary structure prediction problem.
+
+module Main where
+
+import           Control.Applicative ()
+import           Control.Monad
+import           Control.Monad.ST
+import           Data.Char (toUpper,toLower)
+import           Data.List
+import           Data.Vector.Fusion.Util
+import           Language.Haskell.TH
+import           Language.Haskell.TH.Syntax
+import qualified Data.Vector.Fusion.Stream.Monadic as SM
+import qualified Data.Vector.Unboxed as VU
+import           Data.Vector.Unboxed (Vector)
+import           Text.Printf
+import           Data.Sequence ((|>),Seq,empty)
+import qualified Data.Vector.Fusion.Stream as S
+import           Data.Foldable (toList)
+
+import           ADP.Fusion
+import           Data.PrimitiveArray as PA hiding (map,toList)
+import           FormalLanguage.CFG
+
+import           FormalLanguage.GrammarProduct
+
+
+
+[grammarProduct|
+Grammar: Step
+N: X
+T: c
+S: X
+X -> stp <<< X c
+X -> del <<< X
+//
+Grammar: Stand
+N: X
+S: X
+X -> del <<< X
+//
+Grammar: Done
+N: X
+S: X
+X -> don <<< e
+//
+Product: Global
+Step >< Step  -  Stand * 2  +  Done * 2
+//
+Emit: Global
+|]
+
+makeAlgebraProduct ''SigGlobal
+
+
+
+score :: Monad m => SigGlobal m Int Int Char
+score = SigGlobal
+  { donDon = \   (Z:.():.()) -> 0
+  , stpStp = \ x (Z:.a :.b ) -> if a==b then x+1 else -999999
+  , delStp = \ x (Z:.():.b ) -> x - 2
+  , stpDel = \ x (Z:.a :.()) -> x - 2
+  , h       = SM.foldl' max (-999999)
+  }
+{-# INLINE score #-}
+
+-- |
+--
+-- TODO use fmlist to make this more efficient.
+
+pretty :: Monad m => SigGlobal m (String,String) [(String,String)] Char
+pretty = SigGlobal
+  { donDon = \       (Z:.():.()) -> ("","")
+  , stpStp = \ (x,y) (Z:.a :.b ) -> (x ++ [a],y ++ [b])
+  , delStp = \ (x,y) (Z:.():.b ) -> (x ++ "-",y ++ [b])
+  , stpDel = \ (x,y) (Z:.a :.()) -> (x ++ [a],y ++ "-")
+  , h      = SM.toList
+  }
+
+runNeedlemanWunsch :: Int -> String -> String -> (Int,[(String,String)])
+runNeedlemanWunsch k i1' i2' = (d, take k . unId $ axiom b) where
+  i1 = VU.fromList i1'
+  i2 = VU.fromList i2'
+  !(Z:.t) = runNeedlemanWunschForward i1 i2
+  d = unId $ axiom t
+  !(Z:.b) = gGlobal (score <|| pretty) (toBacktrack t (undefined :: Id a -> Id a)) (chr i1) (chr i2)
+{-# NoInline runNeedlemanWunsch #-}
+
+-- | Decoupling the forward phase for CORE observation.
+
+runNeedlemanWunschForward :: Vector Char -> Vector Char -> Z:.(ITbl Id Unboxed (Z:.PointL:.PointL) Int)
+runNeedlemanWunschForward i1 i2 = let n1 = VU.length i1; n2 = VU.length i2 in mutateTablesDefault $
+  gGlobal score
+    (ITbl 0 0 (Z:.EmptyOk:.EmptyOk) (PA.fromAssocs (Z:.PointL 0:.PointL 0) (Z:.PointL n1:.PointL n2) (-999999) []))
+    (chr i1) (chr i2)
+{-# NoInline runNeedlemanWunschForward #-}
+
+main = do
+  ls <- lines <$> getContents
+  let eats [] = return ()
+      eats [x] = return ()
+      eats (a:b:xs) = do
+        putStrLn a
+        putStrLn b
+        let (k,ys) = runNeedlemanWunsch 1 a b
+        forM_ ys $ \(y1,y2) -> printf "%s %5d\n%s\n" y1 k y2
+        eats xs
+  eats ls
+
