diff --git a/src/Language/Lambda/Eval.hs b/src/Language/Lambda/Eval.hs index 8400022488ca6b5dfd8f1cc613a796a9f3f32871..79d04eba302e303a7deaea2d3073357a63a75cbb 100644 --- a/src/Language/Lambda/Eval.hs +++ b/src/Language/Lambda/Eval.hs @@ -15,18 +15,23 @@ evalExpr :: (Eq n, Ord n) -> (LambdaExpr n, Map.Map n (LambdaExpr n)) evalExpr globals uniqs (Let name expr) = (Let name expr', Map.insert name expr' globals) - where expr' = evalExpr' uniqs (subGlobals globals expr) + where expr' = evalExpr' uniqs (subGlobals globals uniqs expr) evalExpr globals uniqs expr = (evalExpr' uniqs expr', globals) - where expr' = subGlobals globals expr + where expr' = subGlobals globals uniqs expr subGlobals :: (Eq n, Ord n) => Map.Map n (LambdaExpr n) -- ^ globals + -> [n] -- ^ unique supply -> LambdaExpr n -- ^ the expression -> LambdaExpr n -subGlobals g e@(Var x) = Map.findWithDefault e x g -subGlobals g (App e1 e2) = App (subGlobals g e1) (subGlobals g e2) -subGlobals g (Abs n expr) = Abs n (subGlobals g expr) -subGlobals _ expr = expr +subGlobals globals uniqs expr@(Var x) = Map.findWithDefault expr x globals +subGlobals globals uniqs (App e1 e2) = App (subGlobals globals uniqs e1) + (subGlobals globals uniqs e2) +subGlobals globals uniqs (Abs n expr) = Abs n expr' + where expr' | Map.member n globals = expr + | otherwise = subGlobals globals uniqs expr + fvs = freeVarsOf expr +subGlobals _ _ expr = expr -- | Evaluate an expression; does not support `let` evalExpr' :: Eq n diff --git a/test/Language/Lambda/EvalSpec.hs b/test/Language/Lambda/EvalSpec.hs index 21afaf92690a8a77dfdeae1656cfa08f7f9452fb..ef2275d21daf4b81dc9bbf92c02596beb94ef5b0 100644 --- a/test/Language/Lambda/EvalSpec.hs +++ b/test/Language/Lambda/EvalSpec.hs @@ -1,6 +1,6 @@ module Language.Lambda.EvalSpec where -import Data.Map (empty, insert) +import Data.Map (fromList, empty, insert) import Test.Hspec import Language.Lambda @@ -46,6 +46,21 @@ spec = do fst (evalExpr globals uniques expr) `shouldBe` Var "x" + describe "subGlobals" $ do + let globals = fromList [("w", Var "x")] + subGlobals' = subGlobals globals ["a"] + + it "subs simple variables" $ + subGlobals' (Var "w") `shouldBe` Var "x" + + it "does not sub shadowed bindings" $ do + let expr = Abs "w" (Var "w") + subGlobals' expr `shouldBe` expr + + xit "does not capture globals" $ do + let expr = Abs "x" (Var "w") + subGlobals' expr `shouldBe` Abs "a" (Var "x") + describe "betaReduce" $ do let betaReduce' = betaReduce []