diff --git a/SyntaxMacros.cabal b/SyntaxMacros.cabal
--- a/SyntaxMacros.cabal
+++ b/SyntaxMacros.cabal
@@ -1,5 +1,6 @@
 name:               SyntaxMacros 
-version:            0.2
+version:            1.0
+cabal-version:      >= 1.2.3  
 license:            LGPL
 license-file:       COPYRIGHT
 maintainer:         Marcos Viera <mviera@fing.edu.uy>
@@ -10,23 +11,25 @@
 category:           Development 
 stability:          Experimental
 copyright:          Universiteit Utrecht
-build-depends:      base>=4 && <5, haskell98, template-haskell>=2.4.0.1, TTTAS>=0.4.0, AspectAG>=0.2,
-                    uulib>=0.9.12, containers>=0.3
-cabal-version:      >= 1.2.3  
-exposed-modules:    Language.Grammars.Grammar, 
-                    Language.Grammars.SyntaxMacros, 
-                    Language.Grammars.SyntaxMacros.Scanner
-other-modules:      Language.Grammars.SyntaxMacros.Machine, 
-                    Language.Grammars.SyntaxMacros.Token, 
-                    Language.Grammars.SyntaxMacros.TokenParser, 
-                    Language.Grammars.SyntaxMacros.ScanUtils, 
-                    Language.Grammars.SyntaxMacros.Utils, 
-                    Language.Grammars.Transformations.GramTrafo,
-                    Language.Grammars.Transformations.LeftCorner,
-                    Language.Grammars.Transformations.LeftFact
-extensions:         EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies,
-                    MultiParamTypeClasses, RankNTypes, ScopedTypeVariables,
-                    TypeSynonymInstances, UndecidableInstances, GADTs
-hs-source-dirs:     src
 extra-source-files: README, LICENSE-LGPL 
