X-Git-Url: http://lambda.jimpryor.net/git/gitweb.cgi?p=lambda.git;a=blobdiff_plain;f=code%2Fski_evaluator.hs;h=348b216f96e5bdbfaa081a797589cf6a366938cc;hp=845d6dad8bd17ac613d13b2b30b50bce8ecc81a6;hb=29f30e097b5d2b178a0e0104c41ff53f724e1239;hpb=c802743d4972249bbeb4648717784250bc5b1360;ds=sidebyside diff --git a/code/ski_evaluator.hs b/code/ski_evaluator.hs index 845d6dad..348b216f 100644 --- a/code/ski_evaluator.hs +++ b/code/ski_evaluator.hs @@ -1,24 +1,24 @@ -data Term = I | S | K | FA Term Term deriving (Eq, Show) - -skomega = (FA (FA (FA S I) I) (FA (FA S I) I)) -test = (FA (FA K I) skomega) - -reduce_one_step :: Term -> Term -reduce_one_step t = case t of - 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 - -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 - FA a b -> - let t' = FA (reduce a) (reduce b) in - if (is_redex t') then reduce (reduce_one_step t') - else t' +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_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'