summaryrefslogtreecommitdiff
path: root/compiler/utils/Util.lhs
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/utils/Util.lhs')
-rw-r--r--compiler/utils/Util.lhs30
1 files changed, 24 insertions, 6 deletions
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