module Language.Lambda.Eval where
import Data.List
import Data.Maybe
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)
betaReduce :: Eq n => [n] -> LambdaExpr n -> LambdaExpr n -> LambdaExpr n
betaReduce uniqs (App e1 e1') e2 = App (betaReduce uniqs e1 e1') e2
betaReduce _ expr@(Var _) e2 = App expr e2
betaReduce uniqs (Abs n e1) e2 = evalExpr uniqs . sub n e1' $ e2
where fvs = freeVarsOf e2
e1' = alphaConvert uniqs fvs e1
alphaConvert :: Eq n => [n] -> [n] -> LambdaExpr n -> LambdaExpr n
alphaConvert uniqs freeVars (Abs name body)
| name `elem` freeVars = Abs uniq . sub name body . Var $ uniq
| otherwise = Abs name . alphaConvert uniqs freeVars $ body
where uniq = fromMaybe name (find (`notElem` freeVars) uniqs)
alphaConvert _ _ e = e
etaConvert :: Eq n => LambdaExpr n -> LambdaExpr n
etaConvert (Abs n (App e1 (Var n')))
| n == n' = etaConvert e1
| otherwise = Abs n (App (etaConvert e1) (Var n'))
etaConvert (Abs n e@(Abs _ _))
| e == e' = Abs n e'
| otherwise = etaConvert (Abs n e')
where e' = etaConvert e
etaConvert (Abs n expr) = Abs n (etaConvert expr)
etaConvert (App e1 e2) = App (etaConvert e1) (etaConvert e2)
etaConvert expr@(Var _) = expr
sub :: Eq n => n -> LambdaExpr n -> LambdaExpr n -> LambdaExpr n
sub name b@(Var name') expr
| name == name' = expr
| otherwise = b
sub name b@(Abs name' expr') expr
| name == name' = b
| otherwise = Abs name' (sub name expr' expr)
sub name (App e1 e2) expr = App (sub name e1 expr)
(sub name e2 expr)
freeVarsOf :: Eq n => LambdaExpr n -> [n]
freeVarsOf (Abs n expr) = filter (/=n) . freeVarsOf $ expr
freeVarsOf (App e1 e2) = freeVarsOf e1 ++ freeVarsOf e2
freeVarsOf (Var n) = [n]