kure 2.4.2 → 2.4.10

raw patch · 9 files changed

+128/−116 lines, 9 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Language/KURE/Combinators.hs +6/−5
• Language/KURE/Translate.hs +23/−15
• Language/KURE/Utilities.hs +78/−75
• Language/KURE/Walker.hs +3/−6
• examples/Expr/Kure.hs +9/−9
• examples/Fib/Examples.hs +2/−2
• examples/Fib/Kure.hs +3/−3
• examples/Lam/Kure.hs +3/−0
• kure.cabal +1/−1

@@ -61,12 +61,13 @@            , constant ) where -import Prelude hiding (id , (.), catch)+import Prelude hiding (id , (.), foldr)  import Control.Monad import Control.Category import Control.Arrow +import Data.Foldable import Data.Monoid import Data.List (isPrefixOf) @@ -90,7 +91,7 @@ ma <<+ mb = ma `catchM` const mb  -- | Select the first monadic computation that succeeds, discarding any thereafter.-catchesM :: MonadCatch m => [m a] -> m a+catchesM :: (Foldable f, MonadCatch m) => f (m a) -> m a catchesM = foldr (<<+) (fail "catchesM failed")  -- | Catch a failing monadic computation, making it succeed with a constant value.@@ -210,15 +211,15 @@ r1 >+> r2 = attemptR r1 >>> readerT (\ (b,_) -> snd ^>> if b then tryR r2 else r2)  -- | Sequence a list of 'Arrow's, succeeding if any succeed.-orR :: (CategoryCatch arr, ArrowApply arr) => [arr a a] -> arr a a+orR :: (Foldable f, CategoryCatch arr, ArrowApply arr) => f (arr a a) -> arr a a orR = foldr (>+>) (failT "orR failed")  -- | Sequence a list of 'Category's, succeeding if all succeed.-andR :: Category arr => [arr a a] -> arr a a+andR :: (Foldable f, Category arr) => f (arr a a) -> arr a a andR = foldr (>>>) id  -- | Select the first 'CategoryCatch' that succeeds, discarding any thereafter.-catchesT :: CategoryCatch arr => [arr a b] -> arr a b+catchesT :: (Foldable f, CategoryCatch arr) => f (arr a b) -> arr a b catchesT = foldr (<+) (failT "catchesT failed")  ------------------------------------------------------------------------------------------

