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:
hallgren
2010-11-26 18:25:29 +00:00
parent 4c6b772934
commit 52eb1dcc37

View File

@@ -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 ()