(This e-mail is literate Haskell source code.) On Sun, Jan 31, 2010 at 06:52:33PM +0000, Stephen Tetley wrote: ] In this case a simple stack tracking the expression as it is reduced ] should work, the code below isn't entirely correct as it seems to need ] 'r' input twice to do the first roll-back, but it is along the right ] lines. ] ] The function 'evaluate' has been split to pass the stack into the ] function 'evalWithStack' which does the recursive work. Along these lines we may also change evalStep using the Writer monad.
import Control.Monad.Writer
data Expression = Val Integer | Add Expression Expression | Subtract Expression Expression | Multiply Expression Expression | Divide Expression Expression deriving Show
demo1 = (Add(Add(Add(Add(Val 6)(Val 5))(Val 10))(Val 7))(Val 30))
Some utilities:
-- | Applying a function to two Val's. val :: BinOp Integer -> BinOp Expression val (#) (Val a) (Val b) = Val (a # b)
type BinOp a = a -> a -> a
We can use the same type stack of expressions as before.
type Stack = [Expression]
Our monad is a writer of stacks:
type Evaluation a = Writer Stack a
The idea is to 'tell' each step of the evaluation.
step :: Expression -> Evaluation Expression step x = tell [x] >> return x
If there's nothing to do we just return the value. We don't 'tell' because we didn't evaluate anything. With an Add we recursively evaluate the operands. If they 'tell' anything then we modify their expression to include ourselves with 'censor'.
evalStep' :: Expression -> Evaluation Expression evalStep' (Val x) = return (Val x) evalStep' (Add x y) = do x' <- censor (map (\k -> Add k y)) (evalStep' x) y' <- censor (map (\k -> Add x' k)) (evalStep' y) step (val (+) x' y')
In fact, that pattern may be abstracted way
evalBinOp :: BinOp Integer -> BinOp Expression -> (Expression -> Expression -> Evaluation Expression) evalBinOp (#) mkOp x y = do x' <- censor (map (\k -> mkOp k y)) (evalStep x) y' <- censor (map (\k -> mkOp x' k)) (evalStep y) step (val (#) x' y')
evalStep :: Expression -> Evaluation Expression evalStep (Val x) = return (Val x) evalStep (Add x y) = evalBinOp (+) Add x y evalStep (Subtract x y) = evalBinOp (-) Subtract x y evalStep (Multiply x y) = evalBinOp (*) Multiply x y evalStep (Divide x y) = evalBinOp div Divide x y
However we'll generate all expressions lazily at once
evaluate :: Expression -> Stack evaluate expr = expr : execWriter (evalStep expr)
Now you just have to walk lazily through the list :). This is the job of a zipper, which I'll briefly reconstruct here.
data Zipper a = Zipper [a] a [a]
fromList (x:xs) = Zipper [] x xs focus (Zipper _ x _) = x
left z@(Zipper [] _ _) = z left (Zipper (l:ls) x rs) = Zipper ls l (x:rs)
right z@(Zipper _ _ []) = z right (Zipper ls x (r:rs)) = Zipper (x:ls) r rs
And then the "boring" IO part:
interactive :: Expression -> IO () interactive = go . fromList . evaluate where go z = do putStrLn $ "Result is " ++ show (focus z) putStrLn "Do another step (y/n) or rollback (r)?" c <- getLine case c of "y" -> go (right z) "r" -> go (left z) _ -> putStrLn "Sayonara!"
Of course you could also see if we are on one of the ends of the zipper to tell the user he cannot step or rollback. Hope that helps, -- Felipe.