[Haskell-beginners] one more step backwards
Stephen Tetley
stephen.tetley at gmail.com
Sun Jan 31 13:52:33 EST 2010
Hi John
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.
Best wishes
Stephen
module RollbackEval where
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))
evalStep :: Expression -> Expression
evalStep (Val x)= (Val x)
evalStep (Add x y)
= case x of
(Val a) -> case y of
(Val b) -> Val (a+b)
left -> Add x (evalStep y)
right -> Add (evalStep x)y
type Stack = [Expression]
evaluate :: Expression -> IO ()
evaluate exp = do
stk <- evalWithStack exp [exp]
putStrLn "Stack:"
mapM_ (putStrLn . show) stk
evalWithStack :: Expression -> Stack -> IO Stack
-- Base case
evalWithStack (Val a) stk = return stk
-- Recursive case
evalWithStack e stk = do
putStrLn "Evaluating one more step"
let e' = (evalStep e)
putStrLn ("Result is "++(show e'))
putStrLn "Do another step (y/n) or rollback (r)? :"
c <- getLine
case c of
"y" -> evalWithStack e' (e':stk)
"r" -> let (a,stk') = stackBack stk in evalWithStack a stk'
_ -> do { putStrLn ("Ok you said" ++ show[c]
++ "so that's it"
++ show (getCount stk))
; return (e':stk)
}
stackBack :: Stack -> (Expression,Stack)
stackBack [a] = (a,[a])
stackBack (a:as) = (a,as)
stackBack [] = error "Whoops empty - should be unreachable"
getCount :: Stack -> Int
getCount stk = length stk
-------------------
More information about the Beginners
mailing list