Can parse definitions

1 files changed, 21 insertions, 5 deletions

diff --git a/lambda-calcul/haskell/src/Minilang/Lambda/Parser.hs b/lambda-calcul/haskell/src/Minilang/Lambda/Parser.hs
index e15dc00..b0f4b8f 100644
--- a/lambda-calcul/haskell/src/Minilang/Lambda/Parser.hs
+++ b/lambda-calcul/haskell/src/Minilang/Lambda/Parser.hs
@@ -1,29 +1,33 @@
-{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE LambdaCase #-}
 
 module Minilang.Lambda.Parser where
 
 import Control.Applicative (Alternative (many), (<|>))
+import Data.Aeson (FromJSON, ToJSON)
 import Data.Bifunctor (first)
 import Data.Functor (void)
 import qualified Data.List as List
 import Data.Text (Text, pack)
 import qualified Data.Text as Text
 import Data.Void (Void)
+import GHC.Generics (Generic)
 import Minilang.Lambda.Eval (Term)
 import qualified Minilang.Lambda.Eval as Eval
 import Text.Megaparsec (Parsec, between, empty, errorBundlePretty, parse, some, try)
 import Text.Megaparsec.Char (alphaNumChar, char, letterChar, space1, symbolChar)
 import qualified Text.Megaparsec.Char.Lexer as L
-import GHC.Generics (Generic)
-import Data.Aeson (ToJSON, FromJSON)
 
 type Parser = Parsec Void Text
 
 data ParseError = ParseError Text
   deriving (Eq, Show)
 
-data AST = Sym Text | Abs [Text] AST | App AST AST [AST]
+data AST
+  = Sym Text
+  | Abs [Text] AST
+  | App AST AST [AST]
+  | Def Text AST
   deriving (Eq, Show, Generic, ToJSON, FromJSON)
 
 desugar :: AST -> Term
@@ -39,6 +43,8 @@ desugar = \case
       (\acc a -> Eval.App acc (desugar a))
       (Eval.App (desugar x) (desugar y))
       rest
+  Def _name _body ->
+    undefined
 
 resugar :: Term -> AST
 resugar = \case
@@ -59,13 +65,14 @@ pretty = \case
   Sym symb -> symb
   Abs bound body -> "(lam (" <> Text.unwords bound <> ") " <> pretty body <> ")"
   App x y rest -> "(" <> mconcat (List.intersperse " " (pretty <$> (x : y : rest))) <> ")"
+  Def name body -> "(def " <> name <> " " <> pretty body <> ")"
 
 parse :: Text -> Either ParseError AST
 parse =
   first (ParseError . pack . errorBundlePretty) . Text.Megaparsec.parse ast ""
 
 ast :: Parser AST
-ast = try letExpr <|> try lambda <|> try sym <|> try app
+ast = try defExpr <|> try letExpr <|> try lambda <|> try sym <|> try app
 
 app :: Parser AST
 app =
@@ -85,6 +92,15 @@ lambda =
            )
     )
 
+defExpr :: Parser AST
+defExpr =
+  between
+    lpar
+    rpar
+    ( lexeme "def"
+        *> ((Def . pack <$> identifier) <*> ast)
+    )
+
 letExpr :: Parser AST
 letExpr =
   between