-ghc-options:        -Wall
+library
+        build-depends:      base>=4 && <5, haskell98, template-haskell>=2.4.0.1, TTTAS>=0.4.0, AspectAG>=0.2,
+                            uulib>=0.9.12, containers>=0.3, HList>=0.2
+        exposed-modules:    Language.Grammars.Grammar, 
+                            Language.Grammars.SyntaxMacros, 
+                            Language.Grammars.SyntaxMacros.Scanner
+        other-modules:      Language.Grammars.SyntaxMacros.Machine, 
+                            Language.Grammars.SyntaxMacros.Token, 
+                            Language.Grammars.SyntaxMacros.TokenParser, 
+                            Language.Grammars.SyntaxMacros.ScanUtils, 
+                            Language.Grammars.SyntaxMacros.Utils, 
+                            Language.Grammars.Transformations.GramTrafo,
+                            Language.Grammars.Transformations.RemoveEmpties,
+                            Language.Grammars.Transformations.RemoveFix,
+                            Language.Grammars.Transformations.LeftCorner
+        extensions:         EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies,
+                            MultiParamTypeClasses, RankNTypes, ScopedTypeVariables,
+                           TypeSynonymInstances, UndecidableInstances, GADTs
+        hs-source-dirs:     src
+        ghc-options:        -Wall
+
diff --git a/examples/LangDef.hs b/examples/LangDef.hs
--- a/examples/LangDef.hs
+++ b/examples/LangDef.hs
@@ -1,13 +1,13 @@
-{-# LANGUAGE  Arrows, DoRec, EmptyDataDecls, FlexibleContexts #-}
+{-# OPTIONS -fcontext-stack=100 #-}
 
+{-# LANGUAGE  Arrows, DoRec #-}
+
 module LangDef where
 
 import qualified Data.Set as Set
 
 import Control.Arrow
 
-import UU.Pretty
-
 import Language.Grammars.SyntaxMacros
 import Language.Grammars.Grammar
 
@@ -16,28 +16,57 @@
 import LangSem
 import Utils
 
+import Control.Applicative
 
+import Data.HList
+
+import UU.Pretty.Basic
+
+
 prds = proc () -> do
-         rec  root    <- addNT -<  [  prd (`semAGItf` ()) $ ch_expr<=>exp  <.> prdEnd  ] 
 
-              exp     <- addNT -<  [  prd semLet $ trm "let" <.> ch_lnm<=>var  <.>  trm "=" <.> ch_val<=>exp <.> 
-                                                   trm "in"  <.> ch_body<=>exp <.> prdEnd   
-                                   ,  prd semAdd $ ch_ae1<=>term <.> trm "+"  <.> ch_ae2<=>exp <.> prdEnd
-                                   ,  prdId term  ]
-                                 
-              term    <- addNT -<  [  prd semMul $ ch_me1<=>term <.> trm "*"  <.> ch_me2<=>factor <.> prdEnd
-                                   ,  prdId factor ]
+         rec     root    <- addNT -<  (iI (`semAGItf` emptyRecord) (ch_expr <=> exp) Ii)
+                 exp     <- addNT -<  (iI semLet "let" (ch_lnm   <=> var)  "=" (ch_val <=> exp) "in" (ch_body <=> exp) Ii)
+                                      <|>
+                                      (iI semAdd (ch_ae1  <=>  exp) "+" (ch_ae2 <=> term) Ii)
+                                      <|>
+                                      ntPrd term
+                 term    <- addNT -<  (iI semMul (ch_me1  <=>  term)  "*"  (ch_me2 <=> factor) Ii)
+                                      <|>
+                                      ntPrd factor
 
-              factor  <- addNT -<  [  prd semCst $ ch_cv<=>int  <.> prdEnd 
-                                   ,  prd semVar $ ch_vnm<=>var <.> prdEnd ]
+                 factor  <- addNT -<  (iI semCst (ch_cv <=> int) Ii)
+                                      <|> 
+                                      (iI semVar (ch_vnm <=> var) Ii)
 
-         exportNTs -< Export root $   ntExp     ^=  exp     ^| 
-                                      ntTerm    ^=  term    ^|
-                                      ntFactor  ^=  factor  ^|  
-                                      ntNil 
+         exportNTs -< exportList root  $   export ntExp     exp 
+                                       .   export ntTerm    term 
+                                       .   export ntFactor  factor  
+ 
+{-
+-- another possible version
+prds = proc () -> do
 
+         rec     root    <- addNT -<  (`semAGItf` emptyRecord) <$> ch_expr <=> exp
+                 exp     <- addNT -<  semLet <$  tr "let" <*>  ch_lnm   <=> var  <*  tr "=" <*> ch_val <=> exp <* tr "in"  <*>  ch_body <=> exp
+                                      <|>
+                                      semAdd <$>  ch_ae1  <=>  exp   <* tr "+"  <*>  ch_ae2 <=> term
+                                      <|>
+                                      ntPrd term
+                 term    <- addNT -<  semMul <$>  ch_me1  <=>  term  <* tr "*"  <*>  ch_me2 <=> factor
+                                      <|>
+                                      ntPrd factor
 
+                 factor  <- addNT -<  semCst <$>  ch_cv <=> int
+                                      <|> 
+                                      semVar <$>  ch_vnm <=> var
 
+         exportNTs -< exportList root  $   export ntExp     exp 
+                                       .   export ntTerm    term 
+                                       .   export ntFactor  factor  
+
+-}
+
 gramOpts :: ScanOpts
 gramOpts
   =  defaultScanOpts
@@ -45,4 +74,5 @@
         ,   scoSpecChars        =   Set.fromList "=+*"
         ,   scoDollarIdent      =   True
         }
+ 
 
diff --git a/examples/LangExt.hs b/examples/LangExt.hs
--- a/examples/LangExt.hs
+++ b/examples/LangExt.hs
@@ -1,4 +1,6 @@
-{-# LANGUAGE  Arrows, DoRec, EmptyDataDecls, FlexibleContexts, TemplateHaskell, NoMonomorphismRestriction #-}
+{-# OPTIONS -fcontext-stack=100 #-}
+{-# LANGUAGE  Arrows, DoRec, EmptyDataDecls, FlexibleContexts, TemplateHaskell, NoMonomorphismRestriction,
+    RankNTypes #-}
 
 module LangExt where
 
@@ -17,41 +19,64 @@
 import LangSem
 import Utils
 
+import Control.Applicative
+
 import Data.HList.Label4
 import Data.HList.TypeEqGeneric1
 import Data.HList.TypeCastGeneric1
 
 
+
 -- modifications of the semantics
 synM = synmodM
 inhM = inhmodM
 
-$(chLabel "se" ''T_Expr)
 
-sppSq = synM spp $ do me1 <- at ch_me1 
-                      return $ "square " >|< (me1 # spp)   
+--Syntax Macro 1 -------------------------------------------------------------- 
 
-semSq r = knit (sppSq `ext` aspMul)  
-               (ch_me1 .=. (r # ch_se) .*. ch_me2 .=. (r # ch_se) .*. emptyRecord)
+type AttExpr =  Record (HCons (LVPair (Proxy Att_ienv) [(String,Int)]) HNil)
+                -> Record (HCons (LVPair (Proxy Att_spp) PP_Doc)
+                          (HCons (LVPair (Proxy Att_sval) Int) HNil))
 
 
-$(chLabels ["pe1","pe2"] ''T_Expr)
+--Square
+$(chLabel "se" ''T_Expr)
 
-sppPyth  = synM spp  $ do  ae1 <- at ch_ae1
-                           ae2 <- at ch_ae2 
-                           return $ "pyth " >|< (ae1 # spp) >|< " "
-                                            >|< (ae2 # spp)   
+sppSq = synM spp $ do me1 <- at ch_se 
+                      return $ "square" >#< (me1 # spp)   
 
-svalPyth = synM sval $ do  ae1 <- at ch_ae1
-                           ae2 <- at ch_ae2
-                           return  $ (\p1 p2 -> p1 * p1 + p2 * p2 )(ae1 # sval) (ae2 # sval)     
+se2m r = (ch_me1 .=. (r # ch_se) .*. ch_me2 .=. (r # ch_se) .*. emptyRecord)
+m2se r = (ch_se .=. (r # ch_me1) .*. emptyRecord)
 
-semPyth r = knit (sppPyth `ext` svalPyth `ext` aspAdd) 
-                 (ch_ae1 .=. (r # ch_pe1) .*. ch_ae2 .=. (r # ch_pe2) .*. emptyRecord)
+aspSq = sppSq `ext` (adapt aspMul se2m se2m m2se)
+semSq = \s -> knit aspSq (s .*. emptyRecord)  
 
 
+--Pyth
+$(chLabels ["pe1","pe2"] ''T_Expr)
 
+sppSq' = synM spp $ do liftM (# spp) (at ch_se) 
+aspSq' = sppSq' `ext` aspSq 
 
+sppPyth  = synM spp  $ do  pe1 <- at ch_pe1
+                           pe2 <- at ch_pe2 
+                           return $ "pyth" >#< (pe1 # spp) >#< (pe2 # spp)   
+
+aspAdd' =  graft  (graft  aspAdd
+                          (ch_ae2 .=. ch_ae2 .*. hNil)
+                          ch_ae1 
+                          aspSq' 
+                          (ch_se .=. ch_pe1 .*. hNil))
+                  (ch_pe1 .=. ch_pe1 .*. hNil)
+                  ch_ae2
+                  aspSq' 
+                  (ch_se .=. ch_pe2 .*. hNil)
+
+aspPyth    = sppPyth `ext` aspAdd'
+semPyth = \p1 p2 -> knit  aspPyth (p1 .*. p2 .*. emptyRecord)  
+                
+
+--Parenthesis
 $(chLabel "pe" ''T_Expr)
 
 sppPar  = syn spp  $ do  pe <- at ch_pe
@@ -59,44 +84,111 @@
 svalPar = syn sval $ do  liftM (# sval) (at ch_pe)
 ienvPar = copy ienv exprNT
 
+aspPar = sppPar `ext` ienvPar `ext` svalPar
    
-semPar = knit (sppPar `ext` ienvPar `ext` svalPar)
+semPar = \e -> knit aspPar (e .*. emptyRecord)
 
 
+--Substitution
 sppSubst = synM spp $ do  lnm   <- at ch_lnm
                           val   <- at ch_val
                           body  <- at ch_body
                           return $ (body # spp) >|< "[" >|< (pp lnm)  >|< " | " >|< (val # spp) >|< "]" 
 
-semSubst r = knit (sppSubst `ext` aspLet) r
+semSubst = \l v b -> knit (sppSubst `ext` aspLet) (l .*. v .*. b .*. emptyRecord)
 
 
 
---extended grammar (syntax macro) 
 
-type AttExpr =  Record (HCons (LVPair (Proxy Att_ienv) [(String,Int)]) HNil)
-                -> Record (HCons (LVPair (Proxy Att_spp) PP_Doc)
-                          (HCons (LVPair (Proxy Att_sval) Int) HNil))
+--Grammar Extension
+prds'  ::  ( NTRecord (nts env) 
+           , GetNT NTExp    (nts env)  (Symbol AttExpr TNonT env)
+           , GetNT NTTerm   (nts env)  (Symbol AttExpr TNonT env)
+           , GetNT NTFactor (nts env)  (Symbol AttExpr TNonT env)) 
+       =>    SyntaxMacro env start nts start nts
+prds' = proc imported -> do
+         let exp     = getNT ntExp     imported
+         let term    = getNT ntTerm    imported
+         let factor  = getNT ntFactor  imported
 
+         addProds   -<  (exp,     ( iI semSubst  (ch_body <=> exp) "[" (ch_lnm <=> var) "|" (ch_val <=> exp) "]" Ii))
 
-prds'  ::    ( NTRecord (nts env) 
-             , GetNT NTExp    (nts env)  (Symbol AttExpr TNonT env)
-             , GetNT NTFactor (nts env)  (Symbol AttExpr TNonT env)) 
-       =>    SyntaxMacro env (Export start nts) (Export start nts)
-prds' = proc (Export root nts) -> do
-         let exp     = getNT ntExp     nts
-         addProds   -<  (exp,     [  prd semSq    $ trm "square"  <.> ch_se<=>exp <.> prdEnd
-                                  ,  prd semPyth  $ trm "pyth" <.> ch_pe1<=>exp <.> ch_pe2<=>exp <.> prdEnd
-                                  ,  prd semSubst $ ch_body<=>exp <.> trm "[" <.> ch_lnm<=>var <.> 
-                                                    trm "|" <.> ch_val<=>exp <.> trm "]"  <.> prdEnd    ])
+         addProds   -<  (term,    ( iI semSq     "square"  (ch_se  <=> factor) Ii) <|>
+                                  ( iI semPyth   "pyth"    (ch_pe1 <=> factor) (ch_pe2 <=> factor) Ii))
  
-
-         let factor  = getNT ntFactor  nts
-         addProds   -<  (factor,  [  prd semPar $ trm "(" <.> ch_pe<=>exp <.> trm ")" <.>  prdEnd  ])
+         addProds   -<  (factor,  ( iI semPar    "(" (ch_pe <=> exp) ")" Ii )    )
          
-         exportNTs  -< (Export root nts)
+         exportNTs  -< imported
 
+
+
 gramOpts' gramOpts = gramOpts `extKeywordsTxt` [ "square", "pyth" ] `extSpecChars` "()[|]"
+
+
+
+--Syntax Macro 2 --------------------------------------------------------------
+
+--Double
+$(chLabel "de" ''T_Expr)
+
+aspTwo = fixCst aspCst ch_cv 2
+
+aspMul' =  graft  aspMul
+                  (ch_me2 .=. ch_de .*. hNil) 
+                  ch_me1
+                  aspTwo
+                  hNil 
+
+sppDb = synM spp $ do de <- at ch_de 
+                      return $ "double" >#< (de # spp)   
+
+aspDb = sppDb `ext` aspMul'
+                
+semDb = \d -> knit aspDb (d .*. emptyRecord)
+
+           
+
+
+--AddMul
+$(chLabels ["am1","am2","am3"] ''T_Expr)
+
+
+sppAddMul = synM spp $ do  am1 <- at ch_am1 
+                           am2 <- at ch_am2 
+                           am3 <- at ch_am3 
+                           return $ "addmul" >#< (am1 # spp) >#< (am2 # spp) >#< (am3 # spp)  
+
+aspAddMul = ext sppAddMul $  graft  aspAdd
+                                    (ch_ae1 .=. ch_am1 .*. hNil)
+                                    ch_ae2 
+                                    aspMul
+                                    (ch_me1 .=. ch_am2 .*. ch_me2 .=. ch_am3 .*. hNil)
+ 
+semAddMul = \p1 p2 p3 -> knit aspAddMul (p1 .*. p2 .*. p3 .*. emptyRecord)
+                          
+
+
+--Grammar Extension
+
+prds''  ::    ( NTRecord (nts env) 
+              , GetNT NTTerm   (nts env)  (Symbol AttExpr TNonT env)
+              , GetNT NTFactor (nts env)  (Symbol AttExpr TNonT env)) 
+       =>    SyntaxMacro env start nts start nts
+prds'' = proc imported -> do
+         let term    = getNT ntTerm    imported
+         let factor  = getNT ntFactor  imported
+
+
+         addProds   -<  (term,     (iI semDb      "double"  (ch_de   <=> factor) Ii) <|>
+                                   (iI semAddMul  "addmul"  (ch_am1  <=> factor) (ch_am2  <=> factor) (ch_am3  <=> factor) Ii))
+
+         
+         exportNTs  -< imported
+
+
+
+gramOpts'' gramOpts = gramOpts `extKeywordsTxt` [ "double", "addmul" ] `extSpecChars` "()[|]"
+
 
 
 
diff --git a/examples/LangSem.hs b/examples/LangSem.hs
--- a/examples/LangSem.hs
+++ b/examples/LangSem.hs
@@ -23,7 +23,7 @@
              |  Mul {me1 :: T_Expr, me2 :: T_Expr}
              |  Add {ae1 :: T_Expr, ae2 :: T_Expr}
              |  Let {lnm :: String, val :: T_Expr, body :: T_Expr}
-  deriving Show
+          deriving Show
 
 
 
@@ -91,11 +91,11 @@
 aspLet   = sppLet   `ext` ienvLet   `ext` svalLet
 
 
-semAGItf  r  = knit aspAGItf r 
-semCst r     = knit aspCst  r
-semVar r     = knit aspVar  r
-semMul r     = knit aspMul  r
-semAdd r     = knit aspAdd  r
-semLet      = knit aspLet  
+semAGItf  = \r -> knit aspAGItf (r .*. emptyRecord)   
+semCst    = \c -> knit aspCst (c .*. emptyRecord)  
+semVar    = \v -> knit aspVar (v .*. emptyRecord)  
+semMul    = \m1 m2 -> knit aspMul  (m1 .*. m2 .*. emptyRecord)  
+semAdd    = \a1 a2 -> knit aspAdd  (a1 .*. a2 .*. emptyRecord)
+semLet    = \l v b -> knit aspLet  (l .*. v .*. b .*. emptyRecord)
 
 
diff --git a/examples/Main.hs b/examples/Main.hs
--- a/examples/Main.hs
+++ b/examples/Main.hs
@@ -6,8 +6,8 @@
 
 import LangDef
 import LangSem
-import LangExt
 
+import LangExt
 
 import Language.Grammars.SyntaxMacros
 import Language.Grammars.SyntaxMacros.Scanner
@@ -19,14 +19,18 @@
 
 test1 = do
         tokens <- scanFile gramOpts "prog.src"
-        let (Ok res) = (parse . compile ) gram tokens
-        print $ res # spp
-        print $ res # sval
+        let r = (parse . compile ) gram tokens
 
+        case ( parse . compile ) gram tokens of
+           (Ok res) -> do print $ res # spp
+                          print $ res # sval
+           (Rep _ err) -> print err
 
 
-gram' = closeGram (extendGram prds prds') 
 
+
+gram' = closeGram (prds <++> prds') 
+
 test2 = do
         tokens <- scanFile (gramOpts' gramOpts) "prog2.src"
         case ( parse . compile ) gram' tokens of
@@ -34,7 +38,15 @@
                           print $ res # sval
            (Rep _ err) -> print err
 
+gram'' = closeGram (prds <++> prds' <++> prds'') 
 
-main = test1 >> test2 
+test3 = do
+        tokens <- scanFile ((gramOpts'' . gramOpts') gramOpts) "prog3.src"
+        case ( parse . compile ) gram'' tokens of
+           (Ok res) -> do print $ res # spp
+                          print $ res # sval
+           (Rep _ err) -> print err
 
+
+main = test1 >> test2 >> test3
 
diff --git a/examples/README.txt b/examples/README.txt
deleted file mode 100644
--- a/examples/README.txt
+++ /dev/null
@@ -1,9 +0,0 @@
-Modules of the example:
-
-- LangSem.hs   semantic functions of the original language
-- LangDef. hs  definition of the grammar of the original language
-- LangExt.hs   extension (grammar + semantics) of the language
-- Utils.hs     some definitions shared by LangDef and LangExt
-- prog.src     program with the syntax of the original language
-- prog2.src    program with the extended syntax
-- Main.hs      creates and executes compilers of the original and extended languages
diff --git a/examples/prog2.src b/examples/prog2.src
--- a/examples/prog2.src
+++ b/examples/prog2.src
@@ -1,1 +1,1 @@
-let letter= pyth ( 2 + 1) 3 in ( (x + 1) [x | 10]) * (letter + square 4)
+let letter= pyth ( 2 + 1) 3 in ( (x + 1) [x | 10]) * (letter + square 2)
diff --git a/examples/prog3.src b/examples/prog3.src
new file mode 100644
--- /dev/null
+++ b/examples/prog3.src
@@ -0,0 +1,1 @@
+let letter= pyth ( 2 + 1) 3 in ( (x + 1) [x | 10]) * (letter + addmul 2 3 4 + square ( double 3 ))
diff --git a/examples/test b/examples/test
deleted file mode 100644
--- a/examples/test
+++ /dev/null
@@ -1,5 +0,0 @@
-cd ..
-runghc Setup.hs build
-sudo runghc Setup.hs install
-cd examples
-ghci Main
diff --git a/pru.hs b/pru.hs
deleted file mode 100644
--- a/pru.hs
+++ /dev/null
@@ -1,11 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}
-
-class A a b | a -> b where
- fa :: a -> b
-
-
-instance A Bool Bool where
- fa b = b
-
-instance A a a where
- fa a = a + 1
diff --git a/src/Language/Grammars/.Grammar.hs.swp b/src/Language/Grammars/.Grammar.hs.swp
new file mode 100644
Binary files /dev/null and b/src/Language/Grammars/.Grammar.hs.swp differ
diff --git a/src/Language/Grammars/Grammar.hs b/src/Language/Grammars/Grammar.hs
--- a/src/Language/Grammars/Grammar.hs
+++ b/src/Language/Grammars/Grammar.hs
@@ -1,26 +1,46 @@
-{-# LANGUAGE ExistentialQuantification, GADTs, EmptyDataDecls, 
-    MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, FlexibleContexts, UndecidableInstances  #-}
+{-# LANGUAGE ExistentialQuantification, GADTs, EmptyDataDecls,
+    MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, FlexibleContexts, UndecidableInstances #-}
 
 module Language.Grammars.Grammar where
 
 import Language.AbstractSyntax.TTTAS
-import Language.Grammars.AspectAG hiding (append)
+import Data.HList
 
+import Control.Applicative
+import Unsafe.Coerce
 
+
+-------------------------------------------
+-- GRAMMAR REPRESENTATION
+-------------------------------------------
+
+data TL
+data FL a
+
+
 data Grammar a  
   = forall env . Grammar  (Ref a env)  
-                          (Env Productions env env)
+                          (GramEnv env env)
 
-newtype Productions a env 
-  = PS {unPS :: [Prod a env]}
+type GramEnv = Env (Productions TL)
 
-data Prod a env where
-      Seq   ::  Symbol    b  t     env  ->  Prod   (b -> a)  env  
-                                        ->  Prod   a         env
-      End   ::  a                       ->  Prod   a         env
+newtype Productions l a env 
+  = PS {unPS :: [Prod l a env]}
 
-data DTerm = DTerm
+data Prod l a env where
+      Star      ::  Prod l (a->b) env -> Prod l a      env ->  Prod l b  env
+      FlipStar  ::  Prod l a      env -> Prod l (a->b) env ->  Prod l b  env
+      Sym       ::  Symbol a t env                         ->  Prod l a  env
+      Pure      ::  a                                      ->  Prod l a  env
 
+      Fix       ::  Productions (FL a) a env               ->  Prod l      a  env
+      Var       ::                                             Prod (FL a) a  env 
+
+-- I tried with HOAS, but it is more restrictive
+--      Fix       ::  (forall s. Prod a s -> Productions a s)  -> Prod a env 
+
+type DTerm = String
+
 data TTerm
 data TNonT
 data TAttT
@@ -30,13 +50,14 @@
 
   Nont    :: Ref a env ->  Symbol  a        TNonT   env
   -- attributed terminals
-  NontInt   ::             Symbol  Int      TAttT   env
-  NontChar  ::             Symbol  Char     TAttT   env
-  NontVarid ::             Symbol  String   TAttT   env
-  NontConid ::             Symbol  String   TAttT   env
-  NontOp    ::             Symbol  String   TAttT   env 
+  TermInt   ::             Symbol  Int      TAttT   env
+  TermChar  ::             Symbol  Char     TAttT   env
+  TermVarid ::             Symbol  String   TAttT   env
+  TermConid ::             Symbol  String   TAttT   env
+  TermOp    ::             Symbol  String   TAttT   env 
   --- TODO: the rest of EnumValToken
 
+
 getRefNT :: Symbol a TNonT env -> Ref a env
 getRefNT (Nont ref) = ref
 
@@ -49,82 +70,194 @@
           ->  Maybe (Equal (a,t1) (b,t2))
 matchSym (Nont x)   (Nont y)             = pairEq $ match x y
 matchSym (Term x)   (Term y) | x == y    = Just Eq
-matchSym NontInt    NontInt              = Just Eq
-matchSym NontVarid  NontVarid            = Just Eq
-matchSym NontConid  NontConid            = Just Eq
-matchSym NontOp     NontOp               = Just Eq
+matchSym TermInt    TermInt              = Just Eq
+matchSym TermVarid  TermVarid            = Just Eq
+matchSym TermConid  TermConid            = Just Eq
+matchSym TermOp     TermOp               = Just Eq
 matchSym _          _                    = Nothing
 
 
-append  :: (a -> b -> c) -> Prod a env -> Symbol b t env 
-        -> Prod c env
-append g (End f     )  s  =  Seq s  (End (g f))
-append g (Seq t ts  )  s  
-  =  Seq t (append  (\b c d -> g (b d) c) ts s)
-
-
 int   ::  Symbol Int     TAttT  env
 char  ::  Symbol Char    TAttT  env
 var   ::  Symbol String  TAttT  env
 con   ::  Symbol String  TAttT  env
 op    ::  Symbol String  TAttT  env
 
-int   =  NontInt
-char  =  NontChar
-var   =  NontVarid
-con   =  NontConid
-op    =  NontOp
+int   =  TermInt
+char  =  TermChar
+var   =  TermVarid
+con   =  TermConid
+op    =  TermOp
 
 
-data EP a b env = EP a (b env)
+------------------------
+-- APPLICATIVE INTERFACE
+
+
+newtype ListProd l env a = PP { unPP :: [ Prod l a env ] }
+
+
+prod :: ListProd l env a -> Productions l a env
+prod (PP ps) = PS ps
+
+sym  ::  Symbol a  t  env -> ListProd l env a
+sym  s = PP [ Sym $ s ]
+
+nt :: Symbol a  TNonT  env -> ListProd l env a
+nt s = sym s
+
+ntPrd :: Symbol a  TNonT  env -> ListProd l env a
+ntPrd s =  id <$> nt s
+ 
+
+tr ::  String -> ListProd l env DTerm
+tr s = PP [ Sym $ Term s ]
+
+
+varPrd   ::  ListProd (FL a) env a
+varPrd    = PP [ Var ]
+fixPrd  ::  ListProd (FL a) env a -> ListProd l env a
+fixPrd p  = PP [ (Fix . prod) p ]
+
+
+instance Functor (ListProd l env) where
+ fmap f (PP p) = PP [ Star (Pure f) p' | p' <- p ]
+
+instance Applicative (ListProd l env) where
+ pure f = PP [ Pure f ]
+ 
+ (PP f) <*> (PP g) = PP [ Star f' g' | f' <- f, g' <- g ]
+
+instance Alternative (ListProd l env) where
+ empty = PP []
+ 
+ (PP f) <|> (PP g) = PP (f ++ g)
+
+ some p = fixPrd (one <|> more)
+     where  one  = (:[]) <$> toFL p 
+            more = (:)   <$> toFL p <*> varPrd
+
+
+ many p = fixPrd (none <|> more) 
+     where  none = pure [] 
+            more = (:)   <$> toFL p <*> varPrd
+
+toFL :: ListProd l env a -> ListProd (FL b) env a
+toFL (PP p) = PP $ map prodToFL p
+
+prodToFL :: Prod l a env -> Prod (FL b) a env
+prodToFL (Star      f  g)  = Star      (prodToFL f) (prodToFL g)
+prodToFL (FlipStar  f  g)  = FlipStar  (prodToFL f) (prodToFL g)
+prodToFL (Sym       s)     = Sym s
+prodToFL (Pure      a)     = Pure a
+prodToFL (Fix       f)     = Fix f
+prodToFL Var               = unsafeCoerce Var -- the other option is to add an error here
+
+
+pSome :: ListProd (FL [a]) env a -> ListProd l env [a]
+pSome p = fixPrd (one <|> more)
+     where  one  = (:[]) <$> p 
+            more = (:)   <$> p <*> varPrd
+
+pMany :: ListProd (FL [a]) env a -> ListProd l env [a]
+pMany p = fixPrd (none <|> more)
+     where  none = pure [] 
+            more = (:)   <$> p <*> varPrd
+
+
+------------------------
+-- IDIOMS
+
+-- | The  `Ii` is to be pronounced as @stop@
+data Ii = Ii 
+
+-- | The function `iI` is to be pronounced as @start@
+iI ::Idiomatic  l env (a -> a) g => g
+iI = idiomatic (pure id)
+
+class Idiomatic l env f g  | g -> f l env  where
+    idiomatic :: ListProd l env f -> g
+
+instance  Idiomatic l env x  (Ii -> ListProd l env x) where
+    idiomatic ix Ii = ix
+instance  Idiomatic l env f g  => Idiomatic  l env (a -> f) (ListProd l env a -> g) where
+    idiomatic isf is = idiomatic (isf <*> is)
+
+instance Idiomatic l env f g => Idiomatic l env ((a -> b) -> f)  ((a -> b) -> g) where
+    idiomatic isf f = idiomatic (isf <*> (pure f))
+
+instance (Idiomatic  l env f g) 
+       => Idiomatic  l env f (String -> g) where
+    idiomatic isf str = idiomatic (isf <* (tr str))
+
+
+-------------------------------------------------------------------------------
+
+
+newtype  LSPair nt a t env = LSPair { symLSPair :: (Symbol a t env) }  
+
+labelLSPair :: LSPair nt a t env -> nt
+labelLSPair _ = undefined
+
+infixr 6 ^= 
+(^=) :: nt -> Symbol a t env -> LSPair nt a t env
+(^=) _ = LSPair
+
 infixr 6 <=>
 
-(<=>) ::  a -> b env -> EP a b env
-(<=>) = EP
+class LabelSymbol t v v' | t v -> v' where 
+ (<=>) :: label -> Symbol v t env -> ListProd l env (LVPair label v')
 
 
-infixr 5 <.>
+instance LabelSymbol TAttT v (Record HNil -> v) where
+ l <=> v =  (\x -> l .=. (\(Record HNil) -> x)) <$> (PP [ Sym v ])
 
-data PreProd a b env = PreProd (a -> (Prod b env))
+instance LabelSymbol TNonT v v where
+ l <=> v =  (l .=.) <$> (PP [ Sym v ])
 
-class ProdSeq a b c d | a c -> b d  where
-  (<.>) :: a env -> b env -> PreProd c d env
+instance LabelSymbol TTerm v v where -- only to have all the instances
+ l <=> v =  (l .=.) <$> (PP [ Sym v ])
 
-instance (HExtend (LVPair t v) l l') => ProdSeq  
-        (EP t (Symbol b TNonT))
-        (PreProd (l -> v -> t2) (b -> a))
-        (l' -> t2)
-        a where
 
-  (EP chn s)   <.>  (PreProd ps) = PreProd $ 
-         \f ->  let f' r = \x -> f (chn .=. x .*. r) 
-                in   Seq s $ ps f'
 
-instance (HExtend (LVPair t (Record HNil -> v)) l l') => ProdSeq
-        (EP t (Symbol b TAttT))
-        (PreProd (l -> v -> t2) (b -> a))
-        (l' -> t2)
-        a where
+-------------------------------------------------------------------------------
+-- Show instances for the Grammars
+-- Just for debugging purposes
 
-   (EP pn s) <.> (PreProd pp) =  PreProd $ \r ->  Seq s $ pp (f r)
-               where f r p = \x -> r (pn .=. (\(Record HNil) -> x) .*. p) 
+instance Show (Grammar a) where
+ show (Grammar r prods) = show r ++ "\n" ++ show prods
 
+instance ShowEnv (Env (Productions l) env env') => Show (Env (Productions l) env env') where
+ show env = showEnv 0 env
 
-instance ProdSeq
-        (Symbol DTerm TTerm)
-        (PreProd (t1 -> DTerm -> t2) (DTerm -> a))
-        (t1 -> t2)
-        a where
+class ShowEnv a where
+    showEnv :: Int -> a -> String
 
-  s  <.> (PreProd pp) = PreProd $ \r -> Seq s $ pp (f r)
-               where f r p = \DTerm -> r p 
+instance ShowEnv (Env (Productions l) env env') where
+    showEnv _ (Empty)         = "\n"
+    showEnv n (Ext nts nont)  = show n ++ "->" ++ show nont ++ "\n" ++ showEnv (n+1) nts
+ 
+instance Show (Productions l a env) where
+ show (PS prods) = show prods
 
-prdEnd ::  PreProd (Record HNil -> b) b env
-prdEnd = PreProd $ \f -> End (f emptyRecord)
+instance Show (Prod l a env) where
+ show (Star pf pa)      = "(" ++ show pf ++ "<*>" ++ show pa ++ ")"
+ show (FlipStar pa pf)  = "(" ++ show pa ++ "<**>" ++ show pf  ++ ")"
+ show (Sym s)           = show s 
+ show (Pure _)          = "pure"
+ show (Fix f)           = "fix " ++ show f
+ show Var               = "var"
 
-prd ::  (a -> b) -> PreProd (a -> b) t t1 -> Prod t t1
-prd sem (PreProd ps) = ps sem  
+instance Show (Symbol a t env) where
+ show (Term s)    = show s
+ show (Nont r)    = show r
+ show (TermInt)   = "int"
+ show (TermChar)  = "char"
+ show (TermVarid) = "var"
+ show (TermConid) = "con"
+ show (TermOp)    = "op"
 
-prdId ::  Symbol a TNonT env -> Prod a env
-prdId nt = Seq nt  $ End id
+instance Show (Ref a env) where
+ show Zero     = "0"
+ show (Suc r)  = show  $ (1::Int) + ((read . show) r)
 
diff --git a/src/Language/Grammars/SyntaxMacros.hs b/src/Language/Grammars/SyntaxMacros.hs
--- a/src/Language/Grammars/SyntaxMacros.hs
+++ b/src/Language/Grammars/SyntaxMacros.hs
@@ -1,69 +1,72 @@
 {-# LANGUAGE Arrows, ExistentialQuantification, GADTs, Rank2Types, FlexibleContexts, ScopedTypeVariables
     , EmptyDataDecls, MultiParamTypeClasses, FlexibleInstances, OverlappingInstances, FunctionalDependencies, UndecidableInstances
-    , TypeFamilies  #-}
+  #-}
 
 module Language.Grammars.SyntaxMacros where
 
 import Language.AbstractSyntax.TTTAS
 import Control.Arrow
 
-import UU.Parsing.Interface hiding (Symbol,parse,Ok)
 import qualified UU.Parsing as UU
 import Language.Grammars.SyntaxMacros.Scanner
 
-import Language.Grammars.Grammar
+import Language.Grammars.Grammar 
+import Language.Grammars.Transformations.RemoveFix
+import Language.Grammars.Transformations.RemoveEmpties
 import Language.Grammars.Transformations.LeftCorner
-import Language.Grammars.Transformations.LeftFact
 
-type GramTrafo = Trafo Unit Productions
-type ExtGram      env      nts   
-           = GramTrafo env  ()   (nts env)
-type SyntaxMacro  env nts  nts'  
-           = GramTrafo env  (nts env)  (nts' env)
 
+type GramTrafo = Trafo Unit (Productions TL)
+type ExtGram      env  start  nts   
+           = GramTrafo env  ()   (Export start nts env)
+type SyntaxMacro  env  start  nts  start' nts'  
+           = GramTrafo env  (Export start nts env)  (Export start' nts' env)
+
 data Export start nts env = Export (Symbol start TNonT env) (nts env)
 
 -- add a new non-terminal to the grammar
-addNT  ::  GramTrafo env [Prod a env] (Symbol a TNonT env)
+addNT  ::  GramTrafo env (ListProd TL env a) (Symbol a TNonT env)
 addNT  =  proc  p -> do 
-                r  <- newSRef -< PS p
+                r  <- newSRef -< prod p
                 returnA -< Nont r
 
 
 -- add productions to an existing non-terminal
 addProds  ::  GramTrafo  env 
-                         (Symbol a TNonT env, [Prod a env]) ()
-addProds  = proc (nt, prds) -> do
+                         (Symbol a TNonT env, ListProd TL env a) ()
+addProds  = proc (nont, prds) -> do
       updateFinalEnv  -< 
-         updateEnv (\(PS ps) -> PS $ prds ++ ps) (getRefNT nt)
+         updateEnv (\ps -> PS $ (unPP prds) ++ (unPS ps)) (getRefNT nont)
 
  
 -- close the grammar
-closeGram :: (forall env. ExtGram  env (Export a nts)) 
+closeGram :: (forall env. ExtGram  env a nts) 
                 -> Grammar a 
 closeGram prds  = case runTrafo prds Unit () of
      Result _ (Export (Nont r) _) gram 
-            -> (leftfactoring . leftcorner) $ Grammar r gram
-
+            -> (leftCorner . removeEmpties . removeFix) $ Grammar r gram
 
 extendGram  ::  (NTRecord (nts env), NTRecord (nts' env))  
-            =>  ExtGram env (Export start nts) 
-                -> SyntaxMacro env (Export start nts) (Export start' nts') 
-                -> ExtGram env (Export start' nts')
+            =>  ExtGram env start nts 
+                -> SyntaxMacro env start nts start' nts' 
+                -> ExtGram env start' nts'
 extendGram g sm = g >>> sm
 
+(<++>)      ::  (NTRecord (nts env), NTRecord (nts' env))  
+            =>  ExtGram env start nts 
+                -> SyntaxMacro env start nts start' nts' 
+                -> ExtGram env start' nts'
+
+(<++>) = extendGram
+
 exportNTs ::  NTRecord (nts env) => GramTrafo env (Export start nts env) (Export start nts env)
 exportNTs = returnA
 
 
 -- extensible record
 
-newtype  NTField nt a env = NTField { symbolNTField :: (Symbol a TNonT env) }  
 
-labelNTField :: NTField nt a env -> nt
-labelNTField _ = undefined
-
-data  NTCons nt v l env  = NTCons (NTField nt v env) (l env)
+data  NTCons nt v l env  = NTCons (LSPair nt v TNonT env) (l env)
 data  NTNil         env  = NTNil
 
 class NTRecord r 
@@ -83,13 +86,10 @@
 ntNil :: NTNil env
 ntNil = NTNil
 
-infixr 4 ^= 
-(^=) :: nt -> (Symbol a TNonT env) -> NTField nt a env
-(^=) _ = NTField
 
 
-infixr 2 ^| 
-(^|) :: NTRecord (NTCons nt a l env) => NTField nt a env -> l env -> NTCons nt a l env
+infixr 4 ^| 
+(^|) :: NTRecord (NTCons nt a l env) => LSPair nt a TNonT env -> l env -> NTCons nt a l env
 (^|) = NTCons
 
 
@@ -101,58 +101,70 @@
 instance Fail (NotFound nt) => GetNT nt (NTNil env) r where
  getNT = undefined
 instance GetNT nt  (NTCons nt v l env) (Symbol v TNonT env) where -- using overlapping
- getNT _ (NTCons f _)  = symbolNTField f
+ getNT _     (NTCons f _)    = symLSPair f
 instance GetNT nt1 (l env) r => GetNT nt1 (NTCons nt2 v l env) r where
- getNT nt (NTCons _ l)  = getNT nt l
+ getNT nont  (NTCons _ l)    = getNT nont l
 
+instance GetNT nt (nts env) r => GetNT nt (Export start nts env) r where
+ getNT nont  (Export _ nts)  = getNT nont nts
 
+getStart :: Export start nts env ->  (Symbol start TNonT env)
+getStart (Export start _) = start
+
+exportList :: Symbol start TNonT env -> (NTNil env -> nts env) -> Export start nts env
+exportList r l = Export r $ l ntNil
+
+export  ::  (NTRecord (l env), NotDuplicated nt (l env))
+        =>  nt -> Symbol a TNonT env 
+        -> l env ->  NTCons nt a l env
+export l nont = (^|) (l ^= nont) 
+
 -- COMPILE --------------------------------------------------------------------
 
-pInt            ::   Parser Token Int
-pChr            ::   Parser Token Char
-pCon            ::   Parser Token String
-pVar            ::   Parser Token String
-pOp             ::   Parser Token String
+pInt            ::   UU.Parser Token Int
+pChr            ::   UU.Parser Token Char
+pCon            ::   UU.Parser Token String
+pVar            ::   UU.Parser Token String
+pOp             ::   UU.Parser Token String
 
-pChr            =    head <$> pChar
-pInt            =    read <$> pInteger
-pCon            =    id <$> pConid
-pVar            =    id <$> pVarid
-pOp             =    id <$> pVarsym
+pChr            =    head UU.<$> pChar
+pInt            =    read UU.<$> pInteger
+pCon            =    id UU.<$> pConid
+pVar            =    id UU.<$> pVarid
+pOp             =    id UU.<$> pVarsym
 
-pTerm           ::  (UU.Parsing.Interface.IsParser p Token) 
+pTerm           ::  (UU.IsParser p Token) 
                 =>  String -> p DTerm
-pTerm t         =  const DTerm <$>   (pKey t)
+pTerm t         =   pKey t
 
 newtype Const f a s = C {unC :: f a}
 
 
-compile :: Grammar a -> Parser Token a
+compile :: Grammar a -> UU.Parser Token a
 compile (Grammar (start :: Ref a env) rules) 
                        = unC (lookupEnv start result)
   where  result  =  
           mapEnv 
-          (\ (PS ps) -> C (foldr1 (<|>) [ comp p | p <- ps]))
+          (\ (PS ps) -> C (foldr1 (UU.<|>) [ comp p | p <- ps]))
           rules
-         comp :: forall t . Prod t env -> Parser Token t
-         comp (End x)   = pLow x 
-         comp (Seq (Term t) ss) 
-                       = flip ($)  <$> pTerm t <*> comp ss 
-         comp (Seq (Nont n) ss) 
-                       = flip ($)  <$> unC (lookupEnv n result)
-                                     <*> comp ss
-         comp (Seq (NontInt) ss) 
-                       = flip ($)  <$> pInt <*> comp ss 
-         comp (Seq (NontChar) ss) 
-                       = flip ($)  <$> pChr <*> comp ss 
-         comp (Seq (NontVarid) ss) 
-                       = flip ($)  <$> pVar <*> comp ss 
-         comp (Seq (NontConid) ss) 
-                       = flip ($)  <$> pCon <*> comp ss 
-         comp (Seq (NontOp) ss) 
-                       = flip ($)  <$> pOp  <*> comp ss 
 
+         comp :: forall t . Prod TL t env -> UU.Parser Token t
 
+         comp (Star     x y)   = comp x UU.<*>   comp y
+         comp (FlipStar x y)   = comp x UU.<**>  comp y
+         comp (Pure     x)     = UU.pLow x
+
+         comp (Sym (Term t))   = pTerm t
+         comp (Sym (Nont n))   = unC (lookupEnv n result)
+
+         comp (Sym TermInt)    = pInt
+         comp (Sym TermChar)   = pChr
+         comp (Sym TermVarid)  = pVar
+         comp (Sym TermConid)  = pCon
+         comp (Sym TermOp)     = pOp
+
+         comp (Fix _)          = error "This shouldn't be happening!"
+
 mapEnv  ::  (forall a . f a s -> g a s)  
         ->  Env f s env -> Env g s env
 mapEnv  _ Empty       = Empty
@@ -161,28 +173,28 @@
 
 -- PARSE ----------------------------------------------------------------------
 
-type ParseMsg = Message Token (Maybe Token)
+type ParseMsg = UU.Message Token (Maybe Token)
 
 data ParseResult a = Ok  a
                    | Rep a [ParseMsg] 
       deriving Show
 
-parse :: Parser Token a -> [Token] -> ParseResult a
+parse :: UU.Parser Token a -> [Token] -> ParseResult a
 parse p input = case rparse p input of
                   (a,[]  ) -> Ok a
                   (a,msgs) -> Rep a msgs
 
 
-rparse :: Parser Token a -> [Token] -> (a, [ParseMsg])
-rparse p input = let ((Pair a _),msgs) =  eval (UU.parse p input)
+rparse :: UU.Parser Token a -> [Token] -> (a, [ParseMsg])
+rparse p input = let (UU.Pair a _,msgs) =  eval (UU.parse p input)
                  in (a,msgs)
- where eval :: Steps a Token (Maybe Token) -> (a, [ParseMsg])
-       eval (OkVal v        r) = let (a,msgs) = v `seq` eval r 
-                                 in  (v a,msgs)
-       eval (UU.Ok          r) = eval r
-       eval (Cost  _        r) = eval  r
-       eval (StRepair _ msg r) = let (v,msgs) = eval r 
-                                 in  (v,msg:msgs)
-       eval (Best _   r     _) = eval  r
-       eval (NoMoreSteps v   ) = (v,[]) 
+ where eval :: UU.Steps a Token (Maybe Token) -> (a, [ParseMsg])
+       eval (UU.OkVal v        r) = let (a,msgs) = v `seq` eval r 
+                                    in  (v a,msgs)
+       eval (UU.Ok             r) = eval r
+       eval (UU.Cost  _        r) = eval  r
+       eval (UU.StRepair _ msg r) = let (v,msgs) = eval r 
+                                    in  (v,msg:msgs)
+       eval (UU.Best _   r     _) = eval  r
+       eval (UU.NoMoreSteps v   ) = (v,[]) 
 
diff --git a/src/Language/Grammars/Transformations/GramTrafo.hs b/src/Language/Grammars/Transformations/GramTrafo.hs
--- a/src/Language/Grammars/Transformations/GramTrafo.hs
+++ b/src/Language/Grammars/Transformations/GramTrafo.hs
@@ -1,64 +1,75 @@
-{-# OPTIONS -fglasgow-exts #-}
-
+{-# LANGUAGE RankNTypes, GADTs #-}
 module Language.Grammars.Transformations.GramTrafo where
 
 import Language.AbstractSyntax.TTTAS
 import Language.Grammars.Grammar
 
-newtype MapA_X env a env'
-  = MapA_X (forall x t. Symbol x t env -> Maybe (Ref (x -> a) env'))
+data MapA_X env a env'
+  = MapA_X (forall x t. Symbol (x->a)  t env -> Maybe (Ref x       env')) -- Star
+           (forall x t. Symbol x       t env -> Maybe (Ref (x->a)  env')) -- Flip
 
+
 emptyMap :: MapA_X env a env'
-emptyMap  = MapA_X (const Nothing)
+emptyMap  = MapA_X (const Nothing) (const Nothing)
 
-extendMap :: Symbol x t env -> MapA_X env a env'
-          -> MapA_X env a (env',x->a)
-extendMap  x (MapA_X m) 
-       = MapA_X  (\s -> case matchSym s x of
+extendMapS :: Symbol (x->a) t env -> MapA_X env a env'
+           -> MapA_X env a (env',x)
+extendMapS  x (MapA_X ms mf) 
+        = MapA_X  (\s -> case matchSym s x of
                                      Just Eq -> Just Zero
-                                     Nothing -> fmap Suc (m s)
-                      )
+                                     Nothing -> fmap Suc (ms s))
+                  (\s -> fmap Suc (mf s))
 
+extendMapF :: Symbol x t env -> MapA_X env a env'
+           -> MapA_X env a (env',x->a)
+extendMapF  x (MapA_X ms mf) 
+        = MapA_X  (\s -> fmap Suc (ms s))
+                  (\s -> case matchSym s x of
+                                     Just Eq -> Just Zero
+                                     Nothing -> fmap Suc (mf s))
+                 
 
-type GramTrafo env a = Trafo (MapA_X env a) Productions
 
+type GramTrafo env a = Trafo (MapA_X env a) (Productions TL)
 
+
 initMap :: GramTrafo env a s c d
-        -> Trafo Unit Productions s c d
+        -> Trafo Unit (Productions TL) s c d
 initMap (Trafo st) 
         = Trafo (\_ -> case st emptyMap of
                             TrafoE _ f -> TrafoE Unit f
                 )
 
-newNontR ::  forall x t env s a 
-         .   Symbol x t env 
-         ->  GramTrafo env a s (Productions (x->a) s) (Ref (x->a) s)
-newNontR x = Trafo $ \m -> extEnv (extendMap x m)
+newNontRS  ::  forall x t env s a 
+           .   Symbol (x->a) t env 
+           ->  GramTrafo env a s (Productions TL x s) (Ref x s)
+newNontRS x = Trafo $ \m -> extEnv (extendMapS x m)
 
+newNontRF  ::  forall x t env s a 
+           .   Symbol x t env 
+           ->  GramTrafo env a s (Productions TL (x->a) s) (Ref (x->a) s)
+newNontRF x = Trafo $ \m -> extEnv (extendMapF x m)
 
+
 newtype Mapping old new 
            = Mapping (Env Ref new old) 
 
 map2trans :: Mapping env s -> T env s
 map2trans (Mapping env) 
-     = T (\r -> (lookupEnv r env))
+     = T (flip lookupEnv env)
 
-mapProd  :: T env1 env2 -> Prod a env1 -> Prod a env2
-mapProd _ (End x)            = End x
-mapProd t (Seq (Term x) r)   = Seq  (Term x) 
-                                    (mapProd t r)
 
-mapProd t (Seq (Nont x) r)   = Seq (Nont (unT t x)) 
-                                   (mapProd t r)
-mapProd t (Seq NontInt r)    = Seq NontInt 
-                                   (mapProd t r)
-mapProd t (Seq NontChar r)   = Seq NontChar 
-                                   (mapProd t r)
-mapProd t (Seq NontVarid r)  = Seq NontVarid 
-                                   (mapProd t r)
-mapProd t (Seq NontConid r)  = Seq NontConid 
-                                   (mapProd t r)
-mapProd t (Seq NontOp r)     = Seq NontOp 
-                                   (mapProd t r)
-
+mapProd  :: T env1 env2 -> Prod l a env1 -> Prod l a env2
+mapProd t (Sym (Nont x))      = Sym (Nont (unT t x)) 
+mapProd _ (Sym (Term x))      = Sym  (Term x) 
+mapProd _ (Sym TermInt)       = Sym TermInt 
+mapProd _ (Sym TermChar)      = Sym TermChar 
+mapProd _ (Sym TermVarid)     = Sym TermVarid 
+mapProd _ (Sym TermConid)     = Sym TermConid 
+mapProd _ (Sym TermOp)        = Sym TermOp 
+mapProd _ (Pure x)            = Pure x
+mapProd t (Star r l)          = Star     (mapProd t r) (mapProd t l)
+mapProd t (FlipStar r l)      = FlipStar (mapProd t r) (mapProd t l)
+mapProd t (Fix (PS ps))       = Fix $ PS (map (mapProd t) ps)
+mapProd _ Var                 = Var
 
diff --git a/src/Language/Grammars/Transformations/LeftCorner.hs b/src/Language/Grammars/Transformations/LeftCorner.hs
--- a/src/Language/Grammars/Transformations/LeftCorner.hs
+++ b/src/Language/Grammars/Transformations/LeftCorner.hs
@@ -1,6 +1,6 @@
 {-# OPTIONS -XExistentialQuantification -XArrows -XDoRec -XGADTs #-}
 
-module Language.Grammars.Transformations.LeftCorner (leftcorner) where
+module Language.Grammars.Transformations.LeftCorner (leftCorner) where
 
 import Language.AbstractSyntax.TTTAS
 import Language.Grammars.Grammar
@@ -8,24 +8,24 @@
 import Control.Arrow
 
 
-leftcorner :: forall a . Grammar a -> Grammar a
-leftcorner (Grammar start productions)
+leftCorner :: forall a . Grammar a -> Grammar a
+leftCorner (Grammar start productions)
       = case runTrafo (lctrafo productions) Unit () of
             Result _ (T tt) gram -> 
                  Grammar (tt start) gram
 
-lctrafo :: Env Productions env env 
-        -> Trafo Unit Productions s () (T env s)
+lctrafo :: GramEnv env env 
+        -> Trafo Unit (Productions TL) s () (T env s)
 lctrafo productions = proc _ ->
             do   rec  let tenv_s = map2trans menv_s
                       menv_s <- (rules1 productions productions) -< tenv_s
                  returnA -< tenv_s
 
 
-rules1  ::  Env Productions env env
-        ->  Env Productions env env' 
-        ->  Trafo  Unit Productions s (T env s) 
-                                      (Mapping env' s)
+rules1  ::  GramEnv env env
+        ->  GramEnv env env' 
+        ->  Trafo  Unit (Productions TL) s (T env s) 
+                                           (Mapping env' s)
 rules1 _ Empty          
      = proc _ ->
         returnA -< Mapping Empty  
@@ -36,94 +36,188 @@
             r <- newSRef -< p   
             Mapping e <- rules1 productions ps -< tenv_s
             returnA -< Mapping (Ext e r)
- 
-app_rule1 :: forall env a s. Env Productions env env
-          -> [Prod a env]
-          -> Trafo Unit Productions s (T env s) (Productions a s)
+
+
+app_rule1 :: forall env a s. GramEnv env env
+          -> [Prod TL a env]
+          -> Trafo Unit (Productions TL) s (T env s) (Productions TL a s)
 app_rule1 productions prods =  initMap 
           ( proc tenv_s -> 
-                do pss <- sequenceA  (map  (rule1 productions) prods) -< tenv_s 
+                do pss <- sequenceA  (map  (rule1 productions . accessLeftMost) prods) -< tenv_s 
                    returnA -< PS (concatMap unPS pss)
           )
 
-rule1  :: Env Productions env env -> Prod a env 
-       -> GramTrafo env a s (T env s) (Productions a s)
-rule1 gram (Seq x beta) 
+rule1  :: GramEnv env env -> Prod TL a env 
+       -> GramTrafo env a s (T env s) (Productions TL a s)
+
+rule1 gram (Star (Sym x) beta) 
      = proc tenv_s ->
-        do  insert gram x -< (tenv_s, mapProd tenv_s beta)
-                      
+        do  insertS gram x -< (tenv_s, mapProd tenv_s beta)
 
-rule2  :: Env Productions env env 
-       -> Symbol x t env 
-       -> GramTrafo env a s (T env s, Ref (x -> a) s) 
-                            (Productions a s)
-rule2 _    (Term a) 
+rule1 gram (FlipStar (Sym x) beta) 
+     = proc tenv_s ->
+        do  insertF gram x -< (tenv_s, mapProd tenv_s beta)
+
+rule1 gram (Sym x) 
+     = rule1 gram $ FlipStar (Sym x) (Pure id)
+
+rule1 _ (Pure _) 
+     = error "Left-Corner(1): The grammar has empty productions."
+rule1 _ _
+     = error "Left-Corner(2): error in the transformation!!!"
+
+
+accessLeftMost :: Prod TL a env -> Prod TL a env
+accessLeftMost (Star      (Star      f g) h) 
+  = accessLeftMost $ FlipStar f (Star (Star (Pure (\g' h' f' -> f' g' h'))   g) h)
+accessLeftMost (Star      (FlipStar  f g) h) 
+  = accessLeftMost $ FlipStar f (Star (Star (Pure flip)                      g) h)
+accessLeftMost (FlipStar  (Star      f g) h) 
+  = accessLeftMost $ FlipStar f (Star (Star (Pure (\g' h' f' -> h' (f' g'))) g) h)
+accessLeftMost (FlipStar  (FlipStar  f g) h) 
+  = accessLeftMost $ FlipStar f (Star (Star (Pure (\g' h' f' -> h' (g' f'))) g) h)
+accessLeftMost p = p 
+
+rule2S  :: GramEnv env env 
+        -> Symbol (x->a) t env 
+        -> GramTrafo env a s (T env s, Ref x s) 
+                             (Productions TL a s)
+rule2S gram (Nont b) 
+     = case lookupEnv b gram of
+          PS ps ->  proc (tenv_s, a_x) ->
+                      do pss <- sequenceA  
+                                (map  (rule2bS gram  . accessLeftMost) ps) -< (tenv_s, a_x)
+                         returnA -< PS (concatMap unPS pss)
+
+
+
+rule2bS  :: GramEnv env env 
+         -> Prod TL (b->a) env 
+         -> GramTrafo env a s (T env s, Ref b s) 
+                              (Productions TL a s)
+
+rule2bS gram (Star (Sym x) beta) 
+     = proc (tenv_s, a_b) ->
+         do insertF gram x -< (tenv_s, Star (Star (Pure (\b y bya -> bya b y)) (mapProd tenv_s beta)) (Sym $ Nont a_b) )
+
+rule2bS gram (FlipStar (Sym x) beta) 
+     = proc (tenv_s, a_b) ->
+         do insertF gram x -< (tenv_s, Star (Star (Pure (\bya y b -> bya b y)) (mapProd tenv_s beta)) (Sym $ Nont a_b) )
+
+rule2bS gram (Sym x) 
+     = rule2bS gram $ FlipStar (Sym x) (Pure id)
+
+rule2bS _ (Pure _)
+     = error "Left-Corner(3): The grammar has empty productions."
+
+rule2bS _ _
+     = error "Left-Corner(4): error in the transformation!!!"
+
+--
+
+rule2F  :: GramEnv env env 
+        -> Symbol x t env 
+        -> GramTrafo env a s (T env s, Ref (x->a) s) 
+                             (Productions TL a s)
+rule2F _    (Term a) 
      = proc (_, a_x) ->
-        do  returnA -< PS [rule2a a a_x]
-rule2 gram (Nont b) 
+        do  returnA -< PS [rule2aF a a_x]
+rule2F gram (Nont b) 
      = case lookupEnv b gram of
           PS ps ->  proc (tenv_s, a_x) ->
                       do pss <- sequenceA  
-                                (map  (rule2b gram) ps) -< (tenv_s, a_x)
+                                (map  (rule2bF gram  . accessLeftMost) ps) -< (tenv_s, a_x)
                          returnA -< PS (concatMap unPS pss)
-rule2 _    NontInt 
+rule2F _    TermInt 
      = proc (_, a_x) ->
-        do  returnA -< PS [rule2a' NontInt a_x]
-rule2 _    NontChar 
+        do  returnA -< PS [rule2a'F TermInt a_x]
+rule2F _    TermChar 
      = proc (_, a_x) ->
-        do  returnA -< PS [rule2a' NontChar a_x]
-rule2 _    NontVarid 
+        do  returnA -< PS [rule2a'F TermChar a_x]
+rule2F _    TermVarid 
      = proc (_, a_x) ->
-        do  returnA -< PS [rule2a' NontVarid a_x]
-rule2 _    NontConid 
+        do  returnA -< PS [rule2a'F TermVarid a_x]
+rule2F _    TermConid 
      = proc (_, a_x) ->
-        do  returnA -< PS [rule2a' NontConid a_x]
-rule2 _    NontOp 
+        do  returnA -< PS [rule2a'F TermConid a_x]
+rule2F _    TermOp 
      = proc (_, a_x) ->
-        do  returnA -< PS [rule2a' NontOp a_x]
+        do  returnA -< PS [rule2a'F TermOp a_x]
 
 
-rule2a' :: Symbol a t s -> Ref (a -> b) s -> Prod b s
-rule2a' s refA_a
-     =  Seq s $ Seq (Nont refA_a) $ End ($) 
+rule2a'F :: Symbol a t s -> Ref (a->b) s -> Prod TL b s
+rule2a'F s refA_a
+     =  FlipStar (Sym s) (Sym $ Nont refA_a) -- (flip ($)) <$> (Sym s) <*> nont refA_a
 
 
-rule2a :: String -> Ref (DTerm -> a) s -> Prod a s
-rule2a a refA_a
-     =  Seq (Term a) $ Seq (Nont refA_a) $ End ($) 
+rule2aF :: String -> Ref (DTerm -> a) s -> Prod TL a s
+rule2aF a refA_a
+     =  FlipStar (Sym $ Term a) (Sym $ Nont refA_a) -- (flip ($)) <$> term a <*> nont refA_a
 
-rule2b  :: Env Productions env env 
-        -> Prod b env 
-        -> GramTrafo env a s (T env s, Ref (b -> a) s) 
-                             (Productions a s)
-rule2b gram (Seq x beta) 
+
+rule2bF  :: GramEnv env env 
+         -> Prod TL b env 
+         -> GramTrafo env a s (T env s, Ref (b -> a) s) 
+                              (Productions TL a s)
+
+rule2bF gram (Star (Sym x) beta) 
      = proc (tenv_s, a_b) ->
-         do insert gram x -< (tenv_s, append  (flip (.)) 
-                                              (mapProd tenv_s beta) 
-                                              (Nont a_b))
+         do insertF gram x -< (tenv_s, Star (Star (Pure (\b xa bx -> xa (bx b))) (mapProd tenv_s beta)) (Sym $ Nont a_b) )
 
-insert ::  forall x t env s a
-       .   Env Productions env env 
-       ->  Symbol x t env
-       ->  GramTrafo env a s  (T env s, Prod (x->a) s)
-                              (Productions a s)
-insert gram x = 
+rule2bF gram (FlipStar (Sym x) beta) 
+     = proc (tenv_s, a_b) ->
+         do insertF gram x -< (tenv_s, Star (Star (Pure (flip (.))) (mapProd tenv_s beta)) (Sym $ Nont a_b) )
+
+rule2bF gram (Sym x) 
+     = rule2bF gram $ FlipStar (Sym x) (Pure id)
+
+rule2bF _ (Pure _)
+     = error "Left-Corner(5): The grammar has empty productions."
+
+rule2bF _ _
+     = error "Left-Corner(6): error in the transformation!!!"
+
+insertS ::  forall x t env s a
+        .   GramEnv env env 
+        ->  Symbol (x->a) t env
+        ->  GramTrafo env a s  (T env s, Prod TL x s)
+                               (Productions TL a s)
+insertS gram x = 
      Trafo (
-           \(MapA_X m) -> case m x of
-                       Just r   -> extendA_X (MapA_X m) r
+           \(MapA_X ms mf) -> case ms x of
+                       Just r   -> extendA_X (MapA_X ms mf) r
+           
                        Nothing  -> let  Trafo step = insertNewA_X 
-                                   in   step (MapA_X m)
+                                   in   step (MapA_X ms mf)
            )
      where
        insertNewA_X = proc (tenv_s,p) ->
-                     do  r <- newNontR x -< PS [p]
-                         rule2 gram x    -< (tenv_s,r)
+                     do  r <- newNontRS x  -< PS [p]
+                         rule2S gram x     -< (tenv_s,r)
 
 
-extendA_X :: m env2-> Ref (x->a) env2-> TrafoE m Productions s env2 (t, Prod (x->a) s) (Productions a env)
-extendA_X m r = fmap  (const $ PS []) $ 
-                      updateSRef m r (\(_,p) (PS ps) -> PS (p:ps))
+insertF ::  forall x t env s a
+        .   GramEnv env env 
+        ->  Symbol x t env
+        ->  GramTrafo env a s  (T env s, Prod TL (x->a) s)
+                               (Productions TL a s)
+insertF gram x = 
+     Trafo (
+           \(MapA_X ms mf) -> case mf x of
+                       Just r   -> extendA_X (MapA_X ms mf) r
+           
+                       Nothing  -> let  Trafo step = insertNewA_X 
+                                   in   step (MapA_X ms mf)
+           )
+     where
+       insertNewA_X = proc (tenv_s,p) ->
+                     do  r <- newNontRF x  -< PS [p]
+                         rule2F gram x     -< (tenv_s,r)
 
 
+extendA_X  :: m env2 -> Ref x env2 
+            -> TrafoE m (Productions TL) s env2 (t, Prod TL x s) (Productions TL a env)
+extendA_X m r = fmap  (const $ PS []) $ 
+                       updateSRef m r (\(_,p) (PS ps) -> PS (p:ps))
 
 
diff --git a/src/Language/Grammars/Transformations/LeftFact.hs b/src/Language/Grammars/Transformations/LeftFact.hs
deleted file mode 100644
--- a/src/Language/Grammars/Transformations/LeftFact.hs
+++ /dev/null
@@ -1,158 +0,0 @@
-{-# OPTIONS -XExistentialQuantification -XArrows -XDoRec #-}
-
-module Language.Grammars.Transformations.LeftFact (leftfactoring) where
-
-import Language.AbstractSyntax.TTTAS
-import Language.Grammars.Grammar
-import Language.Grammars.Transformations.GramTrafo
-import Control.Arrow
-import Data.Maybe
-
-
-
---list of repeated symbols (with hidden type)
-data AnySym env = forall x t. AnySym (Symbol x t env)
-
-newtype BT env s = BT (Bool, T env s)
-
--- The 'leftfactoring' function makes a feed-back loop to apply the 
--- transformation to the Grammar.
--- If the transformation has produced new nonterminals (repeated initial
--- symbols have been found) the 'leftfactoring' function is called again.
-leftfactoring :: forall a. Grammar a -> Grammar a
-leftfactoring (Grammar start productions)
-      = case runTrafo (lftrafo productions) Unit () of
-            Result _ (BT (b,T tt)) gram -> 
-                 let g = Grammar (tt start) gram
-                 in  if b then leftfactoring g
-                          else g 
-
-lftrafo :: Env Productions env env 
-        -> Trafo Unit Productions s () (BT env s)
-lftrafo productions = proc _ ->
-            do   rec  let tenv_s = map2trans menv_s
-                      (b,menv_s) <- (rules productions) -< tenv_s
-                 returnA -< BT (b,tenv_s)
-
-
--- The function 'rules' is defined by induction over the original Grammar. 
--- Applies the "transformation rule" for each nonterminal (and
--- its corresponding productions) of the Grammar.
--- First of all, the list of "repeated initial symbols" in the productions
--- of a nonterminal is found.
--- Having this list, the rule is applied to the productions.
--- The nonterminal is added to the new Grammar, with the productions
--- generated by the rule.
--- The output of the Trafo is compound by a boolean indicating if repeated
--- symbols were found, and the Mapping from the positions in the new Grammar
--- for each nonterminal of the old Grammar.
-rules  ::  Env Productions env env' 
-        -> Trafo Unit Productions s (T env s) (Bool,(Mapping env' s))
-rules Empty           
-       = proc _ ->
-          returnA -< (False, Mapping Empty)
-
-rules (Ext ps (PS prods)) = 
-    let rep = getrepeated prods
-    in proc tenv_s ->
-         do p <- app_rule rep prods -< tenv_s
-            r <- newSRef -< p   
-            (bs,Mapping e) <- rules ps -< tenv_s
-            returnA -< ((length rep > 0) || bs, Mapping (Ext e r))
- 
-app_rule :: forall env a s. [AnySym env]
-         -> [Prod a env]
-         -> Trafo Unit Productions s (T env s) (Productions a s)
-app_rule rep prods =  initMap 
-          ( proc tenv_s -> 
-                do pss <- sequenceA  (map  (rule rep) prods) -< tenv_s 
-                   returnA -< PS (concatMap unPS pss)
-          )
-
--- If the first symbol of the production is in the list of "repeated
--- initial symbols", the transformation generated by 'rinstert'
--- is called with input the rest of the production. So, a new nonterminal
--- A_Rest_X is generated (if necessary) and the rest (beta) of the production
--- is stored as a production of it.
--- In other case the production (with its references mapped to the
--- to the new Grammar) is returned. 
-rule :: [AnySym env] -> Prod a env
-     -> GramTrafo env a s (T env s) (Productions a s)
-rule _   (End a) = proc env2s ->
-                    do returnA -< PS [ mapProd env2s (End a) ]
-                        
-rule rep (Seq x beta) 
-      | x `iselem` rep = proc env2s ->
-                        do  rinsert x -< (env2s, mapProd env2s beta)
-      | otherwise    = proc env2s ->
-                        do returnA -< PS [ mapProd env2s (Seq x beta) ]
-
-
--- Insertion of a new production into one "rest" nonterminal.
--- If the symbol 'x' is in the MapA_X the nonterminal was already
--- added, so we obtain the reference of the nonterminal and add the new
--- production.
--- Otherwise, we have to create the new nonterminal (newNontR x).
-rinsert :: forall t env s a x. Symbol x t env
-        -> GramTrafo env a s (T env s, Prod (x->a) s) (Productions a s)
-rinsert x = 
-     Trafo (
-           \(MapA_X m) -> case m x of
-                       Nothing -> case proc (env2s,p) ->
-                                          do r <- newNontR x -< PS [p]
-                                             addprod x -< (env2s,r) 
-                                  of Trafo step -> step (MapA_X m)
-                       Just r  -> TrafoE (MapA_X m)
-                                         (\(_,p) t e f ->
-                                              ( PS []
-                                              , t
-                                              , updateEnv (\(PS ps) 
-                                                             -> PS (p:ps))
-                                                          r e
-                                              , f
-                                              )
-                                         )
-           )
-
-
-addprod :: Symbol x t env -> GramTrafo env a s (T env s, Ref (x -> a) s) 
-                                           (Productions a s)     
-addprod (Term x) = proc (_,    a__x) -> 
-                      do returnA -< PS [ Seq (Term x) $ Seq (Nont a__x) $ End ($)]
-addprod (Nont r) = proc (env2s, a__x) -> 
-                      do returnA -< PS [ Seq (Nont (unT env2s r)) $ Seq (Nont a__x) 
-                                         $ End ($)]
-addprod (NontInt) = proc (_, a__x) -> 
-                      do returnA -< PS [ Seq NontInt $ Seq (Nont a__x) $ End ($)]
-addprod (NontChar) = proc (_, a__x) -> 
-                      do returnA -< PS [ Seq NontChar $ Seq (Nont a__x) $ End ($)]
-addprod (NontVarid) = proc (_, a__x) -> 
-                      do returnA -< PS [ Seq NontVarid $ Seq (Nont a__x) $ End ($)]
-addprod (NontConid) = proc (_, a__x) -> 
-                      do returnA -< PS [ Seq NontConid $ Seq (Nont a__x) $ End ($)]
-addprod (NontOp) = proc (_, a__x) -> 
-                      do returnA -< PS [ Seq NontOp $ Seq (Nont a__x) $ End ($)]
-
--- Get the list of symbols that are repeated as "first symbol" in the list
--- of productions.
-getrepeated :: [Prod a env] -> [AnySym env]
-getrepeated prods = repeated $ mapMaybe head' prods
-      where head' (End _  ) = Nothing
-            head' (Seq x _) = Just (AnySym x)
-            repeated [] = []
-            repeated (ax@(AnySym x):xs) 
-              | x `iselem` xs = ax : repeated (filter (noteqAny ax) xs)
-              | otherwise     = repeated xs
-
-            noteqAny (AnySym x) (AnySym y) = (aux $ matchSym x y)
-                                               
-aux :: Maybe (Equal a b) -> Bool
-aux (Just Eq) = False
-aux Nothing   = True  
-
-iselem :: Symbol a t env -> [AnySym env] -> Bool
-iselem _ []              = False
-iselem x ((AnySym y):ys) = case (matchSym x y) of
-                                  (Just Eq) -> True
-                                  Nothing   -> iselem x ys 
-
diff --git a/src/Language/Grammars/Transformations/RemoveEmpties.hs b/src/Language/Grammars/Transformations/RemoveEmpties.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Grammars/Transformations/RemoveEmpties.hs
@@ -0,0 +1,154 @@
+
+module Language.Grammars.Transformations.RemoveEmpties (removeEmpties) where
+
+
+import Language.Grammars.Grammar
+import Language.AbstractSyntax.TTTAS
+
+
+data HasEmpty a env = Unknown | HasEmpty (Prod TL a env) | HasNotEmpty
+ deriving (Show)
+
+
+removeEmpties :: Grammar a -> Grammar a
+removeEmpties (Grammar start prods) 
+     =  Grammar start $ removeEmptiesEnv (findEmpties prods) prods 
+
+
+
+findEmpties :: GramEnv env env -> Env HasEmpty env env 
+findEmpties prods = findEmpties' prods (initEmpties prods)
+         where
+            findEmpties' prds empties = 
+                  case stepFindEmpties empties prds empties of
+                      (empties', True,  _)     -> findEmpties' prds empties'
+                      (empties', False, False) -> empties'
+                      (_,        False, True)  -> error "Remove Empties(1): Incorrect Grammar!!"
+
+initEmpties :: GramEnv use def -> Env HasEmpty use def 
+initEmpties Empty        = Empty
+initEmpties (Ext nts _)  = Ext (initEmpties nts) Unknown
+
+stepFindEmpties :: Env HasEmpty use use -> GramEnv use def -> Env HasEmpty use def 
+                -> (Env HasEmpty use def, Bool, Bool) 
+stepFindEmpties _       Empty          Empty        
+    = (Empty, False, False)
+stepFindEmpties empties (Ext rprd prd) (Ext re e)   
+    = let (re',rchanged,rhasUnk) = stepFindEmpties empties rprd re
+          (e', changed, hasUnk)  = updateEmpty empties prd e
+      in  (Ext re' e', changed || rchanged, hasUnk || rhasUnk)
+stepFindEmpties _       _              _ 
+    = error "RemoveEmpties(2): Error in the transformation!!!"        
+
+
+updateEmpty :: Env HasEmpty use use -> (Productions TL) a use -> HasEmpty a use  
+            -> (HasEmpty a use, Bool, Bool) 
+updateEmpty _       _   (HasEmpty p) = (HasEmpty p,  False, False)
+updateEmpty _       _   HasNotEmpty  = (HasNotEmpty, False, False)
+updateEmpty empties prd Unknown      = case hasEmpty empties prd of
+                                        Unknown -> (Unknown, False, True)
+                                        e       -> (e,       True,  False)
+
+hasEmpty :: Env HasEmpty env env -> (Productions TL) a env -> HasEmpty a env
+hasEmpty empties (PS ps)= foldr (\p re -> combHasEmpty (isEmpty p empties) re) HasNotEmpty ps
+
+
+combHasEmpty :: HasEmpty a env -> HasEmpty a env -> HasEmpty a env
+combHasEmpty (HasEmpty _)     (HasEmpty _)     = error "Remove Empties(3): Ambiguous Grammar!!!"
+combHasEmpty _                (HasEmpty p)     = HasEmpty p
+combHasEmpty (HasEmpty p)     _                = HasEmpty p
+combHasEmpty HasNotEmpty      HasNotEmpty      = HasNotEmpty
+combHasEmpty _                Unknown          = Unknown
+combHasEmpty Unknown          _                = Unknown
+
+
+isEmpty :: Prod TL a env -> Env HasEmpty env env -> HasEmpty a env
+isEmpty (Pure a)              _       = HasEmpty (Pure a)
+isEmpty (Sym (Term _))        _       = HasNotEmpty
+isEmpty (Sym (TermInt))       _       = HasNotEmpty
+isEmpty (Sym (TermChar))      _       = HasNotEmpty
+isEmpty (Sym (TermVarid))     _       = HasNotEmpty
+isEmpty (Sym (TermConid))     _       = HasNotEmpty
+isEmpty (Sym (TermOp))        _       = HasNotEmpty
+isEmpty (Sym (Nont r))        empties = lookupEnv r empties
+isEmpty (Star pl pr)          empties = case isEmpty pl empties of
+                                         HasEmpty (Pure f)  -> case isEmpty pr empties of
+                                                                HasEmpty (Pure x)  -> HasEmpty $ Pure (f x)
+                                                                HasEmpty _         -> error "RemoveEmpties(4): Error in the transformation!!!"
+                                                                HasNotEmpty        -> HasNotEmpty
+                                                                Unknown            -> Unknown
+                                         HasEmpty _         -> error "RemoveEmpties(5): Error in the transformation!!!"
+                                         HasNotEmpty        -> HasNotEmpty
+                                         Unknown            -> case isEmpty pr empties of
+                                                                HasNotEmpty        -> HasNotEmpty
+                                                                _                  -> Unknown
+isEmpty (FlipStar pl pr)      empties = case isEmpty pl empties of
+                                         HasEmpty (Pure x)  -> case isEmpty pr empties of
+                                                                HasEmpty (Pure f)  -> HasEmpty $ Pure (f x)
+                                                                HasEmpty _         -> error "RemoveEmpties(6): Error in the transformation!!!"
+                                                                HasNotEmpty        -> HasNotEmpty
+                                                                Unknown            -> Unknown
+                                         HasEmpty _         -> error "RemoveEmpties(7): Error in the transformation!!!"
+                                         HasNotEmpty        -> HasNotEmpty
+                                         Unknown            -> case isEmpty pr empties of
+                                                                HasNotEmpty        -> HasNotEmpty
+                                                                _                  -> Unknown
+
+isEmpty (Fix _)               _       = error "RemoveEmpties(8): cannot transform grammars with Fix constructions."
+
+
+
+removeEmptiesEnv :: Env HasEmpty use use -> GramEnv use def -> GramEnv use def
+removeEmptiesEnv _       Empty         
+    = Empty
+removeEmptiesEnv empties (Ext rprds prds)    
+    = Ext (removeEmptiesEnv empties rprds) (removeEmpty empties prds)
+
+
+removeEmpty :: Env HasEmpty env env -> Productions TL a env -> Productions TL a env
+removeEmpty empties (PS prds) = PS $ foldr ((++) . remEmptyProd) [] prds 
+  where 
+     -- if we don't allow the starting point to be empty, 
+     -- then we can ignore the empty part
+     remEmptyProd prd = let (prd',_) = splitEmpty empties prd
+                        in  prd'
+
+
+splitEmpty :: Env HasEmpty env env -> Prod TL a env -> ([Prod TL a env], Maybe (Prod TL a env))
+
+splitEmpty  empties  (Star f g)  
+    =  let (fne, fe) = splitEmpty empties f 
+           (gne, ge) = splitEmpty empties g 
+
+           fne_gne   = [ Star fv gv | fv <- fne, gv <- gne ] 
+           fne_ge    = case ge of
+                         Nothing -> []
+                         Just gv -> [ Star fv gv | fv <- fne] 
+
+           fe_gne  = case fe of
+                         Nothing -> []
+                         Just fv -> [ FlipStar gv fv | gv <- gne] 
+           fe_ge   = do 
+                         (Pure fv) <- fe
+                         (Pure gv) <- ge
+                         return $ Pure (fv gv)
+
+       in  (fne_gne ++ fne_ge ++ fe_gne , fe_ge)
+
+
+splitEmpty  empties  (Sym (Nont r))  
+    = case lookupEnv r empties of
+              HasEmpty (Pure f)  -> ([Sym $ Nont r], Just (Pure f))
+              HasEmpty _         -> error "RemoveEmpties(9): Error in the transformation!!!"
+              HasNotEmpty        -> ([Sym $ Nont r], Nothing)
+              Unknown            -> error "RemoveEmpties(10): Error in the transformation!!!"
+
+splitEmpty  _        (Sym  s)  = ([Sym s], Nothing)
+splitEmpty  _        (Pure a)  = ([],Just $ Pure a)
+
+splitEmpty  _        (FlipStar _ _)  
+    = error "RemoveEmpties(11): FlipStar cannot be used to define grammars."
+splitEmpty  _        (Fix _)  
+    = error "RemoveEmpties(12): cannot transform grammars with Fix constructions."
+
+
diff --git a/src/Language/Grammars/Transformations/RemoveFix.hs b/src/Language/Grammars/Transformations/RemoveFix.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Grammars/Transformations/RemoveFix.hs
@@ -0,0 +1,78 @@
+{-# LANGUAGE  RankNTypes, Arrows, DoRec #-} 
+
+module Language.Grammars.Transformations.RemoveFix (removeFix) where
+
+
+import Language.AbstractSyntax.TTTAS
+import Language.Grammars.Grammar
+import Language.Grammars.Transformations.GramTrafo
+
+import Control.Arrow
+
+removeFix :: forall a . Grammar a -> Grammar a
+removeFix (Grammar start productions)
+      = case runTrafo (remfixtrafo productions) Unit () of
+            Result _ (T tt) gram -> 
+                 Grammar (tt start) gram
+
+remfixtrafo :: GramEnv env env 
+        -> Trafo Unit (Productions TL) s () (T env s)
+remfixtrafo productions = proc _ ->
+            do   rec  let tenv_s = map2trans menv_s
+                      menv_s <- (remfixProds productions) -< tenv_s
+                 returnA -< tenv_s
+
+
+remfixProds  ::  GramEnv env env' 
+             ->  Trafo  Unit (Productions TL) s (T env s) 
+                                                (Mapping env' s)
+remfixProds Empty          
+     = proc _ ->
+        returnA -< Mapping Empty  
+
+remfixProds (Ext p (PS prods)) 
+     = proc tenv_s ->
+        do  ps <- sequenceA  (map  remfixProd prods) -< tenv_s 
+            r  <- newSRef -< PS ps   
+            Mapping e <- remfixProds p -< tenv_s
+            returnA -< Mapping (Ext e r)
+
+
+
+remfixProd  :: Prod l a env 
+            -> Trafo Unit (Productions TL) s (T env s) (Prod l a s)
+
+remfixProd (Fix (PS ps)) 
+     = proc tenv_s ->
+        do  rec  ps' <- sequenceA (map remfixProd ps) -< tenv_s
+                 r   <- newSRef -<  PS (map (remVar r) ps')     
+            returnA -< (Sym $ Nont r)
+
+remfixProd (Star f g) 
+     = proc tenv_s ->
+        do  f' <- remfixProd f -< tenv_s
+            g' <- remfixProd g -< tenv_s
+            returnA -< Star f' g'
+
+remfixProd (FlipStar f g) 
+     = proc tenv_s ->
+        do  f' <- remfixProd f -< tenv_s
+            g' <- remfixProd g -< tenv_s
+            returnA -< FlipStar f' g'
+
+remfixProd p 
+     = proc tenv_s ->
+        do  returnA -< mapProd tenv_s p
+
+
+
+remVar  :: Ref b env -> Prod (FL b) a env -> Prod TL a env
+remVar _ (Sym s)             = Sym s 
+remVar _ (Pure x)            = Pure x
+remVar r  (Star f g)         = Star (remVar r f) (remVar r g)
+remVar r  (FlipStar f g)     = FlipStar (remVar r f) (remVar r g)
+remVar r  Var                = Sym (Nont r) 
+
+remVar _ (Fix _)             = error "RemoveFix(1): error in the transformation!!!"
+
+