experiment/lambda
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

this is Wrong

Browse source
This commit is contained in:
Michael Zhang 2018-02-20 14:46:39 -06:00
parent ed836f6790
commit b25a764943
No known key found for this signature in database
GPG key ID: A1B65B603268116B
1 changed files with 31 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

41
lambda.ml
View file

@ -7,10 +7,17 @@ exception UnboundVariable of string
exception EvaluationComplete exception EvaluationComplete
(* (*
((\a.(\b.((a a) b))) (\a.(\b.a))) (\a.(\b.a)) ((\a.(\b.((a a) b))) (\a.(\b.a))) (\a.(\b.a)) = (\a.(\b.a))
((\a.(\b.((a b) a))) (\a.(\b.a))) (\a.(\b.b)) ((\a.(\b.((a b) a))) (\a.(\b.a))) (\a.(\b.b)) = (\a.(\b.b))
(\n.\f.\x.f ((n f) x)) (\f.\x.x)
*) *)
let debug = true
let print_debug str =
if debug then print_endline str else ()
let rec string_of_term (t: Types.term) = let rec string_of_term (t: Types.term) =
match t with match t with
| TmAbs(x, t1) -> | TmAbs(x, t1) ->
@ -49,14 +56,26 @@ let rec subst name tm repl =
let rec try_subst name tm repl = let rec try_subst name tm repl =
match tm with match tm with
| TmVar(x) -> if x = name then (true, repl) else (false, TmVar(x)) | TmVar(x) ->
| TmAbs(n, t) -> if n = name then (false, TmAbs(n, t)) else (let (s, t') = try_subst name t repl in (s, TmAbs(n, t'))) if x = name then
| TmApp(a, b) -> (let ((sa, a'), (sb, b')) = (try_subst name a repl, try_subst name b repl) in (sa || sb, TmApp(a', b'))) (true, repl)
else
(false, TmVar(x))
| TmAbs(n, t) ->
if n = name then
let (s, t') = try_subst n t (TmVar n) in
(false, TmAbs(n, t'))
else
let (s, t') = try_subst name t repl in
(s, TmAbs(n, t'))
| TmApp(a, b) ->
let ((sa, a'), (sb, b')) = (try_subst name a repl, try_subst name b repl) in
(sa || sb, TmApp(a', b'))
let rec eval (ctx, t) = let rec eval (ctx, t) =
let rec helper (ctx, t) d = let rec helper (ctx, t) d =
(*print_endline ((String.init (d * 2) (fun _ -> ' ')) ^ "helper" ^ (string_of_term t)); print_debug ((String.init (d * 2) (fun _ -> ' ')) ^ "helper" ^ (string_of_term t));
print_endline (string_of_ctx ctx);*) print_debug (string_of_ctx ctx);
match t with match t with
| TmApp(TmApp(_, _) as a, b) -> | TmApp(TmApp(_, _) as a, b) ->
let (_, a') = helper (ctx, a) (d + 1) in let (_, a') = helper (ctx, a) (d + 1) in
@ -65,7 +84,7 @@ let rec eval (ctx, t) =
(* let ctx' = assign ctx (n, r) in (* let ctx' = assign ctx (n, r) in
helper (ctx', t) (d + 1) *) helper (ctx', t) (d + 1) *)
let (s, t') = try_subst n t r in let (s, t') = try_subst n t r in
(*print_endline ("try_subst('" ^ n ^ "', " ^ (string_of_term t) ^ ", " ^ (string_of_term r) ^ ") = " ^ (if s then "true" else "false"));*) print_debug ("try_subst('" ^ n ^ "', " ^ (string_of_term t) ^ ", " ^ (string_of_term r) ^ ") = " ^ (if s then "true" else "false"));
if s then helper (ctx, t') (d + 1) else (ctx, t') if s then helper (ctx, t') (d + 1) else (ctx, t')
| TmApp(TmVar(n), b) -> | TmApp(TmVar(n), b) ->
let (_, a) = helper (ctx, lookup ctx n) (d + 1) in let (_, a) = helper (ctx, lookup ctx n) (d + 1) in
@ -75,7 +94,7 @@ let rec eval (ctx, t) =
| TmAbs(n, _) as t -> | TmAbs(n, _) as t ->
let r = TmVar(n) in let r = TmVar(n) in
let (s, t') = try_subst n t r in let (s, t') = try_subst n t r in
(*print_endline ("try_subst('" ^ n ^ "', " ^ (string_of_term t) ^ ", " ^ (string_of_term r) ^ ") = " ^ (if s then "true" else "false"));*) print_debug ("try_subst('" ^ n ^ "', " ^ (string_of_term t) ^ ", " ^ (string_of_term r) ^ ") = " ^ (if s then "true" else "false"));
if s then helper (ctx, t') (d + 1) else (ctx, t') if s then helper (ctx, t') (d + 1) else (ctx, t')
in try in try
let (ctx', t') = helper (ctx, t) 0 in let (ctx', t') = helper (ctx, t) 0 in
@ -83,7 +102,9 @@ let rec eval (ctx, t) =
eval (ctx', t') eval (ctx', t')
with with
| UnboundVariable v -> raise (Failure ("unbound variable '" ^ v ^ "'")) | UnboundVariable v -> raise (Failure ("unbound variable '" ^ v ^ "'"))
| EvaluationComplete -> (ctx, t) | EvaluationComplete ->
print_debug "evaluation complete";
(ctx, t)
let _ = let _ =
let rec loop ctx = let rec loop ctx =