wip beta reduction

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 :: Expr -> Expr -> Maybe Expr
-bind (Abstraction v b) arg = Left "Unimplemented"
+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"

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"))