From c25979b76c1dd22b6dc33acb994e9044c56a68f9 Mon Sep 17 00:00:00 2001
From: tomsmeding <tom.smeding@gmail.com>
Date: Sun, 17 Dec 2017 22:31:01 +0100
Subject: #include

---
 parser.hs | 38 +++++++++++++++++++++++++++-----------
 1 file changed, 27 insertions(+), 11 deletions(-)

(limited to 'parser.hs')

diff --git a/parser.hs b/parser.hs
index 4f9e965..93d457c 100644
--- a/parser.hs
+++ b/parser.hs
@@ -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
-- 
cgit v1.2.3-70-g09d2