funclang series5: Finished nameslash solution and added eval function for ass13.

funclang-taddeus/series5/ass12.ml

@@ -44,7 +44,7 @@ let rec expr2string =
     | Cond (cond, e1, e2) -> "if " ^ expr2string(cond)
                              ^ " then " ^ expr2string(e1)
                              ^ " else " ^ expr2string(e2)
-    | Fun (arg, e) -> "func " ^ arg ^ " -> " ^ expr2string(e)
+    | Fun (arg, e) -> "fun " ^ arg ^ " -> " ^ expr2string(e)
     | FunAp (e1, e2) -> "(" ^ expr2string(e1) ^ " " ^ expr2string(e2) ^ ")"
     | Let (var, e1, e2) -> "let " ^ var ^ " = " ^ expr2string(e1)
                            ^ " in " ^ expr2string(e2)
@@ -71,33 +71,27 @@ let freevars e =
     in
     free_vars [] e
 
-let cnt = ref 0
-let getNewId id = (cnt := !cnt + 1; "_" ^ id ^ "_" ^ string_of_int (! cnt))
-
 (* Substitue all occurences of y by a in exp *)
-let rec subs exp y a =
-    match exp with
-    | Var x when x = y -> a
-    | Num _ | Bool _ | Var _ -> exp
+let rec subs exp y a = match exp with
+      Var x when x = y -> a
     | MonopAp (op, e) -> MonopAp (op, subs e y a)
     | BinopAp (op, e1, e2) -> BinopAp (op, subs e1 y a, subs e2 y a)
-    | Fun (arg, _) when arg = y -> exp
+    | Fun (x, _) when x = y -> exp
     | Fun (x, e) ->
         let free_a = freevars a in
-        if List.mem x free_a then
-            (* Replace x with a new variable w to avoid free variable
-             * corruption in a *)
-            (*let all_free_vars = free_a @ (freevars e) in
-            let rec copy_x =
-                let new_x = getNewId x in
-                if List.mem new_x all_free_vars then copy_x else new_x
-            in*)
-            let w = getNewId x in
+        let free_e = freevars e in
+        if List.mem y free_e && List.mem x free_a then
+            (* Replace x with a new variable w to avoid name clash *)
+            let all_free_vars = free_a @ free_e in
+            let rec add_prime x =
+                let new_x = x ^ "'" in
+                if List.mem new_x all_free_vars then add_prime x else new_x
+            in
+            let w = add_prime x in
             Fun (w, subs (subs e x (Var w)) y a)
         else
             Fun (x, subs e y a)
     | FunAp (e1, e2) -> FunAp (subs e1 y a, subs e2 y a)
     | Cond (cond, e1, e2) ->  Cond (subs cond y a, subs e1 y a, subs e2 y a)
-    | Let (x, e1, e2) when x = y -> Let (x, e1, e2)
-    | Let (x, e1, e2) -> Let (x, e1, e2)
-    | LetRec (x, e1, e2) -> LetRec (x, e1, e2)
+    | Let (x, e1, e2) when x != y -> Let (x, subs e1 y a, subs e2 y a)
+    | _ -> exp

funclang-taddeus/series5/ass13.ml

+#use "ass12.ml"
+
+(* Perform all possible beta-reductions on an expression until the normal form
+ * has been reached *)
+let rec eval exp = match exp with
+      MonopAp (op, e) -> MonopAp (op, eval e)
+    | BinopAp (op, e1, e2) -> BinopAp (op, eval e1, eval e2)
+    | Fun (x, e) -> Fun (x, eval e)
+    | FunAp (Fun (x, Var y), a) when y = x -> eval a (* identity function *)
+    | FunAp (Fun (y, e), a) -> (* prevent recursion *)
+        let result = (subs e y a) in
+        if result = exp then result else eval result
+    | FunAp (e1, e2) -> (* prevent recursion *)
+        let result = FunAp (eval e1, eval e2) in
+        if result = exp then result else eval result
+    | Cond (cond, e1, e2) -> Cond (eval cond, eval e1, eval e2)
+    | Let (x, e1, e2) -> eval (subs e2 x e1)
+    | LetRec (x, e1, e2) -> LetRec (x, eval e1, eval e2)
+    | _ -> exp

funclang-taddeus/series5/test_ass12.ml → funclang-taddeus/series5/test.ml

 #use "ass12.ml";;
+#use "ass13.ml";;
 
 (* let a = 1 in b *)
 print_endline (expr2string (Let ("a", (Num 1), (Var "b"))));;
@@ -62,5 +63,19 @@ show_freevars ass1a;;
 (* [a, b, c] *)
 show_freevars ass1b;;
 
+let show_eval e =
+    print_endline ("\nEvaluation of:\n" ^ (expr2string e)
+                   ^ "\nis:\n" ^ (expr2string (eval e)))
+;;
+
 (* fun u -> fun w -> fun a -> a *)
-print_endline (expr2string (subs ass1b));;
+show_eval ass1a;;
+
+(* (a (b c)) *)
+show_eval ass1b;;
+
+(* fun y' -> fun z -> ((y y') z) *)
+let x = Var "x" in
+let y = Var "y" in
+let z = Var "z" in
+show_eval (app (l "x" (l "y" (l "z" (app (app x y) z)))) y);;