3 files changed, 152 insertions, 0 deletions
diff --git a/arith/Core.hs b/arith/Core.hs
new file mode 100644
index 0000000..acec5b4
--- /dev/null
+++ b/arith/Core.hs
@@ -0,0 +1,59 @@
+module Core
+    ( Term(..)
+    , isNumericVal
+    , isVal
+    , eval
+    ) where
+
+data Term = TmTrue
+          | TmFalse
+          | TmIf Term Term Term
+          | TmZero
+          | TmSucc Term
+          | TmPred Term
+          | TmIsZero Term
+
+instance Show Term where
+    show TmTrue          = "true"
+    show TmFalse         = "false"
+    show (TmIf t1 t2 t3) = "if " ++ show t1 ++ " then " ++ show t2 ++ " else " ++ show t3
+    show TmZero          = "0"
+    show (TmSucc t)      = "succ " ++ show t
+    show (TmPred t)      = "pred " ++ show t
+    show (TmIsZero t)    = "iszero " ++ show t
+
+isNumericVal :: Term -> Bool
+isNumericVal TmZero      = True
+isNumericVal (TmSucc t1) = isNumericVal t1
+isNumericVal _           = False
+
+isVal :: Term -> Bool
+isVal TmTrue  = True
+isVal TmFalse = True
+isVal t       = isNumericVal t
+
+eval1 :: Term -> Maybe Term
+eval1 (TmIf TmTrue  t2 t3) = Just t2
+eval1 (TmIf TmFalse t2 t3) = Just t3
+eval1 (TmIf t1      t2 t3) = do
+    t1' <- eval1 t1
+    return $ TmIf t1' t2 t3
+eval1 (TmSucc t1) = do
+    t1' <- eval1 t1
+    return $ TmSucc t1'
+eval1 (TmPred TmZero)                          = Just $ TmZero
+eval1 (TmPred (TmSucc nv1)) | isNumericVal nv1 = Just nv1
+eval1 (TmPred t1)                              = do
+    t1' <- eval1 t1
+    return $ TmPred t1'
+eval1 (TmIsZero TmZero)                          = Just $ TmTrue
+eval1 (TmIsZero (TmSucc nv1)) | isNumericVal nv1 = Just $ TmFalse
+eval1 (TmIsZero t1)                              = do
+    t1' <- eval1 t1
+    return $ TmIsZero t1'
+eval1 _ = Nothing
+
+eval :: Term -> Term
+eval t = case eval1 t of
+    Just t' -> eval t'
+    Nothing -> t
diff --git a/arith/Main.hs b/arith/Main.hs
new file mode 100644
index 0000000..45b10eb
--- /dev/null
+++ b/arith/Main.hs
@@ -0,0 +1,23 @@
+module Main where
+
+import System.IO (hFlush, stdout)
+import Text.Parsec (parse)
+
+import Core
+import Parser
+
+repl :: IO ()
+repl = do
+    putStr "arith> "
+    hFlush stdout
+    line <- getLine
+    if line == ":q"
+        then putStrLn "Bye!"
+        else do
+            case parse parseProgram "<stdin>" line of
+                Left err -> print err
+                Right term -> print (eval term)
+            repl
+
+main :: IO ()
+main = repl
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