[Haskell-beginners] one more step backwards

[Felipe Lessa]

(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.