Fakultas Ilmu Komputer UI

Commit c8ab7d2d authored by Sean Gillespie's avatar Sean Gillespie
Browse files

Add let support in Lambda evaluator

parent 0e5d2f7d
......@@ -25,8 +25,7 @@ type Globals = Map.Map String (LambdaExpr String)
evalString :: Globals
-> String
-> Either ParseError (LambdaExpr String, Globals)
evalString globals str = flip (,) globals <$> eval'
where eval' = evalExpr uniques <$> parseExpr str
evalString globals str = evalExpr globals uniques <$> parseExpr str
uniques :: [String]
uniques = concatMap (\p -> map (:p) . reverse $ ['a'..'z']) suffix
......
......@@ -3,18 +3,50 @@ module Language.Lambda.Eval where
import Data.List
import Data.Maybe
import qualified Data.Map as Map
import Language.Lambda.Expression
evalExpr :: Eq n => [n] -> LambdaExpr n -> LambdaExpr n
evalExpr uniqs (Abs name expr) = Abs name . evalExpr uniqs $ expr
evalExpr _ expr@(Var _) = expr
evalExpr uniqs (App e1 e2) = betaReduce uniqs (evalExpr uniqs e1)
(evalExpr uniqs e2)
-- | Evaluate an expression
evalExpr :: (Eq n, Ord n)
=> Map.Map n (LambdaExpr n) -- ^ globals
-> [n] -- ^ unique supply
-> LambdaExpr n -- ^ the expression to evaluate
-> (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)
evalExpr globals uniqs expr = (evalExpr' uniqs expr', globals)
where expr' = subGlobals globals expr
betaReduce :: Eq n => [n] -> LambdaExpr n -> LambdaExpr n -> LambdaExpr n
betaReduce uniqs (App e1 e1') e2 = App (betaReduce uniqs e1 e1') e2
subGlobals :: (Eq n, Ord n)
=> Map.Map n (LambdaExpr n) -- ^ globals
-> 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
-- | Evaluate an expression; does not support `let`
evalExpr' :: Eq n
=> [n] -- ^ unique supply
-> LambdaExpr n -- ^ the expression to evaluate
-> LambdaExpr n
evalExpr' _ expr@(Var _) = expr
evalExpr' uniqs (Abs name expr) = Abs name . evalExpr' uniqs $ expr
evalExpr' uniqs (Let name expr) = Let name . evalExpr' uniqs $ expr
evalExpr' uniqs (App e1 e2) = betaReduce uniqs (evalExpr' uniqs e1)
(evalExpr' uniqs e2)
betaReduce :: Eq n
=> [n]
-> LambdaExpr n
-> LambdaExpr n
-> LambdaExpr n
betaReduce _ expr@(Var _) e2 = App expr e2
betaReduce uniqs (Abs n e1) e2 = evalExpr uniqs . sub n e1' $ e2
betaReduce uniqs (App e1 e1') e2 = App (betaReduce uniqs e1 e1') e2
betaReduce uniqs (Abs n e1) e2 = evalExpr' uniqs . sub n e1' $ e2
where fvs = freeVarsOf e2
e1' = alphaConvert uniqs fvs e1
......
module Language.Lambda.EvalSpec where
import Data.Map (empty, insert)
import Test.Hspec
import Language.Lambda
......@@ -9,7 +10,7 @@ import Language.Lambda.Expression
spec :: Spec
spec = do
describe "evalExpr" $ do
let evalExpr' = evalExpr uniques
let evalExpr' = fst <$> evalExpr empty uniques
it "beta reduces" $ do
let expr = App (Abs "x" (Var "x")) (Var "z")
......@@ -28,6 +29,23 @@ spec = do
(Abs "f" (Var "x"))
evalExpr' expr `shouldBe` Abs "z" (Var "x")
it "reduces let bodies" $ do
let expr = Let "x" $ App (Abs "y" (Var "y")) (Var "z")
evalExpr' expr `shouldBe` Let "x" (Var "z")
it "let expressions update state" $ do
let expr = Let "w" (Var "x")
(_, globals) = evalExpr empty uniques expr
globals `shouldBe` insert "w" (Var "x") empty
it "subs global variables" $ do
let globals = insert "w" (Var "x") empty
expr = Var "w"
fst (evalExpr globals uniques expr)
`shouldBe` Var "x"
describe "betaReduce" $ do
let betaReduce' = betaReduce []
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment