Commit cc0bfa94 authored by Taddeus Kroes's avatar Taddeus Kroes

funclang series5: Added documentation.

parent 65606dde
...@@ -12,6 +12,7 @@ let balance_node node = match node with ...@@ -12,6 +12,7 @@ let balance_node node = match node with
| Node (a, b, c, d) -> node | Node (a, b, c, d) -> node
| Leaf -> raise (Failure "Cannot balance a leaf") | Leaf -> raise (Failure "Cannot balance a leaf")
(* Insert a new value it a tree *)
(* 'a rbtree -> 'a -> 'a rbtree *) (* 'a rbtree -> 'a -> 'a rbtree *)
let insert tree value = let insert tree value =
let rec insert_in_tree = function let rec insert_in_tree = function
...@@ -33,6 +34,7 @@ let insert tree value = ...@@ -33,6 +34,7 @@ let insert tree value =
Node (v, _, left, right) -> Node (v, Black, left, right) Node (v, _, left, right) -> Node (v, Black, left, right)
| Leaf -> raise (Failure "Error during insertion") | Leaf -> raise (Failure "Error during insertion")
(* Check if a value exists in a tree *)
(* 'a -> 'a rbtree -> bool *) (* 'a -> 'a rbtree -> bool *)
let rec lookup value = function let rec lookup value = function
Leaf -> false Leaf -> false
......
...@@ -13,7 +13,8 @@ type expr = Num of int (* integer constant *) ...@@ -13,7 +13,8 @@ type expr = Num of int (* integer constant *)
| Let of string * expr * expr (* variable binding *) | Let of string * expr * expr (* variable binding *)
| LetRec of string * expr * expr (* recursive variable binding *) | LetRec of string * expr * expr (* recursive variable binding *)
(* Convert a given expression to a string representation *) (* Convert a given expression to a string representation. I think the code is
* self-explanatory and therefore needs no more documentation *)
let rec expr2string = let rec expr2string =
let monop2string = function let monop2string = function
Neg -> "-" Neg -> "-"
...@@ -46,7 +47,10 @@ let rec expr2string = ...@@ -46,7 +47,10 @@ let rec expr2string =
^ " else " ^ expr2string(e2) ^ " else " ^ expr2string(e2)
| Fun (arg, e) -> "fun " ^ arg ^ " -> " ^ expr2string(e) | Fun (arg, e) -> "fun " ^ arg ^ " -> " ^ expr2string(e)
| FunAp (e1, e2) -> | FunAp (e1, e2) ->
(* Add parenthesis around argument when needed *) (* Add parenthesis around argument when it contains spaces. I'm not
* sure if this is required in this implementation, but I found that is
* is tidy when trying to represent OCaml syntax (see the 'fac'
* function in 'test_expr.ml') *)
let eval_e2 = expr2string(e2) in let eval_e2 = expr2string(e2) in
let eval_e2 = (if (String.get eval_e2 0) != '(' let eval_e2 = (if (String.get eval_e2 0) != '('
&& String.contains eval_e2 ' ' && String.contains eval_e2 ' '
...@@ -57,18 +61,22 @@ let rec expr2string = ...@@ -57,18 +61,22 @@ let rec expr2string =
| LetRec (var, e1, e2) -> "let rec " ^ var ^ " = " ^ expr2string(e1) | LetRec (var, e1, e2) -> "let rec " ^ var ^ " = " ^ expr2string(e1)
^ " in " ^ expr2string(e2) ^ " in " ^ expr2string(e2)
(* Find all free variables within an expression *) (* Find all free variables within an expression. Where no rules apply,
* concatenat the free variables of all sub-expressions *)
let freevars e = let freevars e =
let rec free_vars bound_vars = function let rec free_vars bound_vars = function
Num _ | Bool _ -> [] Num _ | Bool _ -> []
| Var v when List.mem v bound_vars -> [] | Var v when List.mem v bound_vars -> []
(* FV(x) = {x} *)
| Var v -> [v] | Var v -> [v]
| MonopAp (_, e) -> free_vars bound_vars e | MonopAp (_, e) -> free_vars bound_vars e
| BinopAp (_, e1, e2) | BinopAp (_, e1, e2)
(* FV((e1 e2)) = FV(e1) UNION FV(e2) *)
| FunAp (e1, e2) -> free_vars bound_vars e1 @ free_vars bound_vars e2 | FunAp (e1, e2) -> free_vars bound_vars e1 @ free_vars bound_vars e2
| Cond (cond, e1, e2) -> free_vars bound_vars cond | Cond (cond, e1, e2) -> free_vars bound_vars cond
@ free_vars bound_vars e1 @ free_vars bound_vars e1
@ free_vars bound_vars e2 @ free_vars bound_vars e2
(* FV(lamda x.e) = FV(e) \ {x} *)
| Fun (arg, e) -> free_vars (arg::bound_vars) e | Fun (arg, e) -> free_vars (arg::bound_vars) e
| Let (v, e1, e2) -> free_vars (v::bound_vars) e2 | Let (v, e1, e2) -> free_vars (v::bound_vars) e2
@ free_vars bound_vars e1 @ free_vars bound_vars e1
...@@ -77,18 +85,33 @@ let freevars e = ...@@ -77,18 +85,33 @@ let freevars e =
in in
free_vars [] e free_vars [] e
(* Substitue all occurences of y by a in exp *) (* Substitue all occurences of y by a in exp using the substitution rules
* provided in the lecture.
* NOTE: I have decided to resolve name clashes here instead of in the eval
* function of assignment 13. The reason for this is that both in the lecture
* and in lambda calculus wiki's on the internet, name clashes are resolved by
* applying the substution rule that I've implemented in lines 112-120 below.
* This function is called 'subs', so it should implement this substitution
* rule *)
let rec subs exp y a = match exp with let rec subs exp y a = match exp with
Var x when x = y -> a Var x when x = y -> a
(* substitute in operator arguments *)
| MonopAp (op, e) -> MonopAp (op, subs e 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) | BinopAp (op, e1, e2) -> BinopAp (op, subs e1 y a, subs e2 y a)
(* (lambda y.e)[a/x] --> lambda y.e
* if y = x *)
| Fun (x, _) when x = y -> exp | Fun (x, _) when x = y -> exp
(* (lambda y.e)[a/x] --> lambda w.(e[w/y][a/x])
* if y != x, x free in e, y free in a, new variable w
* lambda y.(e[a/x])
* otherwise *)
| Fun (x, e) -> | Fun (x, e) ->
let free_a = freevars a in let free_a = freevars a in
let free_e = freevars e in let free_e = freevars e in
if List.mem y free_e && List.mem x free_a then if List.mem y free_e && List.mem x free_a then
(* Replace x with a new variable w to avoid name clash *) (* Replace x with a new variable w to avoid a name clash *)
let all_free_vars = free_a @ free_e in let all_free_vars = free_a @ free_e in
(* Add primes to the new variable until it is free *)
let rec add_prime x = let rec add_prime x =
let new_x = x ^ "'" in let new_x = x ^ "'" in
if List.mem new_x all_free_vars then add_prime x else new_x if List.mem new_x all_free_vars then add_prime x else new_x
...@@ -97,7 +120,14 @@ let rec subs exp y a = match exp with ...@@ -97,7 +120,14 @@ let rec subs exp y a = match exp with
Fun (w, subs (subs e x (Var w)) y a) Fun (w, subs (subs e x (Var w)) y a)
else else
Fun (x, subs e y a) Fun (x, subs e y a)
(* (e e')[a/x] --> (e[a/x])(e'[a/x]) *)
| FunAp (e1, e2) -> FunAp (subs e1 y a, subs e2 y a) | FunAp (e1, e2) -> FunAp (subs e1 y a, subs e2 y a)
(* Conditional expression has no substirution rules, just substitute in all
* sub-expressions recursively *)
| Cond (cond, e1, e2) -> Cond (subs cond y a, 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)
(* Only substitue in a 'let'/'let rec' expression if there is no name clash
* with the assigned variable *)
| Let (x, e1, e2) when x != y -> Let (x, subs e1 y a, subs e2 y a) | Let (x, e1, e2) when x != y -> Let (x, subs e1 y a, subs e2 y a)
| LetRec (x, e1, e2) when x != y -> LetRec (x, subs e1 y a, subs e2 y a)
(* No substitition rule applies, just return the expression *)
| _ -> exp | _ -> exp
...@@ -30,17 +30,25 @@ let rec eval exp = ...@@ -30,17 +30,25 @@ let rec eval exp =
And -> Bool (a && b) And -> Bool (a && b)
| Or -> Bool (a || b) | Or -> Bool (a || b)
| _ -> raise (Failure "Unknown locical operator")) | _ -> raise (Failure "Unknown locical operator"))
(* No operation is possible on a variable and a number/boolean *)
| (op, e1, e2) -> BinopAp (op, eval e1, eval e2) | (op, e1, e2) -> BinopAp (op, eval e1, eval e2)
in in
match exp with match exp with
MonopAp (op, e) -> eval_monop (op, eval e) MonopAp (op, e) -> eval_monop (op, eval e)
| BinopAp (op, e1, e2) -> eval_binop (op, e1, e2) | BinopAp (op, e1, e2) -> eval_binop (op, e1, e2)
| Fun (x, e) -> Fun (x, eval e) | Fun (x, e) -> Fun (x, eval e)
| FunAp (Fun (x, Var y), a) when y = x -> eval a (* identity function *) | FunAp (Fun (x, Var y), a) when y = x ->
| FunAp (Fun (y, e), a) -> (* prevent recursion *) (* Applied identity function, evaluates to application argument *)
eval a
| FunAp (Fun (y, e), a) ->
(* Function application, substitute function argument with
* application argument in function body. Prevent recursion by
* comparing the result with the original expression *)
let result = (subs e y a) in let result = (subs e y a) in
if result = exp then result else eval result if result = exp then result else eval result
| FunAp (e1, e2) -> (* prevent recursion *) | FunAp (e1, e2) ->
(* Expression application, evaluate both sides. Prevent recursion by
* comparing the result with the original expression *)
let result = FunAp (eval e1, eval e2) in let result = FunAp (eval e1, eval e2) in
if result = exp then result else eval result if result = exp then result else eval result
| Cond (cond, e1, e2) -> | Cond (cond, e1, e2) ->
......
...@@ -15,13 +15,13 @@ let a = insert a 22 ...@@ -15,13 +15,13 @@ let a = insert a 22
let a = insert a 27;; let a = insert a 27;;
(* Lookup some values that are in the tree *) (* Lookup some values that are in the tree *)
assert (lookup 13 a);; assert (lookup 13 a);
assert (lookup 1 a);; assert (lookup 1 a);
assert (lookup 6 a);; assert (lookup 6 a);
assert (lookup 27 a);; assert (lookup 27 a);
(* Lookup some values that are not in the tree *) (* Lookup some values that are not in the tree *)
assert (not (lookup 2 a));; assert (not (lookup 2 a));
assert (not (lookup 64 a));; assert (not (lookup 64 a));
assert (not (lookup 48 a));; assert (not (lookup 48 a));
assert (not (lookup 12 a));; assert (not (lookup 12 a));;
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment