Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Glasgow Haskell Compiler
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Locked Files
Issues
0
Issues
0
List
Boards
Labels
Service Desk
Milestones
Iterations
Merge Requests
0
Merge Requests
0
Requirements
Requirements
List
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Security & Compliance
Security & Compliance
Dependency List
License Compliance
Operations
Operations
Incidents
Environments
Packages & Registries
Packages & Registries
Package Registry
Container Registry
Analytics
Analytics
CI / CD
Code Review
Insights
Issue
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Shayne Fletcher
Glasgow Haskell Compiler
Commits
08894f96
Commit
08894f96
authored
Jan 14, 2012
by
Ian Lynagh
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Switch to using the time package, rather than old-time
parent
7bc456d7
Changes
11
Hide whitespace changes
Inline
Side-by-side
Showing
11 changed files
with
75 additions
and
47 deletions
+75
-47
compiler/deSugar/Coverage.lhs
compiler/deSugar/Coverage.lhs
+4
-3
compiler/ghc.cabal.in
compiler/ghc.cabal.in
+4
-1
compiler/iface/BinIface.hs
compiler/iface/BinIface.hs
+0
-11
compiler/iface/MkIface.lhs
compiler/iface/MkIface.lhs
+2
-3
compiler/main/DriverPipeline.hs
compiler/main/DriverPipeline.hs
+6
-6
compiler/main/Finder.lhs
compiler/main/Finder.lhs
+2
-2
compiler/main/GHC.hs
compiler/main/GHC.hs
+2
-2
compiler/main/GhcMake.hs
compiler/main/GhcMake.hs
+10
-10
compiler/main/HscTypes.lhs
compiler/main/HscTypes.lhs
+6
-6
compiler/utils/Binary.hs
compiler/utils/Binary.hs
+18
-0
compiler/utils/Util.lhs
compiler/utils/Util.lhs
+21
-3
No files found.
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 <- getModification
UTC
Time 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 getModification
UTC
Time 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 <- getModification
UTC
Time 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
<-
getModification
UTC
Time
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
$
getModification
UTC
Time
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
.
getModification
UTC
Time
)
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
.
getModification
UTC
Time
)
(
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
$
getModification
UTC
Time
(
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
<-
getModification
UTC
Time
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 ->
Clock
Time -> IO Linkable
findObjectLinkable :: Module -> FilePath ->
UTC
Time -> 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
$
getC
lock
Time
currentTime
<-
liftIO
$
getC
urrent
Time
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
,
Clock
Time
)
->
Maybe
(
StringBuffer
,
UTC
Time
)
->
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
$
getModification
UTC
Time
file
-- The file exists; we checked in getRootSummary above.
-- If it gets removed subsequently, then this
-- getModificationTime may fail, but that's the right
-- getModification
UTC
Time 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
$
getModification
UTC
Time
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
,
Clock
Time
)
->
Maybe
(
StringBuffer
,
UTC
Time
)
->
[
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
(
getModification
UTC
Time
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
Clock
Time
)
getObjTimestamp
::
ModLocation
->
Bool
->
IO
(
Maybe
UTC
Time
)
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
,
Clock
Time
)
->
Maybe
(
StringBuffer
,
UTC
Time
)
->
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,
Clock
Time)
targetContents :: Maybe (StringBuffer,
UTC
Time)
-- ^ in-memory text buffer?
}
...
...
@@ -1632,7 +1632,7 @@ data Usage
} -- ^ Module from the current package
| UsageFile {
usg_file_path :: FilePath,
usg_mtime ::
Clock
Time
usg_mtime ::
UTC
Time
-- ^ 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
Clock
Time)
modificationTimeIfExists :: FilePath -> IO (Maybe
UTC
Time)
modificationTimeIfExists f = do
(do t <- getModificationTime f; return (Just t))
(do t <- getModification
UTC
Time f; return (Just t))
`catchIO` \e -> if isDoesNotExistError e
then return Nothing
else ioError e
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment