Ocaml Error: Answer error (please help fix) - ocaml

Question

I have been stuck with this for more than an hour. So the test bench is at the bottom, and the answer is supposed to show 120 but I keep getting 20. I believe it only does 5 * 4 not the rest of 3 2 and 1.
What is the problem??
I tried to fix all the other ones but they seem correct. is it a calculation error? is it WHILE problem?
type exp =
| NUM of int | TRUE | FALSE | UNIT
| VAR of id
| ADD of exp * exp
| SUB of exp * exp
| MUL of exp * exp
| DIV of exp * exp
| EQUAL of exp * exp
| LESS of exp * exp
| NOT of exp
| SEQ of exp * exp (* sequence *)
| IF of exp * exp * exp (* if-then-else *)
| WHILE of exp * exp (* while loop *)
| LETV of id * exp * exp (* variable binding *)
| LETF of id * id list * exp * exp (* procedure binding *)
| CALLV of id * exp list (* call by value *)
| CALLR of id * id list (* call by referenece *)
| RECORD of (id * exp) list (* record construction *)
| FIELD of exp * id (* access record field *)
| ASSIGN of id * exp (* assgin to variable *)
| ASSIGNF of exp * id * exp (* assign to record field *)
| WRITE of exp
and id = string
type loc = int
type value =
| Num of int
| Bool of bool
| Unit
| Record of record
and record = (id * loc) list
type memory = (loc * value) list
type env = binding list
and binding = LocBind of id * loc | ProcBind of id * proc
and proc = id list * exp * env
(********************************)
(* Handling environment *)
(********************************)
let rec lookup_loc_env : id -> env -> loc
= fun x env ->
match env with
| [] -> raise(Failure ("Variable "^x^" is not included in environment"))
| hd::tl ->
begin match hd with
| LocBind (id,l) -> if(x=id) then l else lookup_loc_env x tl
| ProcBind _ -> lookup_loc_env x tl
end
let rec lookup_proc_env : id -> env -> proc
= fun x env ->
match env with
| [] -> raise(Failure ("Variable "^x^" is not included in environment"))
| hd::tl ->
begin match hd with
| LocBind _ -> lookup_proc_env x tl
| ProcBind (id,binding) -> if (x=id) then binding else lookup_proc_env x tl
end
let extend_env : binding -> env -> env
= fun e env -> e::env
let empty_env = []`enter code here`
(***************************)
(* Handling memory *)
(***************************)
let rec lookup_mem : loc -> memory -> value
= fun l mem ->
match mem with
| [] -> raise(Failure ("location "^(string_of_int l)^" is not included in memory"))
| (loc,v)::tl -> if(l=loc) then v else lookup_mem l tl
let extend_mem : (loc * value) -> memory -> memory
= fun (l,v) mem -> (l,v)::mem
let empty_mem = []
(***************************)
(* Handling record *)
(***************************)
let rec lookup_record : id -> record -> loc
= fun id record ->
match record with
| [] -> raise(Failure ("field "^ id ^" is not included in record"))
| (x,l)::tl -> if(id=x) then l else lookup_record id tl
let extend_record : (id * loc) -> record -> record
= fun (x,l) record -> (x,l)::record
let empty_record = []
(***************************)
let counter = ref 0
let new_location () = counter:=!counter+1;!counter
exception NotImplemented
exception UndefinedSemantics
let rec list_fold2 : ('a -> 'b -> 'c -> 'c)-> 'a list -> 'b list -> 'c -> 'c
= fun func l1 l2 acc ->
match (l1,l2) with
| ([],[]) -> acc
| (hd1::tl1,hd2::tl2) -> list_fold2 func tl1 tl2 (func hd1 hd2 acc)
| _ -> raise (Failure "two lists have different length")
let rec list_fold : ('a -> 'b -> 'b) -> 'a list -> 'b -> 'b
= fun func l acc ->
match l with
| [] -> acc
| hd::tl -> list_fold func tl (func hd acc)
let value2str : value -> string
= fun v ->
match v with
| Num n -> string_of_int n
| Bool b -> string_of_bool b
| Unit -> "unit"
| Record _ -> "record"
let rec eval_aop : env -> memory -> exp -> exp -> (int -> int -> int) -> (value * memory)
= fun env mem e1 e2 op ->
let (v1,mem1) = eval env mem e1 in
let (v2,mem2) = eval env mem1 e2 in
match (v1,v2) with
| (Num n1, Num n2) -> (Num (op n1 n2), mem2)
| _ -> raise (Failure "arithmetic operation type error")
and eval : env -> memory -> exp -> (value * memory)
=fun env mem e ->
match e with
| NUM n -> (Num n, mem)
| TRUE -> (Bool true, mem)
| FALSE -> (Bool false, mem)
| UNIT -> (Unit, mem)
| VAR x -> ((lookup_mem (lookup_loc_env x env) mem ), mem )
| ADD (e1, e2) -> eval_aop env mem e1 e2 (+)
| SUB (e1, e2) -> eval_aop env mem e1 e2 (-)
| MUL (e1, e2) -> eval_aop env mem e1 e2 ( * )
| DIV (e1, e2) -> eval_aop env mem e1 e2 (/)
|EQUAL (e1, e2) ->
let (v1, mem1) = eval env mem e1 in
let (v2, mem2) = eval env mem1 e2 in
if v1 = v2 then (Bool true, mem2) else (Bool false, mem2)
|LESS (e1, e2) ->
let (v1, mem1) = eval env mem e1 in
let (v2, mem2) = eval env mem1 e2 in
begin match (v1, v2) with
| (Num n1, Num n2) ->
if Num n1 < Num n2 then (Bool true, mem2) else (Bool false, mem2)
| _ -> raise (UndefinedSemantics)
end
|NOT (e1) ->
let (b, mem1) = eval env mem e1 in
if b = b then (Bool false,mem1) else (Bool true,mem1)
|SEQ (e1, e2) ->
let (v1, mem1) = eval env mem e1 in
let (v2, mem2) = eval env mem1 e2 in
(v2,mem2)
|IF (e1,e2,e3) ->
(match (eval env mem e1) with
| (Bool true, mem1) -> eval env mem1 e1
| (Bool false, mem1) -> eval env mem1 e2
| _ -> raise (UndefinedSemantics) )
|WHILE (e1,e2) ->
begin match (eval env mem e1) with
| (Bool true, mem1) ->
let (v1, mem2) = eval env mem1 e2 in
eval env mem2 e2
| (Bool false, mem1) -> (Unit, mem1)
| _ -> raise (UndefinedSemantics)
end
|LETV (x,e1,e2) ->
let (v1, mem1) = eval env mem e1 in
let a = LocBind (x, (new_location()) ) in
let (v2,mem2) = eval (extend_env a env) (extend_mem ((lookup_loc_env x)(extend_env a env), v1) mem1 )e2 in
(v2,mem2)
| ASSIGN (x,e1) ->
let (v1, mem1) = eval env mem e1 in
(v1, extend_mem ((lookup_loc_env x env) , (v1) ) mem1)
| WRITE e ->
let (v1,mem1) = eval env mem e in
let _ = print_endline(value2str v1) in
(v1,mem1)
| _ -> raise NotImplemented
;;
let runb : exp -> value
=fun exp -> let (v, _) = eval empty_env empty_mem exp in v;;
let test = LETV ("ret", NUM 1,
LETV ("n", NUM 5,
SEQ (
WHILE (LESS (NUM 0, VAR "n"),
SEQ (
ASSIGN ("ret", MUL (VAR "ret", VAR "n")),
ASSIGN ("n", SUB (VAR "n", NUM 1))
)
),
VAR "ret")))
;;
runb test;;

Answer 1

When evaluating WHILE you need to make sure the inner expression is evaluated as a WHILE. But you are evaluating it just as itself. In other words, the recursive call to eval should be passing e but you are just passing e2.
As a result you're just getting two evaluations of the loop, which gives 20.
So it seems to me.