arith1.ml

[lambda.git] / code / arith1.ml

diff --git a/code/arith1.ml b/code/arith1.ml
new file mode 100644 (file)
index 0000000..71f66cd
--- /dev/null
+++ b/code/arith1.ml
@@ -0,0 +1,39 @@
+type num = int -> int
+type contents = Num of num   | Op of (num -> num) | Op2 of (num -> num -> num)
+type tree = Leaf of contents | Branch of tree * tree | Error
+
+let mid a = fun _ -> a;;  (* K *)
+
+let map2 f u v x = f (u x) (v x);;  (* S *)
+
+let rec eval (t:tree) = match t with
+  | Leaf _ -> t
+  | Branch (Leaf (Op f), b2) -> (match (eval b2) with
+                                | Leaf (Num n) -> Leaf (Num (f n))
+                                | _ -> Error)
+  | Branch (Leaf (Op2 f), b2) -> (match (eval b2) with
+                                 | Leaf (Num n) -> Leaf (Op (f n))
+                                 | _ -> Error)
+  | Branch (b1, b2) -> eval (Branch (eval b1, eval b2))
+  | _ -> Error
+
+
+(* to get an arithmetic function, type, e.g., "(+)".
+   to get times instead of comment, type "( * )". *)
+
+(* Encoding of (+ 1 (* (/ 6 x) 4))  *)
+let t1 = Branch ((Branch ((Leaf (Op2 (map2 (+)))),
+                          (Leaf (Num (mid 1))))),
+                 (Branch ((Branch ((Leaf (Op2 (map2 ( * ))),
+                                   (Branch ((Branch ((Leaf (Op2 (map2 (/)))),
+                                                     (Leaf (Num (mid 6))))),
+                                            (Leaf (Num (fun x -> x)))))))),
+                          (Leaf (Num (mid 4))))));;
+
+
+(* try
+
+match eval t1 with Leaf (Num f) -> f 2;;
+
+The answer should be 13.
+*)