From: simonmar Date: Mon, 19 Jun 2000 13:28:35 +0000 (+0000) Subject: [project @ 2000-06-19 13:28:35 by simonmar] X-Git-Tag: Approximately_9120_patches~4174 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;ds=sidebyside;h=43956364fc6c89be88f770cc069e7d2e86b941da;p=ghc-hetmet.git [project @ 2000-06-19 13:28:35 by simonmar] Time fixes from Michael Weber : * `toClockTime' previously didn't honor the `tz' field of a `CalendarTime', which led to time warping when applying => (toUTCTime (toClockTime ... (toUTCTime (toClockTime someTime) ... ))) continuously. Now it accepts at least - and UTC-encoded `CalendarTime's (TODO: test, whether all timezones work) and converts them correctly to -format (which is always UTC, as one might have guessed). * `addToClockTime' now works. Previously, `tz' seconds were added(!) when used like: => addToClockTime noTimeDiff someTime which is clearly wrong. Now, the following (hopefully) always holds => someTime == (addToClockTime noTimeDiff someTime) * `diffClockTimes' works correctly, and is the dual to `addToClockTime', i.e. => diff == ((addToClockTime diff someTime) `diffClockTimes` someTime) should now hold for all diff, someTime Previously, it reports ugly diffs at {min,hour,day,...}-breaks, for example: => "2000/06/18 01:00 UTC" `diffClockTimes` "2000/06/17 23:00 UTC" == 1 day, -22 hours whereas now it emits "7200 secs". This number can be converted with `normalizeTimeDiff' to "2 hours". * added `normalizeTimeDiff', which calculates year, month, days, etc. out of an unnormalized `TimeDiff' (generated by `diffClockTimes', for example) * `formatTimeDiff': added the missing "%c" case. The format is proprietary, though... Is there a nicer one? --- diff --git a/ghc/lib/std/List.lhs b/ghc/lib/std/List.lhs index 709687a..08c2ddf 100644 --- a/ghc/lib/std/List.lhs +++ b/ghc/lib/std/List.lhs @@ -266,8 +266,8 @@ partition :: (a -> Bool) -> [a] -> ([a],[a]) {-# INLINE partition #-} partition p xs = foldr (select p) ([],[]) xs -select p x (ts,fs) | p x = (x:ts,fs) - | otherwise = (ts, x:fs) +select p x ~(ts,fs) | p x = (x:ts,fs) + | otherwise = (ts, x:fs) \end{code} @mapAccumL@ behaves like a combination @@ -515,3 +515,35 @@ unfoldr f b = Just (a,new_b) -> a : unfoldr f new_b Nothing -> [] \end{code} + +#if 0 /* should go in PrelList, but dependency problems */ +foldl' is a strict version of foldl; that is, it doesn't build up a +huge suspension in its first argument as it traverses the list. Valid +when f is strict. + +\begin{code} +foldl' :: (a -> b -> a) -> a -> [b] -> a +foldl' _ z [] = z +foldl' f z (x:xs) = let a = f z x in seq a (foldl f a xs) + +foldl1' :: (a -> a -> a) -> [a] -> a +foldl1' f (x:xs) = foldl' f x xs +foldl1' _ [] = errorEmptyList "foldl1'" + +{-# RULES +"maximumInt" maximum = maximum' :: [Int] -> Int +"maximumInteger" maximum = maximum' :: [Integer] -> Integer +"minimumInt" minimum = minimum' :: [Int] -> Int +"minimumInteger" minimum = minimum' :: [Integer] -> Integer + #-} + +{-# SPECIALISE maximum' :: [Int] -> Int #-} +{-# SPECIALISE minimum' :: [Int] -> Int #-} + +maximum' [] = errorEmptyList "maximum'" +maximum' xs = foldl1' max xs + +minimum' [] = errorEmptyList "minimum'" +minimum' xs = foldl1' min xs +\end{code} +#endif diff --git a/ghc/lib/std/Locale.lhs b/ghc/lib/std/Locale.lhs index 3248c8b..3c3d9d6 100644 --- a/ghc/lib/std/Locale.lhs +++ b/ghc/lib/std/Locale.lhs @@ -5,13 +5,21 @@ \begin{code} -module Locale(TimeLocale(..), defaultTimeLocale) where +module Locale + ( TimeLocale(..) + , defaultTimeLocale + + , iso8601DateFormat + , rfc822DateFormat + ) +where import Prelude -- so as to force recompilations when reqd. data TimeLocale = TimeLocale { wDays :: [(String, String)], -- full and abbreviated week days months :: [(String, String)], -- full and abbreviated months + intervals :: [(String, String)], amPm :: (String, String), -- AM/PM symbols dateTimeFmt, dateFmt, -- formatting strings timeFmt, time12Fmt :: String @@ -31,6 +39,15 @@ defaultTimeLocale = TimeLocale { ("September", "Sep"), ("October", "Oct"), ("November", "Nov"), ("December", "Dec")], + intervals = [ ("year","years") + , ("month", "months") + , ("day","days") + , ("hour","hours") + , ("min","mins") + , ("sec","secs") + , ("usec","usecs") + ], + amPm = ("AM", "PM"), dateTimeFmt = "%a %b %e %H:%M:%S %Z %Y", dateFmt = "%m/%d/%y", @@ -38,4 +55,14 @@ defaultTimeLocale = TimeLocale { time12Fmt = "%I:%M:%S %p" } + +iso8601DateFormat :: Maybe String -> String +iso8601DateFormat timeFmt = + "%Y-%m-%d" ++ case timeFmt of + Nothing -> "" -- normally, ISO-8601 just defines YYYY-MM-DD + Just fmt -> ' ' : fmt -- but we can add a time spec + + +rfc822DateFormat :: String +rfc822DateFormat = "%a, %_d %b %Y %H:%M:%S %Z" \end{code} diff --git a/ghc/lib/std/Time.lhs b/ghc/lib/std/Time.lhs index a3d9a73..6d2ade9 100644 --- a/ghc/lib/std/Time.lhs +++ b/ghc/lib/std/Time.lhs @@ -1,4 +1,4 @@ -% +e% % (c) The GRASP/AQUA Project, Glasgow University, 1995-99 % \section[Time]{Haskell 1.4 Time of Day Library} @@ -8,6 +8,61 @@ 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 @@ -23,6 +78,7 @@ module Time , diffClockTimes , addToClockTime + , normalizeTimeDiff -- non-standard , timeDiffToString -- non-standard , formatTimeDiff -- non-standard @@ -255,7 +311,7 @@ addToClockTime (TimeDiff year mon day hour min sec 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)) @@ -269,18 +325,51 @@ addToClockTime (TimeDiff year mon day hour min sec psec) toClockTime cal{ctMonth=month', ctYear=year'} diffClockTimes :: ClockTime -> ClockTime -> TimeDiff -diffClockTimes tod_a tod_b = +-- 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 - CalendarTime year_a mon_a day_a hour_a min_a sec_a psec_a _ _ _ _ _ = toUTCTime tod_a - CalendarTime year_b mon_b day_b hour_b min_b sec_b psec_b _ _ _ _ _ = toUTCTime tod_b + 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 - TimeDiff (year_a - year_b) - (fromEnum mon_a - fromEnum mon_b) - (day_a - day_b) - (hour_a - hour_b) - (min_a - min_b) - (sec_a - sec_b) - (psec_a - psec_b) + 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 @@ -354,6 +443,7 @@ toClockTime (CalendarTime year mon mday hour min sec psec wday yday tzname tz is ) where isDst = if isdst then (1::Int) else 0 + #else toCalendarTime :: ClockTime -> IO CalendarTime toCalendarTime (TOD (S# i) psec) @@ -421,7 +511,7 @@ toClockTime (CalendarTime year mon mday hour min sec psec _wday _yday _tzname tz else unsafePerformIO ( do res <- malloc1 - rc <- toClockSec year (fromEnum mon) mday hour min sec isDst res + rc <- toClockSec year (fromEnum mon) mday hour min sec tz isDst res if rc /= 0 then do i <- cvtUnsigned res @@ -429,7 +519,12 @@ toClockTime (CalendarTime year mon mday hour min sec psec _wday _yday _tzname tz else error "Time.toClockTime: can't perform conversion" ) where - isDst = if isdst then (1::Int) else 0 + -- `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 @@ -468,7 +563,9 @@ formatCalendarTime :: TimeLocale -> String -> CalendarTime -> String formatCalendarTime l fmt (CalendarTime year mon day hour min sec _ wday yday tzname _ _) = doFmt fmt - where doFmt ('%':c:cs) = decode c ++ doFmt cs + 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 "" = "" @@ -539,10 +636,12 @@ timeDiffToString :: TimeDiff -> String timeDiffToString = formatTimeDiff defaultTimeLocale "%c" formatTimeDiff :: TimeLocale -> String -> TimeDiff -> String -formatTimeDiff l fmt (TimeDiff year month day hour min sec _) +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 @@ -551,6 +650,7 @@ formatTimeDiff l fmt (TimeDiff year month day hour min sec _) '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 @@ -576,6 +676,17 @@ formatTimeDiff l fmt (TimeDiff year month day hour min sec _) '%' -> "%" 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} @@ -619,7 +730,7 @@ 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 -> MBytes -> IO Int + -> Int -> Int -> Int -> MBytes -> IO Int foreign import "libHS_cbits" "getClockTime" unsafe primGetClockTime :: MutableByteArray RealWorld Int diff --git a/ghc/lib/std/cbits/stgio.h b/ghc/lib/std/cbits/stgio.h index c551226..6530eee 100644 --- a/ghc/lib/std/cbits/stgio.h +++ b/ghc/lib/std/cbits/stgio.h @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: stgio.h,v 1.21 2000/05/28 17:47:27 panne Exp $ + * $Id: stgio.h,v 1.22 2000/06/19 13:28:35 simonmar Exp $ * * (c) The GRASP/AQUA Project, Glasgow University, 1994-1999 * @@ -224,7 +224,7 @@ StgInt toUTCTime (StgInt, StgByteArray, StgByteArray); StgInt prim_toUTCTime ( StgInt64,StgByteArray ); /* toClockSec.c */ -StgInt toClockSec (StgInt, StgInt, StgInt, StgInt, StgInt, StgInt, StgInt, StgByteArray); +StgInt toClockSec (StgInt, StgInt, StgInt, StgInt, StgInt, StgInt, StgInt, StgInt, StgByteArray); /* writeError.c */ StgAddr addrOf_ErrorHdrHook(void); diff --git a/ghc/lib/std/cbits/toClockSec.c b/ghc/lib/std/cbits/toClockSec.c index b461fba..57b4830 100644 --- a/ghc/lib/std/cbits/toClockSec.c +++ b/ghc/lib/std/cbits/toClockSec.c @@ -1,7 +1,7 @@ /* * (c) The GRASP/AQUA Project, Glasgow University, 1994-1998 * - * $Id: toClockSec.c,v 1.5 1999/11/26 16:25:56 simonmar Exp $ + * $Id: toClockSec.c,v 1.6 2000/06/19 13:28:35 simonmar Exp $ * * toClockSec Runtime Support */ @@ -11,7 +11,7 @@ #include "timezone.h" StgInt -toClockSec(I_ year, I_ mon, I_ mday, I_ hour, I_ min, I_ sec, I_ isdst, StgByteArray res) +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; @@ -33,7 +33,18 @@ toClockSec(I_ year, I_ mon, I_ mday, I_ hour, I_ min, I_ sec, I_ isdst, StgByteA #endif if (t == (time_t) -1) return 0; - - *(time_t *)res = t; + /* + * 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; }