code/arith1.ml

   1 type num = int -> int
   2 type contents = Num of num   | Op of (num -> num) | Op2 of (num -> num -> num)
   3 type tree = Leaf of contents | Branch of tree * tree | Error
   4
   5 let mid a = fun _ -> a;;  (* K *)
   6
   7 let map2 f u v x = f (u x) (v x);;  (* S *)
   8
   9 let rec eval (t:tree) = match t with
  10   | Leaf _ -> t
  11   | Branch (Leaf (Op f), b2) -> (match (eval b2) with
  12                                 | Leaf (Num n) -> Leaf (Num (f n))
  13                                 | _ -> Error)
  14   | Branch (Leaf (Op2 f), b2) -> (match (eval b2) with
  15                                  | Leaf (Num n) -> Leaf (Op (f n))
  16                                  | _ -> Error)
  17   | Branch (b1, b2) -> eval (Branch (eval b1, eval b2))
  18   | _ -> Error
  19
  20
  21 (* to get an arithmetic function, type, e.g., "(+)".
  22    to get times instead of comment, type "( * )". *)
  23
  24 (* Encoding of (+ 1 (* (/ 6 x) 4))  *)
  25 let t1 = Branch ((Branch ((Leaf (Op2 (map2 (+)))),
  26                           (Leaf (Num (mid 1))))),
  27                  (Branch ((Branch ((Leaf (Op2 (map2 ( * ))),
  28                                    (Branch ((Branch ((Leaf (Op2 (map2 (/)))),
  29                                                      (Leaf (Num (mid 6))))),
  30                                             (Leaf (Num (fun x -> x)))))))),
  31                           (Leaf (Num (mid 4))))));;
  32
  33
  34 (* try
  35
  36 match eval t1 with Leaf (Num f) -> f 2;;
  37
  38 The answer should be 13.
  39 *)