@@ -24,6 +24,7 @@         , translate         , rewrite         , contextfreeT+        , contextonlyT         , constT         , contextT         , exposeT@@ -46,23 +47,26 @@         , testLensT         , bidirectionalL         , pureL- ) where -import Prelude hiding (id, (.))+import Prelude hiding (id, (.), mapM)+ import Control.Applicative-import Control.Monad+import Control.Monad hiding (mapM) import Control.Category import Control.Arrow++import Data.Traversable import Data.Monoid+ import Language.KURE.Combinators  ------------------------------------------------------------------------------------------  -- | An abstract representation of a transformation from a value of type @a@ in a context @c@ to a monadic value of type @m b@. --   The 'Translate' type is the basis of the entire KURE library.-data Translate c m a b = Translate { -- | Apply a 'Translate' to a value and its context.-                                     apply :: c -> a -> m b}+newtype Translate c m a b = Translate { -- | Apply a 'Translate' to a value and its context.+                                        apply :: c -> a -> m b}  -- | The primitive  way of building a 'Translate'. translate :: (c -> a -> m b) -> Translate c m a b@@ -79,8 +83,12 @@  -- | Build a 'Translate' that doesn't depend on the context. contextfreeT :: (a -> m b) -> Translate c m a b-contextfreeT = translate . const+contextfreeT f = translate (\ _ -> f) +-- | Build a 'Translate' that doesn't depend on the value.+contextonlyT :: (c -> m b) -> Translate c m a b+contextonlyT f = translate (\ c _ -> f c)+ -- | Build a constant 'Translate' from a monadic computation. constT :: m b -> Translate c m a b constT = contextfreeT . const@@ -94,7 +102,7 @@ exposeT = translate (curry return)  -- | Map a 'Translate' over a list.-mapT :: Monad m => Translate c m a b -> Translate c m [a] [b]+mapT :: (Traversable t, Monad m) => Translate c m a b -> Translate c m (t a) (t b) mapT t = translate (mapM . apply t)  -- | An identity 'Rewrite' with side-effects.@@ -125,7 +133,7 @@    empty = constT empty  -- (<|>) :: Translate c m a b -> Translate c m a b -> Translate c m a b-   t1 <|> t2 = translate $ \ c a -> apply t1 c a <|> apply t2 c a+   t1 <|> t2 = translate (\ c a -> apply t1 c a <|> apply t2 c a)  -- | Lifting through a Reader transformer, where (c,a) is the read-only environment. instance Monad m => Monad (Translate c m a) where@@ -161,11 +169,11 @@ -- | The 'Kleisli' 'Category' induced by @m@, lifting through a Reader transformer, where @c@ is the read-only environment. instance Monad m => Category (Translate c m) where ---  id :: Translate c m a a-    id = contextfreeT return+-- id :: Translate c m a a+   id = contextfreeT return ---  (.) :: Translate c m b d -> Translate c m a b -> Translate c m a d-    t2 . t1 = translate $ \ c -> apply t1 c >=> apply t2 c+-- (.) :: Translate c m b d -> Translate c m a b -> Translate c m a d+   t2 . t1 = translate (\ c -> apply t1 c >=> apply t2 c)  -- | The 'Kleisli' 'Category' induced by @m@, lifting through a Reader transformer, where @c@ is the read-only environment. instance MonadCatch m => CategoryCatch (Translate c m) where@@ -184,7 +192,7 @@    arr f = contextfreeT (return . f)  -- first :: Translate c m a b -> Translate c m (a,z) (b,z)-   first t = translate $ \ c (a,z) -> liftM (\b -> (b,z)) (apply t c a)+   first t = translate $ \ c (a,z) -> liftM (\ b -> (b,z)) (apply t c a)  -- (***) :: Translate c m a1 b1 -> Translate c m a2 b2 -> Translate c m (a1,a2) (b1,b2)    t1 *** t2 = translate $ \ c (a,b) -> liftM2 (,) (apply t1 c a) (apply t2 c b)@@ -208,7 +216,7 @@ instance Monad m => ArrowApply (Translate c m) where  -- app :: Translate c m (Translate c m a b, a) b-   app = translate $ \ c (t,a) -> apply t c a+   app = translate (\ c (t,a) -> apply t c a)  ------------------------------------------------------------------------------------------ @@ -298,7 +306,7 @@ -- failT :: String -> Lens c m a b    failT = lens . fail --- catch :: Lens c m a b -> (String -> Lens c m a b) -> Lens c m a b+-- catchT :: Lens c m a b -> (String -> Lens c m a b) -> Lens c m a b    l1 `catchT` l2 = lens (attemptM (focusR l1 id) >>= either (lensT . l2) (const (lensT l1)))  -- | Construct a 'Lens' from a 'BiTranslate'.

