diff options
author | Ian Lynagh <igloo@earth.li> | 2012-01-14 17:07:10 +0000 |
---|---|---|
committer | Ian Lynagh <igloo@earth.li> | 2012-01-14 17:07:10 +0000 |
commit | 08894f96407635781a233145435a78f144accab0 (patch) | |
tree | 2d89fcddef28508720aacaa7d7eeba0b177415dc | |
parent | 7bc456d776608051163aa08cee48e21599e129ae (diff) | |
download | haskell-08894f96407635781a233145435a78f144accab0.tar.gz |
Switch to using the time package, rather than old-time
-rw-r--r-- | compiler/deSugar/Coverage.lhs | 7 | ||||
-rw-r--r-- | compiler/ghc.cabal.in | 5 | ||||
-rw-r--r-- | compiler/iface/BinIface.hs | 11 | ||||
-rw-r--r-- | compiler/iface/MkIface.lhs | 5 | ||||
-rw-r--r-- | compiler/main/DriverPipeline.hs | 12 | ||||
-rw-r--r-- | compiler/main/Finder.lhs | 4 | ||||
-rw-r--r-- | compiler/main/GHC.hs | 4 | ||||
-rw-r--r-- | compiler/main/GhcMake.hs | 20 | ||||
-rw-r--r-- | compiler/main/HscTypes.lhs | 12 | ||||
-rw-r--r-- | compiler/utils/Binary.hs | 18 | ||||
-rw-r--r-- | compiler/utils/Util.lhs | 24 |
11 files changed, 75 insertions, 47 deletions
diff --git a/compiler/deSugar/Coverage.lhs b/compiler/deSugar/Coverage.lhs index 84cb6d628f..2d0ad237fc 100644 --- a/compiler/deSugar/Coverage.lhs +++ b/compiler/deSugar/Coverage.lhs @@ -41,7 +41,8 @@ import CLabel import Util import Data.Array -import System.Directory ( createDirectoryIfMissing ) +import Data.Time +import System.Directory import Trace.Hpc.Mix import Trace.Hpc.Util @@ -158,7 +159,7 @@ writeMixEntries dflags mod count entries filename tabStop = 8 -- <tab> counts as a normal char in GHC's location ranges. createDirectoryIfMissing True hpc_mod_dir - modTime <- getModificationTime filename + modTime <- getModificationUTCTime filename let entries' = [ (hpcPos, box) | (span,_,_,box) <- entries, hpcPos <- [mkHpcPos span] ] when (length entries' /= count) $ do @@ -1097,7 +1098,7 @@ type MixEntry_ = (SrcSpan, [String], [OccName], BoxLabel) -- This hash only has to be hashed at Mix creation time, -- and is for sanity checking only. -mixHash :: FilePath -> Integer -> Int -> [MixEntry] -> Int +mixHash :: FilePath -> UTCTime -> Int -> [MixEntry] -> Int mixHash file tm tabstop entries = fromIntegral $ hashString (show $ Mix file tm 0 tabstop entries) \end{code} diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in index a9d86f88be..51ae1542e3 100644 --- a/compiler/ghc.cabal.in +++ b/compiler/ghc.cabal.in @@ -61,11 +61,14 @@ Library if !flag(base3) && !flag(base4) Build-Depends: base < 3 + if flag(stage1) && impl(ghc < 7.5) + Build-Depends: old-time >= 1 && < 1.1 + if flag(base3) || flag(base4) Build-Depends: directory >= 1 && < 1.2, process >= 1 && < 1.2, bytestring >= 0.9 && < 0.10, - old-time >= 1 && < 1.1, + time < 1.5, containers >= 0.1 && < 0.5, array >= 0.1 && < 0.4 diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs index c701013725..6bf4da9fec 100644 --- a/compiler/iface/BinIface.hs +++ b/compiler/iface/BinIface.hs @@ -59,7 +59,6 @@ import Data.Word import Data.Array import Data.IORef import Control.Monad -import System.Time ( ClockTime(..) ) -- --------------------------------------------------------------------------- @@ -618,16 +617,6 @@ instance Binary AvailInfo where ac <- get bh return (AvailTC ab ac) - --- where should this be located? -instance Binary ClockTime where - put_ bh (TOD x y) = put_ bh x >> put_ bh y - - get bh = do - x <- get bh - y <- get bh - return $ TOD x y - instance Binary Usage where put_ bh usg@UsagePackageModule{} = do putByte bh 0 diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs index 35b4c91f2a..86a512469a 100644 --- a/compiler/iface/MkIface.lhs +++ b/compiler/iface/MkIface.lhs @@ -111,7 +111,6 @@ import Data.Map (Map) import qualified Data.Map as Map import Data.IORef import System.FilePath -import System.Directory (getModificationTime) \end{code} @@ -886,7 +885,7 @@ mkOrphMap get_key decls mkUsageInfo :: HscEnv -> Module -> ImportedMods -> NameSet -> [FilePath] -> IO [Usage] mkUsageInfo hsc_env this_mod dir_imp_mods used_names dependent_files = do { eps <- hscEPS hsc_env - ; mtimes <- mapM getModificationTime dependent_files + ; mtimes <- mapM getModificationUTCTime dependent_files ; let mod_usages = mk_mod_usage_info (eps_PIT eps) hsc_env this_mod dir_imp_mods used_names ; let usages = mod_usages ++ map to_file_usage (zip dependent_files mtimes) @@ -1334,7 +1333,7 @@ checkModUsage _this_pkg UsageFile{ usg_file_path = file, usg_mtime = old_mtime } = liftIO $ handleIO handle $ do - new_mtime <- getModificationTime file + new_mtime <- getModificationUTCTime file return $ old_mtime /= new_mtime where handle = diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index 5c0d1b7d8c..f1c04174e1 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -190,7 +190,7 @@ compile' (nothingCompiler, interactiveCompiler, batchCompiler) (Just location) maybe_stub_o -- The object filename comes from the ModLocation - o_time <- getModificationTime object_filename + o_time <- getModificationUTCTime object_filename return ([DotO object_filename], o_time) let linkable = LM unlinked_time this_mod hs_unlinked @@ -353,13 +353,13 @@ linkingNeeded dflags linkables pkg_deps = do -- modification times on all of the objects and libraries, then omit -- linking (unless the -fforce-recomp flag was given). let exe_file = exeFileName dflags - e_exe_time <- tryIO $ getModificationTime exe_file + e_exe_time <- tryIO $ getModificationUTCTime exe_file case e_exe_time of Left _ -> return True Right t -> do -- first check object files and extra_ld_inputs extra_ld_inputs <- readIORef v_Ld_inputs - e_extra_times <- mapM (tryIO . getModificationTime) extra_ld_inputs + e_extra_times <- mapM (tryIO . getModificationUTCTime) extra_ld_inputs let (errs,extra_times) = splitEithers e_extra_times let obj_times = map linkableTime linkables ++ extra_times if not (null errs) || any (t <) obj_times @@ -375,7 +375,7 @@ linkingNeeded dflags linkables pkg_deps = do pkg_libfiles <- mapM (uncurry findHSLib) pkg_hslibs if any isNothing pkg_libfiles then return True else do - e_lib_times <- mapM (tryIO . getModificationTime) + e_lib_times <- mapM (tryIO . getModificationUTCTime) (catMaybes pkg_libfiles) let (lib_errs,lib_times) = splitEithers e_lib_times if not (null lib_errs) || any (t <) lib_times @@ -906,7 +906,7 @@ runPhase (Hsc src_flavour) input_fn dflags0 -- changed (which the compiler itself figures out). -- Setting source_unchanged to False tells the compiler that M.o is out of -- date wrt M.hs (or M.o doesn't exist) so we must recompile regardless. - src_timestamp <- io $ getModificationTime (basename <.> suff) + src_timestamp <- io $ getModificationUTCTime (basename <.> suff) let hsc_lang = hscTarget dflags source_unchanged <- io $ @@ -919,7 +919,7 @@ runPhase (Hsc src_flavour) input_fn dflags0 else do o_file_exists <- doesFileExist o_file if not o_file_exists then return SourceModified -- Need to recompile - else do t2 <- getModificationTime o_file + else do t2 <- getModificationUTCTime o_file if t2 > src_timestamp then return SourceUnmodified else return SourceModified diff --git a/compiler/main/Finder.lhs b/compiler/main/Finder.lhs index 3ac3a473a3..1417dad061 100644 --- a/compiler/main/Finder.lhs +++ b/compiler/main/Finder.lhs @@ -46,8 +46,8 @@ import Data.IORef ( IORef, writeIORef, readIORef, atomicModifyIORef ) import System.Directory import System.FilePath import Control.Monad -import System.Time ( ClockTime ) import Data.List ( partition ) +import Data.Time type FileExt = String -- Filename extension @@ -528,7 +528,7 @@ findObjectLinkableMaybe mod locn -- Make an object linkable when we know the object file exists, and we know -- its modification time. -findObjectLinkable :: Module -> FilePath -> ClockTime -> IO Linkable +findObjectLinkable :: Module -> FilePath -> UTCTime -> IO Linkable findObjectLinkable mod obj_fn obj_time = return (LM obj_time mod [DotO obj_fn]) -- We used to look for _stub.o files here, but that was a bug (#706) -- Now GHC merges the stub.o into the main .o (#3687) diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs index 6c31e2e1bf..d3a8bb11de 100644 --- a/compiler/main/GHC.hs +++ b/compiler/main/GHC.hs @@ -300,11 +300,11 @@ import Lexer import System.Directory ( doesFileExist, getCurrentDirectory ) import Data.Maybe import Data.List ( find ) +import Data.Time import Data.Typeable ( Typeable ) import Data.Word ( Word8 ) import Control.Monad import System.Exit ( exitWith, ExitCode(..) ) -import System.Time ( getClockTime ) import Exception import Data.IORef import System.FilePath @@ -812,7 +812,7 @@ compileToCore fn = do compileCoreToObj :: GhcMonad m => Bool -> CoreModule -> m () compileCoreToObj simplify cm@(CoreModule{ cm_module = mName }) = do dflags <- getSessionDynFlags - currentTime <- liftIO $ getClockTime + currentTime <- liftIO $ getCurrentTime cwd <- liftIO $ getCurrentDirectory modLocation <- liftIO $ mkHiOnlyModLocation dflags (hiSuf dflags) cwd ((moduleNameSlashes . moduleName) mName) diff --git a/compiler/main/GhcMake.hs b/compiler/main/GhcMake.hs index 3db920553e..a2fb9edf16 100644 --- a/compiler/main/GhcMake.hs +++ b/compiler/main/GhcMake.hs @@ -62,15 +62,15 @@ import UniqFM import qualified Data.Map as Map import qualified FiniteMap as Map( insertListWith) -import System.Directory ( doesFileExist, getModificationTime ) +import System.Directory import System.IO ( fixIO ) import System.IO.Error ( isDoesNotExistError ) -import System.Time ( ClockTime ) import System.FilePath import Control.Monad import Data.Maybe import Data.List import qualified Data.List as List +import Data.Time -- ----------------------------------------------------------------------------- -- Loading the program @@ -1200,7 +1200,7 @@ summariseFile -> FilePath -- source file name -> Maybe Phase -- start phase -> Bool -- object code allowed? - -> Maybe (StringBuffer,ClockTime) + -> Maybe (StringBuffer,UTCTime) -> IO ModSummary summariseFile hsc_env old_summaries file mb_phase obj_allowed maybe_buf @@ -1214,10 +1214,10 @@ summariseFile hsc_env old_summaries file mb_phase obj_allowed maybe_buf -- return the cached summary if the source didn't change src_timestamp <- case maybe_buf of Just (_,t) -> return t - Nothing -> liftIO $ getModificationTime file + Nothing -> liftIO $ getModificationUTCTime file -- The file exists; we checked in getRootSummary above. -- If it gets removed subsequently, then this - -- getModificationTime may fail, but that's the right + -- getModificationUTCTime may fail, but that's the right -- behaviour. if ms_hs_date old_summary == src_timestamp @@ -1251,7 +1251,7 @@ summariseFile hsc_env old_summaries file mb_phase obj_allowed maybe_buf src_timestamp <- case maybe_buf of Just (_,t) -> return t - Nothing -> liftIO $ getModificationTime file + Nothing -> liftIO $ getModificationUTCTime file -- getMofificationTime may fail -- when the user asks to load a source file by name, we only @@ -1285,7 +1285,7 @@ summariseModule -> IsBootInterface -- True <=> a {-# SOURCE #-} import -> Located ModuleName -- Imported module to be summarised -> Bool -- object code allowed? - -> Maybe (StringBuffer, ClockTime) + -> Maybe (StringBuffer, UTCTime) -> [ModuleName] -- Modules to exclude -> IO (Maybe ModSummary) -- Its new summary @@ -1306,7 +1306,7 @@ summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod) case maybe_buf of Just (_,t) -> check_timestamp old_summary location src_fn t Nothing -> do - m <- tryIO (getModificationTime src_fn) + m <- tryIO (getModificationUTCTime src_fn) case m of Right t -> check_timestamp old_summary location src_fn t Left e | isDoesNotExistError e -> find_it @@ -1398,7 +1398,7 @@ summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod) ms_obj_date = obj_timestamp })) -getObjTimestamp :: ModLocation -> Bool -> IO (Maybe ClockTime) +getObjTimestamp :: ModLocation -> Bool -> IO (Maybe UTCTime) getObjTimestamp location is_boot = if is_boot then return Nothing else modificationTimeIfExists (ml_obj_file location) @@ -1407,7 +1407,7 @@ getObjTimestamp location is_boot preprocessFile :: HscEnv -> FilePath -> Maybe Phase -- ^ Starting phase - -> Maybe (StringBuffer,ClockTime) + -> Maybe (StringBuffer,UTCTime) -> IO (DynFlags, FilePath, StringBuffer) preprocessFile hsc_env src_fn mb_phase Nothing = do diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs index b6bf938332..db81bc43f0 100644 --- a/compiler/main/HscTypes.lhs +++ b/compiler/main/HscTypes.lhs @@ -164,11 +164,11 @@ import Control.Monad ( mplus, guard, liftM, when ) import Data.Array ( Array, array ) import Data.IORef import Data.Map ( Map ) +import Data.Time import Data.Word import Data.Typeable ( Typeable ) import Exception import System.FilePath -import System.Time ( ClockTime ) -- ----------------------------------------------------------------------------- -- Source Errors @@ -356,7 +356,7 @@ data Target = Target { targetId :: TargetId, -- ^ module or filename targetAllowObjCode :: Bool, -- ^ object code allowed? - targetContents :: Maybe (StringBuffer,ClockTime) + targetContents :: Maybe (StringBuffer,UTCTime) -- ^ in-memory text buffer? } @@ -1632,7 +1632,7 @@ data Usage } -- ^ Module from the current package | UsageFile { usg_file_path :: FilePath, - usg_mtime :: ClockTime + usg_mtime :: UTCTime -- ^ External file dependency. From a CPP #include or TH addDependentFile. Should be absolute. } deriving( Eq ) @@ -1803,8 +1803,8 @@ data ModSummary ms_mod :: Module, -- ^ Identity of the module ms_hsc_src :: HscSource, -- ^ The module source either plain Haskell, hs-boot or external core ms_location :: ModLocation, -- ^ Location of the various files belonging to the module - ms_hs_date :: ClockTime, -- ^ Timestamp of source file - ms_obj_date :: Maybe ClockTime, -- ^ Timestamp of object, if we have one + ms_hs_date :: UTCTime, -- ^ Timestamp of source file + ms_obj_date :: Maybe UTCTime, -- ^ Timestamp of object, if we have one ms_srcimps :: [Located (ImportDecl RdrName)], -- ^ Source imports of the module ms_textual_imps :: [Located (ImportDecl RdrName)], -- ^ Non-source imports of the module from the module *text* ms_hspp_file :: FilePath, -- ^ Filename of preprocessed source file @@ -2100,7 +2100,7 @@ stuff is the *dynamic* linker, and isn't present in a stage-1 compiler \begin{code} -- | Information we can use to dynamically link modules into the compiler data Linkable = LM { - linkableTime :: ClockTime, -- ^ Time at which this linkable was built + linkableTime :: UTCTime, -- ^ Time at which this linkable was built -- (i.e. when the bytecodes were produced, -- or the mod date on the files) linkableModule :: Module, -- ^ The linkable module itself diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs index bfddf5b322..feb4be50c1 100644 --- a/compiler/utils/Binary.hs +++ b/compiler/utils/Binary.hs @@ -76,6 +76,7 @@ import Foreign import Data.Array import Data.IORef import Data.Char ( ord, chr ) +import Data.Time import Data.Typeable #if __GLASGOW_HASKELL__ >= 701 import Data.Typeable.Internal @@ -488,6 +489,23 @@ instance (Binary a, Binary b) => Binary (Either a b) where 0 -> do a <- get bh ; return (Left a) _ -> do b <- get bh ; return (Right b) +instance Binary UTCTime where + put_ bh u = do put_ bh (utctDay u) + put_ bh (utctDayTime u) + get bh = do day <- get bh + dayTime <- get bh + return $ UTCTime { utctDay = day, utctDayTime = dayTime } + +instance Binary Day where + put_ bh d = put_ bh (toModifiedJulianDay d) + get bh = do i <- get bh + return $ ModifiedJulianDay { toModifiedJulianDay = i } + +instance Binary DiffTime where + put_ bh dt = put_ bh (toRational dt) + get bh = do r <- get bh + return $ fromRational r + #if defined(__GLASGOW_HASKELL__) || 1 --to quote binary-0.3 on this code idea, -- diff --git a/compiler/utils/Util.lhs b/compiler/utils/Util.lhs index bbf56bc2fe..d09a1ad345 100644 --- a/compiler/utils/Util.lhs +++ b/compiler/utils/Util.lhs @@ -76,6 +76,7 @@ module Util ( -- * IO-ish utilities createDirectoryHierarchy, doesDirNameExist, + getModificationUTCTime, modificationTimeIfExists, global, consIORef, globalM, @@ -113,7 +114,6 @@ import System.IO.Error as IO ( isDoesNotExistError ) import System.Directory ( doesDirectoryExist, createDirectory, getModificationTime ) import System.FilePath -import System.Time ( ClockTime ) import Data.Char ( isUpper, isAlphaNum, isSpace, chr, ord, isDigit ) import Data.Ratio ( (%) ) @@ -122,6 +122,12 @@ import Data.Bits import Data.Word import qualified Data.IntMap as IM +import Data.Time +#if __GLASGOW_HASKELL__ < 705 +import Data.Time.Clock.POSIX +import System.Time +#endif + infixr 9 `thenCmp` \end{code} @@ -1029,12 +1035,24 @@ doesDirNameExist fpath = case takeDirectory fpath of "" -> return True -- XXX Hack _ -> doesDirectoryExist (takeDirectory fpath) +----------------------------------------------------------------------------- +-- Backwards compatibility definition of getModificationTime + +getModificationUTCTime :: FilePath -> IO UTCTime +#if __GLASGOW_HASKELL__ < 705 +getModificationUTCTime f = do + TOD secs _ <- getModificationTime f + return $ posixSecondsToUTCTime (realToFrac secs) +#else +getModificationUTCTime = getModificationTime +#endif + -- -------------------------------------------------------------- -- check existence & modification time at the same time -modificationTimeIfExists :: FilePath -> IO (Maybe ClockTime) +modificationTimeIfExists :: FilePath -> IO (Maybe UTCTime) modificationTimeIfExists f = do - (do t <- getModificationTime f; return (Just t)) + (do t <- getModificationUTCTime f; return (Just t)) `catchIO` \e -> if isDoesNotExistError e then return Nothing else ioError e |