1 files changed, 77 insertions, 0 deletions
diff --git a/parser.hs b/parser.hs
new file mode 100644
index 0000000..4f9e965
--- /dev/null
+++ b/parser.hs
@@ -0,0 +1,77 @@
+module Parser(parseProgram, parseExpression) where
+
+import Control.Monad
+import Data.Char
+import Text.Parsec
+
+import AST
+
+
+type Parser = Parsec String ()
+
+
+parseProgram :: String -> Either ParseError Program
+parseProgram = parse pProgram ""
+
+pProgram :: Parser Program
+pProgram = between pWhiteComment eof (liftM Program (many pValue))
+
+
+parseExpression :: String -> Either ParseError Value
+parseExpression = parse pExpression ""
+
+pExpression :: Parser Value
+pExpression = between pWhiteComment eof pValue
+
+
+pValue :: Parser Value
+pValue = pVEllipsis <|> pVList <|> pVNum <|> pVString <|> pVName <|> pVQuoted  <?> "value"
+
+pVList :: Parser Value
+pVList = flip label "list" $ do
+    symbol "("
+    exs <- many pValue
+    symbol ")"
+    return $ VList exs
+
+pVNum :: Parser Value
+pVNum = liftM (VNum . read) (many1 digit) <* pWhiteComment  <?> "number"
+
+pVString :: Parser Value
+pVString = flip label "string" $ do
+    void $ char '"'
+    s <- manyTill anyChar (symbol "\"")
+    return $ VString s
+
+pVName :: Parser Value
+pVName = flip label "name" $ do
+    first <- satisfy isFirstNameChar
+    rest <- many (satisfy isNameChar)
+    pWhiteComment
+    return $ VName $ first : rest
+  where
+    isNameChar c = ((c >= '*' && c <= 'z') || c `elem` "!#$%&|~") && c /= ';'
+    isFirstNameChar c = isNameChar c && not (isDigit c)
+
+pVQuoted :: Parser Value
+pVQuoted = char '\'' >> liftM VQuoted pValue  <?> "quoted value"
+
+pVEllipsis :: Parser Value
+pVEllipsis = symbol "..." >> return VEllipsis  <?> "ellipsis"
+
+
+symbol :: String -> Parser ()
+symbol s = try (string s) >> pWhiteComment
+
+pWhiteComment :: Parser ()
+pWhiteComment = do
+    pWhitespace
+    void $ many $ pComment >> pWhitespace
+  where
+    pWhitespace :: Parser ()
+    pWhitespace = void (many space)  <?> "whitespace"
+
+    pComment :: Parser ()
+    pComment = flip label "comment" $ do
+        void $ char ';'
+        void (manyTill anyChar (void endOfLine <|> eof))