mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-09 04:59:31 -06:00
Add builtin preprocessors. Avoid creating tmp file. Fix multipreprocessor bug.
* The gf command line options -preproc=mkPresent and -preproc=mkMinimal now refer to internal preprocessors equivalent to lib/src/mkPresent and lib/src/mkMinimal. * The temporary file _gf_preproc.tmp is not created when running an internal preprocessor, unless there is an error, since errors messages refer to locations in the preprocessed file. (Possibly allowing the rgl build to be parallelized.) * After running an external preprocessor, the temporary file is deleted, unless there was an error. * (Bug fix) Before, when running more than one preprocessor, the same file name would be used for both input and output, e.g., mkPresent _gf_preproc.tmp > _gf_preproc.tmp which would result in an empty file being processed. Now, the input and output files will always be different.
This commit is contained in:
@@ -30,23 +30,71 @@ import Data.List (nub)
|
||||
import qualified Data.ByteString.Char8 as BS
|
||||
import Control.Monad (foldM)
|
||||
import System.Cmd (system)
|
||||
import System.Directory(removeFile)
|
||||
|
||||
getSourceModule :: Options -> FilePath -> IOE SourceModule
|
||||
getSourceModule opts file0 = ioe $
|
||||
catch (do file <- foldM runPreprocessor file0 (flag optPreprocessors opts)
|
||||
content <- BS.readFile file
|
||||
case runP pModDef content of
|
||||
Left (Pn l c,msg) -> return (Bad (file++":"++show l++":"++show c++": "++msg))
|
||||
Right mo -> return (Ok (addOptionsToModule opts mo)))
|
||||
(\e -> return (Bad (show e)))
|
||||
do tmp <- foldM runPreprocessor (Source file0) (flag optPreprocessors opts)
|
||||
content <- keepTemp tmp
|
||||
case runP pModDef content of
|
||||
Left (Pn l c,msg) -> do file <- writeTemp tmp
|
||||
let location = file++":"++show l++":"++show c
|
||||
return (Bad (location++": "++msg))
|
||||
Right mo -> do removeTemp tmp
|
||||
return (Ok (addOptionsToModule opts mo))
|
||||
`catch` (return . Bad . show)
|
||||
|
||||
addOptionsToModule :: Options -> SourceModule -> SourceModule
|
||||
addOptionsToModule opts = mapSourceModule (\m -> m { flags = flags m `addOptions` opts })
|
||||
|
||||
-- FIXME: should use System.IO.openTempFile
|
||||
runPreprocessor :: FilePath -> String -> IO FilePath
|
||||
runPreprocessor file0 p = do
|
||||
let tmp = "_gf_preproc.tmp"
|
||||
cmd = p +++ file0 ++ ">" ++ tmp
|
||||
system cmd
|
||||
return tmp
|
||||
runPreprocessor :: Temporary -> String -> IO Temporary
|
||||
runPreprocessor tmp0 p =
|
||||
maybe external internal (lookup p builtin_preprocessors)
|
||||
where
|
||||
internal preproc = (Internal . preproc) `fmap` readTemp tmp0
|
||||
external =
|
||||
do file0 <- writeTemp tmp0
|
||||
-- FIXME: should use System.IO.openTempFile
|
||||
let file1a = "_gf_preproc.tmp"
|
||||
file1b = "_gf_preproc2.tmp"
|
||||
-- file0 and file1 must be different
|
||||
file1 = if file0==file1a then file1b else file1a
|
||||
cmd = p +++ file0 ++ ">" ++ file1
|
||||
system cmd
|
||||
return (Temp file1)
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
builtin_preprocessors = [("mkPresent",mkPresent),("mkMinimal",mkMinimal)]
|
||||
|
||||
mkPresent = omit_lines "--# notpresent" -- grep -v "\-\-\# notpresent"
|
||||
mkMinimal = omit_lines "--# notminimal" -- grep -v "\-\-\# notminimal"
|
||||
|
||||
omit_lines s = BS.unlines . filter (not . BS.isInfixOf bs) . BS.lines
|
||||
where bs = BS.pack s
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
data Temporary = Source FilePath | Temp FilePath | Internal BS.ByteString
|
||||
|
||||
writeTemp tmp =
|
||||
case tmp of
|
||||
Source path -> return path
|
||||
Temp path -> return path
|
||||
Internal str -> do -- FIXME: should use System.IO.openTempFile
|
||||
let tmp = "_gf_preproc.tmp"
|
||||
BS.writeFile tmp str
|
||||
return tmp
|
||||
|
||||
readTemp tmp = do str <- keepTemp tmp
|
||||
removeTemp tmp
|
||||
return str
|
||||
|
||||
keepTemp tmp =
|
||||
case tmp of
|
||||
Source path -> BS.readFile path
|
||||
Temp path -> BS.readFile path
|
||||
Internal str -> return str
|
||||
|
||||
removeTemp (Temp path) = removeFile path
|
||||
removeTemp _ = return ()
|
||||
Reference in New Issue
Block a user