summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorIan Lynagh <igloo@earth.li>2012-01-14 17:07:10 +0000
committerIan Lynagh <igloo@earth.li>2012-01-14 17:07:10 +0000
commit08894f96407635781a233145435a78f144accab0 (patch)
tree2d89fcddef28508720aacaa7d7eeba0b177415dc
parent7bc456d776608051163aa08cee48e21599e129ae (diff)
downloadhaskell-08894f96407635781a233145435a78f144accab0.tar.gz
Switch to using the time package, rather than old-time
-rw-r--r--compiler/deSugar/Coverage.lhs7
-rw-r--r--compiler/ghc.cabal.in5
-rw-r--r--compiler/iface/BinIface.hs11
-rw-r--r--compiler/iface/MkIface.lhs5
-rw-r--r--compiler/main/DriverPipeline.hs12
-rw-r--r--compiler/main/Finder.lhs4
-rw-r--r--compiler/main/GHC.hs4
-rw-r--r--compiler/main/GhcMake.hs20
-rw-r--r--compiler/main/HscTypes.lhs12
-rw-r--r--compiler/utils/Binary.hs18
-rw-r--r--compiler/utils/Util.lhs24
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