diff --git a/src/Evaluation.hs b/src/Evaluation.hs index b5ca12f..6c7d717 100644 --- a/src/Evaluation.hs +++ b/src/Evaluation.hs @@ -8,11 +8,14 @@ subst v@(Variable vname) name content = if vname == name then content else v subst (Abstraction vname body) name content = Abstraction vname (subst body name content) subst (Application f arg) name content = Application (subst f name content) (subst arg name content) -bind :: Expr -> Expr -> Either String Expr -bind (Abstraction v b) arg = Left "Unimplemented" +bind :: Expr -> Expr -> Maybe Expr +bind (Abstraction v b) arg = Just $ subst b v arg +bind _ _ = Nothing beta :: Expr -> Maybe Expr -beta _ = Nothing +beta (Variable _) = Nothing +beta (Abstraction name body) = beta body +beta (Application f arg) = bind f arg run :: Expr -> Expr run _ = Variable "a" diff --git a/test/EvaluationSpec.hs b/test/EvaluationSpec.hs index f9c24fe..13283a0 100644 --- a/test/EvaluationSpec.hs +++ b/test/EvaluationSpec.hs @@ -1,6 +1,6 @@ module EvaluationSpec (spec) where -import Evaluation (subst) +import Evaluation (beta, subst) import Parser (Expr (Abstraction, Application, Variable)) import Test.Hspec @@ -12,8 +12,41 @@ spec = do it "can substitute matched variables" $ subst (Variable "x") "x" (Variable "z") `shouldBe` Variable "z" it "can substitute nested variables" $ - subst absWithZ "z" absI `shouldNotBe` absWithZMaker absI + subst absWithZ "z" absI `shouldBe` absWithZMaker absI + describe "beta reduction" $ do + -- Normal forms (no redex) + it "returns Nothing for a bare variable" $ + beta (Variable "x") `shouldBe` Nothing + it "returns Nothing for a bare abstraction" $ + beta absI `shouldBe` Nothing + it "returns Nothing when application has no lambda on left" $ + beta (Application (Variable "x") (Variable "y")) `shouldBe` Nothing + + -- Basic reductions + it "reduces identity: (λi. i) y → y" $ + beta (Application absI (Variable "y")) + `shouldBe` Just (Variable "y") + it "reduces constant function: (λx. z) y → z" $ + beta (Application (Abstraction "x" (Variable "z")) (Variable "y")) + `shouldBe` Just (Variable "z") + + -- Self-application + it "(λx. x x)(λi. i) → (λi. i)(λi. i)" $ + beta (Application selfApp absI) + `shouldBe` Just (Application absI absI) + it "(λi. i)(λi. i) → (λi. i)" $ + beta (Application absI absI) + `shouldBe` Just absI + + -- Redex not at top level + it "reduces redex in function position: ((λi. i) y) z → y z" $ + beta (Application (Application absI (Variable "y")) (Variable "z")) + `shouldBe` Just (Application (Variable "y") (Variable "z")) + it "reduces redex inside lambda body: λz. (λi. i) y → λz. y" $ + beta (Abstraction "z" (Application absI (Variable "y"))) + `shouldBe` Just (Abstraction "z" (Variable "y")) where absWithZMaker z = Abstraction "x" (Application z (Variable "x")) absWithZ = absWithZMaker (Variable "z") absI = Abstraction "i" (Variable "i") + selfApp = Abstraction "x" (Application (Variable "x") (Variable "x"))