[Haskell-beginners] substitution

[Stephen Tetley]

Hi John

I was wrong yesterday with my advice - the arithmetic ops are going
down the right spine but only after they have gone down the left spine
in one step. As I changed the code to go down both spines during one
step, the evaluator got an answer that looked right by cheating (it
was doing too much work at one step). For different input I don't
think it would have worked.

To maintain stepping, one option is for evalStep to return both the
one-step-transformed expression and a dictionary that represents the
values at current step.

With a non-stepping evaluator the dictionary can simply be passed down
through the tree, but that doesn't work for a stepping evaluator,
consider this example:

let x = 5 in (x + (x * 2))     : dict {}

evalStep is two operations:
first add the binding                   ==> x + (x * 5)     : dict { x := 5 }
second perform one (recursive) evalStep ==> 5 + (x * 5)	    : dict { x := 5 }

return the expression                   ==> 5 + (x * 5)

Unfortunately because of the stepping you are throwing away the
dictionary with the binding { x := 5 } - the stepping function only
returns the partially evaluated expression, not the expression plus
modified dictionary.

So the next evaluation attempt has the input:

5 + (x * 5) : dict { }

... as there is nothing in the dictionary the lookup will fail.


Here's a version that changes the type of evalStep so that it returns
the modified dictionary - I took the liberty of changing the case
expressions to nested pattern matching within evalStep so that I could
copy/paste/modify the code more easily:


data Expression = Val Double
               | Add Expression Expression
               | Subtract Expression Expression
               | Multiply Expression Expression
               | Divide Expression Expression
	       | Var String
	       | Let String Expression Expression
        deriving Show

demo1 = (Add(Multiply(Divide(Subtract(Val 25)(Val 5))(Val 10))(Val 7))(Val 30))
--let x = 1+1 in 3 - x
test1 = Let "x" (Add (Val 1) (Val 1)) (Subtract (Val 3) (Var "x"))

test6 = Let "y" (Add (Val 7)(Val 6)) (Subtract (Val 6)(Var "y"))

-- 4 * (let x = 1+1 in 3 + x)
test2 = Multiply (Val 4) test1

-- x * (let x = 1+1 in 3 + x)
test3 = Let "y" (Add (Val 4)(Val 7)) (Multiply  test1 (Var "y"))

test5 = Add (test1) test6
type Dict =[(String,Expression)]
emptyDict :: Dict
emptyDict = []

addEntry :: String->Expression ->Dict -> Dict
addEntry n e d = (n,e): d

lookupEntry :: String -> Dict -> Maybe Expression
lookupEntry n [] = Nothing
lookupEntry n (x:xs) = if (n == k)
			then (Just v)
	               else lookupEntry n xs
			where (k,v) = x

evalStep :: Dict -> Expression -> (Dict,Expression)
evalStep d (Val x) =   (d, Val x)

evalStep d (Add (Val a) (Val b)) = (d, Val (a+b))
evalStep d (Add (Val a)  y     ) = let (_,r) = evalStep d y in (d, Add
(Val a) r)
evalStep d (Add x        y     ) = let (_,l) = evalStep d x in (d, Add l y)

evalStep d (Subtract (Val a) (Val b)) = (d, Val (a-b))
evalStep d (Subtract (Val a)  y     ) = let (_,r) = evalStep d y in
(d, Subtract (Val a) r)
evalStep d (Subtract x        y     ) = let (_,l) = evalStep d x in
(d, Subtract l y)


evalStep d (Multiply (Val a) (Val b)) = (d,Val (a*b))
evalStep d (Multiply (Val a)  y     ) = let (_,r) = evalStep d y in
(d, Multiply (Val a) r)
evalStep d (Multiply x        y     ) = let (_,l) = evalStep d x in
(d, Multiply l y)

evalStep d (Divide (Val a) (Val b)) = (d, Val (a/b))
evalStep d (Divide (Val a)  y     ) = let (_,r) = evalStep d y in (d,
Divide (Val a) r)
evalStep d (Divide x        y     ) = let (_,l) = evalStep d x in (d,
Divide l y)

evalStep d (Let n (Val _) (Val b))  = (d, Val b) -- redundant let
evalStep d (Let n e1      e2     )  = evalStep (addEntry n e1 d) e2

evalStep d (Var x)
   = case lookup x d of
       Just e -> (d,e)
       Nothing -> error "Error in expression -- no definition for variable!"


evaluate :: Dict-> [Expression] -> Expression -> IO()
evaluate d (x:xs) e = do

     putStrLn (show e)
     putStrLn "Do another step (y/n) or rollback (r)? :"
     c <- getLine
     case c of
       "y" -> let (d',e') = (evalStep d e) in evaluate d' (e:x:xs) e'
-- build up history

       "r" ->  case (x:xs) of
		(x:xs)-> evaluate d xs x
		[]-> do { putStrLn "Empty"
			;evaluate d(x:xs) e
		}
       "n"  ->  putStrLn $ "Ok you said no :" ++ c



runExpr expr i = step i expr emptyDict
  where
    step n e _ | n < 1 = e
    step n e d         = let (d',e') = evalStep d e in step (n-1) e' d'


isFree :: String -> Expression -> Bool
isFree n1 (Let n2 e1 e2)
	|n1 == n2 = False
	|otherwise = True



subst :: String -> Expression -> Expression->Expression
subst n e1 e2
	|isFree n e2 = subst' n e1 e2
	|otherwise = e2

subst' :: String -> Expression -> Expression->Expression
subst' n0 e1 (Var n1)
	|n0 == n1 = e1
	|otherwise = Var n1

subst' s v (Add e1 e2) = Add(subst' s v e1)(subst' s v e2)

subst' s v (Multiply e1 e2) = Multiply(subst' s v e1)(subst' s v e2)

subst' s v (Divide e1 e2) = Divide(subst' s v e1)(subst' s v e2)

subst' s v (Subtract e1 e2) = Subtract(subst' s v e1)(subst' s v e2)
subst' s v (Let n e1 e2)=
	Let n (subst' s v e1)(subst' s v e2)