diff --git a/lamb.cabal b/lamb.cabal index 134cc60..0465f79 100644 --- a/lamb.cabal +++ b/lamb.cabal @@ -14,7 +14,7 @@ executable lamb main-is: Main.hs other-modules: Parser, Evaluation - build-depends: base + build-depends: base, parsec hs-source-dirs: src default-language: Haskell2010 @@ -26,6 +26,6 @@ test-suite lamb-tests ParserSpec, Evaluation, EvaluationSpec - build-depends: base, hspec + build-depends: base, hspec, parsec build-tool-depends: hspec-discover:hspec-discover default-language: Haskell2010 diff --git a/src/Parser.hs b/src/Parser.hs index 9e59750..e259bd3 100644 --- a/src/Parser.hs +++ b/src/Parser.hs @@ -1,12 +1,36 @@ module Parser where +import Control.Monad (void) +import Text.Parsec +import Text.Parsec.String (Parser) + data Expr = Variable String | Abstraction (String, Expr) | Application (Expr, Expr) deriving (Eq) instance Show Expr where show (Variable name) = name show (Abstraction (arg, body)) = "λ" ++ arg ++ ". " ++ show body - show (Application (f, x)) = show f ++ " " ++ show x + show (Application (f, x)) = "(" ++ show f ++ " " ++ show x ++ ")" + +ws :: Parser () +ws = skipMany (void space) + +variable :: Parser Expr +variable = do + name <- many letter + return $ Variable name + +abstraction :: Parser Expr +abstraction = do + _ <- void (char 'λ') + variable <- many letter + body <- parseExpr + return $ Abstraction (variable, body) + +parseExpr :: Parser Expr +parseExpr = variable <|> abstraction parse :: String -> Either String Expr -parse _ = Left "unimplemented" +parse content = case Text.Parsec.parse parseExpr "" content of + Left err -> Left (show err) + Right val -> Right val diff --git a/test/ParserSpec.hs b/test/ParserSpec.hs index cb67e5b..933f218 100644 --- a/test/ParserSpec.hs +++ b/test/ParserSpec.hs @@ -1,10 +1,49 @@ module ParserSpec (spec) where -import Parser (Expr (Abstraction, Variable), parse) +import Parser (Expr (Abstraction, Application, Variable), parse) import Test.Hspec spec :: Spec spec = do describe "Parser" $ do - it "can parse basic expressions" $ + it "can parse variable" $ + (parse "x") `shouldBe` Right (Variable "x") + it "can parse identity abstraction" $ (parse "λx.x") `shouldBe` Right (Abstraction ("x", Variable "x")) + it "can parse mockingbird of identity" $ + (parse "(λx.x x) (λx.x)") -- (λx.x) (λx.x) -> (λx.x) + `shouldBe` Right + ( Application + ( Abstraction + ( "x", + Application + ( Variable "x", + Variable "x" + ) + ), + Abstraction ("x", Variable "x") + ) + ) + it "it can parse successor" $ + (parse "λn.λf.λx.f (n f x)") + `shouldBe` Right + ( Abstraction + ( "n", + Abstraction + ( "f", + Abstraction + ( "x", + Application + ( Variable "f", + Application + ( Application + ( Variable "n", + Variable "f" + ), + Variable "x" + ) + ) + ) + ) + ) + )