diff options
Diffstat (limited to 'parser.hs')
-rw-r--r-- | parser.hs | 77 |
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)) |