diff --git a/Language/KURE.hs b/Language/KURE.hs
--- a/Language/KURE.hs
+++ b/Language/KURE.hs
@@ -17,10 +17,12 @@
         , module Language.KURE.Combinators
         , module Language.KURE.MonadCatch
         , module Language.KURE.Injection
+        , module Language.KURE.Path
 ) where
 
 import Language.KURE.Combinators
 import Language.KURE.MonadCatch
 import Language.KURE.Translate
 import Language.KURE.Injection
+import Language.KURE.Path
 import Language.KURE.Walker
diff --git a/Language/KURE/Injection.hs b/Language/KURE/Injection.hs
--- a/Language/KURE/Injection.hs
+++ b/Language/KURE/Injection.hs
@@ -72,7 +72,7 @@
 projectWithFailMsgM msg = maybe (fail msg) return . project
 {-# INLINE projectWithFailMsgM #-}
 
--- | Projects a value and lifts it into a 'MonadCatch', with the possibility of failure.
+-- | Projects a value and lifts it into a 'Monad', with the possibility of failure.
 projectM :: (Monad m, Injection a g) => g -> m a
 projectM = projectWithFailMsgM "projectM failed"
 {-# INLINE projectM #-}
diff --git a/Language/KURE/Path.hs b/Language/KURE/Path.hs
new file mode 100644
--- /dev/null
+++ b/Language/KURE/Path.hs
@@ -0,0 +1,140 @@
+{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, TypeSynonymInstances, FlexibleInstances, UndecidableInstances #-}
+
+-- |
+-- Module: Language.KURE.Path
+-- Copyright: (c) 2012--2013 The University of Kansas
+-- License: BSD3
+--
+-- Maintainer: Neil Sculthorpe <neil@ittc.ku.edu>
+-- Stability: beta
+-- Portability: ghc
+--
+-- This module provides several Path abstractions, used for denoting a path through the tree.
+
+module Language.KURE.Path
+       (
+         -- * Paths
+         -- | A @crumb@ is a value that denotes which child node to descended into.
+         --   That is, a path through a tree is specified by a \"trail of breadcrumbs\".
+         --   For example, if the children are numbered, 'Int' could be used as the @crumb@ type.
+         --   'SnocPath' is useful for recording where you have been, as it is cheap to keep adding to the end of the list as you travel further.
+         --   'Path' is useful for recording where you intend to go, as you'll need to access it in order.
+
+         -- ** Relative Paths
+         Path
+       , rootPathT
+         -- ** Snoc Paths
+       , SnocPath(..)
+       , snocPathToPath
+       , pathToSnocPath
+       , lastCrumb
+         -- ** Absolute Paths
+       , AbsolutePath
+       , lastCrumbT
+       , ExtendPath(..)
+       , ReadPath(..)
+       , absPathT
+       )
+where
+
+import Data.Monoid
+
+import Control.Arrow ((>>^))
+
+import Language.KURE.Translate
+import Language.KURE.Combinators.Translate
+import Language.KURE.Injection
+
+-------------------------------------------------------------------------------
+
+-- | A 'Path' is just a list.
+--   The intent is that a path represents a route through the tree from an arbitrary node.
+type Path crumb = [crumb]
+
+-------------------------------------------------------------------------------
+
+-- | A 'SnocPath' is a list stored in reverse order.
+newtype SnocPath crumb = SnocPath [crumb] deriving Eq
+
+instance Monoid (SnocPath crumb) where
+-- mempty :: SnocPath crumb
+   mempty = SnocPath []
+
+-- mappend :: SnocPath crumb -> SnocPath crumb -> SnocPath crumb
+   mappend (SnocPath p1) (SnocPath p2) = SnocPath (p2 ++ p1)
+
+-- | Convert a 'Path' to a 'SnocPath'.  O(n).
+pathToSnocPath :: Path crumb -> SnocPath crumb
+pathToSnocPath p = SnocPath (reverse p)
+{-# INLINE pathToSnocPath #-}
+
+-- | Convert a 'SnocPath' to a 'Path'.  O(n).
+snocPathToPath :: SnocPath crumb -> Path crumb
+snocPathToPath (SnocPath p) = reverse p
+{-# INLINE snocPathToPath #-}
+
+instance Show crumb => Show (SnocPath crumb) where
+-- show :: SnocPath crumb -> String
+   show = show . snocPathToPath
+   {-# INLINE show #-}
+
+-- | Get the last crumb from a 'SnocPath'.  O(1).
+lastCrumb :: SnocPath crumb -> Maybe crumb
+lastCrumb (SnocPath p) = safehead p
+{-# INLINE lastCrumb #-}
+
+-------------------------------------------------------------------------------
+
+-- | A class of things that can be extended by crumbs.
+--   Typically, @c@ is a context type.
+--   The typical use is to extend an 'AbsolutePath' stored in the context (during tree traversal).
+--   Note however, that if an 'AbsolutePath' is not stored in the context, an instance can still be declared with @(\@\@ cr)@ as an identity operation.
+class ExtendPath c crumb | c -> crumb where
+  -- | Extend the current 'AbsolutePath' by one crumb.
+  (@@) :: c -> crumb -> c
+
+-- | A 'SnocPath' from the root.
+type AbsolutePath = SnocPath
+
+-- | A class for contexts that store the current 'AbsolutePath', allowing transformations to depend upon it.
+class ReadPath c crumb | c -> crumb where
+  -- | Read the current absolute path.
+  absPath :: c -> AbsolutePath crumb
+
+-- | Lifted version of 'absPath'.
+absPathT :: (ReadPath c crumb, Monad m) => Translate c m a (AbsolutePath crumb)
+absPathT = contextT >>^ absPath
+{-# INLINE absPathT #-}
+
+-- | Retrieve the 'Path' from the root to the current node.
+rootPathT :: (ReadPath c crumb, Monad m) => Translate c m a (Path crumb)
+rootPathT = absPathT >>^ snocPathToPath
+{-# INLINE rootPathT #-}
+
+-- | Lifted version of 'lastCrumb'.
+lastCrumbT :: (ReadPath c crumb, Monad m) => Translate c m a crumb
+lastCrumbT = contextonlyT (projectWithFailMsgM (fail "lastCrumbT failed: at the root, no crumbs yet.") . lastCrumb . absPath)
+{-# INLINE lastCrumbT #-}
+
+-------------------------------------------------------------------------------
+
+-- | Any 'SnocPath' can be extended.
+instance ExtendPath (SnocPath crumb) crumb where
+-- (@@) :: SnocPath crumb -> crumb -> SnocPath crumb
+   (SnocPath crs) @@ cr = SnocPath (cr:crs)
+   {-# INLINE (@@) #-}
+
+-- | The simplest instance of 'ReadPath' is 'AbsolutePath' itself.
+instance ReadPath (AbsolutePath crumb) crumb where
+-- absPath :: AbsolutePath crumb -> AbsolutePath crumb
+   absPath = id
+   {-# INLINE absPath #-}
+
+-------------------------------------------------------------------------------
+
+safehead :: [a] -> Maybe a
+safehead []    = Nothing
+safehead (a:_) = Just a
+{-# INLINE safehead #-}
+
+-------------------------------------------------------------------------------
diff --git a/Language/KURE/Walker.hs b/Language/KURE/Walker.hs
--- a/Language/KURE/Walker.hs
+++ b/Language/KURE/Walker.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE MultiParamTypeClasses, ScopedTypeVariables #-}
+{-# LANGUAGE MultiParamTypeClasses, ScopedTypeVariables, FlexibleContexts #-}
 
 -- |
 -- Module: Language.KURE.Walker
@@ -55,20 +55,11 @@
         , oneLargestT
 
         -- * Utilitity Translations
-        , numChildrenT
-        , hasChildT
+        , childrenT
         , summandIsTypeT
 
         -- * Paths
-        -- ** Absolute Paths
-        , AbsolutePath
-        , rootAbsPath
-        , PathContext(..)
-        , absPathT
-        -- ** Relative Paths
-        , Path
-        , rootPath
-        , rootPathT
+        -- ** Path-based Translations
         , pathsToT
         , onePathToT
         , oneNonEmptyPathToT
@@ -94,7 +85,6 @@
 
 import Data.Maybe (isJust)
 import Data.Monoid
-import Data.List
 import Data.DList (singleton, toList)
 
 import Control.Monad
@@ -106,6 +96,7 @@
 import Language.KURE.Lens
 import Language.KURE.Injection
 import Language.KURE.Combinators
+import Language.KURE.Path
 
 -------------------------------------------------------------------------------
 
@@ -144,33 +135,26 @@
   {-# INLINE oneR #-}
 
   -- | Construct a 'Lens' to the n-th child node.
-  childL :: MonadCatch m => Int -> Lens c m g g
+  childL :: (ReadPath c crumb, Eq crumb, MonadCatch m) => crumb -> Lens c m g g
   childL = childL_default
   {-# INLINE childL #-}
 
 ------------------------------------------------------------------------------------------
 
--- | Count the number of children of the current node.
-numChildrenT :: (Walker c g, MonadCatch m) => Translate c m g Int
-numChildrenT = getSum `liftM` allT (return $ Sum 1)
-{-# INLINE numChildrenT #-}
-
--- | Determine if the current node has a child of the specified number.
---   Useful when defining custom versions of 'childL'.
-hasChildT :: (Walker c g, MonadCatch m) => Int -> Translate c m g Bool
-hasChildT n = do c <- numChildrenT
-                 return (n >= 0 && n < c)
-{-# INLINE hasChildT #-}
+-- | List the children of the current node.
+childrenT :: (ReadPath c crumb, Walker c g, MonadCatch m) => Translate c m g [crumb]
+childrenT = allT (lastCrumbT >>^ return)
+{-# INLINE childrenT #-}
 
 -------------------------------------------------------------------------------
 
 -- | Apply a 'Translate' to a specified child.
-childT :: (Walker c g, MonadCatch m) => Int -> Translate c m g b -> Translate c m g b
+childT :: (ReadPath c crumb, Eq crumb, Walker c g, MonadCatch m) => crumb -> Translate c m g b -> Translate c m g b
 childT n = focusT (childL n)
 {-# INLINE childT #-}
 
 -- | Apply a 'Rewrite' to a specified child.
-childR :: (Walker c g, MonadCatch m) => Int -> Rewrite c m g -> Rewrite c m g
+childR :: (ReadPath c crumb, Eq crumb, Walker c g, MonadCatch m) => crumb -> Rewrite c m g -> Rewrite c m g
 childR n = focusR (childL n)
 {-# INLINE childR #-}
 
@@ -307,97 +291,48 @@
 
 -------------------------------------------------------------------------------
 
--- | A path from the root.
-newtype AbsolutePath = AbsolutePath [Int] deriving Eq
-
-instance Show AbsolutePath where
-  show (AbsolutePath p) = show (reverse p)
-  {-# INLINE show #-}
-
--- | The (empty) 'AbsolutePath' to the root.
-rootAbsPath :: AbsolutePath
-rootAbsPath = AbsolutePath []
-{-# INLINE rootAbsPath #-}
+-- Apply a local Translate, using only a local path as context.
+applySnocPathT :: Translate (SnocPath crumb) m a b -> Translate c m a b
+applySnocPathT t = contextfreeT (apply t mempty)
 
 
--- | Contexts that are instances of 'PathContext' contain the current 'AbsolutePath'.
---   Any user-defined combinators (typically 'allR' and congruence combinators) should update the 'AbsolutePath' using '@@'.
-class PathContext c where
-  -- | Retrieve the current absolute path.
-  absPath :: c -> AbsolutePath
-
-  -- | Extend the current absolute path by one descent.
-  (@@) :: c -> Int -> c
-
--- | The simplest instance of 'PathContext' is 'AbsolutePath' itself.
-instance PathContext AbsolutePath where
--- absPath :: AbsolutePath -> AbsolutePath
-   absPath = id
-   {-# INLINE absPath #-}
-
--- (@@) :: AbsolutePath -> Int -> AbsolutePath
-   (AbsolutePath ns) @@ n = AbsolutePath (n:ns)
-   {-# INLINE (@@) #-}
-
--- | Lifted version of 'absPath'.
-absPathT :: (PathContext c, Monad m) => Translate c m a AbsolutePath
-absPathT = absPath `liftM` contextT
-{-# INLINE absPathT #-}
-
--------------------------------------------------------------------------------
-
--- | A path is a route to descend the tree from an arbitrary node.
-type Path = [Int]
-
--- | Retrieve the 'Path' from the root to the current node.
-rootPath :: PathContext c => c -> Path
-rootPath c = let AbsolutePath p = absPath c
-              in reverse p
-{-# INLINE rootPath #-}
-
--- | Lifted version of 'rootPath'.
-rootPathT :: (PathContext c, Monad m) => Translate c m a Path
-rootPathT = rootPath `liftM` contextT
-{-# INLINE rootPathT #-}
-
---  Provided the first 'AbsolutePath' is a prefix of the second 'AbsolutePath',
---  computes the 'Path' from the end of the first to the end of the second.
-rmPathPrefix :: AbsolutePath -> AbsolutePath -> Maybe Path
-rmPathPrefix (AbsolutePath p1) (AbsolutePath p2) = do guard (p1 `isSuffixOf` p2)
-                                                      return $ drop (length p1) (reverse p2)
-{-# INLINE rmPathPrefix #-}
-
---  Construct a 'Path' from the current node to the end of the given 'AbsolutePath', provided that 'AbsolutePath' passes through the current node.
-abs2pathT :: (PathContext c, Monad m) => AbsolutePath -> Translate c m a Path
-abs2pathT there = do here <- absPathT
-                     maybe (fail "Absolute path does not pass through current node.") return (rmPathPrefix here there)
-{-# INLINE abs2pathT #-}
-
 -- | Find the 'Path's to every node that satisfies the predicate.
-pathsToT :: (PathContext c, Walker c g, MonadCatch m) => (g -> Bool) -> Translate c m g [Path]
-pathsToT q = collectT (acceptR q >>> absPathT) >>= mapM abs2pathT
+pathsToT :: forall c crumb g m. (Walker (SnocPath crumb) g, MonadCatch m) => (g -> Bool) -> Translate c m g [Path crumb]
+pathsToT q = applySnocPathT pathsToT' >>^ map snocPathToPath
+  where
+    pathsToT' :: Translate (SnocPath crumb) m g [SnocPath crumb]
+    pathsToT' =  collectT (acceptR q >>> contextT)
+    {-# INLINE pathsToT' #-}
 {-# INLINE pathsToT #-}
 
+-- | Find the 'Path's to every node that satisfies the predicate, ignoring nodes below successes.
+prunePathsToT :: forall c crumb g m. (Walker (SnocPath crumb) g, MonadCatch m) => (g -> Bool) -> Translate c m g [Path crumb]
+prunePathsToT q = applySnocPathT prunePathsToT' >>^ map snocPathToPath
+  where
+    prunePathsToT' :: Translate (SnocPath crumb) m g [SnocPath crumb]
+    prunePathsToT' =  collectPruneT (acceptR q >>> contextT)
+    {-# INLINE prunePathsToT' #-}
+{-# INLINE prunePathsToT #-}
+
+
 -- | Find the 'Path' to the first node that satisfies the predicate (in a pre-order traversal).
-onePathToT :: (PathContext c, Walker c g, MonadCatch m) => (g -> Bool) -> Translate c m g Path
-onePathToT q = setFailMsg "No matching nodes found." $
-               onetdT (acceptR q >>> absPathT) >>= abs2pathT
+onePathToT :: forall c crumb g m. (Walker (SnocPath crumb) g, MonadCatch m) => (g -> Bool) -> Translate c m g (Path crumb)
+onePathToT q = applySnocPathT onePathToT' >>^ snocPathToPath
+  where
+    onePathToT' :: (Walker (SnocPath crumb) g, MonadCatch m) => Translate (SnocPath crumb) m g (SnocPath crumb)
+    onePathToT' =  setFailMsg "No matching nodes found." $
+                   onetdT (acceptR q >>> contextT)
+    {-# INLINE onePathToT' #-}
 {-# INLINE onePathToT #-}
 
 -- | Find the 'Path' to the first descendent node that satisfies the predicate (in a pre-order traversal).
-oneNonEmptyPathToT :: (PathContext c, Walker c g, MonadCatch m) => (g -> Bool) -> Translate c m g Path
-oneNonEmptyPathToT q = setFailMsg "No matching nodes found." $
-                       do start <- absPathT
-                          onetdT (acceptR q >>> absPathT >>> acceptR (/= start)) >>= abs2pathT
+oneNonEmptyPathToT :: (Walker (SnocPath crumb) g, MonadCatch m) => (g -> Bool) -> Translate c m g (Path crumb)
+oneNonEmptyPathToT q = applySnocPathT $ oneT (lastCrumbT &&& onePathToT q >>^ uncurry (:))
 {-# INLINE oneNonEmptyPathToT #-}
 
--- | Find the 'Path's to every node that satisfies the predicate, ignoring nodes below successes.
-prunePathsToT :: (PathContext c, Walker c g, MonadCatch m) => (g -> Bool) -> Translate c m g [Path]
-prunePathsToT q = collectPruneT (acceptR q >>> absPathT) >>= mapM abs2pathT
-{-# INLINE prunePathsToT #-}
 
 -- local function used by uniquePathToT and uniquePrunePathToT
-requireUniquePath :: Monad m => Translate c m [Path] Path
+requireUniquePath :: Monad m => Translate c m [Path crumb] (Path crumb)
 requireUniquePath = contextfreeT $ \ ps -> case ps of
                                              []  -> fail "No matching nodes found."
                                              [p] -> return p
@@ -405,12 +340,12 @@
 {-# INLINE requireUniquePath #-}
 
 -- | Find the 'Path' to the node that satisfies the predicate, failing if that does not uniquely identify a node.
-uniquePathToT :: (PathContext c, Walker c g, MonadCatch m) => (g -> Bool) -> Translate c m g Path
+uniquePathToT :: (Walker (SnocPath crumb) g, MonadCatch m) => (g -> Bool) -> Translate c m g (Path crumb)
 uniquePathToT q = pathsToT q >>> requireUniquePath
 {-# INLINE uniquePathToT #-}
 
 -- | Build a 'Path' to the node that satisfies the predicate, failing if that does not uniquely identify a node (ignoring nodes below successes).
-uniquePrunePathToT :: (PathContext c, Walker c g, MonadCatch m) => (g -> Bool) -> Translate c m g Path
+uniquePrunePathToT :: (Walker (SnocPath crumb) g, MonadCatch m) => (g -> Bool) -> Translate c m g (Path crumb)
 uniquePrunePathToT q = prunePathsToT q >>> requireUniquePath
 {-# INLINE uniquePrunePathToT #-}
 
@@ -421,42 +356,42 @@
 {-# INLINE tryL #-}
 
 -- | Construct a 'Lens' by following a 'Path'.
-pathL :: (Walker c g, MonadCatch m) => Path -> Lens c m g g
+pathL :: (ReadPath c crumb, Eq crumb, Walker c g, MonadCatch m) => Path crumb -> Lens c m g g
 pathL = serialise . map childL
 {-# INLINE pathL #-}
 
 -- | Construct a 'Lens' that points to the last node at which the 'Path' can be followed.
-exhaustPathL :: (Walker c g, MonadCatch m) => Path -> Lens c m g g
+exhaustPathL :: (ReadPath c crumb, Eq crumb, Walker c g, MonadCatch m) => Path crumb -> Lens c m g g
 exhaustPathL = foldr (\ n l -> tryL (childL n >>> l)) id
 {-# INLINE exhaustPathL #-}
 
 -- | Repeat as many iterations of the 'Path' as possible.
-repeatPathL :: (Walker c g, MonadCatch m) => Path -> Lens c m g g
+repeatPathL :: (ReadPath c crumb, Eq crumb, Walker c g, MonadCatch m) => Path crumb -> Lens c m g g
 repeatPathL p = let go = tryL (pathL p >>> go)
                  in go
 {-# INLINE repeatPathL #-}
 
 -- | Build a 'Lens' from the root to a point specified by an 'AbsolutePath'.
-rootL :: (Walker c g, MonadCatch m) => AbsolutePath -> Lens c m g g
-rootL = pathL . rootPath
+rootL :: (ReadPath c crumb, Eq crumb, Walker c g, MonadCatch m) => AbsolutePath crumb -> Lens c m g g
+rootL = pathL . snocPathToPath
 {-# INLINE rootL #-}
 
 -------------------------------------------------------------------------------
 
 -- | Apply a 'Rewrite' at a point specified by a 'Path'.
-pathR :: (Walker c g, MonadCatch m) => Path -> Rewrite c m g -> Rewrite c m g
+pathR :: (ReadPath c crumb, Eq crumb, Walker c g, MonadCatch m) => Path crumb -> Rewrite c m g -> Rewrite c m g
 pathR = focusR . pathL
 {-# INLINE pathR #-}
 
 -- | Apply a 'Translate' at a point specified by a 'Path'.
-pathT :: (Walker c g, MonadCatch m) => Path -> Translate c m g b -> Translate c m g b
+pathT :: (ReadPath c crumb, Eq crumb, Walker c g, MonadCatch m) => Path crumb -> Translate c m g b -> Translate c m g b
 pathT = focusT . pathL
 {-# INLINE pathT #-}
 
 -------------------------------------------------------------------------------
 
 -- | Check if it is possible to construct a 'Lens' along this path from the current node.
-testPathT :: (Walker c g, MonadCatch m) => Path -> Translate c m g Bool
+testPathT :: (ReadPath c crumb, Eq crumb, Walker c g, MonadCatch m) => Path crumb -> Translate c m g Bool
 testPathT = testLensT . pathL
 {-# INLINE testPathT #-}
 
@@ -604,128 +539,85 @@
 
 -------------------------------------------------------------------------------
 
-data PInt a = PInt {-# UNPACK #-} !Int a
-
-secondPInt :: (a -> b) -> PInt a -> PInt b
-secondPInt f = \ (PInt i a) -> PInt i (f a)
-{-# INLINE secondPInt #-}
-
--------------------------------------------------------------------------------
-
--- This is hideous.
--- Admittedly, part of the problem is using MonadCatch.  If allR just used Monad, this (and other things) would be much simpler.
+-- If allR just used Monad (rather than MonadCatch), this (and other things) would be simpler.
 -- And currently, the only use of MonadCatch is that it allows the error message to be modified.
 
 -- Failure should not occur, so it doesn't really matter where the KureM monad sits in the GetChild stack.
 -- I've arbitrarily made it a local failure.
 
-newtype GetChild c g a = GetChild (Int -> PInt (KureM a, Maybe (c,g)))
+data GetChild c g a = GetChild (KureM a) (Maybe (c,g))
 
-unGetChild :: GetChild c g a -> Int -> PInt (KureM a, Maybe (c,g))
-unGetChild (GetChild f) = f
-{-# INLINE unGetChild #-}
+getChildSecond :: (Maybe (c,g) -> Maybe (c,g)) -> GetChild c g a -> GetChild c g a
+getChildSecond f (GetChild ka mcg) = GetChild ka (f mcg)
+{-# INLINE getChildSecond #-}
 
 instance Monad (GetChild c g) where
 -- return :: a -> GetChild c g a
-   return a = GetChild $ \ i -> PInt i (return a, Nothing)
+   return a = GetChild (return a) Nothing
    {-# INLINE return #-}
 
 -- fail :: String -> GetChild c g a
-   fail msg = GetChild $ \ i -> PInt i (fail msg, Nothing)
+   fail msg = GetChild (fail msg) Nothing
    {-# INLINE fail #-}
 
 -- (>>=) :: GetChild c g a -> (a -> GetChild c g b) -> GetChild c g b
-   ma >>= f = GetChild $ \ i0 -> let PInt i1 (kma, mcg) = unGetChild ma i0
-                                  in runKureM (\ a   -> (secondPInt.second) (mplus mcg) $ unGetChild (f a) i1)
-                                              (\ msg -> PInt i1 (fail msg, mcg))
-                                              kma
+   (GetChild kma mcg) >>= k = runKureM (\ a   -> getChildSecond (mplus mcg) (k a))
+                                       (\ msg -> GetChild (fail msg) mcg)
+                                       kma
    {-# INLINE (>>=) #-}
 
 instance MonadCatch (GetChild c g) where
 -- catchM :: GetChild c g a -> (String -> GetChild c g a) -> GetChild c g a
-   ma `catchM` f = GetChild $ \ i0 -> let p@(PInt i1 (kma, mcg)) = unGetChild ma i0
-                                       in runKureM (\ _   -> p)
-                                                   (\ msg -> (secondPInt.second) (mplus mcg) $ unGetChild (f msg) i1)
-                                                   kma
+   gc@(GetChild kma mcg) `catchM` k = runKureM (\ _   -> gc)
+                                               (\ msg -> getChildSecond (mplus mcg) (k msg))
+                                               kma
    {-# INLINE catchM #-}
 
 
-wrapGetChild :: Int -> Rewrite c (GetChild c g) g
-wrapGetChild n = rewrite $ \ c a -> GetChild $ \ m -> PInt (m + 1)
-                                                           (return a, if n == m then Just (c, a) else Nothing)
+wrapGetChild :: (ReadPath c crumb, Eq crumb) => crumb -> Rewrite c (GetChild c g) g
+wrapGetChild cr = do cr' <- lastCrumbT
+                     rewrite $ \ c a -> GetChild (return a) (if cr == cr' then Just (c, a) else Nothing)
 {-# INLINE wrapGetChild #-}
 
 unwrapGetChild :: Rewrite c (GetChild c g) g -> Translate c Maybe g (c,g)
-unwrapGetChild r = translate $ \ c a -> let PInt _ (_,mcg) = unGetChild (apply r c a) 0
-                                         in mcg
+unwrapGetChild = resultT (\ (GetChild _ mcg) -> mcg)
 {-# INLINE unwrapGetChild #-}
 
-getChild :: Walker c g => Int -> Translate c Maybe g (c, g)
+getChild :: (ReadPath c crumb, Eq crumb, Walker c g) => crumb -> Translate c Maybe g (c, g)
 getChild = unwrapGetChild . allR . wrapGetChild
 {-# INLINE getChild #-}
 
 -------------------------------------------------------------------------------
 
-newtype SetChild a = SetChild (Int -> PInt (KureM a))
-
-unSetChild :: SetChild a -> Int -> PInt (KureM a)
-unSetChild (SetChild f) = f
-{-# INLINE unSetChild #-}
-
-instance Monad SetChild where
--- return :: a -> SetChild c g a
-   return a = SetChild $ \ i -> PInt i (return a)
-   {-# INLINE return #-}
-
--- fail :: String -> SetChild c g a
-   fail msg = SetChild $ \ i -> PInt i (fail msg)
-   {-# INLINE fail #-}
-
--- (>>=) :: SetChild c g a -> (a -> SetChild c g b) -> SetChild c g b
-   ma >>= f = SetChild $ \ i0 -> let PInt i1 ka = unSetChild ma i0
-                                  in runKureM (\ a   -> unSetChild (f a) i1)
-                                              (\ msg -> PInt i1 (fail msg))
-                                              ka
-   {-# INLINE (>>=) #-}
-
-instance MonadCatch SetChild where
--- catchM :: SetChild c g a -> (String -> SetChild c g a) -> SetChild c g a
-   ma `catchM` f = SetChild $ \ i0 -> let PInt i1 ka = unSetChild ma i0
-                                       in runKureM (\ _   -> PInt i1 ka)
-                                                   (\ msg -> unSetChild (f msg) i1)
-                                                   ka
-   {-# INLINE catchM #-}
-
+type SetChild = KureM
 
-wrapSetChild :: Int -> g -> Rewrite c SetChild g
-wrapSetChild n g = contextfreeT $ \ a -> SetChild $ \ m -> PInt (m + 1)
-                                                                (return $ if n == m then g else a)
+wrapSetChild :: (ReadPath c crumb, Eq crumb) => crumb -> g -> Rewrite c SetChild g
+wrapSetChild cr g = do cr' <- lastCrumbT
+                       if cr == cr' then return g else idR
 {-# INLINE wrapSetChild #-}
 
 unwrapSetChild :: Monad m => Rewrite c SetChild g -> Rewrite c m g
-unwrapSetChild r = rewrite $ \ c a -> let PInt _ ka = unSetChild (apply r c a) 0
-                                       in runKureM return fail ka
+unwrapSetChild = resultT (runKureM return fail)
 {-# INLINE unwrapSetChild #-}
 
-setChild :: (Walker c g, Monad m) => Int -> g -> Rewrite c m g
-setChild n = unwrapSetChild . allR . wrapSetChild n
+setChild :: (ReadPath c crumb, Eq crumb, Walker c g, Monad m) => crumb -> g -> Rewrite c m g
+setChild cr = unwrapSetChild . allR . wrapSetChild cr
 {-# INLINE setChild #-}
 
 -------------------------------------------------------------------------------
 
-childL_default :: forall c m g. (Walker c g, MonadCatch m) => Int -> Lens c m g g
-childL_default n = lens $ do cg <- getter
-                             k  <- setter
-                             return (cg, k)
+childL_default :: forall c crumb m g. (ReadPath c crumb, Eq crumb) => (Walker c g, MonadCatch m) => crumb -> Lens c m g g
+childL_default cr = lens $ do cg <- getter
+                              k  <- setter
+                              return (cg, k)
   where
     getter :: Translate c m g (c,g)
-    getter = translate $ \ c a -> maybe (fail $ "there is no child number " ++ show n) return (apply (getChild n) c a)
+    getter = resultT (projectWithFailMsgM "there is no child matching the crumb.") (getChild cr)
     {-# INLINE getter #-}
 
     setter :: Translate c m g (g -> m g)
-    setter = translate $ \ c a -> return (\ b -> apply (setChild n b) c a)
+    setter = translate $ \ c a -> return (\ b -> apply (setChild cr b) c a)
     {-# INLINE setter #-}
-
 {-# INLINE childL_default #-}
 
 -------------------------------------------------------------------------------
diff --git a/examples/Expr/Context.hs b/examples/Expr/Context.hs
new file mode 100644
--- /dev/null
+++ b/examples/Expr/Context.hs
@@ -0,0 +1,37 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
+
+module Expr.Context where
+
+import Data.Monoid (mempty)
+
+import Language.KURE
+
+import Expr.AST
+
+---------------------------------------------------------------------------
+
+data Context = Context (AbsolutePath Int) [(Name,Expr)] -- A list of bindings.
+                                                        -- We assume no shadowing in the language.
+
+instance ExtendPath Context Int where
+-- (@@) :: Context -> Int -> Context
+   (Context p defs) @@ n = Context (p @@ n) defs
+
+instance ReadPath Context Int where
+-- absPath :: Context -> AbsolutePath
+   absPath (Context p _) = p
+
+addDef :: Name -> Expr -> Context -> Context
+addDef v e (Context p defs) = Context p ((v,e):defs)
+
+updateContextCmd :: Cmd -> Context -> Context
+updateContextCmd (Seq c1 c2)  = updateContextCmd c2 . updateContextCmd c1
+updateContextCmd (Assign v e) = (addDef v e)
+
+initialContext :: Context
+initialContext = Context mempty []
+
+lookupDef :: Monad m => Name -> Context -> m Expr
+lookupDef v (Context _ defs) = maybe (fail $ v ++ " not found in context") return (lookup v defs)
+
+---------------------------------------------------------------------------
diff --git a/examples/Expr/Examples.hs b/examples/Expr/Examples.hs
--- a/examples/Expr/Examples.hs
+++ b/examples/Expr/Examples.hs
@@ -3,6 +3,7 @@
 import Language.KURE
 
 import Expr.AST
+import Expr.Context
 import Expr.Kure
 
 -----------------------------------------------------------------
diff --git a/examples/Expr/Kure.hs b/examples/Expr/Kure.hs
--- a/examples/Expr/Kure.hs
+++ b/examples/Expr/Kure.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts #-}
 
 module Expr.Kure where
 
@@ -7,31 +7,7 @@
 import Language.KURE
 
 import Expr.AST
-
----------------------------------------------------------------------------
-
-data Context = Context AbsolutePath [(Name,Expr)] -- A list of bindings.
-                                                  -- We assume no shadowing in the language.
-
-instance PathContext Context where
--- absPath :: Context -> AbsolutePath
-   absPath (Context p _) = p
-
--- (@@) :: Context -> Int -> Context
-   (Context p defs) @@ n = Context (p @@ n) defs
-
-addDef :: Name -> Expr -> Context -> Context
-addDef v e (Context p defs) = Context p ((v,e):defs)
-
-updateContextCmd :: Cmd -> Context -> Context
-updateContextCmd (Seq c1 c2)  = updateContextCmd c2 . updateContextCmd c1
-updateContextCmd (Assign v e) = (addDef v e)
-
-initialContext :: Context
-initialContext = Context rootAbsPath []
-
-lookupDef :: Monad m => Name -> Context -> m Expr
-lookupDef v (Context _ defs) = maybe (fail $ v ++ " not found in context") return (lookup v defs)
+import Expr.Context
 
 ---------------------------------------------------------------------------
 
@@ -88,42 +64,42 @@
 
 ---------------------------------------------------------------------------
 
-assignT :: Monad m => Translate Context m Expr a -> (Name -> a -> b) -> Translate Context m Cmd b
+assignT :: (ExtendPath c Int, Monad m) => Translate c m Expr a -> (Name -> a -> b) -> Translate c m Cmd b
 assignT t f = translate $ \ c cm -> case cm of
                                       Assign n e -> f n <$> apply t (c @@ 0) e
                                       _          -> fail "not an Assign"
 
-assignR :: Monad m => Rewrite Context m Expr -> Rewrite Context m Cmd
+assignR :: (ExtendPath c Int, Monad m) => Rewrite c m Expr -> Rewrite c m Cmd
 assignR r = assignT r Assign
 
 ---------------------------------------------------------------------------
 
-varT :: Monad m => (Name -> b) -> Translate Context m Expr b
+varT :: Monad m => (Name -> b) -> Translate c m Expr b
 varT f = contextfreeT $ \ e -> case e of
                                  Var v -> return (f v)
                                  _     -> fail "not a Var"
 
 ---------------------------------------------------------------------------
 
-litT :: Monad m => (Int -> b) -> Translate Context m Expr b
+litT :: Monad m => (Int -> b) -> Translate c m Expr b
 litT f = contextfreeT $ \ e -> case e of
                                  Lit v -> return (f v)
                                  _     -> fail "not a Lit"
 
 ---------------------------------------------------------------------------
 
-addT :: Monad m => Translate Context m Expr a1 -> Translate Context m Expr a2 -> (a1 -> a2 -> b) -> Translate Context m Expr b
+addT :: (ExtendPath c Int, Monad m) => Translate c m Expr a1 -> Translate c m Expr a2 -> (a1 -> a2 -> b) -> Translate c m Expr b
 addT t1 t2 f = translate $ \ c e -> case e of
                                       Add e1 e2 -> f <$> apply t1 (c @@ 0) e1 <*> apply t2 (c @@ 1) e2
                                       _         -> fail "not an Add"
 
-addAllR :: Monad m => Rewrite Context m Expr -> Rewrite Context m Expr -> Rewrite Context m Expr
+addAllR :: (ExtendPath c Int, Monad m) => Rewrite c m Expr -> Rewrite c m Expr -> Rewrite c m Expr
 addAllR r1 r2 = addT r1 r2 Add
 
-addAnyR :: MonadCatch m => Rewrite Context m Expr -> Rewrite Context m Expr -> Rewrite Context m Expr
+addAnyR :: (ExtendPath c Int, MonadCatch m) => Rewrite c m Expr -> Rewrite c m Expr -> Rewrite c m Expr
 addAnyR r1 r2 = unwrapAnyR $ addAllR (wrapAnyR r1) (wrapAnyR r2)
 
-addOneR :: MonadCatch m => Rewrite Context m Expr -> Rewrite Context m Expr -> Rewrite Context m Expr
+addOneR :: (ExtendPath c Int, MonadCatch m) => Rewrite c m Expr -> Rewrite c m Expr -> Rewrite c m Expr
 addOneR r1 r2 = unwrapOneR $ addAllR (wrapOneR r1) (wrapOneR r2)
 
 ---------------------------------------------------------------------------
diff --git a/examples/Fib/AST.hs b/examples/Fib/AST.hs
--- a/examples/Fib/AST.hs
+++ b/examples/Fib/AST.hs
@@ -1,4 +1,4 @@
-module Fib.AST where
+module Fib.AST (Arith (..)) where
 
 data Arith = Lit Int | Add Arith Arith | Sub Arith Arith | Fib Arith deriving Eq
 
diff --git a/examples/Fib/Examples.hs b/examples/Fib/Examples.hs
--- a/examples/Fib/Examples.hs
+++ b/examples/Fib/Examples.hs
@@ -1,20 +1,22 @@
 module Fib.Examples where
 
+import Data.Monoid (mempty)
+
 import Language.KURE
 
 import Fib.AST
-import Fib.Kure()
+import Fib.Kure
 
 -----------------------------------------------------------------------
 
 -- | For this simple example, the context is just an 'AbsolutePath', and 'Translate' always operates on 'Arith'.
-type TranslateA b = Translate AbsolutePath KureM Arith b
+type TranslateA b = Translate (AbsolutePath Crumb) KureM Arith b
 type RewriteA = TranslateA Arith
 
 -----------------------------------------------------------------------
 
 applyFib :: TranslateA b -> Arith -> Either String b
-applyFib r = runKureM Right Left . apply r rootAbsPath
+applyFib r = runKureM Right Left . apply r mempty
 
 -----------------------------------------------------------------------
 
diff --git a/examples/Fib/Kure.hs b/examples/Fib/Kure.hs
--- a/examples/Fib/Kure.hs
+++ b/examples/Fib/Kure.hs
@@ -1,23 +1,28 @@
-{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, UndecidableInstances #-}
 
-module Fib.Kure where
+module Fib.Kure (Crumb(..)) where
 
+import Prelude hiding (Left, Right)
+
 import Language.KURE
+
 import Fib.AST
 
 import Control.Monad(liftM, ap)
 
 --------------------------------------------------------------------------------------
 
-instance Walker AbsolutePath Arith where
--- allR :: MonadCatch m => Rewrite AbsolutePath m Arith -> Rewrite AbsolutePath m Arith
+data Crumb = LeftChild | RightChild | OnlyChild deriving (Eq,Show)
+
+instance ExtendPath c Crumb => Walker c Arith where
+-- allR :: (ExtendPath c Crumb, MonadCatch m) => Rewrite c m Arith -> Rewrite c m Arith
    allR r = prefixFailMsg "allR failed: " $
      rewrite $ \ c e ->
          case e of
            Lit n      ->  Lit <$> return n
-           Add e0 e1  ->  Add <$> apply r (c @@ 0) e0 <*> apply r (c @@ 1) e1
-           Sub e0 e1  ->  Sub <$> apply r (c @@ 0) e0 <*> apply r (c @@ 1) e1
-           Fib e0     ->  Fib <$> apply r (c @@ 0) e0
+           Add e0 e1  ->  Add <$> apply r (c @@ LeftChild) e0 <*> apply r (c @@ RightChild) e1
+           Sub e0 e1  ->  Sub <$> apply r (c @@ LeftChild) e0 <*> apply r (c @@ RightChild) e1
+           Fib e0     ->  Fib <$> apply r (c @@ OnlyChild) e0
 
 --------------------------------------------------------------------------------------
 
diff --git a/examples/Lam/AST.hs b/examples/Lam/AST.hs
--- a/examples/Lam/AST.hs
+++ b/examples/Lam/AST.hs
@@ -1,4 +1,4 @@
-module Lam.AST where
+module Lam.AST (Name, Exp(..)) where
 
 -------------------------------------------------------------------------------
 
diff --git a/examples/Lam/Context.hs b/examples/Lam/Context.hs
new file mode 100644
--- /dev/null
+++ b/examples/Lam/Context.hs
@@ -0,0 +1,48 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
+module Lam.Context where
+
+import Data.Monoid (mempty)
+
+import Language.KURE
+
+import Lam.AST (Name)
+
+-------------------------------------------------------------------------------
+
+data Crumb = Lam_Body
+           | Lam_Name
+           | App_Fun
+           | App_Arg
+             deriving (Eq, Show)
+
+-- The context
+data LamC = LamC (AbsolutePath Crumb) [Name] -- bound variable names
+
+class AddBoundVar c where
+  addBoundVar :: Name -> c -> c
+
+instance AddBoundVar LamC where
+-- addBoundVar :: Name -> LamC -> LamC
+   addBoundVar v (LamC p vs) = LamC p (v:vs)
+
+instance ExtendPath LamC Crumb where
+-- (@@) :: LamC -> Crumb -> LamC
+   (LamC p vs) @@ cr = LamC (p @@ cr) vs
+
+instance ReadPath LamC Crumb where
+-- absPath :: LamC -> AbsolutePath Crumb
+   absPath (LamC p _) = p
+
+initialLamC :: LamC
+initialLamC = LamC mempty []
+
+bindings :: LamC -> [Name]
+bindings (LamC _ vs) = vs
+
+boundIn :: Name -> LamC -> Bool
+boundIn v c = v `elem` bindings c
+
+freeIn :: Name -> LamC -> Bool
+freeIn v c = not (v `boundIn` c)
+
+-------------------------------------------------------------------------------
diff --git a/examples/Lam/Examples.hs b/examples/Lam/Examples.hs
--- a/examples/Lam/Examples.hs
+++ b/examples/Lam/Examples.hs
@@ -4,40 +4,13 @@
 
 import Lam.AST
 import Lam.Kure
+import Lam.Context
+import Lam.Monad
 
 import Data.List (nub)
 
-import Control.Applicative
-import Control.Monad
 import Control.Category ((>>>))
 
------------------------------------------------------------------
-
-newtype LamM a = LamM {lamM :: Int -> (Int, Either String a)}
-
-runLamM :: LamM a -> Either String a
-runLamM m = snd (lamM m 0)
-
-instance Monad LamM where
-  return a = LamM (\n -> (n,Right a))
-  (LamM f) >>= gg = LamM $ \ n -> case f n of
-                                    (n', Left msg) -> (n', Left msg)
-                                    (n', Right a)  -> lamM (gg a) n'
-  fail msg = LamM (\ n -> (n, Left msg))
-
-instance MonadCatch LamM where
-
-  (LamM st) `catchM` f = LamM $ \ n -> case st n of
-                                        (n', Left msg) -> lamM (f msg) n'
-                                        (n', Right a)  -> (n', Right a)
-
-instance Functor LamM where
-  fmap = liftM
-
-instance Applicative LamM where
-  pure  = return
-  (<*>) = ap
-
 -------------------------------------------------------------------------------
 
 suggestName :: LamM Name
@@ -51,13 +24,13 @@
 
 -------------------------------------------------------------------------------
 
-type RewriteE     = RewriteExp LamM
-type TranslateE b = TranslateExp LamM b
+type TranslateE b = Translate LamC LamM Exp b
+type RewriteE     = TranslateE Exp
 
 -------------------------------------------------------------------------------
 
 applyExp :: TranslateE b -> Exp -> Either String b
-applyExp f = runLamM . apply f initialContext
+applyExp f = runLamM . apply f initialLamC
 
 ------------------------------------------------------------------------
 
@@ -96,7 +69,7 @@
 beta_reduce :: RewriteE
 beta_reduce = withPatFailMsg "Cannot beta-reduce, not app-lambda." $
                 do App (Lam v _) e2 <- idR
-                   pathT [0,0] (tryR $ substExp v e2)
+                   pathT [App_Fun,Lam_Body] (tryR $ substExp v e2)
 
 eta_expand :: RewriteE
 eta_expand = rewrite $ \ c f -> do v <- freshName (bindings c)
diff --git a/examples/Lam/Kure.hs b/examples/Lam/Kure.hs
--- a/examples/Lam/Kure.hs
+++ b/examples/Lam/Kure.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleInstances, FlexibleContexts, MultiParamTypeClasses, UndecidableInstances #-}
 
 module Lam.Kure where
 
@@ -7,42 +7,12 @@
 import Language.KURE
 
 import Lam.AST
-
--------------------------------------------------------------------------------
-
-data Context = Context AbsolutePath [Name] -- bound variable names
-
-instance PathContext Context where
--- absPath :: Context -> AbsolutePath
-   absPath (Context p _) = p
-
--- (@@) :: Context -> Int -> Context
-   (Context p vs) @@ n = Context (p @@ n) vs
-
-addBinding :: Name -> Context -> Context
-addBinding v (Context p vs) = Context p (v:vs)
-
-initialContext :: Context
-initialContext = Context rootAbsPath []
-
-bindings :: Context -> [Name]
-bindings (Context _ vs) = vs
-
-boundIn :: Name -> Context -> Bool
-boundIn v c = v `elem` bindings c
-
-freeIn :: Name -> Context -> Bool
-freeIn v c = not (v `boundIn` c)
-
--------------------------------------------------------------------------------
-
-type TranslateExp m b = Translate Context m Exp b
-type RewriteExp m     = TranslateExp m Exp
+import Lam.Context
 
 -------------------------------------------------------------------------------
 
-instance Walker Context Exp where
--- allR :: MonadCatch m => RewriteExp m -> RewriteExp m
+instance (ExtendPath c Crumb, AddBoundVar c) => Walker c Exp where
+-- allR :: MonadCatch m => Rewrite LamC m Exp -> Rewrite LamC m Exp
    allR r = prefixFailMsg "allR failed: " $
             readerT $ \ e -> case e of
               App _ _ -> appAllR r r
@@ -54,35 +24,35 @@
 -- | Congruence combinators.
 --   Using these ensures that the context is updated consistantly.
 
-varT :: Monad m => (Name -> b) -> TranslateExp m b
+varT :: Monad m => (Name -> b) -> Translate c m Exp b
 varT f = contextfreeT $ \ e -> case e of
                                  Var n -> return (f n)
                                  _     -> fail "no match for Var"
 
 -------------------------------------------------------------------------------
 
-lamT :: Monad m => TranslateExp m a -> (Name -> a -> b) -> TranslateExp m b
+lamT :: (ExtendPath c Crumb, AddBoundVar c, Monad m) => Translate c m Exp a -> (Name -> a -> b) -> Translate c m Exp b
 lamT t f = translate $ \ c e -> case e of
-                                  Lam v e1 -> f v <$> apply t (addBinding v c @@ 0) e1
+                                  Lam v e1 -> f v <$> apply t (addBoundVar v c @@ Lam_Body) e1
                                   _        -> fail "no match for Lam"
 
-lamR :: Monad m => RewriteExp m -> RewriteExp m
+lamR :: (ExtendPath c Crumb, AddBoundVar c, Monad m) => Rewrite c m Exp -> Rewrite c m Exp
 lamR r = lamT r Lam
 
 -------------------------------------------------------------------------------
 
-appT :: Monad m => TranslateExp m a1 -> TranslateExp m a2 -> (a1 -> a2 -> b) -> TranslateExp m b
+appT :: (ExtendPath c Crumb, Monad m) => Translate c m Exp a1 -> Translate c m Exp a2 -> (a1 -> a2 -> b) -> Translate c m Exp b
 appT t1 t2 f = translate $ \ c e -> case e of
-                                      App e1 e2 -> f <$> apply t1 (c @@ 0) e1 <*> apply t2 (c @@ 1) e2
+                                      App e1 e2 -> f <$> apply t1 (c @@ App_Fun) e1 <*> apply t2 (c @@ App_Arg) e2
                                       _         -> fail "no match for App"
 
-appAllR :: Monad m => RewriteExp m -> RewriteExp m -> RewriteExp m
+appAllR :: (ExtendPath c Crumb, Monad m) => Rewrite c m Exp -> Rewrite c m Exp -> Rewrite c m Exp
 appAllR r1 r2 = appT r1 r2 App
 
-appAnyR :: MonadCatch m => RewriteExp m -> RewriteExp m -> RewriteExp m
+appAnyR :: (ExtendPath c Crumb, MonadCatch m) => Rewrite c m Exp -> Rewrite c m Exp -> Rewrite c m Exp
 appAnyR r1 r2 = unwrapAnyR $ appAllR (wrapAnyR r1) (wrapAnyR r2)
 
-appOneR :: MonadCatch m => RewriteExp m -> RewriteExp m -> RewriteExp m
+appOneR :: (ExtendPath c Crumb, MonadCatch m) => Rewrite c m Exp -> Rewrite c m Exp -> Rewrite c m Exp
 appOneR r1 r2 = unwrapOneR $ appAllR (wrapOneR r1) (wrapOneR r2)
 
 -------------------------------------------------------------------------------
diff --git a/examples/Lam/Monad.hs b/examples/Lam/Monad.hs
new file mode 100644
--- /dev/null
+++ b/examples/Lam/Monad.hs
@@ -0,0 +1,35 @@
+module Lam.Monad where
+
+import Language.KURE
+
+import Control.Applicative
+import Control.Monad
+
+-------------------------------------------------------------------------------
+
+newtype LamM a = LamM {lamM :: Int -> (Int, Either String a)}
+
+runLamM :: LamM a -> Either String a
+runLamM m = snd (lamM m 0)
+
+instance Monad LamM where
+  return a = LamM (\n -> (n,Right a))
+  (LamM f) >>= gg = LamM $ \ n -> case f n of
+                                    (n', Left msg) -> (n', Left msg)
+                                    (n', Right a)  -> lamM (gg a) n'
+  fail msg = LamM (\ n -> (n, Left msg))
+
+instance MonadCatch LamM where
+
+  (LamM st) `catchM` f = LamM $ \ n -> case st n of
+                                        (n', Left msg) -> lamM (f msg) n'
+                                        (n', Right a)  -> (n', Right a)
+
+instance Functor LamM where
+  fmap = liftM
+
+instance Applicative LamM where
+  pure  = return
+  (<*>) = ap
+
+-------------------------------------------------------------------------------
diff --git a/kure.cabal b/kure.cabal
--- a/kure.cabal
+++ b/kure.cabal
@@ -1,5 +1,5 @@
 Name:                kure
-Version:             2.6.22
+Version:             2.8.0
 Synopsis:            Combinators for Strategic Programming
 Description:	     The Kansas University Rewrite Engine (KURE) is a domain-specific language for strategic rewriting.
 	 	     KURE was inspired by Stratego and StrategyLib, and has similarities with Scrap Your Boilerplate and Uniplate.
@@ -30,9 +30,12 @@
     examples/Fib/Kure.hs
     examples/Fib/Examples.hs
     examples/Lam/AST.hs
+    examples/Lam/Context.hs
+    examples/Lam/Monad.hs
     examples/Lam/Kure.hs
     examples/Lam/Examples.hs
     examples/Expr/AST.hs
+    examples/Expr/Context.hs
     examples/Expr/Kure.hs
     examples/Expr/Examples.hs
 
@@ -51,6 +54,7 @@
        Language.KURE.Injection
        Language.KURE.Lens
        Language.KURE.MonadCatch
+       Language.KURE.Path
        Language.KURE.Translate
        Language.KURE.Walker