X-Git-Url: http://lambda.jimpryor.net/git/gitweb.cgi?p=lambda.git;a=blobdiff_plain;f=code%2Fski_evaluator.hs;h=348b216f96e5bdbfaa081a797589cf6a366938cc;hp=26f1c0e640da32ae8df729f60b897e91d0303056;hb=061c0095bf19d1c00b53cd25d6b03a9b07ee2365;hpb=ff5b3f5a76fb744b332bc5d0fb3ef5632ce02879 diff --git a/code/ski_evaluator.hs b/code/ski_evaluator.hs index 26f1c0e6..348b216f 100644 --- a/code/ski_evaluator.hs +++ b/code/ski_evaluator.hs @@ -1,24 +1,24 @@ -data Term = I | S | K | App Term Term deriving (Eq, Show) - -skomega = (App (App (App S I) I) (App (App S I) I)) +data Term = I | S | K | App Term Term deriving (Eq, Show) + +skomega = (App (App (App S I) I) (App (App S I) I)) test = (App (App K I) skomega) - -reduce_one_step :: Term -> Term -reduce_one_step t = case t of - 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 - -is_redex :: Term -> Bool -is_redex t = not (t == reduce_one_step t) - -reduce :: Term -> Term -reduce t = case t of - I -> I - K -> K - S -> S - App a b -> - let t' = App (reduce a) (reduce b) in - if (is_redex t') then reduce (reduce_one_step t') - else t' + +reduce_if_redex :: Term -> Term +reduce_if_redex t = case t of + 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 + +is_redex :: Term -> Bool +is_redex t = not (t == reduce_if_redex t) + +reduce_try2 :: Term -> Term +reduce_try2 t = case t of + I -> I + K -> K + S -> S + App a b -> + let t' = App (reduce_try2 a) (reduce_try2 b) in + if (is_redex t') then reduce_try2 (reduce_if_redex t') + else t'