diff --git a/Data/Parser/Grempa/Aux/MultiMap.hs b/Data/Parser/Grempa/Aux/MultiMap.hs
--- a/Data/Parser/Grempa/Aux/MultiMap.hs
+++ b/Data/Parser/Grempa/Aux/MultiMap.hs
@@ -5,10 +5,12 @@
   , lookup
   , insert
   , inserts
+  , delete
   , union
   , unions
   , fromList
   , M.empty
+  , toList
   ) where
 
 import qualified Data.Map as M
@@ -24,11 +26,17 @@
 lookup k m = fromMaybe S.empty $ M.lookup k m
 
 insert :: (Ord a, Ord k) => k -> a -> MultiMap k a -> MultiMap k a
-insert k v m = M.insert k (S.insert v (lookup k m)) m
+insert k v m = M.insert k (S.insert v $ lookup k m) m
 
 inserts :: (Ord a, Ord k) => k -> Set a -> MultiMap k a -> MultiMap k a
-inserts k v m = M.insert k (v `S.union` lookup k m) m
+inserts k v m = M.insertWith S.union k v m
 
+delete :: (Ord a, Ord k) => k -> a -> MultiMap k a -> MultiMap k a
+delete k v m = M.update aux k m
+  where aux ss = let ss' = S.delete v ss in if S.null ss'
+                                               then Nothing
+                                               else Just ss'
+
 union :: (Ord a, Ord k) => MultiMap k a -> MultiMap k a -> MultiMap k a
 union m1 m2 = foldl (flip $ uncurry inserts) m1 $ M.toList m2
 
@@ -37,3 +45,6 @@
 
 fromList :: (Ord a, Ord k) => [(k, a)] -> MultiMap k a
 fromList = foldl (flip $ uncurry insert) M.empty
