[Haskell-cafe] implement a simple DSL meet problem with env data can't be changed

[mo jia]

Base on the correct compiler desc on  https://github.com/pa-ba/calc-comp

Here is the source code

module Lambda_define (
    Name, Expr, eval
)where

import Prelude hiding (null, lookup, map, filter)
import Data.HashMap.Lazy
type Name = [Char]
data Expr = Val Int
          | Add [Expr]
          | Var Name
          | Abs Name Expr
          | App Expr Expr
          | Define Name Expr
          | Begin [Expr]
          | Let (Name, Expr) Expr

data Env = Root |
           Env {
                current :: HashMap Name Value,
                parent  :: Env
           }

data Value =  Num Int | Clo Name Expr Env


envLookup :: Name -> Env -> Value
envLookup n Root = Num 10000 --- fix it
envLookup n env =
    case lookup n (current env) of
        Just v -> v
        otherwise -> envLookup n (parent env)



---------------

setvar :: Name -> Value -> Env -> Env

setvar n v Root = Env{current=fromList [(n, v)] , parent=Root }
setvar n v Env{current=c, parent=p} =
    Env{current=(insert n v c), parent=p }


eval             :: Expr -> Env -> (Value, Env)
eval (Val n) e   =  (Num n , e)
eval (Add [x , y]) e =
    case eval x e of
        (Num n, e') ->  case eval y e of
            (Num m, e1') -> (Num (n+m), e)


eval (Add [x]) e =
    case eval x e of
        (Num n, e') -> (Clo "y" (Add [(Val n), (Var "y")])  e' , e)


eval (Var n) e   =  (envLookup n e, e)

eval (Abs n x) e   =  (Clo n x e, e)


eval (App x y) e =
     case eval x e of
        (Clo n' x' e', env') ->
              case eval y e of
                    (vy, e'') ->
                        (fst (eval x' (Env (fromList [(n', vy)]) e')), e )


--- the saved clojure env can't be changed

eval (Define n e) env =
    case eval e env of
        (v, e') -> (Num 0, setvar n v env) --- fix me why 0


eval (Let (n, e1) e2) env =
      ------ Let should don't chanve the env
      (fst (eval e2 (Env (fromList [(n, (fst (eval e1 env)))]) env)), env)


eval (Begin xs) e =
    case length xs of
        0 -> (Num 0, Root) -- never come here
        1 ->
            case eval (xs !! 0) e of
                (v, e') -> (v, e')
        n  ->
            case eval (Begin (take (n - 1) xs)) e of
                (v, e') -> eval (last xs) e'


test1 =  eval (Begin [(Define "z" (Val 1)), (Define "y" (Abs "x" (Add
[(Var "z"), (Var "x")]))), (Define "x" (Val 7)), (Define "z" (Val
90)), (Add [(Val 5), (App (Var "y") (Val 8))])])  Root


test2 = eval (Begin [(Define "z" (Val 1)), (Define "y" (Abs "x" (Add
[(Var "z"), (Var "x")]))), (Define "x" (Val 7)), (Let ("z", (Val 90))
(Add [(Val 5), (App (Var "y") (Val 8))])) ])  Root


In case you want to see the total program. I put it into

https://github.com/jiamo/correct_compiler/blob/master/src/Lambda_define.hs


Here is my problem:

I want test1 return  (Num 103)
I want test2 return  (Num 14)

But now it both return (Num 14)

One problem I can figure out that  "the eval of Define return a new
env can't change the old env"

Any one have suggests?