tools/PascalPreprocessor.hs
changeset 6414 8474b7fa84d6
parent 6413 6714531e7bd2
child 6425 1ef4192aa80d
--- a/tools/PascalPreprocessor.hs	Tue Nov 22 22:48:02 2011 +0300
+++ b/tools/PascalPreprocessor.hs	Wed Nov 23 20:12:16 2011 +0300
@@ -2,8 +2,10 @@
 
 import Text.Parsec
 import Control.Monad.IO.Class
+import Control.Monad
 import System.IO
 import qualified Data.Map as Map
+import Data.Char
 
 
 -- comments are removed
@@ -15,7 +17,7 @@
 
 preprocess :: String -> IO String
 preprocess fn = do
-    r <- runParserT (preprocessFile fn) Map.empty "" ""
+    r <- runParserT (preprocessFile fn) (Map.empty, [True]) "" ""
     case r of
          (Left a) -> do
              hPutStrLn stderr (show a)
@@ -23,29 +25,40 @@
          (Right a) -> return a
     
     where
-    preprocessFile :: String -> ParsecT String (Map.Map String String) IO String
     preprocessFile fn = do
         f <- liftIO (readFile fn)
         setInput f
         preprocessor
         
-    preprocessor, codeBlock, switch :: ParsecT String (Map.Map String String) IO String
+    preprocessor, codeBlock, switch :: ParsecT String (Map.Map String String, [Bool]) IO String
     
-    preprocessor = chainl codeBlock (return (++)) ""
+    preprocessor = chainr codeBlock (return (++)) ""
     
-    codeBlock = choice [
+    codeBlock = do
+        s <- choice [
             switch
             , comment
-            , char '\'' >> many (noneOf "'") >>= \s -> char '\'' >> return ('\'' : s ++ "'")
-            , many1 $ noneOf "{'/("
-            , char '/' >> notFollowedBy (char '/') >> return "/"
-            , char '(' >> notFollowedBy (char '*') >> return "("
+            , char '\'' >> many (noneOf "'\n") >>= \s -> char '\'' >> return ('\'' : s ++ "'")
+            , identifier >>= replace
+            , noneOf "{" >>= \a -> return [a]
             ]
+        (_, ok) <- getState
+        return $ if and ok then s else ""
+
+    --otherChar c = c `notElem` "{/('_" && not (isAlphaNum c)
+    identifier = do
+        c <- letter <|> oneOf "_"
+        s <- many (alphaNum <|> oneOf "_")
+        return $ c:s
             
     switch = do
         try $ string "{$"
         s <- choice [
             include
+            , ifdef
+            , elseSwitch
+            , endIf
+            , define
             , unknown
             ]
         return s
@@ -63,8 +76,42 @@
         setInput $ f ++ c
         return ""
 
+    ifdef = do
+        s <- try (string "IFDEF") <|> try (string "IFNDEF")
+        let f = if s == "IFNDEF" then not else id
+        
+        spaces
+        d <- many1 alphaNum
+        spaces
+        char '}'
+        
+        updateState $ \(m, b) ->
+            (m, (f $ d `Map.member` m) : b)
+        
+      
+        return ""
+        
+    elseSwitch = do
+        try $ string "ELSE}"
+        updateState $ \(m, b:bs) -> (m, (not b):bs)
+        return ""
+    endIf = do
+        try $ string "ENDIF}"
+        updateState $ \(m, b:bs) -> (m, bs)
+        return ""
+    define = do
+        try $ string "DEFINE"
+        spaces
+        i <- identifier        
+        d <- option "" (string ":=" >> many (noneOf "}"))
+        char '}'
+        updateState $ \(m, b) -> (if and b then Map.insert i d m else m, b)
+        return ""
+    replace s = do
+        (m, _) <- getState
+        return $ Map.findWithDefault s s m
+        
     unknown = do
         fn <- many1 $ noneOf "}\n"
         char '}'
-        return ""
-        
\ No newline at end of file
+        return $ "{$" ++ fn ++ "}"