From ea3a08a8b2c201ffa9d23c21ef0df46c588706d7 Mon Sep 17 00:00:00 2001 From: tzlil Date: Sat, 15 Apr 2023 23:34:11 +0300 Subject: improve normalstep --- src/HW.hs | 17 ++++++++--------- 1 file changed, 8 insertions(+), 9 deletions(-) (limited to 'src/HW.hs') diff --git a/src/HW.hs b/src/HW.hs index a2678ca..6f4a8fc 100644 --- a/src/HW.hs +++ b/src/HW.hs @@ -34,20 +34,19 @@ subst n x (Lam y m) -- | Take a single step in normal order reduction or return Nothing normalstep :: Expr -> Maybe Expr + -- beta normalstep (App (Lam x m) n) = Just (subst n x m) + -- body -normalstep (Lam x m) = case normalstep m of - Just m' -> Just (Lam x m') - Nothing -> Nothing +normalstep (Lam x m) = normalstep m >>= return . Lam x + -- arg -normalstep (App m n) | normalstep m == Nothing = case normalstep n of - Just n' -> Just (App m n') - Nothing -> Nothing +normalstep (App m n) | normalstep m == Nothing = normalstep n >>= return . App m + -- func -normalstep (App m n) = case normalstep m of - Just m' -> Just (App m' n) - Nothing -> Nothing +normalstep (App m n) = normalstep m >>= return . (`App` n) + -- No further reductions normalstep _ = Nothing -- cgit 1.4.1