From: simonmar Date: Fri, 12 Jan 2001 16:16:37 +0000 (+0000) Subject: [project @ 2001-01-12 16:16:36 by simonmar] X-Git-Tag: Approximately_9120_patches~2928 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=ef487d068885c686d60b3e8c9f79f3e66a1f4ef0;p=ghc-hetmet.git [project @ 2001-01-12 16:16:36 by simonmar] Time library FFI'd. --- diff --git a/ghc/lib/std/Time.hsc b/ghc/lib/std/Time.hsc new file mode 100644 index 0000000..80d5a61 --- /dev/null +++ b/ghc/lib/std/Time.hsc @@ -0,0 +1,614 @@ +-- ----------------------------------------------------------------------------- +-- $Id: Time.hsc,v 1.1 2001/01/12 16:16:36 simonmar Exp $ +-- +-- (c) The University of Glasgow, 1995-2001 +-- + +{- +Haskell 98 Time of Day Library +------------------------------ + +The Time library provides standard functionality for clock times, +including timezone information (i.e, the functionality of "time.h", +adapted to the Haskell environment), It follows RFC 1129 in its use of +Coordinated Universal Time (UTC). + +2000/06/17 : +RESTRICTIONS: + * min./max. time diff currently is restricted to + [minBound::Int, maxBound::Int] + + * surely other restrictions wrt. min/max bounds + + +NOTES: + * printing times + + `showTime' (used in `instance Show ClockTime') always prints time + converted to the local timezone (even if it is taken from + `(toClockTime . toUTCTime)'), whereas `calendarTimeToString' + honors the tzone & tz fields and prints UTC or whatever timezone + is stored inside CalendarTime. + + Maybe `showTime' should be changed to use UTC, since it would + better correspond to the actual representation of `ClockTime' + (can be done by replacing localtime(3) by gmtime(3)). + + +BUGS: + * add proper handling of microsecs, currently, they're mostly + ignored + + * `formatFOO' case of `%s' is currently broken... + + +TODO: + * check for unusual date cases, like 1970/1/1 00:00h, and conversions + between different timezone's etc. + + * check, what needs to be in the IO monad, the current situation + seems to be a bit inconsistent to me + + * check whether `isDst = -1' works as expected on other arch's + (Solaris anyone?) + + * add functions to parse strings to `CalendarTime' (some day...) + + * implement padding capabilities ("%_", "%-") in `formatFOO' + + * add rfc822 timezone (+0200 is CEST) representation ("%z") in `formatFOO' +-} + +module Time + ( + Month(..) + , Day(..) + + , ClockTime(..) -- non-standard, lib. report gives this as abstract + , getClockTime + + , TimeDiff(..) + , noTimeDiff -- non-standard (but useful when constructing TimeDiff vals.) + , diffClockTimes + , addToClockTime + + , normalizeTimeDiff -- non-standard + , timeDiffToString -- non-standard + , formatTimeDiff -- non-standard + + , CalendarTime(..) + , toCalendarTime + , toUTCTime + , toClockTime + , calendarTimeToString + , formatCalendarTime + + ) where + +#include "config.h" + +#if defined(HAVE_GETTIMEOFDAY) +# ifdef HAVE_SYS_TIME_H +# include +# endif +#elif defined(HAVE_GETCLOCK) +# ifdef HAVE_SYS_TIMERS_H +# define POSIX_4D9 1 +# include +# endif +#elif defined(HAVE_TIME_H) +# include +#endif + +#ifdef HAVE_WINDOWS_H +#include +#include +#include +#endif + +import Ix +import Locale + +import PrelMarshalAlloc +import PrelMarshalUtils +import PrelMarshalError +import PrelStorable +import PrelCString +import PrelCTypesISO +import PrelCTypes +import PrelCError +import PrelInt +import PrelPtr +import PrelIOBase +import PrelShow +import PrelNum +import PrelBase + +-- One way to partition and give name to chunks of a year and a week: + +data Month + = January | February | March | April + | May | June | July | August + | September | October | November | December + deriving (Eq, Ord, Enum, Bounded, Ix, Read, Show) + +data Day + = Sunday | Monday | Tuesday | Wednesday + | Thursday | Friday | Saturday + deriving (Eq, Ord, Enum, Bounded, Ix, Read, Show) + +-- @ClockTime@ is an abstract type, used for the internal clock time. +-- Clock times may be compared, converted to strings, or converted to an +-- external calendar time @CalendarTime@. + +data ClockTime = TOD Integer -- Seconds since 00:00:00 on 1 Jan 1970 + Integer -- Picoseconds with the specified second + deriving (Eq, Ord) + +-- When a @ClockTime@ is shown, it is converted to a string of the form +-- @"Mon Nov 28 21:45:41 GMT 1994"@. + +-- For now, we are restricted to roughly: +-- Fri Dec 13 20:45:52 1901 through Tue Jan 19 03:14:07 2038, because +-- we use the C library routines based on 32 bit integers. + +instance Show ClockTime where + showsPrec _ (TOD secs _nsec) = + showString $ unsafePerformIO $ do + withObject (fromIntegral secs :: CTime) $ \ p_timer -> do + p_tm <- localtime p_timer -- can't fail, according to POSIX + allocaBytes 64 $ \ p_buf -> do -- big enough for error message + r <- strftime p_buf 50 "%a %b %d %H:%M:%S %Z %Y"## p_tm + if r == 0 + then return "ClockTime.show{Time}: internal error" + else peekCString p_buf + + showList = showList__ (showsPrec 0) + +{- +@CalendarTime@ is a user-readable and manipulable +representation of the internal $ClockTime$ type. The +numeric fields have the following ranges. + +\begin{verbatim} +Value Range Comments +----- ----- -------- + +year -maxInt .. maxInt [Pre-Gregorian dates are inaccurate] +mon 0 .. 11 [Jan = 0, Dec = 11] +day 1 .. 31 +hour 0 .. 23 +min 0 .. 59 +sec 0 .. 61 [Allows for two leap seconds] +picosec 0 .. (10^12)-1 [This could be over-precise?] +wday 0 .. 6 [Sunday = 0, Saturday = 6] +yday 0 .. 365 [364 in non-Leap years] +tz -43200 .. 43200 [Variation from UTC in seconds] +\end{verbatim} + +The {\em tzname} field is the name of the time zone. The {\em isdst} +field indicates whether Daylight Savings Time would be in effect. +-} + +data CalendarTime + = CalendarTime { + ctYear :: Int, + ctMonth :: Month, + ctDay :: Int, + ctHour :: Int, + ctMin :: Int, + ctSec :: Int, + ctPicosec :: Integer, + ctWDay :: Day, + ctYDay :: Int, + ctTZName :: String, + ctTZ :: Int, + ctIsDST :: Bool + } + deriving (Eq,Ord,Read,Show) + +-- The @TimeDiff@ type records the difference between two clock times in +-- a user-readable way. + +data TimeDiff + = TimeDiff { + tdYear :: Int, + tdMonth :: Int, + tdDay :: Int, + tdHour :: Int, + tdMin :: Int, + tdSec :: Int, + tdPicosec :: Integer -- not standard + } + deriving (Eq,Ord,Read,Show) + +noTimeDiff :: TimeDiff +noTimeDiff = TimeDiff 0 0 0 0 0 0 0 + +-- ----------------------------------------------------------------------------- +-- getClockTime returns the current time in its internal representation. + +#if defined(_WIN32) && !defined(cygwin32_TARGET_OS) + -- + -- ftime() as implemented by cygwin (in B20.1) is + -- not right, so stay away & use time() there instead. + -- +getClockTime = do + allocaBytes (#const sizeof(struct timeb)) $ \ p_timeb -> do + ftime p_timeb + sec <- (#peek struct timeb,time) p_timeb :: IO CTime + msec <- (#peek struct timeb,millitime) p_timeb :: IO CUShort + return (TOD (fromIntegral sec) (fromIntegral msec * 1000{-ToDo: correct???-})) + +#elif defined(HAVE_GETTIMEOFDAY) +getClockTime = do + allocaBytes (#const sizeof(struct timeval)) $ \ p_timeval -> do + throwErrnoIfMinus1_ "getClockTime" $ gettimeofday p_timeval nullPtr + sec <- (#peek struct timeval,tv_sec) p_timeval :: IO CLong + usec <- (#peek struct timeval,tv_usec) p_timeval :: IO CLong + return (TOD (fromIntegral sec) ((fromIntegral usec) * 1000)) + +#else /* use POSIX time() */ +getClockTime = do + secs <- time nullPtr -- can't fail, according to POSIX + return (TOD (fromIntegral secs) 0) + +#endif + +-- ----------------------------------------------------------------------------- +-- addToClockTime d t adds a time difference d and a +-- clock time t to yield a new clock time. The difference d +-- may be either positive or negative. diffClockTimes t1 t2 returns +-- the difference between two clock times t1 and t2 as a TimeDiff. + +addToClockTime :: TimeDiff -> ClockTime -> ClockTime +addToClockTime (TimeDiff year mon day hour min sec psec) + (TOD c_sec c_psec) = + let + sec_diff = fromInt sec + 60 * fromInt min + 3600 * fromInt hour + 24 * 3600 * fromInt day + cal = toUTCTime (TOD (c_sec + sec_diff) (c_psec + psec)) + -- FIXME! ^^^^ + new_mon = fromEnum (ctMonth cal) + r_mon + (month', yr_diff) + | new_mon < 0 = (toEnum (12 + new_mon), (-1)) + | new_mon > 11 = (toEnum (new_mon `mod` 12), 1) + | otherwise = (toEnum new_mon, 0) + + (r_yr, r_mon) = mon `quotRem` 12 + + year' = ctYear cal + year + r_yr + yr_diff + in + toClockTime cal{ctMonth=month', ctYear=year'} + +diffClockTimes :: ClockTime -> ClockTime -> TimeDiff +-- diffClockTimes is meant to be the dual to `addToClockTime'. +-- If you want to have the TimeDiff properly splitted, use +-- `normalizeTimeDiff' on this function's result +-- +-- CAVEAT: see comment of normalizeTimeDiff +diffClockTimes (TOD sa pa) (TOD sb pb) = + noTimeDiff{ tdSec = fromIntegral (sa - sb) + -- FIXME: can handle just 68 years... + , tdPicosec = pa - pb + } + + +normalizeTimeDiff :: TimeDiff -> TimeDiff +-- FIXME: handle psecs properly +-- FIXME: ?should be called by formatTimeDiff automagically? +-- +-- when applied to something coming out of `diffClockTimes', you loose +-- the duality to `addToClockTime', since a year does not always have +-- 365 days, etc. +-- +-- apply this function as late as possible to prevent those "rounding" +-- errors +normalizeTimeDiff td = + let + rest0 = tdSec td + + 60 * (tdMin td + + 60 * (tdHour td + + 24 * (tdDay td + + 30 * (tdMonth td + + 365 * tdYear td)))) + + (diffYears, rest1) = rest0 `quotRem` (365 * 24 * 3600) + (diffMonths, rest2) = rest1 `quotRem` (30 * 24 * 3600) + (diffDays, rest3) = rest2 `quotRem` (24 * 3600) + (diffHours, rest4) = rest3 `quotRem` 3600 + (diffMins, diffSecs) = rest4 `quotRem` 60 + in + td{ tdYear = diffYears + , tdMonth = diffMonths + , tdDay = diffDays + , tdHour = diffHours + , tdMin = diffMins + , tdSec = diffSecs + } + +-- ----------------------------------------------------------------------------- +-- toCalendarTime t converts t to a local time, modified by +-- the current timezone and daylight savings time settings. toUTCTime +-- t converts t into UTC time. toClockTime l converts l into the +-- corresponding internal ClockTime. The wday, yday, tzname, and isdst fields +-- are ignored. + +#if HAVE_TM_ZONE +zone x = (#peek struct tm,tm_zone) x :: IO (Ptr CChar) +gmtoff x = (#peek struct tm,tm_gmtoff) x :: IO CLong + +#else /* ! HAVE_TM_ZONE */ +# if HAVE_TZNAME || _WIN32 +# if cygwin32_TARGET_OS +# define tzname _tzname +# endif +# ifndef mingw32_TARGET_OS +extern char *tzname[2]; +# endif +# define ZONE(x) (((struct tm *)x)->tm_isdst ? tzname[1] : tzname[0]) +# else /* ! HAVE_TZNAME */ +/* We're in trouble. If you should end up here, please report this as a bug. */ +# error Dont know how to get at timezone name on your OS. +# endif /* ! HAVE_TZNAME */ +/* Get the offset in secs from UTC, if (struct tm) doesn't supply it. */ + +#if defined(mingw32_TARGET_OS) || defined(cygwin32_TARGET_OS) +#define timezone _timezone +#endif + +#if !defined(HAVE_TIMEZONE) && !defined(mingw32_TARGET_OS) +extern TYPE_TIMEZONE timezone; +#endif + +# if HAVE_ALTZONE +extern time_t altzone; +# define GMTOFF(x) (((struct tm *)x)->tm_isdst ? altzone : timezone ) +# else /* ! HAVE_ALTZONE */ +/* Assume that DST offset is 1 hour ... */ +# define GMTOFF(x) (((struct tm *)x)->tm_isdst ? (timezone - 3600) : timezone ) +# endif /* ! HAVE_ALTZONE */ +#endif /* ! HAVE_TM_ZONE */ + + +toCalendarTime :: ClockTime -> IO CalendarTime +toCalendarTime = clockToCalendarTime localtime + +toUTCTime :: ClockTime -> CalendarTime +toUTCTime = unsafePerformIO . clockToCalendarTime gmtime + +-- ToDo: should be made thread safe, because localtime uses static storage, +-- or use the localtime_r version. +clockToCalendarTime :: (Ptr CTime -> IO (Ptr CTm)) -> ClockTime + -> IO CalendarTime +clockToCalendarTime fun (TOD secs psec) = do + withObject (fromIntegral secs :: CTime) $ \ p_timer -> do + p_tm <- fun p_timer -- can't fail, according to POSIX + sec <- (#peek struct tm,tm_sec ) p_tm :: IO CInt + min <- (#peek struct tm,tm_min ) p_tm :: IO CInt + hour <- (#peek struct tm,tm_hour ) p_tm :: IO CInt + mday <- (#peek struct tm,tm_mday ) p_tm :: IO CInt + mon <- (#peek struct tm,tm_mon ) p_tm :: IO CInt + year <- (#peek struct tm,tm_year ) p_tm :: IO CInt + wday <- (#peek struct tm,tm_wday ) p_tm :: IO CInt + yday <- (#peek struct tm,tm_yday ) p_tm :: IO CInt + isdst <- (#peek struct tm,tm_isdst) p_tm :: IO CInt + zone <- zone p_tm + tz <- gmtoff p_tm + + tzname <- peekCString zone + + let month | mon >= 0 && mon <= 11 = toEnum (fromIntegral mon) + | otherwise = error ("toCalendarTime: illegal month value: " ++ show mon) + + return (CalendarTime + (1900 + fromIntegral year) + month + (fromIntegral mday) + (fromIntegral hour) + (fromIntegral min) + (fromIntegral sec) + psec + (toEnum (fromIntegral wday)) + (fromIntegral yday) + tzname + (fromIntegral tz) + (isdst /= 0)) + + +toClockTime :: CalendarTime -> ClockTime +toClockTime (CalendarTime year mon mday hour min sec psec + _wday _yday _tzname tz isdst) = + + -- `isDst' causes the date to be wrong by one hour... + -- FIXME: check, whether this works on other arch's than Linux, too... + -- + -- so we set it to (-1) (means `unknown') and let `mktime' determine + -- the real value... + let isDst = -1 :: CInt in -- if isdst then (1::Int) else 0 + + if psec < 0 || psec > 999999999999 then + error "Time.toClockTime: picoseconds out of range" + else if tz < -43200 || tz > 43200 then + error "Time.toClockTime: timezone offset out of range" + else + unsafePerformIO $ do + allocaBytes (#const sizeof(struct tm)) $ \ p_tm -> do + (#poke struct tm,tm_sec ) p_tm (fromIntegral sec :: CInt) + (#poke struct tm,tm_min ) p_tm (fromIntegral min :: CInt) + (#poke struct tm,tm_hour ) p_tm (fromIntegral hour :: CInt) + (#poke struct tm,tm_mday ) p_tm (fromIntegral mday :: CInt) + (#poke struct tm,tm_mon ) p_tm (fromIntegral (fromEnum mon) :: CInt) + (#poke struct tm,tm_year ) p_tm (fromIntegral year - 1900 :: CInt) + (#poke struct tm,tm_isdst) p_tm isDst + t <- throwIf (== -1) (\_ -> "Time.toClockTime: invalid input") + (mktime p_tm) + -- + -- mktime expects its argument to be in the local timezone, but + -- toUTCTime makes UTC-encoded CalendarTime's ... + -- + -- Since there is no any_tz_struct_tm-to-time_t conversion + -- function, we have to fake one... :-) If not in all, it works in + -- most cases (before, it was the other way round...) + -- + -- Luckily, mktime tells us, what it *thinks* the timezone is, so, + -- to compensate, we add the timezone difference to mktime's + -- result. + -- + gmtoff <- gmtoff p_tm + let res = fromIntegral t + tz + fromIntegral gmtoff + return (TOD (fromIntegral res) 0) + +-- ----------------------------------------------------------------------------- +-- Converting time values to strings. + +calendarTimeToString :: CalendarTime -> String +calendarTimeToString = formatCalendarTime defaultTimeLocale "%c" + +formatCalendarTime :: TimeLocale -> String -> CalendarTime -> String +formatCalendarTime l fmt (CalendarTime year mon day hour min sec _ + wday yday tzname _ _) = + doFmt fmt + where doFmt ('%':'-':cs) = doFmt ('%':cs) -- padding not implemented + doFmt ('%':'_':cs) = doFmt ('%':cs) -- padding not implemented + doFmt ('%':c:cs) = decode c ++ doFmt cs + doFmt (c:cs) = c : doFmt cs + doFmt "" = "" + + decode 'A' = fst (wDays l !! fromEnum wday) -- day of the week, full name + decode 'a' = snd (wDays l !! fromEnum wday) -- day of the week, abbrev. + decode 'B' = fst (months l !! fromEnum mon) -- month, full name + decode 'b' = snd (months l !! fromEnum mon) -- month, abbrev + decode 'h' = snd (months l !! fromEnum mon) -- ditto + decode 'C' = show2 (year `quot` 100) -- century + decode 'c' = doFmt (dateTimeFmt l) -- locale's data and time format. + decode 'D' = doFmt "%m/%d/%y" + decode 'd' = show2 day -- day of the month + decode 'e' = show2' day -- ditto, padded + decode 'H' = show2 hour -- hours, 24-hour clock, padded + decode 'I' = show2 (to12 hour) -- hours, 12-hour clock + decode 'j' = show3 yday -- day of the year + decode 'k' = show2' hour -- hours, 24-hour clock, no padding + decode 'l' = show2' (to12 hour) -- hours, 12-hour clock, no padding + decode 'M' = show2 min -- minutes + decode 'm' = show2 (fromEnum mon+1) -- numeric month + decode 'n' = "\n" + decode 'p' = (if hour < 12 then fst else snd) (amPm l) -- am or pm + decode 'R' = doFmt "%H:%M" + decode 'r' = doFmt (time12Fmt l) + decode 'T' = doFmt "%H:%M:%S" + decode 't' = "\t" + decode 'S' = show2 sec -- seconds + decode 's' = show2 sec -- number of secs since Epoch. (ToDo.) + decode 'U' = show2 ((yday + 7 - fromEnum wday) `div` 7) -- week number, starting on Sunday. + decode 'u' = show (let n = fromEnum wday in -- numeric day of the week (1=Monday, 7=Sunday) + if n == 0 then 7 else n) + decode 'V' = -- week number (as per ISO-8601.) + let (week, days) = -- [yep, I've always wanted to be able to display that too.] + (yday + 7 - if fromEnum wday > 0 then + fromEnum wday - 1 else 6) `divMod` 7 + in show2 (if days >= 4 then + week+1 + else if week == 0 then 53 else week) + + decode 'W' = -- week number, weeks starting on monday + show2 ((yday + 7 - if fromEnum wday > 0 then + fromEnum wday - 1 else 6) `div` 7) + decode 'w' = show (fromEnum wday) -- numeric day of the week, weeks starting on Sunday. + decode 'X' = doFmt (timeFmt l) -- locale's preferred way of printing time. + decode 'x' = doFmt (dateFmt l) -- locale's preferred way of printing dates. + decode 'Y' = show year -- year, including century. + decode 'y' = show2 (year `rem` 100) -- year, within century. + decode 'Z' = tzname -- timezone name + decode '%' = "%" + decode c = [c] + + +show2, show2', show3 :: Int -> String +show2 x = [intToDigit (x `quot` 10), intToDigit (x `rem` 10)] + +show2' x = if x < 10 then [ ' ', intToDigit x] else show2 x + +show3 x = intToDigit (x `quot` 100) : show2 (x `rem` 100) + +to12 :: Int -> Int +to12 h = let h' = h `mod` 12 in if h' == 0 then 12 else h' + +-- Useful extensions for formatting TimeDiffs. + +timeDiffToString :: TimeDiff -> String +timeDiffToString = formatTimeDiff defaultTimeLocale "%c" + +formatTimeDiff :: TimeLocale -> String -> TimeDiff -> String +formatTimeDiff l fmt td@(TimeDiff year month day hour min sec _) + = doFmt fmt + where + doFmt "" = "" + doFmt ('%':'-':cs) = doFmt ('%':cs) -- padding not implemented + doFmt ('%':'_':cs) = doFmt ('%':cs) -- padding not implemented + doFmt ('%':c:cs) = decode c ++ doFmt cs + doFmt (c:cs) = c : doFmt cs + + decode spec = + case spec of + 'B' -> fst (months l !! fromEnum month) + 'b' -> snd (months l !! fromEnum month) + 'h' -> snd (months l !! fromEnum month) + 'c' -> defaultTimeDiffFmt td + 'C' -> show2 (year `quot` 100) + 'D' -> doFmt "%m/%d/%y" + 'd' -> show2 day + 'e' -> show2' day + 'H' -> show2 hour + 'I' -> show2 (to12 hour) + 'k' -> show2' hour + 'l' -> show2' (to12 hour) + 'M' -> show2 min + 'm' -> show2 (fromEnum month + 1) + 'n' -> "\n" + 'p' -> (if hour < 12 then fst else snd) (amPm l) + 'R' -> doFmt "%H:%M" + 'r' -> doFmt (time12Fmt l) + 'T' -> doFmt "%H:%M:%S" + 't' -> "\t" + 'S' -> show2 sec + 's' -> show2 sec -- Implementation-dependent, sez the lib doc.. + 'X' -> doFmt (timeFmt l) + 'x' -> doFmt (dateFmt l) + 'Y' -> show year + 'y' -> show2 (year `rem` 100) + '%' -> "%" + c -> [c] + + defaultTimeDiffFmt (TimeDiff year month day hour min sec _) = + foldr (\ (v,s) rest -> + (if v /= 0 + then show v ++ ' ':(addS v s) + ++ if null rest then "" else ", " + else "") ++ rest + ) + "" + (zip [year, month, day, hour, min, sec] (intervals l)) + + addS v s = if abs v == 1 then fst s else snd s + + +-- ----------------------------------------------------------------------------- +-- Foreign time interface (POSIX) + +type CTm = () -- struct tm + +foreign import unsafe localtime :: Ptr CTime -> IO (Ptr CTm) +foreign import unsafe gmtime :: Ptr CTime -> IO (Ptr CTm) +foreign import unsafe strftime :: Ptr CChar -> CSize -> Addr## -> Ptr CTm -> IO CSize +foreign import unsafe mktime :: Ptr CTm -> IO CTime +foreign import unsafe time :: Ptr CTime -> IO CTime + +#ifdef HAVE_GETTIMEOFDAY +type CTimeVal = () +foreign import unsafe gettimeofday :: Ptr CTimeVal -> Ptr () -> IO CInt +#endif + +#if defined(_WIN32) && !defined(cygwin32_TARGET_OS) +type CTimeB +foreign import unsafe ftime :: Ptr CTimeB -> IO CInt +#endif diff --git a/ghc/lib/std/Time.lhs b/ghc/lib/std/Time.lhs deleted file mode 100644 index 1cb55f1..0000000 --- a/ghc/lib/std/Time.lhs +++ /dev/null @@ -1,747 +0,0 @@ -% ------------------------------------------------------------------------------ -% $Id: Time.lhs,v 1.25 2001/01/11 17:25:57 simonmar Exp $ -% -% (c) The University of Glasgow, 1995-2000 -% - -\section[Time]{Haskell 1.4 Time of Day Library} - -The {\em Time} library provides standard functionality for -clock times, including timezone information (i.e, the functionality of -"time.h", adapted to the Haskell environment), It follows RFC 1129 in -its use of Coordinated Universal Time (UTC). - -2000/06/17 : -RESTRICTIONS: - * min./max. time diff currently is restricted to - [minBound::Int, maxBound::Int] - - * surely other restrictions wrt. min/max bounds - - -NOTES: - * printing times - - `showTime' (used in `instance Show ClockTime') always prints time - converted to the local timezone (even if it is taken from - `(toClockTime . toUTCTime)'), whereas `calendarTimeToString' - honors the tzone & tz fields and prints UTC or whatever timezone - is stored inside CalendarTime. - - Maybe `showTime' should be changed to use UTC, since it would - better correspond to the actual representation of `ClockTime' - (can be done by replacing localtime(3) by gmtime(3)). - - -BUGS: - * obvious bugs now should be fixed, but there are surely more (and - less obvious one's) lurking around :-} - - * gettimeofday(2) returns secs and _microsecs_, not pico-secs! - this should be changed accordingly (also means updating the H98 - report) - - * add proper handling of microsecs, currently, they're mostly - ignored - - * `formatFOO' case of `%s' is currently broken... - - -TODO: - * check for unusual date cases, like 1970/1/1 00:00h, and conversions - between different timezone's etc. - - * check, what needs to be in the IO monad, the current situation - seems to be a bit inconsistent to me - - * sync #ifdef'ed __HUGS__ parts with current changes (only few) - - * check whether `isDst = -1' works as expected on other arch's - (Solaris anyone?) - - * add functions to parse strings to `CalendarTime' (some day...) - - * implement padding capabilities ("%_", "%-") in `formatFOO' - - * add rfc822 timezone (+0200 is CEST) representation ("%z") in `formatFOO' - - -\begin{code} -{-# OPTIONS -#include "cbits/timezone.h" -#include "cbits/stgio.h" #-} -module Time - ( - Month(..) - , Day(..) - - , ClockTime(..) -- non-standard, lib. report gives this as abstract - , getClockTime - - , TimeDiff(..) - , noTimeDiff -- non-standard (but useful when constructing TimeDiff vals.) - , diffClockTimes - , addToClockTime - - , normalizeTimeDiff -- non-standard - , timeDiffToString -- non-standard - , formatTimeDiff -- non-standard - - , CalendarTime(..) - , toCalendarTime - , toUTCTime - , toClockTime - , calendarTimeToString - , formatCalendarTime - - ) where - -#ifdef __HUGS__ -import PreludeBuiltin -#else -import PrelGHC ( RealWorld, (>#), (<#), (==#), - newByteArray#, readIntArray#, - unsafeFreezeByteArray#, - int2Integer#, negateInt# ) -import PrelBase ( Int(..) ) -import PrelNum ( Integer(..), fromInt ) -import PrelIOBase ( IO(..), unsafePerformIO, stToIO, constructErrorAndFail ) -import PrelShow ( showList__ ) -import PrelPack ( unpackCString, unpackCStringBA, - new_ps_array, freeze_ps_array - ) -import PrelByteArr ( MutableByteArray(..), wORD_SCALE ) -import PrelHandle ( Bytes ) -import PrelPtr - -#endif - -import Ix -import Char ( intToDigit ) -import Locale - -\end{code} - -One way to partition and give name to chunks of a year and a week: - -\begin{code} -data Month - = January | February | March | April - | May | June | July | August - | September | October | November | December - deriving (Eq, Ord, Enum, Bounded, Ix, Read, Show) - -data Day - = Sunday | Monday | Tuesday | Wednesday - | Thursday | Friday | Saturday - deriving (Eq, Ord, Enum, Bounded, Ix, Read, Show) - -\end{code} - -@ClockTime@ is an abstract type, used for the internal clock time. -Clock times may be compared, converted to strings, or converted to an -external calendar time @CalendarTime@. - -\begin{code} -#ifdef __HUGS__ --- I believe Int64 is more than big enough. --- In fact, I think one of Int32 or Word32 would do. - ADR -data ClockTime = TOD Int64 Int64 deriving (Eq, Ord) -#else -data ClockTime = TOD Integer -- Seconds since 00:00:00 on 1 Jan 1970 - Integer -- Picoseconds with the specified second - deriving (Eq, Ord) - -#endif -\end{code} - -When a @ClockTime@ is shown, it is converted to a string of the form -@"Mon Nov 28 21:45:41 GMT 1994"@. - -For now, we are restricted to roughly: -Fri Dec 13 20:45:52 1901 through Tue Jan 19 03:14:07 2038, because -we use the C library routines based on 32 bit integers. - -\begin{code} -#ifdef __HUGS__ -#warning Show ClockTime is bogus -instance Show ClockTime -#else -instance Show ClockTime where - showsPrec p (TOD (S# i) _nsec) = - case int2Integer# i of (# s, d #) -> showsPrec p (TOD (J# s d) _nsec) - showsPrec _ (TOD (J# s# d#) _nsec) = - showString $ unsafePerformIO $ do - let buflen@(I# buflen#) = 50 -- big enough for error message - buf <- allocChars buflen - if s# <# (negateInt# 1#) || s# ># 1# then - return "ClockTime.show{Time}: out of range" - else do - rc <- showTime (I# s#) d# buflen buf - if rc < 0 then - return "ClockTime.show{Time}: internal error" - else do - ba <- stToIO (freeze_ps_array buf buflen#) - return (unpackCStringBA ba) - - showList = showList__ (showsPrec 0) -#endif -\end{code} - - -@CalendarTime@ is a user-readable and manipulable -representation of the internal $ClockTime$ type. The -numeric fields have the following ranges. - -\begin{verbatim} -Value Range Comments ------ ----- -------- - -year -maxInt .. maxInt [Pre-Gregorian dates are inaccurate] -mon 0 .. 11 [Jan = 0, Dec = 11] -day 1 .. 31 -hour 0 .. 23 -min 0 .. 59 -sec 0 .. 61 [Allows for two leap seconds] -picosec 0 .. (10^12)-1 [This could be over-precise?] -wday 0 .. 6 [Sunday = 0, Saturday = 6] -yday 0 .. 365 [364 in non-Leap years] -tz -43200 .. 43200 [Variation from UTC in seconds] -\end{verbatim} - -The {\em tzname} field is the name of the time zone. The {\em isdst} -field indicates whether Daylight Savings Time would be in effect. - -\begin{code} -data CalendarTime - = CalendarTime { - ctYear :: Int, - ctMonth :: Month, - ctDay :: Int, - ctHour :: Int, - ctMin :: Int, - ctSec :: Int, -#ifdef __HUGS__ - ctPicosec :: Int64, -#else - ctPicosec :: Integer, -#endif - ctWDay :: Day, - ctYDay :: Int, - ctTZName :: String, - ctTZ :: Int, - ctIsDST :: Bool - } - deriving (Eq,Ord,Read,Show) - -\end{code} - -The @TimeDiff@ type records the difference between two clock times in -a user-readable way. - -\begin{code} -data TimeDiff - = TimeDiff { - tdYear :: Int, - tdMonth :: Int, - tdDay :: Int, - tdHour :: Int, - tdMin :: Int, - tdSec :: Int, -#ifdef __HUGS__ - tdPicosec :: Int64 -- not standard -#else - tdPicosec :: Integer -- not standard -#endif - } - deriving (Eq,Ord,Read,Show) - -noTimeDiff :: TimeDiff -noTimeDiff = TimeDiff 0 0 0 0 0 0 0 -\end{code} - -@getClockTime@ returns the current time in its internal representation. - -\begin{code} -getClockTime :: IO ClockTime -getClockTime = do - i1 <- malloc1 - i2 <- malloc1 - rc <- primGetClockTime i1 i2 - if rc == 0 - then do - sec <- cvtUnsigned i1 - nsec <- cvtUnsigned i2 - return (TOD sec (nsec * 1000)) - else - constructErrorAndFail "getClockTime" - -#ifdef __HUGS__ -malloc1 = primNewByteArray sizeof_int64 -cvtUnsigned arr = primReadInt64Array arr 0 -#else -malloc1 :: IO (MutableByteArray RealWorld Int) -malloc1 = IO $ \ s# -> - case newByteArray# 1# s# of - (# s2#, barr# #) -> (# s2#, MutableByteArray bot bot barr# #) - where - bot = error "Time.malloc1" - - -- The C routine fills in an unsigned word. We don't have - -- `unsigned2Integer#,' so we freeze the data bits and use them - -- for an MP_INT structure. Note that zero is still handled specially, - -- although (J# 1# (ptr to 0#)) is probably acceptable to gmp. - -cvtUnsigned :: MutableByteArray RealWorld Int -> IO Integer -cvtUnsigned (MutableByteArray _ _ arr#) = IO $ \ s# -> - case readIntArray# arr# 0# s# of - (# s2#, r# #) | r# ==# 0# -> (# s2#, 0 #) - | otherwise -> - case unsafeFreezeByteArray# arr# s2# of - (# s3#, frozen# #) -> (# s3#, J# 1# frozen# #) -#endif -\end{code} - -@addToClockTime@ {\em d} {\em t} adds a time difference {\em d} and a -clock time {\em t} to yield a new clock time. The difference {\em d} -may be either positive or negative. @[diffClockTimes@ {\em t1} {\em -t2} returns the difference between two clock times {\em t1} and {\em -t2} as a @TimeDiff@. - - -\begin{code} -addToClockTime :: TimeDiff -> ClockTime -> ClockTime -addToClockTime (TimeDiff year mon day hour min sec psec) - (TOD c_sec c_psec) = - let - sec_diff = fromInt sec + 60 * fromInt min + 3600 * fromInt hour + 24 * 3600 * fromInt day - cal = toUTCTime (TOD (c_sec + sec_diff) (c_psec + psec)) - -- FIXME! ^^^^ - new_mon = fromEnum (ctMonth cal) + r_mon - (month', yr_diff) - | new_mon < 0 = (toEnum (12 + new_mon), (-1)) - | new_mon > 11 = (toEnum (new_mon `mod` 12), 1) - | otherwise = (toEnum new_mon, 0) - - (r_yr, r_mon) = mon `quotRem` 12 - - year' = ctYear cal + year + r_yr + yr_diff - in - toClockTime cal{ctMonth=month', ctYear=year'} - -diffClockTimes :: ClockTime -> ClockTime -> TimeDiff --- diffClockTimes is meant to be the dual to `addToClockTime'. --- If you want to have the TimeDiff properly splitted, use --- `normalizeTimeDiff' on this function's result --- --- CAVEAT: see comment of normalizeTimeDiff -diffClockTimes (TOD sa pa) (TOD sb pb) = - noTimeDiff{ tdSec = fromIntegral (sa - sb) - -- FIXME: can handle just 68 years... - , tdPicosec = pa - pb - } - - -normalizeTimeDiff :: TimeDiff -> TimeDiff --- FIXME: handle psecs properly --- FIXME: ?should be called by formatTimeDiff automagically? --- --- when applied to something coming out of `diffClockTimes', you loose --- the duality to `addToClockTime', since a year does not always have --- 365 days, etc. --- --- apply this function as late as possible to prevent those "rounding" --- errors -normalizeTimeDiff td = - let - rest0 = tdSec td - + 60 * (tdMin td - + 60 * (tdHour td - + 24 * (tdDay td - + 30 * (tdMonth td - + 365 * tdYear td)))) - - (diffYears, rest1) = rest0 `quotRem` (365 * 24 * 3600) - (diffMonths, rest2) = rest1 `quotRem` (30 * 24 * 3600) - (diffDays, rest3) = rest2 `quotRem` (24 * 3600) - (diffHours, rest4) = rest3 `quotRem` 3600 - (diffMins, diffSecs) = rest4 `quotRem` 60 - in - td{ tdYear = diffYears - , tdMonth = diffMonths - , tdDay = diffDays - , tdHour = diffHours - , tdMin = diffMins - , tdSec = diffSecs - } - -\end{code} - -@toCalendarTime@ {\em t} converts {\em t} to a local time, modified by -the current timezone and daylight savings time settings. @toUTCTime@ -{\em t} converts {\em t} into UTC time. @toClockTime@ {\em l} -converts {\em l} into the corresponding internal @ClockTime@. The -{\em wday}, {\em yday}, {\em tzname}, and {\em isdst} fields are -ignored. - -\begin{code} -#ifdef __HUGS__ -toCalendarTime :: ClockTime -> IO CalendarTime -toCalendarTime (TOD sec psec) = do - res <- allocWords sizeof_int64 - zoneNm <- allocChars 32 - prim_SETZONE res zoneNm - rc <- prim_toLocalTime sec res - if rc /= 0 - then constructErrorAndFail "Time.toCalendarTime: out of range" - else do - sec <- get_tm_sec res - min <- get_tm_min res - hour <- get_tm_hour res - mday <- get_tm_mday res - mon <- get_tm_mon res - year <- get_tm_year res - wday <- get_tm_wday res - yday <- get_tm_yday res - isdst <- get_tm_isdst res - zone <- prim_ZONE res - tz <- prim_GMTOFF res - tzname <- primUnpackCString zone - return (CalendarTime (1900+year) mon mday hour min sec psec - (toEnum wday) yday tzname tz (isdst /= 0)) - -toUTCTime :: ClockTime -> CalendarTime -toUTCTime (TOD sec psec) = unsafePerformIO $ do - res <- allocWords sizeof_int64 - zoneNm <- allocChars 32 - prim_SETZONE res zoneNm - rc <- prim_toUTCTime sec res - if rc /= 0 - then error "Time.toUTCTime: out of range" - else do - sec <- get_tm_sec res - min <- get_tm_min res - hour <- get_tm_hour res - mday <- get_tm_mday res - mon <- get_tm_mon res - year <- get_tm_year res - wday <- get_tm_wday res - yday <- get_tm_yday res - return (CalendarTime (1900+year) mon mday hour min sec psec - (toEnum wday) yday "UTC" 0 False) - -toClockTime :: CalendarTime -> ClockTime -toClockTime (CalendarTime year mon mday hour min sec psec wday yday tzname tz isdst) = - if psec < 0 || psec > 999999999999 then - error "Time.toClockTime: picoseconds out of range" - else if tz < -43200 || tz > 43200 then - error "Time.toClockTime: timezone offset out of range" - else - unsafePerformIO ( do - res <- allocWords sizeof_int64 - rc <- toClockSec year (fromEnum mon) mday hour min sec isDst res - if rc /= (0::Int) - then do - tm <- primReadInt64Array res 0 - return (TOD tm psec) - else error "Time.toClockTime: can't perform conversion" - ) - where - isDst = if isdst then (1::Int) else 0 - -#else -toCalendarTime :: ClockTime -> IO CalendarTime -toCalendarTime (TOD (S# i) psec) - = case int2Integer# i of (# s, d #) -> toCalendarTime (TOD (J# s d) psec) -toCalendarTime (TOD (J# s# d#) psec) = do - res <- allocWords sizeof_struct_tm - zoneNm <- allocChars 32 - prim_SETZONE res zoneNm - rc <- prim_toLocalTime (I# s#) d# res - if rc == 0 - then constructErrorAndFail "Time.toCalendarTime: out of range" - else do - sec <- get_tm_sec res - min <- get_tm_min res - hour <- get_tm_hour res - mday <- get_tm_mday res - mon <- get_tm_mon res - year <- get_tm_year res - wday <- get_tm_wday res - yday <- get_tm_yday res - isdst <- get_tm_isdst res - zone <- get_ZONE res - tz <- get_GMTOFF res - let tzname = unpackCString zone - month - | mon >= 0 && mon <= 11 = toEnum mon - | otherwise = error ("toCalendarTime: illegal month value: " ++ show mon) - - return (CalendarTime (1900+year) month mday hour min sec psec - (toEnum wday) yday tzname tz (isdst /= (0::Int))) - -toUTCTime :: ClockTime -> CalendarTime -toUTCTime (TOD (S# i) psec) - = case int2Integer# i of (# s, d #) -> toUTCTime (TOD (J# s d) psec) -toUTCTime (TOD (J# s# d#) psec) = unsafePerformIO $ do - res <- allocWords sizeof_struct_tm - zoneNm <- allocChars 32 - prim_SETZONE res zoneNm - rc <- prim_toUTCTime (I# s#) d# res - if rc == 0 - then error "Time.toUTCTime: out of range" - else do - sec <- get_tm_sec res - min <- get_tm_min res - hour <- get_tm_hour res - mday <- get_tm_mday res - mon <- get_tm_mon res - year <- get_tm_year res - wday <- get_tm_wday res - yday <- get_tm_yday res - let - month - | mon >= 0 && mon <= 11 = toEnum mon - | otherwise = error ("toCalendarTime: illegal month value: " ++ show mon) - - return (CalendarTime (1900+year) month mday hour min sec psec - (toEnum wday) yday "UTC" 0 False) - -toClockTime :: CalendarTime -> ClockTime -toClockTime (CalendarTime year mon mday hour min sec psec _wday _yday _tzname tz isdst) = - if psec < 0 || psec > 999999999999 then - error "Time.toClockTime: picoseconds out of range" - else if tz < -43200 || tz > 43200 then - error "Time.toClockTime: timezone offset out of range" - else - unsafePerformIO ( do - res <- malloc1 - rc <- toClockSec year (fromEnum mon) mday hour min sec tz isDst res - if rc /= 0 - then do - i <- cvtUnsigned res - return (TOD i psec) - else error "Time.toClockTime: can't perform conversion" - ) - where - -- `isDst' causes the date to be wrong by one hour... - -- FIXME: check, whether this works on other arch's than Linux, too... - -- - -- so we set it to (-1) (means `unknown') and let `mktime' determine - -- the real value... - isDst = -1 -- if isdst then (1::Int) else 0 -#endif - - --- (copied from PosixUtil, for now) --- Allocate a mutable array of characters with no indices. - -#ifdef __HUGS__ -allocChars :: Int -> IO (PrimMutableByteArray RealWorld) -allocChars size = primNewByteArray size - --- Allocate a mutable array of words with no indices - -allocWords :: Int -> IO (PrimMutableByteArray RealWorld) -allocWords size = primNewByteArray size -#else -allocChars :: Int -> IO (MutableByteArray RealWorld Int) -allocChars (I# size#) = stToIO (new_ps_array size#) - --- Allocate a mutable array of words with no indices - -allocWords :: Int -> IO (MutableByteArray RealWorld Int) -allocWords (I# size#) = IO $ \ s# -> - case newByteArray# (wORD_SCALE size#) s# of - (# s2#, barr# #) -> - (# s2#, MutableByteArray bot bot barr# #) - where - bot = error "Time.allocWords" -#endif -\end{code} - -\begin{code} -calendarTimeToString :: CalendarTime -> String -calendarTimeToString = formatCalendarTime defaultTimeLocale "%c" - -formatCalendarTime :: TimeLocale -> String -> CalendarTime -> String -formatCalendarTime l fmt (CalendarTime year mon day hour min sec _ - wday yday tzname _ _) = - doFmt fmt - where doFmt ('%':'-':cs) = doFmt ('%':cs) -- padding not implemented - doFmt ('%':'_':cs) = doFmt ('%':cs) -- padding not implemented - doFmt ('%':c:cs) = decode c ++ doFmt cs - doFmt (c:cs) = c : doFmt cs - doFmt "" = "" - - decode 'A' = fst (wDays l !! fromEnum wday) -- day of the week, full name - decode 'a' = snd (wDays l !! fromEnum wday) -- day of the week, abbrev. - decode 'B' = fst (months l !! fromEnum mon) -- month, full name - decode 'b' = snd (months l !! fromEnum mon) -- month, abbrev - decode 'h' = snd (months l !! fromEnum mon) -- ditto - decode 'C' = show2 (year `quot` 100) -- century - decode 'c' = doFmt (dateTimeFmt l) -- locale's data and time format. - decode 'D' = doFmt "%m/%d/%y" - decode 'd' = show2 day -- day of the month - decode 'e' = show2' day -- ditto, padded - decode 'H' = show2 hour -- hours, 24-hour clock, padded - decode 'I' = show2 (to12 hour) -- hours, 12-hour clock - decode 'j' = show3 yday -- day of the year - decode 'k' = show2' hour -- hours, 24-hour clock, no padding - decode 'l' = show2' (to12 hour) -- hours, 12-hour clock, no padding - decode 'M' = show2 min -- minutes - decode 'm' = show2 (fromEnum mon+1) -- numeric month - decode 'n' = "\n" - decode 'p' = (if hour < 12 then fst else snd) (amPm l) -- am or pm - decode 'R' = doFmt "%H:%M" - decode 'r' = doFmt (time12Fmt l) - decode 'T' = doFmt "%H:%M:%S" - decode 't' = "\t" - decode 'S' = show2 sec -- seconds - decode 's' = show2 sec -- number of secs since Epoch. (ToDo.) - decode 'U' = show2 ((yday + 7 - fromEnum wday) `div` 7) -- week number, starting on Sunday. - decode 'u' = show (let n = fromEnum wday in -- numeric day of the week (1=Monday, 7=Sunday) - if n == 0 then 7 else n) - decode 'V' = -- week number (as per ISO-8601.) - let (week, days) = -- [yep, I've always wanted to be able to display that too.] - (yday + 7 - if fromEnum wday > 0 then - fromEnum wday - 1 else 6) `divMod` 7 - in show2 (if days >= 4 then - week+1 - else if week == 0 then 53 else week) - - decode 'W' = -- week number, weeks starting on monday - show2 ((yday + 7 - if fromEnum wday > 0 then - fromEnum wday - 1 else 6) `div` 7) - decode 'w' = show (fromEnum wday) -- numeric day of the week, weeks starting on Sunday. - decode 'X' = doFmt (timeFmt l) -- locale's preferred way of printing time. - decode 'x' = doFmt (dateFmt l) -- locale's preferred way of printing dates. - decode 'Y' = show year -- year, including century. - decode 'y' = show2 (year `rem` 100) -- year, within century. - decode 'Z' = tzname -- timezone name - decode '%' = "%" - decode c = [c] - - -show2, show2', show3 :: Int -> String -show2 x = [intToDigit (x `quot` 10), intToDigit (x `rem` 10)] - -show2' x = if x < 10 then [ ' ', intToDigit x] else show2 x - -show3 x = intToDigit (x `quot` 100) : show2 (x `rem` 100) - -to12 :: Int -> Int -to12 h = let h' = h `mod` 12 in if h' == 0 then 12 else h' -\end{code} - -Useful extensions for formatting TimeDiffs. - -\begin{code} -timeDiffToString :: TimeDiff -> String -timeDiffToString = formatTimeDiff defaultTimeLocale "%c" - -formatTimeDiff :: TimeLocale -> String -> TimeDiff -> String -formatTimeDiff l fmt td@(TimeDiff year month day hour min sec _) - = doFmt fmt - where - doFmt "" = "" - doFmt ('%':'-':cs) = doFmt ('%':cs) -- padding not implemented - doFmt ('%':'_':cs) = doFmt ('%':cs) -- padding not implemented - doFmt ('%':c:cs) = decode c ++ doFmt cs - doFmt (c:cs) = c : doFmt cs - - decode spec = - case spec of - 'B' -> fst (months l !! fromEnum month) - 'b' -> snd (months l !! fromEnum month) - 'h' -> snd (months l !! fromEnum month) - 'c' -> defaultTimeDiffFmt td - 'C' -> show2 (year `quot` 100) - 'D' -> doFmt "%m/%d/%y" - 'd' -> show2 day - 'e' -> show2' day - 'H' -> show2 hour - 'I' -> show2 (to12 hour) - 'k' -> show2' hour - 'l' -> show2' (to12 hour) - 'M' -> show2 min - 'm' -> show2 (fromEnum month + 1) - 'n' -> "\n" - 'p' -> (if hour < 12 then fst else snd) (amPm l) - 'R' -> doFmt "%H:%M" - 'r' -> doFmt (time12Fmt l) - 'T' -> doFmt "%H:%M:%S" - 't' -> "\t" - 'S' -> show2 sec - 's' -> show2 sec -- Implementation-dependent, sez the lib doc.. - 'X' -> doFmt (timeFmt l) - 'x' -> doFmt (dateFmt l) - 'Y' -> show year - 'y' -> show2 (year `rem` 100) - '%' -> "%" - c -> [c] - - defaultTimeDiffFmt (TimeDiff year month day hour min sec _) = - foldr (\ (v,s) rest -> - (if v /= 0 - then show v ++ ' ':(addS v s) - ++ if null rest then "" else ", " - else "") ++ rest - ) - "" - (zip [year, month, day, hour, min, sec] (intervals l)) - - addS v s = if abs v == 1 then fst s else snd s -\end{code} - -\begin{code} -foreign import "libHS_cbits" "get_tm_sec" unsafe get_tm_sec :: MBytes -> IO Int -foreign import "libHS_cbits" "get_tm_min" unsafe get_tm_min :: MBytes -> IO Int -foreign import "libHS_cbits" "get_tm_hour" unsafe get_tm_hour :: MBytes -> IO Int -foreign import "libHS_cbits" "get_tm_mday" unsafe get_tm_mday :: MBytes -> IO Int -foreign import "libHS_cbits" "get_tm_mon" unsafe get_tm_mon :: MBytes -> IO Int -foreign import "libHS_cbits" "get_tm_year" unsafe get_tm_year :: MBytes -> IO Int -foreign import "libHS_cbits" "get_tm_wday" unsafe get_tm_wday :: MBytes -> IO Int -foreign import "libHS_cbits" "get_tm_yday" unsafe get_tm_yday :: MBytes -> IO Int -foreign import "libHS_cbits" "get_tm_isdst" unsafe get_tm_isdst :: MBytes -> IO Int - -foreign import "libHS_cbits" "sizeof_struct_tm" unsafe sizeof_struct_tm :: Int - -#ifdef __HUGS__ --- believed to be at least 1 bit (the sign bit!) bigger than sizeof_time_t -sizeof_int64 :: Int -sizeof_int64 = 8 -#endif - -type MBytes = MutableByteArray RealWorld Int - -foreign import "libHS_cbits" "sizeof_time_t" unsafe sizeof_time_t :: Int - -foreign import "libHS_cbits" "prim_SETZONE" unsafe prim_SETZONE :: MBytes -> MBytes -> IO () -#ifdef __HUGS__ -foreign import "libHS_cbits" "prim_toLocalTime" unsafe prim_toLocalTime :: Int64 -> MBytes -> IO Int -foreign import "libHS_cbits" "prim_toUTCTime" unsafe prim_toUTCTime :: Int64 -> MBytes -> IO Int -foreign import "libHS_cbits" "prim_ZONE" unsafe prim_ZONE :: Bytes -> IO (Ptr ()) -foreign import "libHS_cbits" "prim_GMTOFF" unsafe prim_GMTOFF :: Bytes -> IO Int -#else -foreign import "libHS_cbits" "toLocalTime" unsafe prim_toLocalTime :: Int -> Bytes -> MBytes -> IO Int -foreign import "libHS_cbits" "toUTCTime" unsafe prim_toUTCTime :: Int -> Bytes -> MBytes -> IO Int -#endif - -foreign import "libHS_cbits" "get_ZONE" unsafe get_ZONE :: MBytes -> IO (Ptr ()) -foreign import "libHS_cbits" "GMTOFF" unsafe get_GMTOFF :: MBytes -> IO Int - - -foreign import "libHS_cbits" "toClockSec" unsafe - toClockSec :: Int -> Int -> Int -> Int -> Int - -> Int -> Int -> Int -> MBytes -> IO Int - -foreign import "libHS_cbits" "getClockTime" unsafe - primGetClockTime :: MutableByteArray RealWorld Int - -> MutableByteArray RealWorld Int - -> IO Int -foreign import "libHS_cbits" "showTime" unsafe - showTime :: Int - -> Bytes - -> Int - -> MBytes - -> IO Int -\end{code} diff --git a/ghc/lib/std/cbits/getClockTime.c b/ghc/lib/std/cbits/getClockTime.c deleted file mode 100644 index 0aa8e06..0000000 --- a/ghc/lib/std/cbits/getClockTime.c +++ /dev/null @@ -1,93 +0,0 @@ -/* - * (c) The GRASP/AQUA Project, Glasgow University, 1994-1998 - * - * $Id: getClockTime.c,v 1.8 1999/10/26 09:34:09 sof Exp $ - * - * getClockTime Runtime Support - */ - -#ifndef _AIX -#define NON_POSIX_SOURCE /* gettimeofday */ -#endif - -#include "Rts.h" -#include "stgio.h" - -/* Note: skewing this code in favour of non-POSIX calls - such as gettimeofday() and getclock() rather than time(), - may seem strange/wrong. There's a good reason for it - though - the non-POSIX calls gives you better precision -- - they return usecs (or nsecs) as well as seconds, which - the users of getClockTime() is interested in knowing. - */ - -#if defined(HAVE_GETTIMEOFDAY) -# ifdef HAVE_SYS_TIME_H -# include -# endif -#elif defined(HAVE_GETCLOCK) -# ifdef HAVE_SYS_TIMERS_H -# define POSIX_4D9 1 -# include -# endif -#elif defined(HAVE_TIME_H) -# include -#endif - -#ifdef HAVE_WINDOWS_H -#include -#include -#include -#endif - -StgInt -getClockTime(StgByteArray sec, StgByteArray nsec) -{ -#if defined(_WIN32) && !defined(cygwin32_TARGET_OS) - /* - * ftime() as implemented by cygwin (in B20.1) is - * not right, so stay away & use time() there instead. - */ - struct timeb t; - - _ftime(&t); - - ((unsigned int *)sec)[0] = (unsigned int)t.time; - ((unsigned int *)nsec)[0] = (unsigned int)t.millitm * 1000; - return 0; -#elif defined(HAVE_GETTIMEOFDAY) - struct timeval tp; - - if (gettimeofday(&tp, NULL) != 0) { - cvtErrno(); - stdErrno(); - return -1; - } - ((unsigned long int *)sec)[0] = tp.tv_sec; - ((unsigned long int *)nsec)[0] = tp.tv_usec * 1000; - return 0; -#elif defined(HAVE_GETCLOCK) - struct timespec tp; - - if (getclock(TIMEOFDAY, &tp) != 0) { - cvtErrno(); - stdErrno(); - return -1; - } - ((unsigned long int *)sec)[0] = tp.tv_sec; - ((unsigned long int *)nsec)[0] = tp.tv_nsec; - return 0; -#elif defined(HAVE_TIME_H) - time_t t; - if ((t = time(NULL)) == (time_t) -1) { - cvtErrno(); - stdErrno(); - return -1; - } - ((unsigned long int *)sec)[0] = t; - ((unsigned long int *)nsec)[0] = 0; - return 0; -#else -#error "getClockTime: don't know how to get at the clock's time" -#endif -} diff --git a/ghc/lib/std/cbits/showTime.c b/ghc/lib/std/cbits/showTime.c deleted file mode 100644 index 43fd6c8..0000000 --- a/ghc/lib/std/cbits/showTime.c +++ /dev/null @@ -1,53 +0,0 @@ -/* - * (c) The GRASP/AQUA Project, Glasgow University, 1994-1998 - * - * $Id: showTime.c,v 1.8 2000/04/06 17:54:01 rrt Exp $ - * - * ClockTime.showsPrec Runtime Support - */ - -#include "Rts.h" -#include "stgio.h" - -#if TIME_WITH_SYS_TIME -# include -# include -#else -# if HAVE_SYS_TIME_H -# include -# else -# include -# endif -#endif - -StgInt -showTime(I_ size, StgByteArray d, I_ maxsize, StgByteArray buf) -{ - time_t t; - struct tm *tm; - - /* - * I allege that with the current (9/99) contents of Time.lhs, - * size will always be >= 0. -- sof - */ - switch(size) { - case 0: - t = 0; - break; - case 1: - t = (time_t) ((StgInt *)d)[0]; - break; - default: - return (-1); - } - tm = localtime(&t); -#ifdef cygwin32_TARGET_OS - /* Same as in timezone.c: tzset() isn't called automatically */ - tzset(); -#endif - if (tm != NULL && strftime(buf, maxsize, "%a %b %d %H:%M:%S %Z %Y", tm) > 0) { - return 1; - } else { - return (-1); - } -} diff --git a/ghc/lib/std/cbits/timezone.c b/ghc/lib/std/cbits/timezone.c deleted file mode 100644 index a54bc1d..0000000 --- a/ghc/lib/std/cbits/timezone.c +++ /dev/null @@ -1,47 +0,0 @@ -/* - * (c) The GRASP/AQUA Project, Glasgow University, 1994-1998 - * - * $Id: timezone.c,v 1.6 1999/12/08 15:47:08 simonmar Exp $ - * - * Timezone Runtime Support - */ - -#include "Rts.h" -#include "stgio.h" -#include "timezone.h" - -StgInt get_tm_sec ( StgAddr x ) { return ((struct tm*)x)->tm_sec; } -StgInt get_tm_min ( StgAddr x ) { return ((struct tm*)x)->tm_min; } -StgInt get_tm_hour ( StgAddr x ) { return ((struct tm*)x)->tm_hour; } -StgInt get_tm_mday ( StgAddr x ) { return ((struct tm*)x)->tm_mday; } -StgInt get_tm_mon ( StgAddr x ) { return ((struct tm*)x)->tm_mon; } -StgInt get_tm_year ( StgAddr x ) { return ((struct tm*)x)->tm_year; } -StgInt get_tm_wday ( StgAddr x ) { return ((struct tm*)x)->tm_wday; } -StgInt get_tm_yday ( StgAddr x ) { return ((struct tm*)x)->tm_yday; } -StgInt get_tm_isdst ( StgAddr x ) { return ((struct tm*)x)->tm_isdst; } -StgAddr prim_ZONE ( StgAddr x ) { return ZONE(x); } -StgInt prim_GMTOFF ( StgAddr x ) { return GMTOFF(x); } - -void -prim_SETZONE ( StgAddr x, StgAddr y ) -{ - SETZONE(x,y); -} - -StgInt sizeof_word ( void ) { return (sizeof(unsigned int)); } -StgInt sizeof_struct_tm ( void ) { return (sizeof(struct tm)); } -StgInt sizeof_time_t ( void ) { return (sizeof(time_t) / sizeof(int)); } - -char* -get_ZONE (StgAddr x) -{ -#ifdef cygwin32_TARGET_OS - /* - * tzname[] isn't properly initialised under cygwin B20.1 - * unless tzset() is called, so better do it here. - */ - tzset(); - -#endif - return (ZONE(x)); -} diff --git a/ghc/lib/std/cbits/timezone.h b/ghc/lib/std/cbits/timezone.h deleted file mode 100644 index f84c241..0000000 --- a/ghc/lib/std/cbits/timezone.h +++ /dev/null @@ -1,99 +0,0 @@ -/* - * (c) The GRASP/AQUA Project, Glasgow University, 1994-1998 - * - * $Id: timezone.h,v 1.10 2000/07/17 15:27:15 rrt Exp $ - * - * Time-zone support header - */ - -#ifndef TIMEZONE_H -#define TIMEZONE_H - -#define _OSF_SOURCE - -#if HAVE_SYS_TYPES_H -# include -#endif - -#if linux_TARGET_OS -/* Sigh, RedHat 5 has the TM_ZONE stuff, but only when _BSD_SOURCE is - * on. The configure script erroneously says we've got TM_ZONE, so - * make sure we use the TZNAME stuff instead. - * - * Aside: tzname is POSIX, whereas tm_zone is BSD. We should be using - * tzname by preference, but the GNU configure stuff gives us HAVE_TM_ZONE - * in preference to HAVE_TZNAME. More sighs. - */ -# undef HAVE_TM_ZONE -# define HAVE_TZNAME 1 - -/* Double sigh. The timezone variable is only available under Linux - * when we're compiling NON_POSIX_SOURCE (or _GNU_SOURCE or whatever), - * but to make that work we have to make sure NON_POSIX_SOURCE is - * defined before anything from /usr/include is included. To avoid - * infecting too much source with NON_POSIX_SOURCE, we frob it - * below... - */ -#undef HAVE_TIMEZONE - -/* The correct solution to this problem would appear to be to ditch - * the standard GNU configure tests for the time stuff, and hack up - * our own that test for POSIX-compliant time support first, then - * BSD-style time stuff. - */ -#endif - -#ifdef solaris2_TARGET_OS -#undef HAVE_TIMEZONE -#endif - -#if TIME_WITH_SYS_TIME -# include -# include -#else -# if HAVE_SYS_TIME_H -# include -# else -# include -# endif -#endif - -#if HAVE_TM_ZONE -#define ZONE(x) (((struct tm *)x)->tm_zone) -#define SETZONE(x,z) (((struct tm *)x)->tm_zone = z) -#define GMTOFF(x) (((struct tm *)x)->tm_gmtoff) -#else /* ! HAVE_TM_ZONE */ -# if HAVE_TZNAME || _WIN32 -# if cygwin32_TARGET_OS -# define tzname _tzname -# endif -# ifndef mingw32_TARGET_OS -extern char *tzname[2]; -# endif - -# define ZONE(x) (((struct tm *)x)->tm_isdst ? tzname[1] : tzname[0]) -# define SETZONE(x,z) -# else /* ! HAVE_TZNAME */ -/* We're in trouble. If you should end up here, please report this as a bug. */ -# error Dont know how to get at timezone name on your OS. -# endif /* ! HAVE_TZNAME */ -/* Get the offset in secs from UTC, if (struct tm) doesn't supply it. */ - -#if defined(mingw32_TARGET_OS) || defined(cygwin32_TARGET_OS) -#define timezone _timezone -#endif - -#if !defined(HAVE_TIMEZONE) && !defined(mingw32_TARGET_OS) -extern TYPE_TIMEZONE timezone; -#endif - -# if HAVE_ALTZONE -extern time_t altzone; -# define GMTOFF(x) (((struct tm *)x)->tm_isdst ? altzone : timezone ) -# else /* ! HAVE_ALTZONE */ -/* Assume that DST offset is 1 hour ... */ -# define GMTOFF(x) (((struct tm *)x)->tm_isdst ? (timezone - 3600) : timezone ) -# endif /* ! HAVE_ALTZONE */ -#endif /* ! HAVE_TM_ZONE */ - -#endif /* TIMEZONE_H */ diff --git a/ghc/lib/std/cbits/toClockSec.c b/ghc/lib/std/cbits/toClockSec.c deleted file mode 100644 index 57b4830..0000000 --- a/ghc/lib/std/cbits/toClockSec.c +++ /dev/null @@ -1,50 +0,0 @@ -/* - * (c) The GRASP/AQUA Project, Glasgow University, 1994-1998 - * - * $Id: toClockSec.c,v 1.6 2000/06/19 13:28:35 simonmar Exp $ - * - * toClockSec Runtime Support - */ - -#include "Rts.h" -#include "stgio.h" -#include "timezone.h" - -StgInt -toClockSec(I_ year, I_ mon, I_ mday, I_ hour, I_ min, I_ sec, I_ tz, I_ isdst, StgByteArray res) -{ - struct tm tm; - time_t t; - - tm.tm_year = year - 1900; - tm.tm_mon = mon; - tm.tm_mday = mday; - tm.tm_hour = hour; - tm.tm_min = min; - tm.tm_sec = sec; - tm.tm_isdst = isdst; - -#ifdef HAVE_MKTIME - t = mktime(&tm); -#elif defined(HAVE_TIMELOCAL) - t = timelocal(&tm); -#else - t = (time_t) -1; -#endif - if (t == (time_t) -1) - return 0; - /* - * mktime expects its argument to be in the local timezone, but - * toUTCTime makes UTC-encoded CalendarTime's ... - * - * Since there is no any_tz_struct_tm-to-time_t conversion - * function, we have to fake one... :-) If not in all, it works in - * most cases (before, it was the other way round...) - * - * Luckily, mktime tells us, what it *thinks* the timezone is, so, - * to compensate, we add the timezone difference to mktime's - * result. - */ - *(time_t *)res = t + tz - GMTOFF(&tm); - return 1; -} diff --git a/ghc/lib/std/cbits/toLocalTime.c b/ghc/lib/std/cbits/toLocalTime.c deleted file mode 100644 index 6295972..0000000 --- a/ghc/lib/std/cbits/toLocalTime.c +++ /dev/null @@ -1,110 +0,0 @@ -/* - * (c) The GRASP/AQUA Project, Glasgow University, 1994-1998 - * - * $Id: toLocalTime.c,v 1.5 2000/05/28 17:47:27 panne Exp $ - * - * toCalendarTime Runtime Support - */ - -#include "Rts.h" -#include "stgio.h" -#include "timezone.h" - -StgInt -toLocalTime(I_ size, StgByteArray d, StgByteArray res) -{ - time_t t; - struct tm *tm,*tmp=(struct tm *)res; - - switch(size) { - default: - return 0; - case 0: - t = 0; - break; - case -1: - t = - (time_t) ((StgInt *)d)[0]; - if (t > 0) - return 0; - break; - case 1: - t = (time_t) ((StgInt *)d)[0]; - if (t < 0) - return 0; - break; - } - tm = localtime(&t); - - if (tm == NULL) - return 0; - - /* - localtime() may return a ptr to statically allocated storage, - so to make toLocalTime reentrant, we manually copy - the structure into the (struct tm *) passed in. - */ - tmp->tm_sec = tm->tm_sec; - tmp->tm_min = tm->tm_min; - tmp->tm_hour = tm->tm_hour; - tmp->tm_mday = tm->tm_mday; - tmp->tm_mon = tm->tm_mon; - tmp->tm_year = tm->tm_year; - tmp->tm_wday = tm->tm_wday; - tmp->tm_yday = tm->tm_yday; - tmp->tm_isdst = tm->tm_isdst; - /* - If you don't have tm_zone in (struct tm), but - you get at it via the shared tmzone[], you'll - lose. Same goes for the tm_gmtoff field. - - */ -#if HAVE_TM_ZONE - strcpy(tmp->tm_zone,tm->tm_zone); - tmp->tm_gmtoff = tm->tm_gmtoff; -#endif - - return 1; -} - -StgInt -prim_toLocalTime(StgInt64 d, StgByteArray res) -{ - time_t t; - struct tm *tm,*tmp=(struct tm *)res; - - t = (time_t) d; - if (t < 0) - return 0; - - tm = localtime(&t); - - if (tm == NULL) - return 0; - - /* - localtime() may return a ptr to statically allocated storage, - so to make toLocalTime reentrant, we manually copy - the structure into the (struct tm *) passed in. - */ - tmp->tm_sec = tm->tm_sec; - tmp->tm_min = tm->tm_min; - tmp->tm_hour = tm->tm_hour; - tmp->tm_mday = tm->tm_mday; - tmp->tm_mon = tm->tm_mon; - tmp->tm_year = tm->tm_year; - tmp->tm_wday = tm->tm_wday; - tmp->tm_yday = tm->tm_yday; - tmp->tm_isdst = tm->tm_isdst; - /* - If you don't have tm_zone in (struct tm), but - you get at it via the shared tmzone[], you'll - lose. Same goes for the tm_gmtoff field. - - */ -#if HAVE_TM_ZONE - strcpy(tmp->tm_zone,tm->tm_zone); - tmp->tm_gmtoff = tm->tm_gmtoff; -#endif - - return 1; -} diff --git a/ghc/lib/std/cbits/toUTCTime.c b/ghc/lib/std/cbits/toUTCTime.c deleted file mode 100644 index 9298f29..0000000 --- a/ghc/lib/std/cbits/toUTCTime.c +++ /dev/null @@ -1,111 +0,0 @@ -/* - * (c) The GRASP/AQUA Project, Glasgow University, 1994-1998 - * - * $Id: toUTCTime.c,v 1.5 2000/05/28 17:47:27 panne Exp $ - * - * toUTCTime Runtime Support - */ - -#include "Rts.h" -#include "stgio.h" -#include "timezone.h" - -StgInt -toUTCTime(I_ size, StgByteArray d, StgByteArray res) -{ - time_t t; - struct tm *tm,*tmp=(struct tm *)res; - - switch(size) { - default: - return 0; - case 0: - t = 0; - break; - case -1: - t = - (time_t) ((StgInt *)d)[0]; - if (t > 0) - return 0; - break; - case 1: - t = (time_t) ((StgInt *)d)[0]; - if (t < 0) - return 0; - break; - } - tm = gmtime(&t); - - if (tm == NULL) - return 0; - - /* - gmtime() may return a ptr to statically allocated storage, - so to make toUTCTime reentrant, we manually copy - the structure into the (struct tm *) passed in. - */ - tmp->tm_sec = tm->tm_sec; - tmp->tm_min = tm->tm_min; - tmp->tm_hour = tm->tm_hour; - tmp->tm_mday = tm->tm_mday; - tmp->tm_mon = tm->tm_mon; - tmp->tm_year = tm->tm_year; - tmp->tm_wday = tm->tm_wday; - tmp->tm_yday = tm->tm_yday; - tmp->tm_isdst = tm->tm_isdst; - /* - If you don't have tm_zone in (struct tm), but - you get at it via the shared tmzone[], you'll - lose. Same goes for the tm_gmtoff field. - - */ -#if HAVE_TM_ZONE - strcpy(tmp->tm_zone,tm->tm_zone); - tmp->tm_gmtoff = tm->tm_gmtoff; -#endif - - return 1; -} - -StgInt -prim_toUTCTime(StgInt64 d, StgByteArray res) -{ - time_t t; - struct tm *tm,*tmp=(struct tm *)res; - - t = (time_t) d; - if (t < 0) - return 0; - - tm = gmtime(&t); - - if (tm == NULL) - return 0; - - /* - gmtime() may return a ptr to statically allocated storage, - so to make toUTCTime reentrant, we manually copy - the structure into the (struct tm *) passed in. - */ - tmp->tm_sec = tm->tm_sec; - tmp->tm_min = tm->tm_min; - tmp->tm_hour = tm->tm_hour; - tmp->tm_mday = tm->tm_mday; - tmp->tm_mon = tm->tm_mon; - tmp->tm_year = tm->tm_year; - tmp->tm_wday = tm->tm_wday; - tmp->tm_yday = tm->tm_yday; - tmp->tm_isdst = tm->tm_isdst; - /* - If you don't have tm_zone in (struct tm), but - you get at it via the shared tmzone[], you'll - lose. Same goes for the tm_gmtoff field. - - */ -#if HAVE_TM_ZONE - strcpy(tmp->tm_zone,tm->tm_zone); - tmp->tm_gmtoff = tm->tm_gmtoff; -#endif - - return 1; -} -