X-Git-Url: http://lambda.jimpryor.net/git/gitweb.cgi?p=lambda.git;a=blobdiff_plain;f=code%2Farith1.ml;h=2ff51f9abe423f5f8da056610fcccdc50307a093;hp=71f66cd466fb6bc5dad57a9ac6f629176904e64b;hb=356cd0ed65c71922aecc155ddab88896c4e0629d;hpb=9fa2ebb32617d76b9dde81b4d6adfada2f15d48d diff --git a/code/arith1.ml b/code/arith1.ml index 71f66cd4..2ff51f9a 100644 --- a/code/arith1.ml +++ b/code/arith1.ml @@ -2,38 +2,42 @@ 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 mid x = fun _ -> x (* K combinator *) +let map f xx = fun n -> f (xx n) (* function composition, that is the B combinator *) +let mapply ff xx = fun n -> (ff n) (xx n) (* S combinator *) +let map2 f xx yy = fun n -> f (xx n) (yy n) -let map2 f u v x = f (u x) (v x);; (* S *) - -let rec eval (t:tree) = match t with +let rec eval (t : tree) = match t with | Leaf _ -> t - | Branch (Leaf (Op f), b2) -> (match (eval b2) with + | Branch (Leaf (Op f), right) -> (match (eval right) with | Leaf (Num n) -> Leaf (Num (f n)) | _ -> Error) - | Branch (Leaf (Op2 f), b2) -> (match (eval b2) with + | Branch (Leaf (Op2 f), right) -> (match (eval right) with | Leaf (Num n) -> Leaf (Op (f n)) | _ -> Error) - | Branch (b1, b2) -> eval (Branch (eval b1, eval b2)) + | Branch (left, right) -> eval (Branch (eval left, eval right)) | _ -> Error -(* to get an arithmetic function, type, e.g., "(+)". - to get times instead of comment, type "( * )". *) +(* To use infix operators in ordinary prefix position, use (+). + Multiplication has to be handled a bit specially, because of how OCaml parses + its comment indicators. To use it in prefix position, make sure there is + space between it and the parentheses, like this: ( * ). +*) -(* Encoding of (+ 1 (* (/ 6 x) 4)) *) +(* Encoding of (+ 1 ( * (/ 6 n) 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 (fun n -> n)))))))), (Leaf (Num (mid 4))))));; -(* try +(* Now evaluate: -match eval t1 with Leaf (Num f) -> f 2;; + match eval t1 with Leaf (Num f) -> f 2;; The answer should be 13. *)