evaluation.ml

(* 
                         CS 51 Final Project
                         MiniML -- Evaluation
*)

(* This module implements a small untyped ML-like language under
   various operational semantics.
 *)

open Expr ;;
  
(* Exception for evaluator runtime, generated by a runtime error in
   the interpreter *)
exception EvalError of string ;;
  
(* Exception for evaluator runtime, generated by an explicit `raise`
   construct in the object language *)
exception EvalException ;;

(*......................................................................
  Environments and values 
 *)

module type ENV = sig
    (* the type of environments *)
    type env
    (* the type of values stored in environments *)
    type value =
      | Val of expr
      | Closure of (expr * env)
   
    (* empty () -- Returns an empty environment *)
    val empty : unit -> env

    (* close expr env -- Returns a closure for `expr` and its `env` *)
    val close : expr -> env -> value

    (* lookup env varid -- Returns the value in the `env` for the
       `varid`, raising an `Eval_error` if not found *)
    val lookup : env -> varid -> value

    (* extend env varid loc -- Returns a new environment just like
       `env` except that it maps the variable `varid` to the `value`
       stored at `loc`. This allows later changing the value, an
       ability used in the evaluation of `letrec`. To make good on
       this, extending an environment needs to preserve the previous
       bindings in a physical, not just structural, way. *)
    val extend : env -> varid -> value ref -> env

    (* env_to_string env -- Returns a printable string representation
       of environment `env` *)
    val env_to_string : env -> string
                                 
    (* value_to_string ?printenvp value -- Returns a printable string
       representation of a value; the optional flag `printenvp`
       (default: `true`) determines whether to include the environment
       in the string representation when called on a closure *)
    val value_to_string : ?printenvp:bool -> value -> string
  end

module Env : ENV =
  struct
    type env = (varid * value ref) list
     and value =
       | Val of expr
       | Closure of (expr * env)

    let empty () : env = [] ;;

    let close (exp : expr) (env : env) : value =
      failwith "close not implemented" ;;

    let lookup (env : env) (varname : varid) : value =
      failwith "lookup not implemented" ;;

    let extend (env : env) (varname : varid) (loc : value ref) : env =
      failwith "extend not implemented" ;;

    let value_to_string ?(printenvp : bool = true) (v : value) : string =
      failwith "value_to_string not implemented" ;;

    let env_to_string (env : env) : string =
      failwith "env_to_string not implemented" ;;
  end
;;


(*......................................................................
  Evaluation functions

  Each of the evaluation functions below evaluates an expression `exp`
  in an enviornment `env` returning a result of type `value`. We've
  provided an initial implementation for a trivial evaluator, which
  just converts the expression unchanged to a `value` and returns it,
/=  along with "stub code" for three more evaluators: a substitution
  model evaluator and dynamic and lexical environment model versions.

  Each evaluator is of type `expr -> Env.env -> Env.value` for
  consistency, though some of the evaluators don't need an
  environment, and some will only return values that are "bare
  values" (that is, not closures). 

  DO NOT CHANGE THE TYPE SIGNATURES OF THESE FUNCTIONS. Compilation
  against our unit tests relies on their having these signatures. If
  you want to implement an extension whose evaluator has a different
  signature, implement it as `eval_e` below.  *)

(* The TRIVIAL EVALUATOR, which leaves the expression to be evaluated
   essentially unchanged, just converted to a value for consistency
   with the signature of the evaluators. *)
   
let eval_t (exp : expr) (_env : Env.env) : Env.value =
  (* coerce the expr, unchanged, into a value *)
  Env.Val exp ;;

(* The SUBSTITUTION MODEL evaluator -- to be completed *)

let rec eval_binop (op : binop) (Env.Val ea : Env.value) (Env.Val eb : Env.value)
        : Env.value =
  match op, ea, eb with
  | Plus, Num n1, Num n2 -> Env.Val (Num (n1 + n2))
  | Minus, Num n1, Num n2 -> Env.Val (Num (n1 - n2))
  | Times, Num n1, Num n2 -> Env.Val (Num (n1 * n2))
  | Equals, Num n1, Num n2 -> Env.Val (Bool (n1 = n2))
  | LessThan, Num n1, Num n2 -> Env.Val (Bool (n1 < n2))
;;

let rec eval_unop (op : unop) (Env.Val e : Env.value) : Env.value =
  match op, e with
  | Negate, Num x -> Env.Val (Num (-1 * x))
;;

let env_val_to_expr (v : Env.value) : expr =
  match v with
  | Val v -> v
  | Closure (ex, en) -> ex
;;

let rec eval_s (exp : expr) (_env : Env.env) : Env.value =
  match exp with
  | Var x -> raise (EvalError ("Unbound variable " ^ x))
  | Num n -> Env.Val (Num n)
  | Bool b -> Env.Val (Bool b)
  | Unop (op, e) -> eval_unop op (eval_s e _env)
  | Binop (op, a, b) -> eval_binop op (eval_s a _env) (eval_s b _env)
  | Conditional (e1, e2, e3) -> if (eval_s e1 _env) = Env.Val (Bool (true)) then
                                  eval_s e2 _env
                                else
                                  eval_s e3 _env
  | Fun (v, e) -> Env.Val exp
  | Let (v, e1, e2) ->  eval_s (subst v (env_val_to_expr (eval_s e1 _env)) e2) _env
  | Letrec (x, d, b) ->
     eval_s
       (subst x
          (subst x (Letrec(x, env_val_to_expr (eval_s d _env), Var x)) (env_val_to_expr (eval_s d _env)))
          b)
       _env
  | App (p, q) ->
     let x, b =
       match eval_s p _env with
       | Env.Val Fun(x_1, b_1) -> x_1, b_1
       | _ -> raise (EvalError "No function found, failed to apply")
     in let v_q = eval_s q _env
        in eval_s (subst x (env_val_to_expr v_q) b) _env
  | Raise | Unassigned -> raise EvalException
;;          
     
(* The DYNAMICALLY-SCOPED ENVIRONMENT MODEL evaluator -- to be
   completed *)
   
let eval_d (_exp : expr) (_env : Env.env) : Env.value =
  failwith "eval_d not implemented" ;;
       
(* The LEXICALLY-SCOPED ENVIRONMENT MODEL evaluator -- optionally
   completed as (part of) your extension *)
   
let eval_l (_exp : expr) (_env : Env.env) : Env.value =
  failwith "eval_l not implemented" ;;

(* The EXTENDED evaluator -- if you want, you can provide your
   extension as a separate evaluator, or if it is type- and
   correctness-compatible with one of the above, you can incorporate
   your extensions within `eval_s`, `eval_d`, or `eval_l`. *)

let eval_e _ =
  failwith "eval_e not implemented" ;;
  
(* Connecting the evaluators to the external world. The REPL in
   `miniml.ml` uses a call to the single function `evaluate` defined
   here. Initially, evaluate is the trivial evaluator `eval_t`. But
   you can define it to use any of the other evaluators as you proceed
   to implement them. (We will directly unit test the four evaluators
   above, not the evaluate function, so it doesn't matter how it's set
   when you submit your solution.) *)
   
let evaluate = eval_s ;;