diff options
Diffstat (limited to 'lambda-calcul/haskell/src/Minilang/Lambda/Eval.hs')
| -rw-r--r-- | lambda-calcul/haskell/src/Minilang/Lambda/Eval.hs | 36 |
1 files changed, 22 insertions, 14 deletions
diff --git a/lambda-calcul/haskell/src/Minilang/Lambda/Eval.hs b/lambda-calcul/haskell/src/Minilang/Lambda/Eval.hs index 0829186..a15d3f9 100644 --- a/lambda-calcul/haskell/src/Minilang/Lambda/Eval.hs +++ b/lambda-calcul/haskell/src/Minilang/Lambda/Eval.hs @@ -1,6 +1,7 @@ module Minilang.Lambda.Eval where -import Data.Text (Text) +import Data.Text (Text, unpack) +import Debug.Trace (trace) data Term = Var Text @@ -8,29 +9,36 @@ data Term | App Term Term deriving (Show, Read, Eq) -type Env = [(Text, Term)] +type Env = [(Text, Value)] + +data Value + = V Text + | Abs Text Term Env + | Ap Value Value + deriving (Show, Read, Eq) -- call-by-value evaluator -eval :: Term -> Env -> Term +eval :: Term -> Env -> Value eval (Var x) env = case lookup x env of Just v -> v -- we do not need to eval v again - Nothing -> Var x -eval (Lam x body) _env = Lam x body + Nothing -> V x -- x is not bound in env +eval (Lam x body) env = Abs x body env eval (App f a) env = -- we need to force evaluation of the argument -- because haskell's default semantics is non-strict -- so if a' is never used, it will not be evaluated! let a' = eval a env in seq a' $ case eval f env of - Lam x body -> eval body ((x, a') : env) - f' -> App f' a' + Abs x body env' -> eval body ((x, a') : env') + f' -> Ap f' a' -evalNeed :: Term -> Env -> Term +evalNeed :: Term -> Env -> Value evalNeed (Var x) env = case lookup x env of - Just v -> evalNeed v env -- we need to eval v because it might be a redex - Nothing -> Var x -evalNeed (Lam x body) _env = Lam x body + Just v -> v + Nothing -> V x +evalNeed (Lam x body) env = Abs x body env evalNeed (App f a) env = - case evalNeed f env of - Lam x body -> evalNeed body ((x, a) : env) - f' -> App f' a + let a' = eval a env + in case evalNeed f env of + Abs x body env' -> evalNeed body ((x, a') : env') + f' -> Ap f' a' |