@@ -1,3 +1,5 @@+{-# LANGUAGE TupleSections #-}+ -- | -- Module: Language.KURE.Utilities -- Copyright: (c) 2012 The University of Kansas@@ -11,9 +13,9 @@  module Language.KURE.Utilities        ( -- * The KURE Monad-         KureMonad-       , runKureMonad-       , fromKureMonad+         KureM+       , runKureM+       , fromKureM          -- * Error Messages        , missingChild          -- * Generic Combinators@@ -56,11 +58,15 @@        , childLMofN ) where +import Prelude hiding (sequence, mapM, or)+ import Control.Applicative-import Control.Monad+import Control.Monad hiding (sequence, mapM) import Control.Arrow  import Data.Monoid+import Data.Foldable+import Data.Traversable  import Language.KURE.Combinators import Language.KURE.Translate@@ -69,45 +75,48 @@  ------------------------------------------------------------------------------- --- | A basic error 'Monad'.  KURE users may use either 'KureMonad' or their own 'Monad'(s).-data KureMonad a = Failure String | Success a deriving (Eq, Show)+-- | 'KureM' is a basic error 'Monad'.+--   The KURE user is free to either use 'KureM' or provide their own monad.+--   'KureM' is essentially the same as ('Either' 'String' @a@), except that the 'fail' method produces an error in the monad,+--   rather than invoking 'error'.+--   A major advantage of this is that monadic pattern match failures are caught safely.+data KureM a = Failure String | Success a deriving (Eq, Show) --- | Eliminator for 'KureMonad'.-runKureMonad :: (a -> b) -> (String -> b) -> KureMonad a -> b-runKureMonad _ f (Failure msg) = f msg-runKureMonad s _ (Success a)   = s a+-- | Eliminator for 'KureM'.+runKureM :: (a -> b) -> (String -> b) -> KureM a -> b+runKureM _ f (Failure msg) = f msg+runKureM s _ (Success a)   = s a --- | Get the value from a 'KureMonad', providing a function to handle the error case.-fromKureMonad :: (String -> a) -> KureMonad a -> a-fromKureMonad = runKureMonad id+-- | Get the value from a 'KureM', providing a function to handle the error case.+fromKureM :: (String -> a) -> KureM a -> a+fromKureM = runKureM id -instance Monad KureMonad where--- return :: a -> KureMonad a+instance Monad KureM where+-- return :: a -> KureM a    return = Success --- (>>=) :: KureMonad a -> (a -> KureMonad b) -> KureMonad b+-- (>>=) :: KureM a -> (a -> KureM b) -> KureM b    (Success a)   >>= f = f a    (Failure msg) >>= _ = Failure msg --- fail :: String -> KureMonad a+-- fail :: String -> KureM a    fail = Failure --- | 'KureMonad' is the minimal monad that can be an instance of 'MonadCatch'.-instance MonadCatch KureMonad where--- catchM :: KureMonad a -> (String -> KureMonad a) -> KureMonad a-+-- | 'KureM' is the minimal monad that can be an instance of 'MonadCatch'.+instance MonadCatch KureM where+-- catchM :: KureM a -> (String -> KureM a) -> KureM a    (Success a)   `catchM` _ = Success a    (Failure msg) `catchM` f = f msg -instance Functor KureMonad where--- fmap :: (a -> b) -> KureMonad a -> KureMonad b+instance Functor KureM where+-- fmap :: (a -> b) -> KureM a -> KureM b    fmap = liftM -instance Applicative KureMonad where--- pure :: a -> KureMonad a+instance Applicative KureM where+-- pure :: a -> KureM a    pure = return --- (<*>) :: KureMonad (a -> b) -> KureMonad a -> KureMonad b+-- (<*>) :: KureM (a -> b) -> KureM a -> KureM b    (<*>) = ap  ------------------------------------------------------------------------------------------@@ -156,17 +165,17 @@                                                   then return (f a1 a2 a3 a4)                                                   else fail "failed for all four children" -attemptAnyN' :: Monad m => ([a] -> b) -> [(Bool,a)] -> m b-attemptAnyN' f bas = let (bs,as) = unzip bas+attemptAnyN' :: (Traversable t, Monad m) => (t a -> b) -> t (Bool,a) -> m b+attemptAnyN' f bas = let (bs,as) = (fmap fst &&& fmap snd) $ bas                       in if or bs                           then return (f as)-                          else fail ("failed for all " ++ show (length bs) ++ " children")+                          else fail ("failed for all " ++ show (length $ toList bs) ++ " children") -attemptAny1N' :: Monad m => (a1 -> [a2] -> r) -> (Bool,a1) -> [(Bool,a2)] -> m r-attemptAny1N' f (b,a) bas = let (bs,as) = unzip bas-                             in if or (b:bs)+attemptAny1N' :: (Traversable t, Monad m) => (a1 -> t a2 -> r) -> (Bool,a1) -> t (Bool,a2) -> m r+attemptAny1N' f (b,a) bas = let (bs,as) = (fmap fst &&& fmap snd) $ bas+                             in if b || or bs                                  then return (f a as)-                                 else fail ("failed for all " ++ show (1 + length bs) ++ " children")+                                 else fail ("failed for all " ++ show (1 + length (toList bs)) ++ " children")  attemptAny2 :: Monad m => (a1 -> a2 -> r) -> m (Bool,a1) -> m (Bool,a2) -> m r attemptAny2 f = liftArgument2 (attemptAny2' f)@@ -177,10 +186,10 @@ attemptAny4 :: Monad m => (a1 -> a2 -> a3 -> a4 -> r) -> m (Bool,a1) -> m (Bool,a2) -> m (Bool,a3) -> m (Bool,a4) -> m r attemptAny4 f = liftArgument4 (attemptAny4' f) -attemptAnyN :: Monad m => ([a] -> b) -> [m (Bool,a)] -> m b+attemptAnyN :: (Traversable t, Monad m) => (t a -> b) -> t (m (Bool,a)) -> m b attemptAnyN f = liftArgumentN (attemptAnyN' f) -attemptAny1N :: Monad m => (a1 -> [a2] -> r) -> m (Bool,a1) -> [m (Bool,a2)] -> m r+attemptAny1N :: (Traversable t, Monad m) => (a1 -> t a2 -> r) -> m (Bool,a1) -> t (m (Bool,a2)) -> m r attemptAny1N f = liftArgument1N (attemptAny1N' f)  -------------------------------------------------------------------------------@@ -219,19 +228,6 @@                                                                   return (f a' b c d)                                                               ) <<+ attemptOne3' (f a) mbb mcc mdd -attemptOneN' :: MonadCatch m => ([a] -> r) -> [(m a, a)] -> m r-attemptOneN' _ []                = fail "failed for all children"-attemptOneN' f [maa]             = attemptOne1' (f . (:[])) maa-attemptOneN' f ((ma , a) : maas) = (do a' <- ma-                                       return $ f (a' : map snd maas)-                                   ) <<+ attemptOneN' (f . (a:)) maas--attemptOne1N' :: MonadCatch m => (a -> [b] -> r) -> (m a, a) -> [(m b, b)] -> m r-attemptOne1N' f (ma , a) mbbs = (do a' <- ma-                                    return $ f a' (map snd mbbs)-                                ) <<+ attemptOneN' (f a) mbbs-- attemptOne2 :: MonadCatch m => (a -> b -> r) -> m (m a, a) -> m (m b, b) -> m r attemptOne2 f = liftArgument2 (attemptOne2' f) @@ -241,12 +237,32 @@ attemptOne4 :: MonadCatch m => (a -> b -> c -> d -> r) -> m (m a, a) -> m (m b, b) -> m (m c, c) -> m (m d, d) -> m r attemptOne4 f = liftArgument4 (attemptOne4' f) -attemptOneN :: MonadCatch m => ([a] -> r) -> [m (m a, a)] -> m r-attemptOneN f = liftArgumentN (attemptOneN' f) -attemptOne1N :: MonadCatch m => (a -> [b] -> r) -> m (m a, a) -> [m (m b, b)] -> m r-attemptOne1N f = liftArgument1N (attemptOne1N' f) +newtype S s m a = S {runS :: s -> m (a, s)}+instance Monad m => Functor (S s m) where fmap = liftM+instance Monad m => Applicative (S s m) where+  {-# INLINE pure #-}+  pure = return+  {-# INLINE (<*>) #-}+  (<*>) = liftM2 ($)+instance Monad m => Monad (S s m) where+  {-# INLINE return #-}+  return a = S $ \ b -> return (a, b)+  {-# INLINE (>>=) #-}+  m >>= f = S $ \ b -> runS m b >>= \(a, b') -> runS (f a) b'++attemptOneN :: (Traversable t, MonadCatch m) => (t a -> r) -> t (m (m a, a)) -> m r+attemptOneN f = (>>= final) . flip runS False . mapM each where+  each m = S $ \ b -> m >>= \(ma, a) -> if b then return (a, b) else liftM (,True) ma <<+ return (a, b)+  final (x, b) = if b then return (f x) else fail "failed for all children"++attemptOne1N :: (Traversable t, MonadCatch m) => (a -> t b -> r) -> m (m a, a) -> t (m (m b, b)) -> m r+attemptOne1N f mmaa mmbbs = do+  (ma, a) <- mmaa+  mbbs    <- sequence mmbbs+  ((\a' -> f a' $ fmap snd mbbs) `liftM` ma) <<+ attemptOneN (f a) (fmap return mbbs)+ -------------------------------------------------------------------------------  -- | A standard error message for when the child index is out of bounds.@@ -305,31 +321,18 @@ childL3of4 :: (MonadCatch m, Node b3) => (b0 -> b1 -> b2 -> b3 -> a) -> b0 -> b1 -> b2 -> (c,b3) -> ((c, Generic b3) , Generic b3 -> m a) childL3of4 f b0 b1 b2 cb3 = childLaux cb3 (\ b3 -> f b0 b1 b2 b3) -childLMofN :: (MonadCatch m, Node b) => Int -> ([b] -> a) -> [(c,b)] -> ((c, Generic b) , Generic b -> m a)-childLMofN m f cbs = childLaux (cbs !! m) (\ b' -> f $ atIndex m (const b') (map snd cbs))---------------------------------------------------------------------------------+childLMofN :: (MonadCatch m, Node b, Traversable t) => Int -> (t b -> a) -> t (c,b) -> ((c, Generic b) , Generic b -> m a)+childLMofN = \ m f cbs ->+  childLaux (toList cbs !! m) $ \ b' -> f $ snd $+    mapAccumL (\n (_, b) -> n `seq` (n + 1, if n == m then b' else b)) 0 cbs+    -- Rather than using map snd and atIndex (2 traversals), we do both at once with a single traversal --- | Modify the value in a list at specified index.-atIndex :: Int -> (a -> a) -> [a] -> [a]-atIndex i f as = [ if n == i then f a else a-                 | (a,n) <- zip as [0..]-                 ]+--   Modify the value in a traversable at specified index.+-- atIndex :: Traversable t => (a -> a) -> Int -> t a -> t a+-- atIndex f n = snd . mapAccumL (\ m a -> m `seq` (m + 1, if m == n then f a else a)) 0  ------------------------------------------------------------------------------- --- liftResult :: Monad m => (a -> b) -> (a -> m b)--- liftResult = result return---- liftResult2 :: Monad m => (a -> b -> c) -> (a -> b -> m c)--- liftResult2 = (result.result) return---- liftResult3 :: Monad m => (a -> b -> c -> d) -> (a -> b -> c -> m d)--- liftResult3 = (result.result.result) return---- liftResult4 :: Monad m => (a -> b -> c -> d -> e) -> (a -> b -> c -> d -> m e)--- liftResult4 = (result.result.result.result) return- liftArgument2 :: Monad m => (a -> b -> m c) -> m a -> m b -> m c liftArgument2 f ma mb = join (liftM2 f ma mb) @@ -339,10 +342,10 @@ liftArgument4 :: Monad m => (a -> b -> c -> d -> m e) -> m a -> m b -> m c -> m d -> m e liftArgument4 f ma mb mc md = join (liftM4 f ma mb mc md) -liftArgumentN :: Monad m => ([a] -> m b) -> [m a] -> m b+liftArgumentN :: (Traversable t, Monad m) => (t a -> m b) -> t (m a) -> m b liftArgumentN f mas = sequence mas >>= f -liftArgument1N :: Monad m => (a -> [b] -> m c) -> m a -> [m b] -> m c+liftArgument1N :: (Traversable t, Monad m) => (a -> t b -> m c) -> m a -> t (m b) -> m c liftArgument1N f ma mbs = do a  <- ma                              bs <- sequence mbs                              f a bs

@@ -21,7 +21,7 @@         , hasChild         , hasChildT -          -- * Tree Walkers+        -- * Tree Walkers         , Walker(..)          -- * Rewrite Traversals@@ -79,8 +79,6 @@          -- ** Testing Paths         ,  testPathT-- ) where  import Prelude hiding (id)@@ -97,7 +95,6 @@  ------------------------------------------------------------------------------------------ - -- | A 'Node' is any node in the tree that you wish to be able to traverse.  class (Injection a (Generic a), Generic a ~ Generic (Generic a)) => Node a where@@ -226,11 +223,11 @@  -- | An always successful traversal that collects the results of all successful applications of a 'Translate' in a list. collectT :: (Walker c m a, a ~ Generic a) => Translate c m (Generic a) b -> Translate c m (Generic a) [b]-collectT t = crushtdT (t >>^ (: []))+collectT t = crushtdT (t >>^ return)  -- | Like 'collectT', but does not traverse below successes. collectPruneT :: (Walker c m a, a ~ Generic a) => Translate c m (Generic a) b -> Translate c m (Generic a) [b]-collectPruneT t = prunetdT (t >>^ (: []))+collectPruneT t = prunetdT (t >>^ return)  ------------------------------------------------------------------------------- 

@@ -39,16 +39,16 @@ initialContext :: Context initialContext = Context rootAbsPath [] -lookupDef :: Name -> Context -> KureMonad Expr+lookupDef :: Name -> Context -> KureM Expr lookupDef v (Context _ defs) = maybe (fail $ v ++ " not found in context") return $ lookup v defs  --------------------------------------------------------------------------- -type TranslateE a b = Translate Context KureMonad a b+type TranslateE a b = Translate Context KureM a b type RewriteE a = TranslateE a a  applyE :: TranslateE a b -> a -> Either String b-applyE t = runKureMonad Right Left . apply t initialContext+applyE t = runKureM Right Left . apply t initialContext  --------------------------------------------------------------------------- @@ -63,7 +63,7 @@  --------------------------------------------------------------------------- -instance Walker Context KureMonad GenericExpr where+instance Walker Context KureM GenericExpr where    childL n = lens $ translate $ \ c g -> case g of                                            GExpr e -> childLgeneric n c e@@ -105,7 +105,7 @@   numChildren (Var _)    = 0   numChildren (Lit _)    = 0 -instance Walker Context KureMonad Expr where+instance Walker Context KureM Expr where   childL n = lens $     case n of       0 ->    addT  exposeT id (childL0of2 Add)@@ -150,7 +150,7 @@   numChildren (Seq _ _)    = 2   numChildren (Assign _ _) = 1 -instance Walker Context KureMonad Cmd where+instance Walker Context KureM Cmd where   childL n = lens $     case n of       0 ->    seqT exposeT id (childL0of2 Seq)@@ -179,7 +179,7 @@  --------------------------------------------------------------------------- -seqT' :: TranslateE Cmd a1 -> TranslateE Cmd a2 -> (KureMonad a1 -> KureMonad a2 -> KureMonad b) -> TranslateE Cmd b+seqT' :: TranslateE Cmd a1 -> TranslateE Cmd a2 -> (KureM a1 -> KureM a2 -> KureM b) -> TranslateE Cmd b seqT' t1 t2 f = translate $ \ c cm -> case cm of                                        Seq cm1 cm2 -> f (apply t1 (c @@ 0) cm1) (apply t2 (updateContextCmd cm1 c @@ 1) cm2)                                        _           -> fail "not a Seq"@@ -222,7 +222,7 @@  --------------------------------------------------------------------------- -addT' :: TranslateE Expr a1 -> TranslateE Expr a2 -> (KureMonad a1 -> KureMonad a2 -> KureMonad b) -> TranslateE Expr b+addT' :: TranslateE Expr a1 -> TranslateE Expr a2 -> (KureM a1 -> KureM a2 -> KureM b) -> TranslateE 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"@@ -241,7 +241,7 @@  --------------------------------------------------------------------------- -eseqT' :: TranslateE Cmd a1 -> TranslateE Expr a2 -> (KureMonad a1 -> KureMonad a2 -> KureMonad b) -> TranslateE Expr b+eseqT' :: TranslateE Cmd a1 -> TranslateE Expr a2 -> (KureM a1 -> KureM a2 -> KureM b) -> TranslateE Expr b eseqT' t1 t2 f = translate $ \ c e -> case e of                                         ESeq cm e1 -> f (apply t1 (c @@ 0) cm) (apply t2 (updateContextCmd cm c @@ 1) e1)                                         _          -> fail "not an ESeq"

