Skip to content

GitLab

Glasgow Haskell Compiler
Glasgow Haskell Compiler
Commit 08894f96 authored by Ian Lynagh's avatar Ian Lynagh
Browse files
Options

Switch to using the time package, rather than old-time

parent 7bc456d7
Hide whitespace changes
Inline Side-by-side
Showing with 75 additions and 47 deletions
compiler/deSugar/Coverage.lhs
View file @ 08894f96
......@@ -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}
......
compiler/ghc.cabal.in
View file @ 08894f96
......@@ -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
......
compiler/iface/BinIface.hs
View file @ 08894f96
......@@ -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
......
compiler/iface/MkIface.lhs
View file @ 08894f96
......@@ -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 =
......
compiler/main/DriverPipeline.hs
View file @ 08894f96
......@@ -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
......
compiler/main/Finder.lhs
View file @ 08894f96
......@@ -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)
......
compiler/main/GHC.hs
View file @ 08894f96
......@@ -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)
......
compiler/main/GhcMake.hs
View file @ 08894f96
......@@ -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
......
compiler/main/HscTypes.lhs
View file @ 08894f96
......@@ -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
......
compiler/utils/Binary.hs
View file @ 08894f96
......@@ -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,
--
......
compiler/utils/Util.lhs
View file @ 08894f96
......@@ -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
......
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