diff --git a/example.lambda b/example.lambda index f79d9f3..aa3dfcc 100644 --- a/example.lambda +++ b/example.lambda @@ -1 +1,3 @@ -((λ x (λ y x)) "Hello, world!") + + +constant = (λ x (λ y x)) diff --git a/src/Lib.hs b/src/Lib.hs index fe3ddf4..c7a084d 100644 --- a/src/Lib.hs +++ b/src/Lib.hs @@ -25,6 +25,7 @@ data Expr | Term Identifier | Abs Identifier Expr | App Expr Expr + | Const Identifier Expr deriving (Show, Eq) data Value @@ -45,6 +46,7 @@ eval :: Env Value -> Expr -> Either Error Value eval _ (Lit string) = Right $ Value string eval env (Term identifier) = maybeToEither (UndeclaredVar identifier) $ lookup identifier env eval env (Abs identifier expr) = Right $ Closure expr env identifier +eval env (Const identifier expr) = Right $ Closure expr env identifier eval env (App t u) = do vt <- eval env t vu <- eval env u @@ -56,6 +58,7 @@ betaReduce :: Env Expr -> Expr -> Either Error Expr betaReduce _ (Lit string) = Right $ Lit string betaReduce env term@(Term identifier) = Right $ fromMaybe term $ lookup identifier env betaReduce env (Abs identifier expr) = Abs identifier <$> betaReduce env expr +betaReduce env (Const identifier expr) = Abs identifier <$> betaReduce env expr betaReduce env (App t u) = do vt <- betaReduce env t vu <- betaReduce env u @@ -91,6 +94,7 @@ checkUnused = go [] mergeUnused unused (go unused expr_l) (go unused expr_r) go unused (Abs "_" expr) = go unused expr go unused (Abs id expr) = go (id : unused) expr + go unused (Const id expr) = go (id : unused) expr mergeUnused :: (Eq a) => [a] -> [a] -> [a] -> [a] mergeUnused env left right = (env \\ removed) ++ added @@ -114,6 +118,7 @@ compile :: Expr -> Either Error String compile (Lit string) = Right $ printf "'%s'" string compile (Term identifier) = Right $ identifier compile (Abs identifier expr) = printf "(%s => %s)" identifier <$> compile expr +compile (Const identifier expr) = printf "%s = %s;\n" identifier <$> compile expr compile (App (Lit id) _) = Left $ NonFunctionApp id compile (App t u) = printf "%s(%s)" <$> compile t <*> compile u diff --git a/src/Parser.hs b/src/Parser.hs index 57ff244..53260af 100644 --- a/src/Parser.hs +++ b/src/Parser.hs @@ -8,7 +8,7 @@ import Control.Monad (guard) import Control.Arrow (first) import Data.Char (isLetter) -import Lib (Expr(Lit, Term, Abs, App), Identifier) +import Lib (Expr(Lit, Term, Abs, App, Const), Identifier) data Parser s m a = Parser { runParser :: s -> m (a, s) } @@ -56,10 +56,13 @@ identifier :: (Alternative m, Monad m) => Parser String m Identifier identifier = some $ satisfy isLetter term :: (Alternative m, Monad m) => Parser String m Expr -term = Term <$> identifier +term = do + many $ char '\n' + Term <$> identifier lambda :: (Alternative m, Monad m) => Parser String m Expr lambda = do + many $ char '\n' char '(' char 'λ' char ' ' @@ -71,6 +74,7 @@ lambda = do app :: (Alternative m, Monad m) => Parser String m Expr app = do + many $ char '\n' char '(' t <- expr char ' ' @@ -78,8 +82,21 @@ app = do char ')' pure $ App t u +constant :: (Alternative m, Monad m) => Parser String m Expr +constant = do + many $ char '\n' + alias <- many $ satisfy (/= ' ') + char ' ' + char '=' + char ' ' + val <- expr + char '\n' + pure $ Const alias val + expr :: (Alternative m, Monad m) => Parser String m Expr -expr = lit - <|> term - <|> lambda - <|> app +expr + = lit + <|> constant + <|> term + <|> lambda + <|> app