+
+toList :: (Ord a, Ord k) => MultiMap k a -> [(k, Set a)]
+toList = M.toList
diff --git a/Data/Parser/Grempa/Grammar.hs b/Data/Parser/Grempa/Grammar.hs
--- a/Data/Parser/Grempa/Grammar.hs
+++ b/Data/Parser/Grempa/Grammar.hs
@@ -38,11 +38,14 @@
 {-# LANGUAGE DoRec, TypeFamilies #-}
 module Data.Parser.Grempa.Grammar
     ( module Data.Parser.Grempa.Grammar.Typed
+    , module Data.Parser.Grempa.Grammar.Levels
     , several0, several, severalInter0, severalInter, cons
     ) where
+
 import Data.Typeable
 import Data.Parser.Grempa.Grammar.Typed
     (Grammar, rule, ToSym(..), (<#>), (<#), (<@>), (<@), epsilon)
+import Data.Parser.Grempa.Grammar.Levels
 
 -- | Create a new rule which consists of 0 or more of the argument symbol.
 --   Example: @several0 x@ matches @x x ... x@
diff --git a/Data/Parser/Grempa/Grammar/Levels.hs b/Data/Parser/Grempa/Grammar/Levels.hs
new file mode 100644
--- /dev/null
+++ b/Data/Parser/Grempa/Grammar/Levels.hs
@@ -0,0 +1,47 @@
+{-# LANGUAGE DoRec #-}
+module Data.Parser.Grempa.Grammar.Levels
+    ( levels
+    , lrule
+    ) where
+
+import Control.Monad.State
+import Control.Monad.Trans
+import Control.Monad.Fix
+import Data.Typeable
+
+import Data.Parser.Grempa.Grammar.Typed
+
+newtype ReverseT m a = ReverseT { runReverseT :: m a }
+
+instance MonadFix m => Monad (ReverseT m) where
+    return            = ReverseT . return
+    ReverseT m >>= f  =
+         ReverseT $ do
+           rec
+             b <- runReverseT (f a)
+             a <- m
+           return b
+
+instance MonadTrans ReverseT where
+    lift = ReverseT
+
+instance MonadFix m => MonadFix (ReverseT m) where
+    mfix f = ReverseT $ mfix (runReverseT . f)
+
+type RStateT s m a = ReverseT (StateT s m) a
+
+levels :: Monad m => RStateT (Maybe a) m r -> m r
+levels = flip evalStateT Nothing . runReverseT
+
+lrule :: (Typeable a, Typeable t)
+      => Rule t a
+      -> RStateT (Maybe (RId t a)) (GrammarState t) (RId t a)
+lrule r = do
+  rec
+    lift $ put (Just rid)
+    rid <- lift $ lift $ rule $ case mnext of
+        Just next -> (id <@> next) : r
+        Nothing   -> r
+    mnext <- lift get
+  return rid
+
diff --git a/Data/Parser/Grempa/Grammar/Typed.hs b/Data/Parser/Grempa/Grammar/Typed.hs
--- a/Data/Parser/Grempa/Grammar/Typed.hs
+++ b/Data/Parser/Grempa/Grammar/Typed.hs
@@ -2,7 +2,7 @@
 {-# OPTIONS_HADDOCK hide #-}
 module Data.Parser.Grempa.Grammar.Typed
     ( Grammar
-    , Prod(..), Symbol(..), RId(..)
+    , Rule, Prod(..), Symbol(..), RId(..)
     , GrammarState
     , rule
     , evalGrammar
@@ -47,7 +47,7 @@
 
 -- The grammar monad giving a unique RuleI to each new rule
 newtype RuleIDs t = RuleIDs { rules :: [RuleI] }
-type GrammarState t a = State (RuleIDs t) a
+type GrammarState t = State (RuleIDs t)
 type Grammar t a = GrammarState t (RId t a)
 
 -- | Get the result from a Grammar computation
diff --git a/Data/Parser/Grempa/Grammar/Untyped.hs b/Data/Parser/Grempa/Grammar/Untyped.hs
--- a/Data/Parser/Grempa/Grammar/Untyped.hs
+++ b/Data/Parser/Grempa/Grammar/Untyped.hs
@@ -3,7 +3,7 @@
     ( Rule, Prod, Symbol(..), RId(..)
     , unType
     , rules, terminals, nonTerminals
-    , first, firstProd, follow
+    , firstProd, follow
     )where
 
 import qualified Control.Arrow as A
@@ -15,6 +15,8 @@
 import qualified Data.Set as S
 
 import Data.Parser.Grempa.Aux.Aux
+import qualified Data.Parser.Grempa.Aux.MultiMap as MM
+import Data.Parser.Grempa.Aux.MultiMap(MultiMap)
 import Data.Parser.Grempa.Parser.Table
 import Data.Parser.Grempa.Grammar.Token
 import qualified Data.Parser.Grempa.Grammar.Typed as T
@@ -103,33 +105,72 @@
 nonTerminals :: Token s => [RId s] -> [Symbol s]
 nonTerminals = map SRule
 
--- | Get the first tokens that a symbol eats
-first :: Token s => Symbol s -> Set (ETok s)
-first = evalDone . first'
+-- | Datatype used in computing the first set
+data RecETok s
+    = RETok {unRETok :: ETok s}
+    | IfEpsilon (RId s) (Prod s)
+    | RRule (RId s)
+  deriving (Eq, Ord)
 
---first' :: Token s => Symbol s -> Done (RId s) () (Set (ETok s))
-first' :: Token s => Symbol s -> DoneA (RId s) (Set (ETok s))
-first' (STerm s)             = return $ S.singleton (ETok s)
-first' (SRule rid@(RId _ r)) = ifNotDone rid $ do
-  rec
-    putDone rid $ case Epsilon `S.member` res of
-        True  -> S.singleton Epsilon
-        False -> S.empty
-    res <- S.unions <$> mapM firstProd' r
-  return res
+type First s a = State (MultiMap (RId s) (RecETok s)) a
 
--- | Get the first tokens of a production
+-- | Get the first tokens that a symbol eats
+-- first :: Token s => Symbol s -> Set (ETok s)
+-- first s = firstProd [s]
+
 firstProd :: Token s => Prod s -> Set (ETok s)
-firstProd = evalDone . firstProd'
+firstProd = flip evalState MM.empty . firstProd'
 
-firstProd' :: Token s => Prod s -> DoneA (RId s) (Set (ETok s))
-firstProd' []     = return $ S.singleton Epsilon
-firstProd' (x:xs) = do
-    fx <- first' x
-    case Epsilon `S.member` fx of
-        True  -> S.union (S.delete Epsilon fx) <$> firstProd' xs
-        False -> return fx
+firstProd' :: Token s => Prod s -> First s (Set (ETok s))
+firstProd' as = do
+    go (RId (-1) undefined) as
+    fixf
+    results <$> gets (MM.lookup (RId (-1) undefined))
+  where
+    go :: Token s => RId s -> Prod s -> First s ()
+    go rid []          = modify $ MM.insert rid (RETok Epsilon)
+    go rid (STerm s:_) = modify $ MM.insert rid (RETok (ETok s))
+    go rid (SRule rid'@(RId _ ps):xs) = do
+        modify $ MM.insert rid (RRule rid')
+        ss <- gets $ MM.lookup rid'
+        when (S.null ss) $ mapM_ (go rid') ps
+        modify $ MM.insert rid (IfEpsilon rid' xs)
 
+    f :: Token s => RId s -> RecETok s -> First s ()
+    f rid rt@(IfEpsilon rid' xs) = do
+        ss  <- gets (MM.lookup rid')
+        when (S.member (RETok Epsilon) ss) $ do
+            modify $ MM.delete rid rt
+            go rid xs
+    f rid rt@(RRule rid') = do
+        ss <- gets (MM.lookup rid')
+        when (clean ss) $ do
+            modify $ MM.delete rid rt
+        modify $ MM.inserts rid (S.filter isRETok ss)
+    f _ _ = return ()
+
+    clean :: Set (RecETok s) -> Bool
+    clean = S.fold ((&&) . isRETok) True
+
+    isRETok :: RecETok s -> Bool
+    isRETok (RETok _) = True
+    isRETok _         = False
+
+    fs :: Token s => First s ()
+    fs = do
+        ss <- get
+        sequence_ [f rid rt | (rid, rts) <- MM.toList ss, rt <- S.toList rts]
+
+    results :: Token s => Set (RecETok s) -> Set (ETok s)
+    results = S.map unRETok . S.filter isRETok
+
+    fixf :: Token s => First s ()
+    fixf = do
+        state <- get
+        fs
+        state' <- get
+        when (state /= state') fixf
+
 -- | Get all symbols that can follow a rule,
 --   also given the start rule and a list of all rules
 follow :: Token s => RId s -> RId s -> [RId s] -> Set (Tok s)
@@ -146,9 +187,11 @@
   where
     followProd []       _ = return S.empty
     followProd (b:beta) a
-        | b == SRule rid = case Epsilon `S.member` firstbeta of
-            True  -> (rest `S.union`) <$> follow' a startrid rids
-            False -> return rest
+        | b == SRule rid =  S.union rest
+                        <$> liftM2 S.union (followProd beta a)
+                                           (if Epsilon `S.member` firstbeta
+                                               then follow' a startrid rids
+                                               else return S.empty)
         | otherwise      = followProd beta a
       where
         firstbeta = firstProd beta
diff --git a/Data/Parser/Grempa/Parser/Conflict.hs b/Data/Parser/Grempa/Parser/Conflict.hs
--- a/Data/Parser/Grempa/Parser/Conflict.hs
+++ b/Data/Parser/Grempa/Parser/Conflict.hs
@@ -38,7 +38,7 @@
     ++ "), between " ++ intercalate " and " (map go confs)
   where
     go cs = "[" ++ intercalate "," (map go' cs) ++ "]"
-    go' (t, a) = "On token " ++ show (unTok t) ++ " " ++ showAction a
+    go' (t, a) = "On token " ++ tokToString t ++ " " ++ showAction a
     showAction (Shift s)       = "shift state " ++ show s
     showAction (Reduce r p _ _) = "reduce (rule " ++ show r ++ ", production " ++ show p ++ ")"
     showAction Accept           = "accept"
diff --git a/Data/Parser/Grempa/Parser/Item.hs b/Data/Parser/Grempa/Parser/Item.hs
--- a/Data/Parser/Grempa/Parser/Item.hs
+++ b/Data/Parser/Grempa/Parser/Item.hs
@@ -3,10 +3,11 @@
     ( It(..), getItProd, isKernelIt
     , kernel
     , nextSymbol
-    , goto
     , nextItPos
     , Gen, GenData(..), runGen, gen
     , askItemSet
+    , precomputeGotos
+    , askGoto
     ) where
 
 import Control.Applicative
@@ -38,6 +39,7 @@
 isKernelIt st it = pos > 0 || (itRId it == st && pos == 0)
   where pos = getItPos it
 
+-- | Get the kernel of an item set
 kernel :: It i s => RId s -> Set (i s) -> Set (i s)
 kernel st = S.filter $ isKernelIt st
 
@@ -69,6 +71,7 @@
     itemSets' c   = (c `S.union` gs, gs)
       where gs    = S.fromList [goto i x | i <- S.toList c, x <- symbols]
 
+-- | Data environment for parser generation
 data GenData i s = GenData
   { gItemSets     :: [(Set (i s), StateI)]
   , gItemSetIndex :: Map (Set (i s)) StateI
@@ -78,31 +81,63 @@
   , gSymbols      :: [Symbol s]
   , gStartState   :: Int
   , gStartRule    :: RId s
+  , gGotos        :: Map (StateI, Symbol s) StateI
   } deriving Show
 
 type Gen i s = Reader (GenData i s)
 runGen :: Gen i s a -> GenData i s -> a
 runGen = runReader
 
+-- | Create an initial parser generator data structure
 gen :: (It i s, Token s) => RId s -> GenData i s
-gen g = GenData is ix rs ts nt sys ss g
+gen g = GenData
+    { gItemSets     = items
+    , gItemSetIndex = itemIx
+    , gRules        = ruless
+    , gTerminals    = terms
+    , gNonTerminals = nonTerms
+    , gSymbols      = syms
+    , gStartState   = snd $ fromMaybe (error "gen: maybe")
+                    $ find (S.member (startItem g) . fst) items
+    , gStartRule    = g
+    , gGotos        = precomputeGotos items itemIx syms
+    }
+  where items    = zip (S.toList $ itemSets g ruless) [0..]
+        itemIx   = M.fromList items
+        ruless   = rules g
+        terms    = terminals ruless
+        nonTerms = nonTerminals ruless
+        syms     = terms ++ nonTerms
+
+-- | Calculate the goto function for all inputs and put it in a map
+precomputeGotos :: (It i s, Token s)
+                => [(Set (i s), StateI)] -> Map (Set (i s)) StateI -> [Symbol s]
+                -> Map (StateI, Symbol s) StateI
+precomputeGotos iss isi syms = M.fromList
+        [((ii, sym), st) | (is, ii) <- iss
+                         , sym      <- syms
+                         , Just st <- [findState $ goto is sym]]
   where
-    is  = zip (S.toList $ itemSets g rs) [0..]
-    ix  = M.fromList is
-    rs  = rules g
-    ts  = terminals rs
-    nt  = nonTerminals rs
-    sys = ts ++ nt
-    ss  = snd $ fromMaybe (error "gen: maybe")
-              $ find (S.member (startItem g) . fst) is
+    findState = lookupItemSet iss isi
 
 
+lookupItemSet :: (It i s, Token s)
+              => [(Set (i s), StateI)] -> Map (Set (i s)) StateI
+              -> Set (i s)
+              -> Maybe StateI
+lookupItemSet iss isi x
+    | S.null x  = Nothing
+    | otherwise = case M.lookup x isi of
+        Nothing -> snd <$> listToMaybe (filter (S.isSubsetOf x . fst) iss)
+        y       -> y
+
+-- | Get what item set index an item set corresponds to
 askItemSet :: (It i s, Token s) => Set (i s) -> Gen i s (Maybe StateI)
-askItemSet x | x == S.empty = return Nothing
 askItemSet x = do
-    res <- M.lookup x <$> asks gItemSetIndex
-    case res of
-        Just r  -> return $ Just r
-        Nothing -> do
-            is <- asks gItemSets
-            return $ snd <$> listToMaybe (filter (S.isSubsetOf x . fst) is)
+    iss <- asks gItemSets
+    isi <- asks gItemSetIndex
+    return $ lookupItemSet iss isi x
+
+-- | Lookup a precomputed goto value
+askGoto :: (It i s, Token s) => StateI -> Symbol s -> Gen i s (Maybe StateI)
+askGoto st sym = M.lookup (st, sym) <$> asks gGotos
diff --git a/Data/Parser/Grempa/Parser/LALR.hs b/Data/Parser/Grempa/Parser/LALR.hs
--- a/Data/Parser/Grempa/Parser/LALR.hs
+++ b/Data/Parser/Grempa/Parser/LALR.hs
@@ -34,7 +34,6 @@
                              "," ++ show po ++
                              "," ++ show la ++ ")\n"
 
-
 instance Token s => It Item s where
     itRId         = itemRId
     itProd        = itemProd
@@ -43,7 +42,6 @@
     closure       = closureLR1
     startItem rid = Item rid 0 0 EOF
 
-
 -- | Determine what items may be valid productions from an item
 closureLR1 :: Token s => Set (Item s) -> Set (Item s)
 closureLR1 = recTraverseG closure'
@@ -78,26 +76,23 @@
 lookaheads :: Token s
            => Int
            -> Set (SLR.Item (Maybe s))
-           -> Set (SLR.Item (Maybe s))
            -> Symbol (Maybe s)
            -> Gen SLR.Item (Maybe s) (LookaheadTable s)
-lookaheads istate i k x = do
-    mjstate <- askItemSet (goto i x)
-    case mjstate of
-        Nothing -> return MM.empty
-        Just jstate -> do
+lookaheads istate k x = do
+    askGoto istate x >>=
+        maybe (return MM.empty) (\jstate -> do
             startSt  <- asks gStartState
             startRId <- asks gStartRule
             let startIt = startItem startRId
             return $ MM.insert (startSt, startIt) (Spont EOF)
                    $ MM.unions
                    $ map (MM.fromList . lookaheadsI jstate)
-                   $ S.toList k
+                   $ S.toList k)
   where
     lookaheadsI jstate a
-        = [case itemLA b /= Tok Nothing of
-               True  -> ((jstate, nextItPos $ fromLALR b), Spont $ itemLA b)
-               False -> ((jstate, nextItPos $ fromLALR b), PropFrom istate a)
+        = [if itemLA b /= Tok Nothing
+               then ((jstate, nextItPos $ fromLALR b), Spont $ itemLA b)
+               else ((jstate, nextItPos $ fromLALR b), PropFrom istate a)
           | b <- S.toList js
           , nextSymbol b == Tok x]
       where js  = closure $ S.singleton $ fromSLR a (Tok Nothing)
@@ -129,7 +124,8 @@
     iss <- asks gItemSets
     let kss  = map (A.first $ kernel st) iss
     syms <- asks gSymbols
-    las <- zipWithM (\(i,n) (k,_) -> MM.unions <$> mapM (lookaheads n i k) syms) iss kss
+    las <- zipWithM (\(_,n) (k,_) -> MM.unions
+                                 <$> mapM (lookaheads n k) syms) iss kss
     let tab = MM.unions las
     return
         [ let newi = [ evalDone $ toIts it <$> findLookaheads tab n it
@@ -142,8 +138,10 @@
 
 slrGenToLalrGen :: Token s => GenData SLR.Item (Maybe s) -> GenData Item (Maybe s)
 slrGenToLalrGen g = let newits = runGen lalrItems g
+                        newix  = M.fromList newits
                     in g { gItemSets     = newits
-                         , gItemSetIndex = M.fromList newits
+                         , gItemSetIndex = newix
+                         , gGotos        = precomputeGotos newits newix (gSymbols g)
                          }
 -- | Create LALR parsing tables from a starting rule of a grammar (augmented)
 lalr :: Token s => RId s -> (ActionTable s, GotoTable s, Int)
@@ -152,21 +150,16 @@
         initg      = slrGenToLalrGen initSlr
         cs         = gItemSets initg
         as         =        [runGen (actions i) initg | i <- cs]
-        gs         = concat [runGen (gotos   i) initg | i <- cs]
+        gs         = concat [runGen (gotos   i) initg | (_, i) <- cs]
     in (as, gs, gStartState initg)
 
 -- | Create goto table
 gotos :: Token s
-      => (Set (Item (Maybe s)), StateI)
-      -> Gen Item (Maybe s) [((StateI, RuleI), StateI)]
-gotos (items, i) = do
+      => StateI -> Gen Item (Maybe s) [((StateI, RuleI), StateI)]
+gotos i = do
     nt     <- asks gNonTerminals
-    map (A.first (i,)) <$> catMaybes <$> sequence
-        [do j <- askItemSet $ goto items a
-            return $ case j of
-                Nothing -> Nothing
-                Just x  -> Just (ai, x)
-          | a@(SRule (RId ai _)) <- nt]
+    catMaybes <$> sequence
+        [fmap ((i,ai),) <$> askGoto i a | a@(SRule (RId ai _)) <- nt]
 
 -- | Create action table
 actions :: Token s
@@ -175,17 +168,12 @@
 actions (items, i) = do
     start  <- asks gStartRule
     let actions' item@Item {itemRId = rid@(RId ri _)} = case nextSymbol item of
-            Tok a@(STerm (Just s)) -> do
-                j <- askItemSet $ goto items a
-                case j of
-                    Just x  -> return [(Tok s, Shift x)]
-                    Nothing -> return []
-            EOF
-                | rid /= start ->
-                    return
-                        [ ( fromJust <$> itemLA item
-                          , Reduce ri (itProd item)
-                                      (length $ getItProd item) [])]
+            Tok a@(STerm (Just s)) ->
+                maybe [] ((:[]) . (Tok s,) . Shift) <$> askGoto i a
+            EOF | rid /= start -> return
+                    [ ( fromJust <$> itemLA item
+                      , Reduce ri (itProd item)
+                                  (length $ getItProd item) [])]
                 | itemLA item == EOF -> return [(EOF, Accept)]
             _ -> return []
     tab <- concat <$> sequence
diff --git a/Data/Parser/Grempa/Parser/SLR.hs b/Data/Parser/Grempa/Parser/SLR.hs
--- a/Data/Parser/Grempa/Parser/SLR.hs
+++ b/Data/Parser/Grempa/Parser/SLR.hs
@@ -1,18 +1,12 @@
 {-# LANGUAGE TupleSections, FlexibleInstances, MultiParamTypeClasses #-}
 module Data.Parser.Grempa.Parser.SLR
     ( Item(..)
-    , slr
     ) where
-import Control.Applicative
-import qualified Control.Arrow as A
-import Control.Monad.Reader
 import Data.Set(Set)
 import qualified Data.Set as S
-import Data.Maybe
 
 import Data.Parser.Grempa.Aux.Aux
 import Data.Parser.Grempa.Parser.Item
-import Data.Parser.Grempa.Parser.Table
 import Data.Parser.Grempa.Grammar.Token
 import Data.Parser.Grempa.Grammar.Untyped
 
@@ -49,62 +43,3 @@
     firstItems :: RId s -> Set (Item s)
     firstItems rid@(RId _ prods) = S.fromList
                                  $ map (\p -> Item rid p 0) [0..length prods - 1]
-
-----------------------------------
-
--- | Create SLR parsing tables from a starting rule of a grammar (augmented)
-slr :: Token s => RId s -> (ActionTable s, GotoTable s, Int)
-slr g =
-    let initg      = gen g
-        cs         = gItemSets initg
-        as         =        [runGen (actions i) initg | i <- cs]
-        gs         = concat [runGen (gotos   i) initg | i <- cs]
-    in (as, gs, gStartState initg)
-
--- | Create goto table
-gotos :: Token s
-      => (Set (Item s), StateI)
-      -> Gen Item s [((StateI, RuleI), StateI)]
-gotos (items, i) = do
-    nt     <- asks gNonTerminals
-    map (A.first (i,)) <$> catMaybes <$> sequence
-        [do j <- askItemSet (goto items a)
-            return $ case j of
-                Nothing -> Nothing
-                Just x  -> Just (ai, x)
-          | a@(SRule (RId ai _)) <- nt]
-
--- | Create action table
-actions :: Token s
-        => (Set (Item s), StateI)
-        -> Gen Item s (StateI, ([(Tok s, Action s)], Action s))
-actions (items, i) = do
-    start  <- asks gStartRule
-    rs     <- asks gRules
-    let actions' item@Item {itemRId = rid@(RId ri _)} = case nextSymbol item of
-            Tok a@(STerm s) -> do
-                j <- askItemSet $ goto items a
-                case j of
-                    Just x  -> return [(Tok s, Shift x)]
-                    Nothing -> return []
-            EOF
-                | rid /= start -> do
-                    let as = S.toList $ follow rid start rs
-                    return [(a, Reduce ri (itProd item) (length $ getItProd item) [])
-                           | a <- as]
-                | otherwise     -> return [(EOF, Accept)]
-            _ -> return []
-    tab <- concat <$> sequence
-        [actions' it | it <- S.toList items]
-    return (i, (mapShifts tab, def (mapShifts tab)))
-  where
-    def tab = if null (reds tab)
-        then Error $ keys $ shifts tab
-        else head  $ elems $ reds tab
-    mapShifts tab = map (A.second $ addShifts $ keys $ shifts tab) tab
-      where addShifts ss (Reduce r pr p _) = Reduce r pr p ss
-            addShifts _  x                 = x
-    reds   = filter (isReduce . snd)
-    shifts = filter (not . isReduce . snd)
-    keys   = map fst
-    elems  = map snd
diff --git a/Grempa.cabal b/Grempa.cabal
--- a/Grempa.cabal
+++ b/Grempa.cabal
@@ -1,5 +1,5 @@
 Name:                Grempa
-Version:             0.1.0
+Version:             0.1.1
 Synopsis:            Embedded grammar DSL and LALR parser generator
 Description:
     A library for expressing programming language grammars in a form similar
@@ -26,7 +26,11 @@
                    , examples/Ex3Fun.hs
                    , examples/Ex3FunLex.hs
                    , examples/Ex3FunParser.hs
-                   , examples/Ex4Test.hs
+                   , examples/Ex4StateA.hs
+                   , examples/Ex4StateB.hs
+                   , examples/Ex4StateLex.hs
+                   , examples/Ex4StateParser.hs
+                   , examples/Ex5Test.hs
 Cabal-version:       >= 1.6
 Flag test
     Description:
@@ -37,7 +41,7 @@
     Build-depends:   array            == 0.3.*
                    , base             == 4.2.*
                    , containers       == 0.3.*
-                   , monads-fd        == 0.1.*
+                   , monads-fd        == 0.2.*
                    , template-haskell == 2.4.*
                    , th-lift          == 0.5.*
     Exposed-modules: Data.Parser.Grempa.Grammar
@@ -45,6 +49,7 @@
                    , Data.Parser.Grempa.Dynamic
     Other-modules:   Data.Parser.Grempa.Aux.Aux
                    , Data.Parser.Grempa.Aux.MultiMap
+                   , Data.Parser.Grempa.Grammar.Levels
                    , Data.Parser.Grempa.Grammar.Token
                    , Data.Parser.Grempa.Grammar.Typed
                    , Data.Parser.Grempa.Grammar.Untyped
@@ -59,5 +64,5 @@
                    , Data.Parser.Grempa.Parser.Table
     GHC-Options:   -Wall
     if flag(test)
-      Build-Depends:   QuickCheck == 2.2.*
+      Build-Depends:   QuickCheck == 2.4.*
       Exposed-modules: Data.Parser.Grempa.Test
diff --git a/README b/README
--- a/README
+++ b/README
@@ -21,8 +21,8 @@
 
 * Examples
 
-    The examples directory contains examples of varying complexity and serves
-    as an introduction to the usage of the library.
+    The examples directory contains examples of varying complexity which can be
+    used as an introduction to the usage of the library.
 
     The examples are numbered, which serves as a suggested reading order.
 
diff --git a/examples/Ex2Calculator.hs b/examples/Ex2Calculator.hs
--- a/examples/Ex2Calculator.hs
+++ b/examples/Ex2Calculator.hs
@@ -55,17 +55,15 @@
 -- This is very similar to the definition of the previous example, but using
 -- operators operating on 'Integer's instead of constructors for the semantic
 -- actions.
-calc = do
+-- Here we are using 'levels' and 'lrule's which means that the rules will
+-- be linked together automatically with identity rules.
+calc = levels $ do
   rec
-    e  <- rule [ (+)   <@> e <# Plus  <#> t
-               , id    <@> t
-               ]
-    t  <- rule [ (*)   <@> t <# Times <#> f
-               , id    <@> f
-               ]
-    f  <- rule [ id    <@  LParen <#> e <# RParen
-               , unNum <@> num
-               ]
+    e  <- lrule [ (+)   <@> e <# Plus  <#> t ]
+    t  <- lrule [ (*)   <@> t <# Times <#> f ]
+    f  <- lrule [ id    <@  LParen <#> e <# RParen
+                , unNum <@> num
+                ]
   return e
   where
     -- We are using the fact that the parser will be able to only look at the
diff --git a/examples/Ex3Fun.hs b/examples/Ex3Fun.hs
--- a/examples/Ex3Fun.hs
+++ b/examples/Ex3Fun.hs
@@ -61,29 +61,29 @@
     -- rule of @apat@ followed by @pats0@, combined with '(:)'.
     pats  <- apat `cons` pats0
 
-    expr <- rule
-        [ECase <@  Case <#> expr <# Of <# LCurl <#> casebrs <# RCurl
-        ,ELet  <@  Let  <#> def <# In <#> expr
-        ,id    <@> expr1
-        ]
-    expr1 <- rule
-        -- All binary operators are parsed as being left-associative
-        -- A post-processor could be used to change this when fixities
-        -- and precedence levels of all operators are are known
-        [flip (flip EOp . fromTok)
-               <@> expr1 <#> op <#> expr2
-        ,id    <@> expr2
-        ]
-    expr2 <- rule
-        [EApp  <@> expr2 <#> expr3
-        ,id    <@> expr3
-        ]
-    expr3 <- rule
-        [EVar . fromTok <@> var
-        ,ENum . fromNum <@> num
-        ,ECon . fromTok <@> con
-        ,paren expr
-        ]
+    expr <- levels $ do
+      rec
+        expr <- lrule
+            [ECase <@  Case <#> expr <# Of <# LCurl <#> casebrs <# RCurl
+            ,ELet  <@  Let  <#> def <# In <#> expr
+            ]
+        expr1 <- lrule
+            -- All binary operators are parsed as being left-associative
+            -- A post-processor could be used to change this when fixities
+            -- and precedence levels of all operators are are known
+            [flip (flip EOp . fromTok)
+                   <@> expr1 <#> op <#> expr2
+            ]
+        expr2 <- lrule
+            [EApp  <@> expr2 <#> expr3
+            ]
+        expr3 <- lrule
+            [EVar . fromTok <@> var
+            ,ENum . fromNum <@> num
+            ,ECon . fromTok <@> con
+            ,paren expr
+            ]
+      return expr
 
     casebr  <- rule [Branch <@> pat <# RightArrow <#> expr]
     casebrs <- severalInter0 SemiColon casebr
diff --git a/examples/Ex4StateA.hs b/examples/Ex4StateA.hs
new file mode 100644
--- /dev/null
+++ b/examples/Ex4StateA.hs
@@ -0,0 +1,51 @@
+{-# LANGUAGE StandaloneDeriving, GeneralizedNewtypeDeriving, DeriveDataTypeable, DoRec #-}
+module Ex4StateA (state, Expr, St, evalSt) where
+
+import Control.Applicative
+import Control.Monad.State
+import Data.Data
+import Data.List
+import Data.Maybe
+
+import Data.Parser.Grempa.Grammar
+
+import Ex4StateLex
+
+-- * Result data definitions
+data Expr
+    = EApp Expr Expr
+    | EVar Integer
+    | ELam Expr
+  deriving (Eq, Show, Typeable)
+
+type St a = [String] -> a
+evalSt f = f []
+
+-- | Grammar for the language
+state :: Grammar Tok Expr
+state = do
+  rec
+    var   <- rule [ fromTok <@> Var ""]
+    term1 <- levels $ do
+      rec
+        -- Here the rules return functions of type 'St'.
+        t1 <- lrule [ mkLam <@  Lambda <#> var <# RightArrow <#> t1 ]
+        t2 <- lrule [ mkApp <@> t2  <#> t3 ]
+        t3 <- lrule [ mkVar <@> var
+                    , id    <@  LParen <#> t1 <# RParen
+                    ]
+      return t1
+      -- Here we apply the final 'St' function to get the real result.
+    term <- rule [ evalSt <@> term1 ]
+  return term
+  where
+    mkLam :: String -> St Expr -> St Expr
+    mkLam v e st = ELam (e (v : st))
+
+    mkApp :: St Expr -> St Expr -> St Expr
+    mkApp a b st = EApp (a st) (b st)
+
+    mkVar :: String -> St Expr
+    mkVar v vars = EVar $ snd
+                        $ fromMaybe undefined
+                        $ find ((== v) . fst) (zip vars [0..])
diff --git a/examples/Ex4StateB.hs b/examples/Ex4StateB.hs
new file mode 100644
--- /dev/null
+++ b/examples/Ex4StateB.hs
@@ -0,0 +1,59 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable, DoRec #-}
+module Ex4StateB (state, Expr, St, evalSt) where
+
+import Control.Applicative
+import Control.Monad.Reader
+import Data.Data
+import Data.List
+import Data.Maybe
+
+import Data.Parser.Grempa.Grammar
+
+import Ex4StateLex
+
+-- * Result data definitions
+data Expr
+    = EApp Expr Expr
+    | EVar Integer
+    | ELam Expr
+  deriving (Eq, Show, Typeable)
+
+-- | The parsing state is just a wrapper around the Reader monad to make it
+--   possible to derive Typeable which is needed. We could also use a State
+--   monad but that is not necessary in this example.
+newtype St a = St { unSt :: Reader [String] a }
+  deriving (Typeable, Applicative, Functor, Monad, MonadReader [String])
+
+evalSt = flip runReader [] . unSt
+
+-- | Grammar for the language
+state :: Grammar Tok Expr
+state = do
+  rec
+    var   <- rule [ fromTok <@> Var ""]
+    term1 <- levels $ do
+      rec
+        -- Now the rules return 'St' computations instead of their data result.
+        t1 <- lrule [ mkLam <@  Lambda <#> var <# RightArrow <#> t1 ]
+        t2 <- lrule [ mkApp <@> t2  <#> t3 ]
+        t3 <- lrule [ mkVar <@> var
+                    , id    <@  LParen <#> t1 <# RParen
+                    ]
+      return t1
+      -- Here we evaluate the final 'St' computation to get the result.
+    term <- rule [ evalSt <@> term1 ]
+  return term
+  where
+    mkLam :: String -> St Expr -> St Expr
+    mkLam v e = ELam <$> local (v :) e
+
+    mkApp :: St Expr -> St Expr -> St Expr
+    mkApp a b = EApp <$> a <*> b
+
+    mkVar :: String -> St Expr
+    mkVar v = do
+      vars <- ask
+      return $ EVar
+             $ snd
+             $ fromMaybe undefined
+             $ find ((== v) . fst) (zip vars [0..])
diff --git a/examples/Ex4StateLex.hs b/examples/Ex4StateLex.hs
new file mode 100644
--- /dev/null
+++ b/examples/Ex4StateLex.hs
@@ -0,0 +1,46 @@
+{-# LANGUAGE TemplateHaskell, DeriveDataTypeable #-}
+module Ex4StateLex
+    ( Tok(..), lexToks
+    ) where
+
+import Data.Char
+import Data.Data
+import Language.Haskell.TH.Lift
+import Data.Parser.Grempa.Static
+
+-- | Token datatype
+data Tok
+    = Var {fromTok :: String}
+    | Lambda
+    | RightArrow
+    | LParen | RParen
+  deriving (Eq, Ord, Data, Typeable, Show, Read)
+
+$(deriveLift ''Tok)
+instance ToPat Tok where toPat = toConstrPat
+
+-- | Do the lexing!
+lexToks :: String -> [Tok]
+lexToks [] = []
+lexToks ('-':'>'        :as) | testHead (not . isSym) as = RightArrow : lexToks as
+lexToks ('\\'            :as) = Lambda : lexToks as
+lexToks ('('            :as) = LParen : lexToks as
+lexToks (')'            :as) = RParen : lexToks as
+lexToks as@(a:rest)
+    | isLower a = go Var isId as
+    | otherwise = lexToks rest
+
+go :: (String -> Tok) -> (Char -> Bool) -> String -> [Tok]
+go c p xs = let (v, rest) = span p xs in c v : lexToks rest
+
+testHead :: (Char -> Bool) -> String -> Bool
+testHead _ ""    = True
+testHead f (a:_) = f a
+
+isId :: Char -> Bool
+isId c = isAlphaNum c || c == '_' || c == '\''
+
+isSym :: Char -> Bool
+isSym '(' = False
+isSym ')' = False
+isSym c   = isPunctuation c || isSymbol c
diff --git a/examples/Ex4StateParser.hs b/examples/Ex4StateParser.hs
new file mode 100644
--- /dev/null
+++ b/examples/Ex4StateParser.hs
@@ -0,0 +1,26 @@
+{-# LANGUAGE TemplateHaskell #-}
+module Ex4StateParser where
+
+import Data.Parser.Grempa.Static
+import Data.Parser.Grempa.Dynamic
+import Control.Monad.State
+
+-- Import the grammar.
+import Ex4StateB
+-- We also need the token datatype in scope or Template Haskell will complain.
+import Ex4StateLex
+
+parseStateStatic :: Parser Tok Expr
+parseStateStatic = $(mkStaticParser state [|state|])
+
+-- | Combine the lexer with a parser
+lexAndParse :: String -> Expr
+lexAndParse = parse parseStateStatic . lexToks
+
+-- | Try it out!
+test :: [Expr]
+test = map lexAndParse inputString
+  where
+    inputString = [ "\\x -> (\\y -> y) x"
+                  , "\\x -> \\y -> \\z -> x y z"
+                  ]
diff --git a/examples/Ex4Test.hs b/examples/Ex4Test.hs
deleted file mode 100644
--- a/examples/Ex4Test.hs
+++ /dev/null
@@ -1,26 +0,0 @@
--- | Use QuickCheck to test your parsers.
-module Ex4Test where
-
--- The Grempa library has to be built with the test flag to be able to use this.
-import Data.Parser.Grempa.Test
-import Test.QuickCheck
-
--- Import the different parsers and grammars
-import Ex1SimpleExpr(expr)
-import Ex1SimpleExprParser(parseExprStatic)
-
-import Ex2Calculator(calc)
-import Ex2CalculatorParser(parseCalcStatic)
-
-import Ex3Fun(fun)
-import Ex3FunParser(parseFunStatic)
-
--- | Running 'quickCheck' on these different tests will generate random
---   inputs from the grammars and the expected output, and compare the parser's
---   output with that. This is useful to see that the parser covers all of the
---   defined language (you should get conflicts if it does not, but it feels
---   good to get an assurance).
-testEx1, testEx2, testEx3 :: Property
-testEx1 = prop_parser parseExprStatic expr
-testEx2 = prop_parser parseCalcStatic calc
-testEx3 = prop_parser parseFunStatic  fun
diff --git a/examples/Ex5Test.hs b/examples/Ex5Test.hs
new file mode 100644
--- /dev/null
+++ b/examples/Ex5Test.hs
@@ -0,0 +1,25 @@
+-- | Use QuickCheck to test your parsers.
+module Ex4Test where
+
+-- The Grempa library has to be built with the test flag to be able to use this.
+import Data.Parser.Grempa.Test
+import Test.QuickCheck
+
+-- Import the different parsers and grammars
+import Ex1SimpleExpr(expr)
+import Ex1SimpleExprParser(parseExprStatic)
+
+import Ex2Calculator(calc)
+import Ex2CalculatorParser(parseCalcStatic)
+
+import Ex3Fun(fun)
+import Ex3FunParser(parseFunStatic)
+
+-- | Running 'quickCheck' on these different tests will generate random
+--   inputs from the grammars and the expected output, and compare the parser's
+--   output with that. This is useful to see that the parser covers all of the
+--   defined language (you should get conflicts if it does not, but it feels
+--   good to get an assurance).
+testEx1 = prop_parser parseExprStatic  expr
+testEx2 = prop_parser parseCalcStatic  calc
+testEx3 = prop_parser parseFunStatic   fun