funclang series5: Added test file for ass12.

funclang-taddeus/series5/ass12.ml

@@ -13,6 +13,7 @@ type expr = Num of int                      (* integer constant *)
           | Let of string * expr * expr     (* variable binding *)
           | LetRec of string * expr * expr  (* recursive variable binding *)
 
+(* Convert a given expression to a string representation *)
 let rec expr2string =
     let monop2string = function
           Neg -> "-"
@@ -50,6 +51,7 @@ let rec expr2string =
     | LetRec (var, e1, e2) -> "let rec " ^ var ^ " = " ^ expr2string(e1)
                               ^ " in " ^ expr2string(e2)
 
+(* Find all free variables within an expression *)
 let freevars e =
     let rec free_vars bound_vars = function
           Num _ | Bool _ -> []
@@ -69,9 +71,33 @@ let freevars e =
     in
     free_vars [] e
 
-(*let rec subs e var replacement =
-    let free = freevars e in
-    match e with
-    | Num _ | Bool _ -> e
-    | Var v when List.mem v bound_vars -> []
-    | Var v -> [v]*)
+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
+    | 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, 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
+            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)

funclang-taddeus/series5/test_ass12.ml

@@ -20,27 +20,32 @@ let show_freevars e =
 ;;
 
 (* Write the expressions of assignment series 1 in our data types *)
-let u = Var "u" in
-let c = Var "c" in
-let bcc = l "b" (l "c" c) in
-let a = Var "a" in
-let aaa = l "a" (app a a) in
-let aaa_aaa = app aaa aaa in
-let v = Var "v" in
-let uvw = l "u" (app (l "v" (l "w" v)) (l "a" a)) in
-let 1a = (app (app bcc aaa_aaa) uvw);;
-
-let v = Var "v" in
-let w = Var "w" in
-let uvw = l "u" (l "v" (l "w" (app (app u v) w))) in
-let x = Var "x" in
-let y = Var "y" in
-let z = Var "z" in
-let xyz = l "x" (l "y" (l "z" (app x (app y z)))) in
-let a = Var "a" in
-let b = Var "b" in
-let c = Var "c" in
-let 1b = (app (app (app (app uvw xyz) a) b) c);;
+let l arg body = Fun (arg, body);;
+let app func arg = FunAp (func, arg);;
+
+let ass1a =
+    let c = Var "c" in
+    let bcc = l "b" (l "c" c) in
+    let a = Var "a" in
+    let aaa = l "a" (app a a) in
+    let aaa_aaa = app aaa aaa in
+    let v = Var "v" in
+    let uvw = l "u" (app (l "v" (l "w" v)) (l "a" a)) in
+    (app (app bcc aaa_aaa) uvw);;
+
+let ass1b =
+    let u = Var "u" in
+    let v = Var "v" in
+    let w = Var "w" in
+    let uvw = l "u" (l "v" (l "w" (app (app u v) w))) in
+    let x = Var "x" in
+    let y = Var "y" in
+    let z = Var "z" in
+    let xyz = l "x" (l "y" (l "z" (app x (app y z)))) in
+    let a = Var "a" in
+    let b = Var "b" in
+    let c = Var "c" in
+    (app (app (app (app uvw xyz) a) b) c);;
 
 (* [a] *)
 show_freevars (Fun ("b", (BinopAp (Add, Var "a", Num 3))));;
@@ -52,10 +57,10 @@ let l arg body = Fun (arg, body);;
 let app f e = FunAp (f, e);;
 
 (* [] *)
-show_freevars 1a;;
+show_freevars ass1a;;
 
 (* [a, b, c] *)
-show_freevars 1b;;
+show_freevars ass1b;;
 
 (* fun u -> fun w -> fun a -> a *)
-(*print_endline (expr2string (subs 1b));;*)
+print_endline (expr2string (subs ass1b));;