ClimbHome: Change misleading Seed assignment to nil value
This was "Seed = ClimbHome", but ClimbHome was a nil value.
This code still worked as the engine interpreted the nil value as empty string.
But it can be very misleading.
This changeset makes the Seed assignment more explicit by assigning the empty string directly.
The compability has been tested.
{-# LANGUAGE ScopedTypeVariables #-}
module PascalPreprocessor where
import Text.Parsec
import Control.Monad.IO.Class
import Control.Monad
import System.IO
import qualified Data.Map as Map
import qualified Control.Exception as E
char' :: Char -> ParsecT String u IO ()
char' = void . char
string' :: String -> ParsecT String u IO ()
string' = void . string
-- comments are removed
comment :: ParsecT String u IO String
comment = choice [
char '{' >> notFollowedBy (char '$') >> manyTill anyChar (try $ char '}') >> return ""
, (try $ string "(*") >> manyTill anyChar (try $ string "*)") >> return ""
, (try $ string "//") >> manyTill anyChar (try newline) >> return "\n"
]
preprocess :: String -> String -> String -> [String] -> IO String
preprocess inputPath alternateInputPath fn symbols = do
r <- runParserT (preprocessFile (inputPath ++ fn)) (Map.fromList $ map (\s -> (s, "")) symbols, [True]) "" ""
case r of
(Left a) -> do
hPutStrLn stderr (show a)
return ""
(Right a) -> return a
where
preprocessFile fn' = do
f <- liftIO (readFile fn')
setInput f
preprocessor
preprocessor, codeBlock, switch :: ParsecT String (Map.Map String String, [Bool]) IO String
preprocessor = chainr codeBlock (return (++)) ""
codeBlock = do
s <- choice [
switch
, comment
, 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
, if'
, elseSwitch
, endIf
, define
, unknown
]
return s
include = do
try $ string' "INCLUDE"
spaces
(char' '"')
ifn <- many1 $ noneOf "\"\n"
char' '"'
spaces
char' '}'
f <- liftIO (readFile (inputPath ++ ifn)
`E.catch` (\(_ :: E.IOException) -> readFile (alternateInputPath ++ ifn)
`E.catch` (\(_ :: E.IOException) -> error $ "File not found: " ++ ifn)
)
)
c <- getInput
setInput $ f ++ c
return ""
ifdef = do
s <- try (string "IFDEF") <|> try (string "IFNDEF")
let f = if s == "IFNDEF" then not else id
ds <- (spaces >> identifier) `sepBy` (spaces >> string "OR")
spaces
char' '}'
updateState $ \(m, b) ->
(m, (f $ any (flip Map.member m) ds) : b)
return ""
if' = do
try (string' "IF" >> notFollowedBy alphaNum)
void $ manyTill anyChar (char' '}')
--char '}'
updateState $ \(m, b) ->
(m, False : b)
return ""
elseSwitch = do
try $ string' "ELSE}"
updateState $ \(m, b:bs) -> (m, (not b):bs)
return ""
endIf = do
try $ string' "ENDIF}"
updateState $ \(m, _:bs) -> (m, bs)
return ""
define = do
try $ string' "DEFINE"
spaces
i <- identifier
d <- ((string ":=" >> return ()) <|> spaces) >> many (noneOf "}")
char' '}'
updateState $ \(m, b) -> (if (and b) && (head i /= '_') then Map.insert i d m else m, b)
return ""
replace s = do
(m, _) <- getState
return $ Map.findWithDefault s s m
unknown = do
un <- many1 $ noneOf "}\n"
char' '}'
return $ "{$" ++ un ++ "}"