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

More robust behaviour in case of missing source files

parent da3ebc0a
......@@ -15,7 +15,6 @@
-}
module CurryBuilder (buildCurry, smake) where
import qualified Control.Exception as C (SomeException (..), catch)
import Control.Monad (liftM)
import Data.Maybe (catMaybes, mapMaybe)
import System.Time (ClockTime)
......@@ -134,7 +133,7 @@ smake :: [FilePath] -- ^ destination files
smake dests deps actOutdated actUpToDate = do
destTimes <- getDestTimes dests
depTimes <- getDepTimes deps
abortOnError $ make destTimes depTimes
make destTimes depTimes
where
make destTimes depTimes
| length destTimes < length dests = actOutdated
......@@ -142,17 +141,18 @@ smake dests deps actOutdated actUpToDate = do
| otherwise = actUpToDate
getDestTimes :: [FilePath] -> IO [ClockTime]
getDestTimes = liftM catMaybes . mapM tryGetModuleModTime
getDestTimes = liftM catMaybes . mapM getModuleModTime
getDepTimes :: [FilePath] -> IO [ClockTime]
getDepTimes = mapM (abortOnError . getModuleModTime)
getDepTimes = mapM (abortOnMissing . getModuleModTime)
outOfDate :: [ClockTime] -> [ClockTime] -> Bool
outOfDate tgtimes dptimes = or [ tg < dp | tg <- tgtimes, dp <- dptimes]
abortOnError :: IO a -> IO a
abortOnError act = C.catch act handler
where handler (C.SomeException e) = abortWith [show e]
abortOnMissing :: IO (Maybe a) -> IO a
abortOnMissing act = act >>= \res -> case res of
Nothing -> abortWith ["Could not inspect modification time of file"]
Just val -> return val
errMissingFile :: String -> String
errMissingFile f = "Missing file \"" ++ f ++ "\""
......
......@@ -86,17 +86,21 @@ targetDeps opts paths sEnv fn = do
-- |Retrieve the dependencies of a given source file
sourceDeps :: Options -> [FilePath] -> SourceEnv -> FilePath -> IO SourceEnv
sourceDeps opts paths sEnv fn = do
hdr <- patchModuleId fn `liftM` (ok . parseHeader fn) `liftM` readModule fn
moduleDeps opts paths sEnv fn hdr
mbFile <- readModule fn
case mbFile of
Nothing -> internalError $ "CurryDeps.sourceDeps: missing file " ++ fn
Just file -> do
let hdr = patchModuleId fn $ ok $ parseHeader fn file
moduleDeps opts paths sEnv fn hdr
-- |Retrieve the dependencies of a given module
moduleDeps :: Options -> [FilePath] -> SourceEnv -> FilePath -> Module -> IO SourceEnv
moduleDeps opts paths sEnv fn (Module m _ is _) = case Map.lookup m sEnv of
Just _ -> return sEnv
Nothing -> do
let imps = imports opts m is
sEnv' = Map.insert m (Source fn imps) sEnv
foldM (moduleIdentDeps opts paths) sEnv' imps
Just _ -> return sEnv
Nothing -> do
let imps = imports opts m is
sEnv' = Map.insert m (Source fn imps) sEnv
foldM (moduleIdentDeps opts paths) sEnv' imps
-- |Retrieve the imported modules and add the import of the Prelude
-- according to the compiler options.
......@@ -118,12 +122,12 @@ moduleIdentDeps opts paths sEnv m = case Map.lookup m sEnv of
| icurryExt `isSuffixOf` fn -> return $ Map.insert m (Interface fn) sEnv
| otherwise -> checkModuleHeader fn
where
libraryPaths = optImportPaths opts
checkModuleHeader fn = do
hdr@(Module m' _ _ _) <- patchModuleId fn `liftM` (ok . parseHeader fn)
`liftM` readModule fn
unless (m == m') $ error $ errWrongModule m m'
moduleDeps opts paths sEnv fn hdr
libraryPaths = optImportPaths opts
checkModuleHeader fn = do
hdr@(Module m' _ _ _) <- patchModuleId fn `liftM` (ok . parseHeader fn)
`liftM` readFile fn
unless (m == m') $ error $ errWrongModule m m'
moduleDeps opts paths sEnv fn hdr
-- If we want to compile the program instead of generating Makefile
-- dependencies the environment has to be sorted topologically. Note
......
......@@ -51,7 +51,7 @@ source2html opts sourcefilename = do
--- @return program
filename2program :: [String] -> String -> IO Program
filename2program paths filename = do
cont <- readModule filename
(Just cont) <- readModule filename
typingParseRes <- catchError $ typingParse paths filename cont
fullParseRes <- catchError $ fullParse paths filename cont
parseRes <- catchError $ return (parse filename cont)
......
......@@ -18,7 +18,7 @@ module Modules
( compileModule, loadModule, checkModuleHeader, checkModule
) where
import Control.Monad (liftM, unless, when)
import Control.Monad (unless, when)
import Data.Maybe (fromMaybe)
import Curry.Base.MessageMonad
......@@ -100,17 +100,22 @@ compileModule opts fn = do
loadModule :: Options -> FilePath -> IO (CompilerEnv, CS.Module)
loadModule opts fn = do
-- read and parse module
parsed <- (ok . CS.parseModule (not extTarget) fn) `liftM` readModule fn
-- check module header
let (mdl, hdrErrs) = checkModuleHeader opts fn parsed
unless (null hdrErrs) $ abortWith hdrErrs
-- load the imported interfaces into an InterfaceEnv
(iEnv, intfErrs) <- loadInterfaces (optImportPaths opts) mdl
unless (null intfErrs) $ errorMessages intfErrs
-- add information of imported modules
let env = importModules opts mdl iEnv
return (env, mdl)
-- read module
mbSrc <- readModule fn
case mbSrc of
Nothing -> abortWith ["missing file: " ++ fn]
Just src -> do
-- parse module
let parsed = ok $ CS.parseModule (not extTarget) fn src
-- check module header
let (mdl, hdrErrs) = checkModuleHeader opts fn parsed
unless (null hdrErrs) $ abortWith hdrErrs
-- load the imported interfaces into an InterfaceEnv
(iEnv, intfErrs) <- loadInterfaces (optImportPaths opts) mdl
unless (null intfErrs) $ errorMessages intfErrs
-- add information of imported modules
let env = importModules opts mdl iEnv
return (env, mdl)
where extTarget = ExtendedFlatCurry `elem` optTargetTypes opts
checkModuleHeader :: Options -> FilePath -> CS.Module -> (CS.Module, [String])
......
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