Commit fb6eb202 authored by Björn Peemöller 's avatar Björn Peemöller
Browse files

Implemented custom preprocessor call

parent 6d42dc9a
...@@ -36,7 +36,7 @@ Executable cymake ...@@ -36,7 +36,7 @@ Executable cymake
Build-Depends: base == 3.* Build-Depends: base == 3.*
Build-Depends: Build-Depends:
curry-base == 0.3.9 curry-base == 0.3.9
, containers, either, mtl, transformers , containers, directory, either, mtl, process, transformers
ghc-options: -Wall ghc-options: -Wall
Other-Modules: Other-Modules:
Base.CurryTypes Base.CurryTypes
......
...@@ -18,11 +18,17 @@ module Modules ...@@ -18,11 +18,17 @@ module Modules
( compileModule, loadModule, checkModuleHeader, checkModule, writeOutput ( compileModule, loadModule, checkModuleHeader, checkModule, writeOutput
) where ) where
import qualified Control.Exception as C (catch, IOException) import qualified Control.Exception as C (catch, IOException)
import Control.Monad (unless, when) import Control.Monad (liftM, unless, when)
import qualified Data.Map as Map (elems) import qualified Data.Map as Map (elems)
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import System.IO (hClose, hGetContents, openFile, IOMode (ReadMode)) import System.Directory (getTemporaryDirectory, removeFile)
import System.Exit (ExitCode (..))
import System.FilePath (normalise)
import System.IO
(IOMode (ReadMode), Handle, hClose, hGetContents, hPutStr, openFile
, openTempFile)
import System.Process (system)
import Curry.Base.Ident import Curry.Base.Ident
import Curry.Base.Message (runMsg) import Curry.Base.Message (runMsg)
...@@ -82,7 +88,7 @@ compileModule opts fn = do ...@@ -82,7 +88,7 @@ compileModule opts fn = do
loadModule :: Options -> FilePath -> CYIO (CompilerEnv, CS.Module) loadModule :: Options -> FilePath -> CYIO (CompilerEnv, CS.Module)
loadModule opts fn = do loadModule opts fn = do
parsed <- parseModule fn parsed <- parseModule opts fn
-- check module header -- check module header
mdl <- checkModuleHeader opts fn parsed mdl <- checkModuleHeader opts fn parsed
-- load the imported interfaces into an InterfaceEnv -- load the imported interfaces into an InterfaceEnv
...@@ -92,16 +98,46 @@ loadModule opts fn = do ...@@ -92,16 +98,46 @@ loadModule opts fn = do
cEnv <- importModules opts mdl iEnv cEnv <- importModules opts mdl iEnv
return (cEnv, mdl) return (cEnv, mdl)
parseModule :: FilePath -> CYIO CS.Module parseModule :: Options -> FilePath -> CYIO CS.Module
parseModule fn = do parseModule opts fn = do
mbSrc <- liftIO $ readModule fn mbSrc <- liftIO $ readModule fn
case mbSrc of case mbSrc of
Nothing -> left [message $ text $ "Missing file: " ++ fn] Nothing -> left [message $ text $ "Missing file: " ++ fn]
Just src -> do Just src -> do
-- parse module case runMsg (CS.unlit fn src) of
case runMsg (CS.parseModule fn src) of Left err -> left [err]
Left err -> left [err] Right (ul, _) -> do
Right (parsed, _) -> right parsed prepd <- preprocess (optPrepOpts opts) fn ul
-- parse module
case runMsg (CS.parseModule fn prepd) of
Left err -> left [err]
Right (parsed, _) -> right parsed
preprocess :: PrepOpts -> FilePath -> String -> CYIO String
preprocess opts fn src
| not (ppPreprocess opts) = return src
| otherwise = do
res <- liftIO $ withTempFile $ \ inFn inHdl -> do
hPutStr inHdl src
hClose inHdl
withTempFile $ \ outFn outHdl -> do
hClose outHdl
ec <- system $ unwords $
[ppCmd opts, normalise fn, inFn, outFn] ++ ppOpts opts
case ec of
ExitFailure x -> return $ Left [message $ text $
"Preprocessor exited with exit code " ++ show x]
ExitSuccess -> Right `liftM` readFile outFn
either left right res
withTempFile :: (FilePath -> Handle -> IO a) -> IO a
withTempFile act = do
tmp <- getTemporaryDirectory
(fn, hdl) <- openTempFile tmp "cymake.curry"
res <- act fn hdl
hClose hdl
removeFile fn
return res
checkModuleHeader :: Monad m => Options -> FilePath -> CS.Module checkModuleHeader :: Monad m => Options -> FilePath -> CS.Module
-> CYT m CS.Module -> CYT m CS.Module
......
Markdown is supported
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