@@ -4,7 +4,7 @@ import Control.Category  import Language.KURE-import Language.KURE.Utilities(runKureMonad)+import Language.KURE.Utilities(runKureM)  import Fib.AST import Fib.Kure@@ -12,7 +12,7 @@ -----------------------------------------------------------------------  applyFib :: RewriteA -> Arith -> Either String Arith-applyFib r = runKureMonad Right Left . apply r rootAbsPath+applyFib r = runKureM Right Left . apply r rootAbsPath  ----------------------------------------------------------------------- 

@@ -3,13 +3,13 @@ module Fib.Kure where  import Language.KURE-import Language.KURE.Utilities(KureMonad,missingChild)+import Language.KURE.Utilities(KureM,missingChild) import Fib.AST  --------------------------------------------------------------------------------------  -- | For this simple example, the context is just an 'AbsolutePath', and 'Translate' always operates on 'Arith'.-type TranslateA b = Translate AbsolutePath KureMonad Arith b+type TranslateA b = Translate AbsolutePath KureM Arith b type RewriteA = TranslateA Arith  --------------------------------------------------------------------------------------@@ -22,7 +22,7 @@   numChildren (Sub _ _) = 2   numChildren (Fib _)   = 1 -instance Walker AbsolutePath KureMonad Arith where+instance Walker AbsolutePath KureM Arith where    childL n = lens $ translate $ \ c e ->     do guardMsg (hasChild n e) (missingChild n)

@@ -138,4 +138,7 @@ appAnyR :: RewriteExp -> RewriteExp -> RewriteExp appAnyR r1 r2 = appT' (attemptR r1) (attemptR r2) (attemptAny2 App) +appOneR :: RewriteExp -> RewriteExp -> RewriteExp+appOneR r1 r2 = appT' (withArgumentT r1) (withArgumentT r2) (attemptOne2 App)+ -------------------------------------------------------------------------------

@@ -1,5 +1,5 @@ Name:                kure-Version:             2.4.2+Version:             2.4.10 Synopsis:            Combinators for Strategic Programming Description:	     The Kansas University Rewrite Engine (KURE) is a DSL for strategic rewriting. 	 	     KURE shares concepts with Stratego, but unlike Stratego, KURE is strongly typed.