X-Git-Url: http://lambda.jimpryor.net/git/gitweb.cgi?p=lambda.git;a=blobdiff_plain;f=code%2Freduction_with_environments.ml;fp=code%2Freduction_with_environments.ml;h=0000000000000000000000000000000000000000;hp=fecac134cef51770f79afa53754c43912d7b6d40;hb=e1626ef4172d63a6bd74cbd8ab0fe56bb8ef8775;hpb=6ee4185debd7b5401900080ace6d0445c08853f5

diff --git a/code/reduction_with_environments.ml b/code/reduction_with_environments.ml
deleted file mode 100644
index fecac134..00000000
--- a/code/reduction_with_environments.ml
+++ /dev/null
@@ -1,82 +0,0 @@
-(* evaluation1.ml: evaluation-based interpreter *)
-
-type literal = Num of int | Bool of bool (* intersection of values and Constant terms *)
-type primFunction = Succ | Pred | IsZero | Leq (* | Leq_partially_applied of int *)
-
-type value = LiteralV of literal (* | Closure ... *)
-type bound_value = value (* for now, "x" is bound to the same type of thing that Var "x" expresses, but in later stages that won't always be true *)
-
-type constant = LiteralC of literal | FunctC of primFunction
-type identifier = string
-
-type lambdaTerm = Constant of constant | Var of identifier | Abstract of identifier * lambdaTerm | App of lambdaTerm * lambdaTerm | IfThenElse of lambdaTerm * lambdaTerm * lambdaTerm | Let of identifier * lambdaTerm * lambdaTerm
-
-module type Env = sig
-  type env
-  val empty: env
-  val push: identifier -> bound_value -> env -> env
-  val lookup: identifier -> env -> bound_value option
-end
-
-module Env1: Env = struct
-  type env = (identifier * bound_value) list
-  let empty = []
-  let push ident value env = (ident,value)::env
-  let rec lookup ident' env = match env with
-    | [] -> None
-    | (ident,value)::_ when ident = ident' -> Some value
-    | _::env' -> lookup ident' env'
-end
-
-module Env2: Env = struct
-  type env = identifier -> bound_value option
-  let empty = fun _ -> None
-  let push ident value env = fun ident' -> if ident = ident' then Some value else env ident'
-  let lookup ident' env = env ident'
-end
-
-open Env1
-
-exception Stuck of lambdaTerm
-
-let rec eval (term:lambdaTerm) (r:env) : value =
-  match term with
-    | IfThenElse(test, yes, no) -> (match eval test r with
-                                      | LiteralV(Bool true) -> eval yes r
-                                      | LiteralV(Bool false) -> eval no r
-                                      | LiteralV lit -> raise (Stuck (IfThenElse(Constant(LiteralC lit),yes,no))))
-    | Let(bound_var, arg, body) -> (match eval arg r with
-                                      | value -> eval body (push bound_var value r))
-    | App(head, arg) -> let headval = eval head r
-                        in let argval = eval arg r
-                        in (match (headval, argval) with
-                              | (LiteralV lit, _) -> raise (Stuck (App(Constant(LiteralC lit), arg)))
-                              | (_,_) -> failwith "not yet implemented")
-    | Var ident -> (match lookup ident r with
-                              | Some v -> v
-                              | None -> raise (Stuck term)) (* free variables are stuck *)
-    | Constant (LiteralC lit) -> LiteralV lit
-    | Constant (FunctC _) -> failwith "not yet implemented"
-    | Abstract (_,_) -> failwith "not yet implemented"
-
-let rec check_numbers (term:lambdaTerm) : unit =
-  match term with
-    | Constant(LiteralC(Num n)) when n < 0 -> failwith ("Bad Number: " ^ string_of_int n)
-    | Constant _ -> ()
-    | Var _ -> ()
-    | Abstract(_, body) -> check_numbers body
-    | App(head, arg) -> let () = check_numbers head
-                        in check_numbers arg
-    | Let(_, arg, body) -> let () = check_numbers arg
-                           in check_numbers body
-    | IfThenElse(test, yes, no) -> let () = check_numbers test
-                           in let () = check_numbers yes
-                           in check_numbers no
-
-let evaluate (term:lambdaTerm) : value =
-  (* scan to verify that term doesn't have any Const(Num (negative)) *)
-  let () = check_numbers term
-  (* evaluate starting with empty env *)
-  in eval term empty
-
-