diff options
Diffstat (limited to 'compiler/utils')
| -rw-r--r-- | compiler/utils/Binary.hs | 18 | ||||
| -rw-r--r-- | compiler/utils/IOEnv.hs | 5 | ||||
| -rw-r--r-- | compiler/utils/Util.lhs | 30 |
3 files changed, 47 insertions, 6 deletions
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/IOEnv.hs b/compiler/utils/IOEnv.hs index c029e4a8e0..ee7e616305 100644 --- a/compiler/utils/IOEnv.hs +++ b/compiler/utils/IOEnv.hs @@ -30,6 +30,7 @@ module IOEnv ( atomicUpdMutVar, atomicUpdMutVar' ) where +import DynFlags import Exception import Panic @@ -88,6 +89,10 @@ instance Show IOEnvFailure where instance Exception IOEnvFailure +instance ContainsDynFlags env => HasDynFlags (IOEnv env) where + getDynFlags = do env <- getEnv + return $ extractDynFlags env + ---------------------------------------------------------------------- -- Fundmantal combinators specific to the monad ---------------------------------------------------------------------- diff --git a/compiler/utils/Util.lhs b/compiler/utils/Util.lhs index 93800b0399..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} @@ -753,7 +759,7 @@ restrictedDamerauLevenshteinDistanceWithLengths m n str1 str2 else restrictedDamerauLevenshteinDistance' (undefined :: Integer) n m str2 str1 restrictedDamerauLevenshteinDistance' - :: (Bits bv) => bv -> Int -> Int -> String -> String -> Int + :: (Bits bv, Num bv) => bv -> Int -> Int -> String -> String -> Int restrictedDamerauLevenshteinDistance' _bv_dummy m n str1 str2 | [] <- str1 = n | otherwise = extractAnswer $ @@ -766,7 +772,7 @@ restrictedDamerauLevenshteinDistance' _bv_dummy m n str1 str2 extractAnswer (_, _, _, _, distance) = distance restrictedDamerauLevenshteinDistanceWorker - :: (Bits bv) => IM.IntMap bv -> bv -> bv + :: (Bits bv, Num bv) => IM.IntMap bv -> bv -> bv -> (bv, bv, bv, bv, Int) -> Char -> (bv, bv, bv, bv, Int) restrictedDamerauLevenshteinDistanceWorker str1_mvs top_bit_mask vector_mask (pm, d0, vp, vn, distance) char2 @@ -795,7 +801,7 @@ restrictedDamerauLevenshteinDistanceWorker str1_mvs top_bit_mask vector_mask sizedComplement :: Bits bv => bv -> bv -> bv sizedComplement vector_mask vect = vector_mask `xor` vect -matchVectors :: Bits bv => String -> IM.IntMap bv +matchVectors :: (Bits bv, Num bv) => String -> IM.IntMap bv matchVectors = snd . foldl' go (0 :: Int, IM.empty) where go (ix, im) char = let ix' = ix + 1 @@ -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 |