section 4. arithHEADmain

1 files changed, 70 insertions, 0 deletions

diff --git a/arith/Parser.hs b/arith/Parser.hs
new file mode 100644
index 0000000..bf5eecb
--- /dev/null
+++ b/arith/Parser.hs
@@ -0,0 +1,70 @@
+module Parser
+    ( parseProgram
+    ) where
+
+import Text.Parsec
+import Text.Parsec.String (Parser)
+
+import Core
+
+lexeme :: Parser a -> Parser a
+lexeme p = p <* spaces
+
+symbol :: String -> Parser String
+symbol = lexeme . string
+
+keyword :: String -> Parser ()
+keyword s = try (string s *> notFollowedBy alphaNum) *> spaces
+
+parens :: Parser a -> Parser a
+parens = between (symbol "(") (symbol ")")
+
+parseTerm :: Parser Term
+parseTerm = parseIf
+        <|> parseSucc
+        <|> parsePred
+        <|> parseIsZero
+        <|> parseTrue
+        <|> parseFalse
+        <|> parseZero
+        <|> parens parseTerm
+
+parseTrue :: Parser Term
+parseTrue = TmTrue <$ keyword "true"
+
+parseFalse :: Parser Term
+parseFalse = TmFalse <$ keyword "false"
+
+parseZero :: Parser Term
+parseZero = TmZero <$ symbol "0"
+
+parseIf :: Parser Term
+parseIf = do
+    keyword "if"
+    t1 <- parseTerm
+    keyword "then"
+    t2 <- parseTerm
+    keyword "else"
+    t3 <- parseTerm
+    return $ TmIf t1 t2 t3
+
+parseSucc :: Parser Term
+parseSucc = do
+    keyword "succ"
+    t <- parseTerm
+    return $ TmSucc t
+
+parsePred :: Parser Term
+parsePred = do
+    keyword "pred"
+    t <- parseTerm
+    return $ TmPred t
+
+parseIsZero :: Parser Term
+parseIsZero = do
+    keyword "iszero"
+    t <- parseTerm
+    return $ TmIsZero t
+
+parseProgram :: Parser Term
+parseProgram = spaces *> parseTerm <* eof