Commit 80316744 authored by Michael Hanus's avatar Michael Hanus
Browse files

currypp: SQLParser searches for info file if it is not passed as a parameter

parent fac95fc2
......@@ -77,7 +77,7 @@ at the beginning of the program.
Integrated code is enclosed in at least two back ticks and ticks
in a Curry program. The number of starting back ticks and ending ticks
must be always identical.
must always be identical.
After the initial back ticks, there must be an identifier
specifying the kind of integrated code,
e.g., \code{regexp} or \code{html} (see below).
......
......@@ -42,18 +42,18 @@ parse parserInfo pos code =
Right pi -> processCompilation pi pos code
--- Reader for parser information file.
---@param filename - path/name of the .info file
---@return either an error message or the parser
--- information
readParserInfo :: String -> IO (Either String ParserInfo)
readParserInfo filename =
do
handle <- openFile filename ReadMode
contents <- (hGetContents handle)
case (readsQTerm contents) of
[] -> return (Left ("ParserInfo-file was not found"++
" or is corrupted."))
((a,_):_) -> return (Right a)
--- @param verb - verbosity level
--- @param filename - path/name of the .info file
--- @return either an error message or the parser information
readParserInfo :: Int -> String -> IO (Either String ParserInfo)
readParserInfo verb filename = do
when (verb > 0) $ putStrLn $ "Read SQL model info file '" ++filename++ "'..."
handle <- openFile filename ReadMode
contents <- (hGetContents handle)
case (readsQTerm contents) of
[] -> return (Left ("ParserInfo-file was not found"++
" or is corrupted."))
((a,_):_) -> return (Right a)
-- auxiliary function to check Result after each stage
checkResult :: PM a -> Either (PM String) (PM a)
......
......@@ -30,6 +30,7 @@
------------------------------------------------------------------------------
module TransICode where
import Directory(getDirectoryContents)
import IO(stderr,hPutStrLn)
import List
import System
......@@ -58,8 +59,8 @@ parsers = maybe iden pars
pars l model p =
case l of
"sql" -> case model of
Left err -> (\_ -> return $ throwPM p err)
_ -> SQLParser.parse model p
Left err -> const (return $ throwPM p err)
_ -> SQLParser.parse model p
"dummy" -> DummyParser.parse p
"format" -> FormatParser.parse "" p
"printf" -> FormatParser.parse "putStr" p
......@@ -99,22 +100,33 @@ formatWarnings ws@((p,_):_) = "\nWARNINGS in " ++ getFilename p ++ ":"
--- Translates a string containing a Curry program with Integrated Code
--- into a string with pure Curry code.
--- The first argument is, if non-empty, the name of an info file containing
--- The second argument is, if non-empty, the name of an info file containing
--- information about the data model in case of integrated SQL code.
--- @param verb - verbosity level
--- @param model - name of file containing information about the datamodel
--- in case of SQL, an empty string otherwise
--- @param fname - The name of the original Curry file
--- @param s - The string that should be translated
--- @return The translated string
translateIntCode :: String -> String -> String -> IO String
translateIntCode model fname s = do
pinfo <- if model == ""
then return (Left "No .info file provided!")
else readParserInfo model
stw <- concatAllIOPM $ (applyLangParsers pinfo) $ ciparser fname s
translateIntCode :: Int -> String -> String -> String -> IO String
translateIntCode verb model fname s = do
pinfo <- tryReadParserInfoFile verb model
stw <- concatAllIOPM $ applyLangParsers pinfo
$ ciparser fname s
putStr (formatWarnings (getWarnings stw))
escapePR (discardWarnings stw) errfun
--- Try to read parser info file.
tryReadParserInfoFile :: Int -> String -> IO (Either String ParserInfo)
tryReadParserInfoFile verb model = do
if null model
then do dirfiles <- getDirectoryContents "." -- maybe modify?
case filter ("_SQLCode.info" `isSuffixOf`) dirfiles of
[] -> return (Left "No .info file provided or found!")
[m] -> readParserInfo verb m
_ -> return (Left "Multiple .info files found!")
else readParserInfo verb model
--- Handles the IO and PM monads around the StandardTokens for the
--- concatenation, so they will not disturb in the real concat function
--- concatAll
......@@ -204,12 +216,11 @@ splitByLine s = splitByLineIter "" s
--- @param iotks - The input StandardTokens wrapped in IO and ParserMonad
--- @result - The translated StandardTokens wrapped in IO and ParserMonad
applyLangParsers :: Either String ParserInfo
-> IO (PM [StandardToken])
-> IO (PM [StandardToken])
-> IO (PM [StandardToken])
-> IO (PM [StandardToken])
applyLangParsers model iotks = do
prtks <- iotks
prpr <- swapIOPM
(liftPM (\tks -> sequenceIO (map (applyLangParser model) tks)) prtks)
prpr <- swapIOPM (liftPM (mapIO (applyLangParser model)) prtks)
return (crumplePM (liftPM (\prpt -> sequencePM prpt) prpr))
--- Select the right translator and apply it to a single StandardToken
......@@ -217,9 +228,9 @@ applyLangParsers model iotks = do
--- error message otherwise
--- @param t - The input StandardToken
--- result - The translated StandardToken wrapped in IO and ParserMonad
applyLangParser :: Either String ParserInfo ->
StandardToken ->
IO (PM StandardToken)
applyLangParser :: Either String ParserInfo
-> StandardToken
-> IO (PM StandardToken)
applyLangParser model (StTk p pexp l c) =
do parsedStringNoIO <- (parsers l model) pexp c
return (bindPM parsedStringNoIO (\s -> cleanPM (StTk p pexp l s)))
......@@ -7,7 +7,7 @@
--- is supported (option `foreigncode`, see module `Translator`).
---
--- @author Michael Hanus
--- @version May 2016
--- @version June 2016
------------------------------------------------------------------------------
import AbstractCurry.Types
......@@ -29,7 +29,7 @@ import TransContracts(transContracts)
cppBanner :: String
cppBanner = unlines [bannerLine,bannerText,bannerLine]
where
bannerText = "Curry Preprocessor (version of 17/05/2016)"
bannerText = "Curry Preprocessor (version of 04/06/2016)"
bannerLine = take (length bannerText) (repeat '=')
--- Preprocessor targets, i.e., kind of entities to be preprocessed:
......@@ -204,7 +204,7 @@ callPreprocessors :: PPOpts -> String -> String -> String -> String -> String
-> IO String
callPreprocessors opts optlines modname srcprog orgfile outfile
| ForeignCode `elem` pptargets
= do icouttxt <- translateIntCode (optModel opts) orgfile srcprog
= do icouttxt <- translateIntCode verb (optModel opts) orgfile srcprog
if null (intersect [SequentialRules, DefaultRules, Contracts] pptargets)
then return icouttxt -- no further preprocessors
else do writeFile orgfile icouttxt
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment