summaryrefslogtreecommitdiff
path: root/lambda-calcul/haskell/src
diff options
context:
space:
mode:
Diffstat (limited to 'lambda-calcul/haskell/src')
-rw-r--r--lambda-calcul/haskell/src/Minilang/Lambda/Eval.hs2
-rw-r--r--lambda-calcul/haskell/src/Minilang/Lambda/Parser.hs33
2 files changed, 27 insertions, 8 deletions
diff --git a/lambda-calcul/haskell/src/Minilang/Lambda/Eval.hs b/lambda-calcul/haskell/src/Minilang/Lambda/Eval.hs
index a15d3f9..cbbdc51 100644
--- a/lambda-calcul/haskell/src/Minilang/Lambda/Eval.hs
+++ b/lambda-calcul/haskell/src/Minilang/Lambda/Eval.hs
@@ -13,7 +13,7 @@ type Env = [(Text, Value)]
data Value
= V Text
- | Abs Text Term Env
+ | Abs Text Term Env -- a closure, ie. lambda with its captured environment
| Ap Value Value
deriving (Show, Read, Eq)
diff --git a/lambda-calcul/haskell/src/Minilang/Lambda/Parser.hs b/lambda-calcul/haskell/src/Minilang/Lambda/Parser.hs
index 37834d3..426a8e8 100644
--- a/lambda-calcul/haskell/src/Minilang/Lambda/Parser.hs
+++ b/lambda-calcul/haskell/src/Minilang/Lambda/Parser.hs
@@ -4,15 +4,16 @@ module Minilang.Lambda.Parser where
import Control.Applicative (Alternative (many), (<|>))
import Data.Bifunctor (first)
+import Data.Functor (void)
import qualified Data.List as List
-import Data.Text (Text, intersperse, pack)
+import Data.Text (Text, pack)
import qualified Data.Text as Text
import Data.Void (Void)
-import Text.Megaparsec (Parsec, between, empty, errorBundlePretty, manyTill, notFollowedBy, optional, parse, try)
-import Text.Megaparsec.Char (alphaNumChar, char, letterChar, space1, string, symbolChar)
-import qualified Text.Megaparsec.Char.Lexer as L
import Minilang.Lambda.Eval (Term)
import qualified Minilang.Lambda.Eval as Eval
+import Text.Megaparsec (Parsec, between, empty, errorBundlePretty, parse, try)
+import Text.Megaparsec.Char (alphaNumChar, char, letterChar, space1, symbolChar)
+import qualified Text.Megaparsec.Char.Lexer as L
type Parser = Parsec Void Text
@@ -24,7 +25,7 @@ data AST = Sym Text | Abs [Text] AST | App AST AST [AST]
desugar :: AST -> Term
desugar = \case
- Sym sym -> Eval.Var sym
+ Sym symb -> Eval.Var symb
Abs bound body ->
foldr
Eval.Lam
@@ -38,7 +39,7 @@ desugar = \case
pretty :: AST -> Text
pretty = \case
- Sym sym -> sym
+ Sym symb -> symb
Abs bound body -> "(lam (" <> Text.unwords bound <> ") " <> pretty body <> ")"
App x y rest -> "(" <> mconcat (List.intersperse " " (pretty <$> (x : y : rest))) <> ")"
@@ -47,7 +48,7 @@ parse =
first (ParseError . pack . errorBundlePretty) . Text.Megaparsec.parse ast ""
ast :: Parser AST
-ast = try lambda <|> try sym <|> try app
+ast = try letExpr <|> try lambda <|> try sym <|> try app
app :: Parser AST
app =
@@ -67,6 +68,24 @@ lambda =
)
)
+letExpr :: Parser AST
+letExpr =
+ between
+ lpar
+ rpar
+ ( do
+ void $ lexeme "let"
+ (bound, binding) <-
+ between
+ lpar
+ rpar
+ ( (,) <$> identifier <*> ast
+ )
+ body <- ast
+ let fun = Abs [pack bound] body
+ return $ App fun binding []
+ )
+
lpar :: Parser Text
lpar = symbol "("