Add Lambda Functions To Interpreters In Ocaml Assignment Solution.

open Ast

exception TypeError

exception UndefinedVar

exception DivByZeroError

(* Remove shadowed bindings *)

let prune_env (env : environment) : environment =

  let binds = List.sort_uniq compare (List.map (fun (id, _) -> id) env) in

  List.map (fun e -> (e, List.assoc e env)) binds

(* Env print function to stdout *)

let print_env_std (env : environment): unit =

  List.fold_left (fun _ (var, value) ->

      match value with

        | Int_Val i -> Printf.printf "- %s => %s\n" var (string_of_int i)

        | Bool_Val b -> Printf.printf "- %s => %s\n" var (string_of_bool b)

        | Closure _ -> ()) () (prune_env env)

(* Env print function to string *)

let print_env_str (env : environment): string =

  List.fold_left (fun acc (var, value) ->

      match value with

        | Int_Val i -> acc ^ (Printf.sprintf "- %s => %s\n" var (string_of_int i))

        | Bool_Val b -> acc ^ (Printf.sprintf "- %s => %s\n" var (string_of_bool b))

        | Closure _ -> acc

      ) "" (prune_env env)

(***********************)

(****** Your Code ******)

(***********************)

(* evaluate an arithmetic expression in an environment *)

let rec eval_expr (e : exp) (env : environment) : value =

  match e with

  | Var n ->

    (match List.assoc_opt n env with

      | None -> raise UndefinedVar

      | Some v -> v)

  | Number n ->

    Int_Val n

  | Plus (e1, e2) ->

    (match (eval_expr e1 env, eval_expr e2 env) with

      | (Int_Val a, Int_Val b) -> Int_Val (a + b)

      | _ -> raise TypeError)

  | Minus (e1, e2) ->

    (match (eval_expr e1 env, eval_expr e2 env) with

      | (Int_Val a, Int_Val b) -> Int_Val (a - b)

      | _ -> raise TypeError)

  | Times (e1, e2) ->

    (match (eval_expr e1 env, eval_expr e2 env) with

      | (Int_Val a, Int_Val b) -> Int_Val (a * b)

      | _ -> raise TypeError)

  | Div (e1, e2) ->

    (match (eval_expr e1 env, eval_expr e2 env) with

      | (Int_Val a, Int_Val b) ->

          if b != 0 then Int_Val (a / b)

          else raise DivByZeroError

      | _ -> raise TypeError)

  | Mod (e1, e2) ->

    (match (eval_expr e1 env, eval_expr e2 env) with

      | (Int_Val a, Int_Val b) ->

          if b != 0 then Int_Val (a mod b)

          else raise DivByZeroError

      | _ -> raise TypeError)

  | Eq (e1, e2) ->

    (match (eval_expr e1 env, eval_expr e2 env) with

      | (Int_Val a, Int_Val b) -> Bool_Val (a = b)

      | (Bool_Val a, Bool_Val b) -> Bool_Val (a = b)

      | _ -> raise TypeError)

  | Leq (e1, e2) ->

    (match (eval_expr e1 env, eval_expr e2 env) with

      | (Int_Val a, Int_Val b) -> Bool_Val (a <= b)

      | _ -> raise TypeError)

  | Lt (e1, e2) ->

    (match (eval_expr e1 env, eval_expr e2 env) with

      | (Int_Val a, Int_Val b) -> Bool_Val (a < b)

      | _ -> raise TypeError)

  | Not e ->

    (match eval_expr e env with

      | Bool_Val a -> Bool_Val (not a)

      | _ -> raise TypeError)

  | And (e1, e2) ->

    (match (eval_expr e1 env, eval_expr e2 env) with

      | (Bool_Val a, Bool_Val b) -> Bool_Val (a && b)

      | _ -> raise TypeError)

  | Or (e1, e2) ->

    (match (eval_expr e1 env, eval_expr e2 env) with

      | (Bool_Val a, Bool_Val b) -> Bool_Val (a || b)

      | _ -> raise TypeError)

  | True ->

    Bool_Val true

  | False ->

    Bool_Val false

  | App (e1, e2) ->

    (match eval_expr e1 env with

      | Closure (env', x, e') -> let v = eval_expr e2 env in

                                  eval_expr e' ((x, v)::env')

      | _ -> raise TypeError)

  | Fun (x, e) ->

    Closure (env, x, e)

(* evaluate a command in an environment *)

let rec eval_command (c : com) (env : environment) : environment =

    match c with

    | While (e, c1) ->

      let rec whilerec guard body env' =

        (match eval_expr guard env' with

        | Bool_Val b ->

            if b then whilerec guard body (eval_command body env')

            else env'

        | _ -> raise TypeError)

      in whilerec e c1 env

    | For (e, c1) ->

      let rec forrec n body env' =

        if n > 0 then forrec (n - 1) body (eval_command body env')

        else env'

      in

        (match eval_expr e env with

        | Int_Val i -> forrec i c1 env

        | _ -> raise TypeError)

    | Cond (e, c1, c2) ->

      (match eval_expr e env with

        | Bool_Val b ->

            if b then eval_command c1 env

            else eval_command c2 env

        | _ -> raise TypeError)

    | Comp (c1, c2) ->

      eval_command c2 (eval_command c1 env)

    | Assg (x, e) ->

      (match List.assoc_opt x env with

        | None -> raise UndefinedVar

        | Some v ->

          (match (v, eval_expr e env) with

          | (Int_Val _, Int_Val b) -> (x, Int_Val b)::env

          | (Bool_Val _, Bool_Val b) -> (x, Bool_Val b)::env

          | (Closure _, Closure (env',y,e')) ->

                    (x, Closure (env',y,e'))::env

          | _ -> raise TypeError))

    | Declare (Int_Type, x) ->

      (x, Int_Val 0) :: env

    | Declare (Bool_Type, x) ->

      (x, Bool_Val false) :: env

    | Declare (Lambda_Type, x) ->

      (x, Closure (env, "x", Var "x")) :: env

    | Skip ->

      env