Parse multiple let expressionsHEADmain

2 files changed, 35 insertions, 14 deletions

diff --git a/lambda-calcul/haskell/src/Minilang/Lambda/Parser.hs b/lambda-calcul/haskell/src/Minilang/Lambda/Parser.hs
index 426a8e8..9ed4626 100644
--- a/lambda-calcul/haskell/src/Minilang/Lambda/Parser.hs
+++ b/lambda-calcul/haskell/src/Minilang/Lambda/Parser.hs
@@ -11,7 +11,7 @@ import qualified Data.Text as Text
 import Data.Void (Void)
 import Minilang.Lambda.Eval (Term)
 import qualified Minilang.Lambda.Eval as Eval
-import Text.Megaparsec (Parsec, between, empty, errorBundlePretty, parse, try)
+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
 
@@ -75,17 +75,23 @@ letExpr =
     rpar
     ( do
         void $ lexeme "let"
-        (bound, binding) <-
+        (bind : binds) <-
           between
             lpar
             rpar
-            ( (,) <$> identifier <*> ast
-            )
+            (some binding)
         body <- ast
-        let fun = Abs [pack bound] body
-        return $ App fun binding []
+        let fun = Abs (fst <$> (bind : binds)) body
+        return $ App fun (snd bind) (snd <$> binds)
     )
 
+binding :: Parser (Text, AST)
+binding =
+  between
+    lpar
+    rpar
+    (((,) . pack <$> identifier) <*> ast)
+
 lpar :: Parser Text
 lpar = symbol "("
 
diff --git a/lambda-calcul/haskell/test/Minilang/Lambda/ParserSpec.hs b/lambda-calcul/haskell/test/Minilang/Lambda/ParserSpec.hs
index edd39df..c6d64c7 100644
--- a/lambda-calcul/haskell/test/Minilang/Lambda/ParserSpec.hs
+++ b/lambda-calcul/haskell/test/Minilang/Lambda/ParserSpec.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE TypeApplications #-}
+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
 
 module Minilang.Lambda.ParserSpec where
 
@@ -11,7 +12,7 @@ import qualified Minilang.Lambda.Eval as Eval
 import Minilang.Lambda.Parser (AST (..), desugar, initialChars, parse, pretty, restChars)
 import Test.Hspec (Spec, parallel, shouldBe)
 import Test.Hspec.QuickCheck (prop)
-import Test.QuickCheck (Arbitrary (..), Gen, NonEmptyList (..), counterexample, elements, forAll, forAllShrink, listOf, oneof, resize, sized, (===), (==>))
+import Test.QuickCheck (Arbitrary (..), Gen, NonEmptyList (..), counterexample, elements, forAll, forAllShrink, listOf, oneof, resize, sized, vectorOf, (===), (==>))
 
 -- ((f x) y) --> (f x y)
 -- (lam (x) (lam (y) y)) --> (lam (x y) y)
@@ -58,13 +59,27 @@ spec = parallel $ do
      in nestedApp term === ar
           & counterexample ("Desugared term: " <> show term)
 
-  prop "parses a let-binding as a function application" $ \(Identifier ident) ->
-    forAll (genAst 3) $ \binding ->
-      forAll (genAst 2) $ \body ->
-        let fun = Abs [ident] body
-            app = App fun binding []
-         in parse ("(let (" <> ident <> " " <> pretty binding <> ") " <> pretty body <> ")")
-              `shouldBe` Right app
+  prop "parses multiple let-binding as a function application" $
+    forAll arbitrary $ \(NonEmpty idents) ->
+      forAll (vectorOf (length idents) $ genAst 3) $ \(binding : bindings) ->
+        forAll (genAst 2) $ \body ->
+          let fun = Abs (unIdent <$> idents) body
+              app = App fun binding bindings
+              bound = zip idents (binding : bindings)
+           in parse
+                ( "(let ("
+                    <> Text.concat
+                      ( map
+                          ( \(Identifier v, t) ->
+                              "(" <> v <> " " <> pretty t <> ")"
+                          )
+                          bound
+                      )
+                    <> ") "
+                    <> pretty body
+                    <> ")"
+                )
+                `shouldBe` Right app
 
 spine :: AST -> Int
 spine = \case