diff options
Diffstat (limited to 'parser.hs')
| -rw-r--r-- | parser.hs | 38 |
1 files changed, 27 insertions, 11 deletions
@@ -1,31 +1,33 @@ module Parser(parseProgram, parseExpression) where import Control.Monad +import Control.Monad.Trans import Data.Char import Text.Parsec +import Text.Parsec.Pos import AST -type Parser = Parsec String () +type Parser = ParsecT String () IO -parseProgram :: String -> Either ParseError Program -parseProgram = parse pProgram "" +parseProgram :: String -> IO (Either ParseError Program) +parseProgram = runParserT pProgram () "" pProgram :: Parser Program pProgram = between pWhiteComment eof (liftM Program (many pValue)) -parseExpression :: String -> Either ParseError Value -parseExpression = parse pExpression "" +parseExpression :: String -> IO (Either ParseError Value) +parseExpression = runParserT pExpression () "" pExpression :: Parser Value pExpression = between pWhiteComment eof pValue pValue :: Parser Value -pValue = pVEllipsis <|> pVList <|> pVNum <|> pVString <|> pVName <|> pVQuoted <?> "value" +pValue = pPPC <|> pVEllipsis <|> pVList <|> pVNum <|> pVString <|> pVName <|> pVQuoted <?> "value" pVList :: Parser Value pVList = flip label "list" $ do @@ -38,10 +40,7 @@ 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 +pVString = fmap VString pString pVName :: Parser Value pVName = flip label "name" $ do @@ -50,7 +49,7 @@ pVName = flip label "name" $ do pWhiteComment return $ VName $ first : rest where - isNameChar c = ((c >= '*' && c <= 'z') || c `elem` "!#$%&|~") && c /= ';' + isNameChar c = ((c >= '*' && c <= 'z') || c `elem` "!$%&|~") && c /= ';' isFirstNameChar c = isNameChar c && not (isDigit c) pVQuoted :: Parser Value @@ -59,10 +58,27 @@ pVQuoted = char '\'' >> liftM VQuoted pValue <?> "quoted value" pVEllipsis :: Parser Value pVEllipsis = symbol "..." >> return VEllipsis <?> "ellipsis" +pPPC :: Parser Value +pPPC = flip label "preprocessor command" $ do + symbol "#include" + fname <- pString + src <- liftIO $ readFile fname + stateBackup <- getParserState + void $ setParserState (State ("(do " ++ src ++ ")") (initialPos fname) ()) + result <- pValue <* eof + void $ setParserState stateBackup + return result + symbol :: String -> Parser () symbol s = try (string s) >> pWhiteComment +pString :: Parser String +pString = flip label "string" $ do + void $ char '"' + s <- manyTill anyChar (symbol "\"") + return s + pWhiteComment :: Parser () pWhiteComment = do pWhitespace |