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 x = fun _ -> x  (* K combinator *)
   6 let map f xx = fun n -> f (xx n)  (* function composition, that is the B combinator *)
   7 let mapply ff xx = fun n -> (ff n) (xx n)  (* S combinator *)
   8 let map2 f xx yy = fun n -> f (xx n) (yy n)
   9
  10 let rec eval (t : tree) = match t with
  11   | Leaf _ -> t
  12   | Branch (Leaf (Op f), right) -> (match (eval right) with
  13                                 | Leaf (Num n) -> Leaf (Num (f n))
  14                                 | _ -> Error)
  15   | Branch (Leaf (Op2 f), right) -> (match (eval right) with
  16                                  | Leaf (Num n) -> Leaf (Op (f n))
  17                                  | _ -> Error)
  18   | Branch (left, right) -> eval (Branch (eval left, eval right))
  19   | _ -> Error
  20
  21
  22 (* To use infix operators in ordinary prefix position, use (+).
  23    Multiplication has to be handled a bit specially, because of how OCaml parses
  24    its comment indicators. To use it in prefix position, make sure there is
  25    space between it and the parentheses, like this: ( * ).
  26 *)
  27
  28 (* Encoding of \n. (+ 1 ( * (/ 6 n) 4))  *)
  29 let t1 = Branch ((Branch ((Leaf (Op2 (map2 (+)))),
  30                           (Leaf (Num (mid 1))))),
  31                  (Branch ((Branch ((Leaf (Op2 (map2 ( * ))),
  32                                    (Branch ((Branch ((Leaf (Op2 (map2 (/)))),
  33                                                      (Leaf (Num (mid 6))))),
  34                                             (Leaf (Num (fun n -> n)))))))),
  35                           (Leaf (Num (mid 4))))));;
  36
  37
  38 (* Now evaluate:
  39
  40     match eval t1 with Leaf (Num f) -> f 2;;
  41
  42 The answer should be 13.
  43 *)