X-Git-Url: http://lambda.jimpryor.net/git/gitweb.cgi?p=lambda.git;a=blobdiff_plain;f=code%2Fski_evaluator.ml;h=f0b4d1669e045bc2c7fee82ef0503ccc9e532be2;hp=5e23ff9af0eb0d1f86271e13d31ef32e59801ae2;hb=e1626ef4172d63a6bd74cbd8ab0fe56bb8ef8775;hpb=4aea3a471f66d67fccff34189186f8cdb561dd68 diff --git a/code/ski_evaluator.ml b/code/ski_evaluator.ml index 5e23ff9a..f0b4d166 100644 --- a/code/ski_evaluator.ml +++ b/code/ski_evaluator.ml @@ -1,30 +1,32 @@ -type term = I | S | K | FA of (term * term) - -let skomega = FA (FA (FA (S,I), I), FA (FA (S,I), I)) -let test = FA (FA (K,I), skomega) - -let reduce_one_step (t:term):term = match t with - FA(I,a) -> a - | FA(FA(K,a),b) -> a - | FA(FA(FA(S,a),b),c) -> FA(FA(a,c),FA(b,c)) - | _ -> t - -let is_redex (t:term):bool = not (t = reduce_one_step t) - -let rec reduce (t:term):term = match t with - I -> I - | K -> K - | S -> S - | FA (a, b) -> - let t' = FA (reduce a, reduce b) in - if (is_redex t') then reduce (reduce_one_step t') - else t' +type term = I | S | K | App of (term * term) -let rec reduce_lazy (t:term):term = match t with - I -> I - | K -> K - | S -> S - | FA (a, b) -> - let t' = FA (reduce_lazy a, b) in - if (is_redex t') then reduce_lazy (reduce_one_step t') - else t' +let skomega = App (App (App (S,I), I), App (App (S,I), I)) +let test = App (App (K,I), skomega) + +let reduce_if_redex (t:term):term = match t with + | App(I,a) -> a + | App(App(K,a),b) -> a + | App(App(App(S,a),b),c) -> App(App(a,c),App(b,c)) + | _ -> t + +let is_redex (t:term):bool = not (t = reduce_if_redex t) + +let rec reduce_try2 (t:term):term = match t with + | I -> I + | K -> K + | S -> S + | App (a, b) -> + let t' = App (reduce_try2 a, reduce_try2 b) in + if (is_redex t') then let t'' = reduce_if_redex t' + in reduce_try2 t'' + else t' + +let rec reduce_lazy (t:term):term = match t with + | I -> I + | K -> K + | S -> S + | App (a, b) -> + let t' = App (reduce_lazy a, b) in + if (is_redex t') then let t'' = reduce_if_redex t' + in reduce_lazy t'' + else t'