diff options
Diffstat (limited to 'lambda-calcul/haskell/test/Minilang/Lambda/ParserSpec.hs')
| -rw-r--r-- | lambda-calcul/haskell/test/Minilang/Lambda/ParserSpec.hs | 31 |
1 files changed, 23 insertions, 8 deletions
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 |