type variable = string;;

type primitive_operator_name = string;;

type value =
  | VInt of int
  | VBool of bool
  | VClosure of environment * variable * expression

and expression =
  | EValue of value 
  | EVariable of variable
  | ELambda of variable * expression
  | EApply of expression * expression
  | EPrimitive of expression * primitive_operator_name * expression
  | EIf of expression * expression * expression
  | ELet of variable * expression * expression

and environment =
    value Environment.environment;;

type local_environment = environment;;
type global_environment = environment;;

type toplevel_form =
  | TDefine of variable * expression;;

type program =
  | PExpression of expression
  | PNonTrivial of toplevel_form * program;;

let operator operator_name value1 value2 =
  match (operator_name, value1, value2) with
    | ("=", VInt i1, VInt i2) ->
      VBool(i1 = i2)
    | ("=", VBool b1, VBool b2) ->
      VBool(b1 = b2)
    | ("+", VInt i1, VInt i2) ->
      VInt(i1 + i2)
    | ("-", VInt i1, VInt i2) ->
      VInt(i1 - i2)
    | ("*", VInt i1, VInt i2) ->
      VInt(i1 * i2)
    | ("/", VInt i1, VInt i2) ->
      VInt(i1 / i2)
    | ("&&", VBool b1, VBool b2) ->
      VBool(b1 && b2)
    | ("||", VBool b1, VBool b2) ->
      VBool(b1 || b2)
    | _ ->
      Printf.printf "%s\n" operator_name;
      failwith "error in primitive call";;

let rec expression_eval expression rho gamma =
  match expression with
    | EValue c ->
      c
    | EVariable x ->
      Environment.lookup x (Environment.extend gamma rho)
    | ELambda(x, e) ->
      VClosure(rho, x, e)
    | EApply(e1, e2) ->
      let VClosure(rho_c, x_c, e_c) =
        expression_eval e1 rho gamma
      and c = expression_eval e2 rho gamma
      in expression_eval e_c (Environment.bind x_c c rho_c) gamma
    | EPrimitive(e1, name, e2) ->
      (operator name)
        (expression_eval e1 rho gamma)
        (expression_eval e2 rho gamma)
    | EIf(e1, e2, e3) ->
      if (expression_eval e1 rho gamma) = (VBool true) then
        expression_eval e2 rho gamma
      else
        expression_eval e3 rho gamma
    | ELet(x, e1, e2) ->
      let c = expression_eval e1 rho gamma
      in expression_eval e2 (Environment.bind x c rho) gamma
;;

let toplevel_form_eval toplevel_form gamma =
  match toplevel_form with
    | TDefine(x, e) ->
      Environment.bind x (expression_eval e Environment.empty gamma) gamma;;

let rec program_eval program gamma =
  match program with
    | PExpression e ->
      expression_eval e Environment.empty gamma
    | PNonTrivial(t, p) ->
      program_eval p (toplevel_form_eval t gamma);;

(*    | _ ->
      failwith "not implemented yet";;
*)
(*
expression_eval (EValue (VInt 42)) Environment.empty Environment.empty;;
*)
let e = EApply(ELambda("x", EVariable "x"),
               EValue(VInt 42));;

let fact = ELambda("n",
                   EIf(EPrimitive(EVariable "n",
                                  "=",
                                  (EValue (VInt 0))),
                       EValue (VInt 1),
                       EPrimitive(EVariable "n",
                                  "*",
                                  EApply(EVariable "fact",
                                         EPrimitive(EVariable "n",
                                                    "-",
                                                    (EValue (VInt 1)))))));;
let p0 =
  PNonTrivial(TDefine("fact", fact),
              PExpression(EApply((EVariable "fact"),
                                 (EValue(VInt 10)))));;

let p =
  PExpression(ELet("fact",
                   fact,
                   (EApply((EVariable "fact"),
                           (EValue(VInt 10))))));;