diff --git a/src/Language/SystemF/Parser.hs b/src/Language/SystemF/Parser.hs index e28c5e68cf03bcb113f55fa7d2396d42a1ece524..fbcb40a6eb02fa715aecc72ab01d52e8379785e7 100644 --- a/src/Language/SystemF/Parser.hs +++ b/src/Language/SystemF/Parser.hs @@ -34,7 +34,7 @@ abs :: Parser (SystemFExpr String String) abs = curry <$> (symbol '\\' *> many1 args <* symbol '.') <*> expr - where args = (,) <$> (identifier <* symbol ':') <*> (TyVar <$> identifier) + where args = (,) <$> (identifier <* symbol ':') <*> ty curry = flip . foldr . uncurry $ Abs -- Parse type expressions diff --git a/test/Language/SystemF/ParserSpec.hs b/test/Language/SystemF/ParserSpec.hs index f2769e2e2ed426c411178a55ed507544687acced..57160fd92262ce42a7a0f31551b3c18a78ece088 100644 --- a/test/Language/SystemF/ParserSpec.hs +++ b/test/Language/SystemF/ParserSpec.hs @@ -23,7 +23,9 @@ spec = do parseExpr "\\a:A b:B. b" `shouldBe` Right (Abs "a" (TyVar "A") (Abs "b" (TyVar "B") (Var "b"))) - it "parses abstractions with arrow types" pending + it "parses abstractions with arrow types" $ + parseExpr "\\f:(T->U). f" + `shouldBe` Right (Abs "f" (TyArrow (TyVar "T") (TyVar "U")) (Var "f")) it "parses simple applications" $ parseExpr "f x" `shouldBe` Right (App (Var "f") (Var "x")) @@ -31,14 +33,28 @@ spec = do it "parses chained applications" $ parseExpr "a b c" `shouldBe` Right (App (App (Var "a") (Var "b")) (Var "c")) - it "parses complex expressions" $ - pendingWith "Abstraction Not Implemented" + it "parses complex expressions" $ do + let exprs = [ + "\\f:(A->B) x:B. f x", + "(\\p:(X->Y->Z) x:X y:Y. y) (\\p:(A->B->C) x:B y:C. x)", + "f (\\x:T. x)", + "(\\ x:X . f x) g y", + "(\\f:(X->Y) . (\\ x:X y:Y. f x y) f x y) w x y" + ] + + mapM_ (flip shouldSatisfy isRight . parseExpr) exprs it "does not parse trailing errors" $ parseExpr "x +" `shouldSatisfy` isLeft - it "ignores whitespace" $ - pendingWith "Abstraction Not Implemented" + it "ignores whitespace" $ do + let exprs = [ + " x ", + " \\ x : X. x ", + " ( x ) " + ] + + mapM_ (flip shouldSatisfy isRight . parseExpr) exprs describe "parseType" $ do it "parses simple variables" $