X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Flib%2Fstd%2FTime.lhs;h=ff8556a085898c1a17f6627b4c432aab01a2ee04;hb=712a982fd4d9bad19c8e4ba7cd5ce5a6b4f8e954;hp=65eca106f89838d193b45fd30e14a7da2f10bb6b;hpb=6bfd2f54231675165b3345689f41ab77db0bbba9;p=ghc-hetmet.git diff --git a/ghc/lib/std/Time.lhs b/ghc/lib/std/Time.lhs index 65eca10..ff8556a 100644 --- a/ghc/lib/std/Time.lhs +++ b/ghc/lib/std/Time.lhs @@ -1,5 +1,5 @@ % -% (c) The GRASP/AQUA Project, Glasgow University, 1995-97 +% (c) The GRASP/AQUA Project, Glasgow University, 1995-99 % \section[Time]{Haskell 1.4 Time of Day Library} @@ -11,34 +11,49 @@ its use of Coordinated Universal Time (UTC). \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(TimeDiff), - diffClockTimes, - addToClockTime, - timeDiffToString, -- non-standard - formatTimeDiff, -- non-standard - - CalendarTime(CalendarTime), - toCalendarTime, - toUTCTime, - toClockTime, - calendarTimeToString, - formatCalendarTime - - ) where - -import PrelBase -import PrelIOBase -import PrelArr -import PrelST -import PrelAddr -import PrelPack ( unpackCString ) + ( + Month(..) + , Day(..) + + , ClockTime(..) -- non-standard, lib. report gives this as abstract + , getClockTime + + , TimeDiff(..) + , noTimeDiff -- non-standard (but useful when constructing TimeDiff vals.) + , diffClockTimes + , addToClockTime + + , timeDiffToString -- non-standard + , formatTimeDiff -- non-standard + + , CalendarTime(..) + , toCalendarTime + , toUTCTime + , toClockTime + , calendarTimeToString + , formatCalendarTime + + ) where + +#ifdef __HUGS__ +import PreludeBuiltin +#else +import PrelGHC ( RealWorld, (>#), (<#), (==#), + newIntArray#, 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(..) ) +import PrelHandle ( Bytes ) +import PrelAddr ( Addr ) + +#endif import Ix import Char ( intToDigit ) @@ -56,7 +71,7 @@ data Month deriving (Eq, Ord, Enum, Bounded, Ix, Read, Show) data Day - = Sunday | Monday | Tuesday | Wednesday + = Sunday | Monday | Tuesday | Wednesday | Thursday | Friday | Saturday deriving (Eq, Ord, Enum, Bounded, Ix, Read, Show) @@ -67,7 +82,16 @@ Clock times may be compared, converted to strings, or converted to an external calendar time @CalendarTime@. \begin{code} -data ClockTime = TOD Integer Integer deriving (Eq, Ord) +#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 @@ -78,14 +102,29 @@ 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 sec@(J# a# s# d#) nsec) = showString $ unsafePerformIO $ - allocChars 32 >>= \ buf -> - _ccall_ showTime (I# s#) (ByteArray bottom d#) buf - >>= \ str -> - return (unpackCString str) + 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} @@ -116,12 +155,16 @@ field indicates whether Daylight Savings Time would be in effect. data CalendarTime = CalendarTime { ctYear :: Int, - ctMonth :: 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, @@ -144,9 +187,16 @@ data TimeDiff 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. @@ -156,7 +206,7 @@ getClockTime :: IO ClockTime getClockTime = do i1 <- malloc1 i2 <- malloc1 - rc <- _ccall_ getClockTime i1 i2 + rc <- primGetClockTime i1 i2 if rc == 0 then do sec <- cvtUnsigned i1 @@ -164,26 +214,31 @@ getClockTime = do return (TOD sec (nsec * 1000)) else constructErrorAndFail "getClockTime" - where - malloc1 = IO $ \ s# -> - case newIntArray# 1# s# of - StateAndMutableByteArray# s2# barr# -> - IOok s2# (MutableByteArray bottom barr#) - - -- 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# 1# (ptr to 0#)) is probably acceptable to gmp. - - cvtUnsigned (MutableByteArray _ arr#) = IO $ \ s# -> - case readIntArray# arr# 0# s# of - StateAndInt# s2# r# -> - if r# ==# 0# - then IOok s2# 0 - else case unsafeFreezeByteArray# arr# s2# of - StateAndByteArray# s3# frozen# -> - IOok s3# (J# 1# 1# frozen#) +#ifdef __HUGS__ +malloc1 = primNewByteArray sizeof_int64 +cvtUnsigned arr = primReadInt64Array arr 0 +#else +malloc1 :: IO (MutableByteArray RealWorld Int) +malloc1 = IO $ \ s# -> + case newIntArray# 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 @@ -196,31 +251,34 @@ t2} as a @TimeDiff@. \begin{code} addToClockTime :: TimeDiff -> ClockTime -> ClockTime addToClockTime (TimeDiff year mon day hour min sec psec) - (TOD c_sec c_psec) = unsafePerformIO $ do - res <- allocWords (``sizeof(time_t)'') - ptr <- _ccall_ toClockSec year mon day hour min sec 0 res - let (A# ptr#) = ptr - if ptr /= ``NULL'' - then let - diff_sec = (int2Integer# (indexIntOffAddr# ptr# 0#)) - diff_psec = psec - in - return (TOD (c_sec + diff_sec) (c_psec + diff_psec)) - else - error "Time.addToClockTime: can't perform conversion of TimeDiff" - + (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)) + + 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 tod_a tod_b = let - CalendarTime year_a mon_a day_a hour_a min_a sec_a psec_a _ _ _ _ _ = toCalendarTime tod_a - CalendarTime year_b mon_b day_b hour_b min_b sec_b psec_b _ _ _ _ _ = toCalendarTime tod_b + 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 in TimeDiff (year_a - year_b) - (mon_a - mon_b) + (fromEnum mon_a - fromEnum mon_b) (day_a - day_b) (hour_a - hour_b) - (min_b - min_a) + (min_a - min_b) (sec_a - sec_b) (psec_a - psec_b) \end{code} @@ -233,47 +291,48 @@ converts {\em l} into the corresponding internal @ClockTime@. The ignored. \begin{code} -toCalendarTime :: ClockTime -> CalendarTime -toCalendarTime (TOD sec@(J# a# s# d#) psec) = unsafePerformIO $ do - res <- allocWords (``sizeof(struct tm)''::Int) +#ifdef __HUGS__ +toCalendarTime :: ClockTime -> IO CalendarTime +toCalendarTime (TOD sec psec) = do + res <- allocWords sizeof_int64 zoneNm <- allocChars 32 - _casm_ ``SETZONE((struct tm *)%0,(char *)%1); '' res zoneNm - tm <- _ccall_ toLocalTime (I# s#) (ByteArray bottom d#) res - if tm == (``NULL''::Addr) - then error "Time.toCalendarTime: out of range" + prim_SETZONE res zoneNm + rc <- prim_toLocalTime sec res + if rc /= 0 + then constructErrorAndFail "Time.toCalendarTime: out of range" else do - sec <- _casm_ ``%r = ((struct tm *)%0)->tm_sec;'' tm - min <- _casm_ ``%r = ((struct tm *)%0)->tm_min;'' tm - hour <- _casm_ ``%r = ((struct tm *)%0)->tm_hour;'' tm - mday <- _casm_ ``%r = ((struct tm *)%0)->tm_mday;'' tm - mon <- _casm_ ``%r = ((struct tm *)%0)->tm_mon;'' tm - year <- _casm_ ``%r = ((struct tm *)%0)->tm_year;'' tm - wday <- _casm_ ``%r = ((struct tm *)%0)->tm_wday;'' tm - yday <- _casm_ ``%r = ((struct tm *)%0)->tm_yday;'' tm - isdst <- _casm_ ``%r = ((struct tm *)%0)->tm_isdst;'' tm - zone <- _ccall_ ZONE tm - tz <- _ccall_ GMTOFF tm - let tzname = unpackCString zone + 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@(J# a# s# d#) psec) = unsafePerformIO $ do - res <- allocWords (``sizeof(struct tm)''::Int) +toUTCTime (TOD sec psec) = unsafePerformIO $ do + res <- allocWords sizeof_int64 zoneNm <- allocChars 32 - _casm_ ``SETZONE((struct tm *)%0,(char *)%1); '' res zoneNm - tm <- _ccall_ toUTCTime (I# s#) (ByteArray bottom d#) res - if tm == (``NULL''::Addr) + prim_SETZONE res zoneNm + rc <- prim_toUTCTime sec res + if rc /= 0 then error "Time.toUTCTime: out of range" else do - sec <- _casm_ ``%r = ((struct tm *)%0)->tm_sec;'' tm - min <- _casm_ ``%r = ((struct tm *)%0)->tm_min;'' tm - hour <- _casm_ ``%r = ((struct tm *)%0)->tm_hour;'' tm - mday <- _casm_ ``%r = ((struct tm *)%0)->tm_mday;'' tm - mon <- _casm_ ``%r = ((struct tm *)%0)->tm_mon;'' tm - year <- _casm_ ``%r = ((struct tm *)%0)->tm_year;'' tm - wday <- _casm_ ``%r = ((struct tm *)%0)->tm_wday;'' tm - yday <- _casm_ ``%r = ((struct tm *)%0)->tm_yday;'' tm + 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) @@ -285,41 +344,120 @@ toClockTime (CalendarTime year mon mday hour min sec psec wday yday tzname tz is error "Time.toClockTime: timezone offset out of range" else unsafePerformIO ( do - res <- allocWords (``sizeof(time_t)'') - ptr <- _ccall_ toClockSec year mon mday hour min sec isDst res - let (A# ptr#) = ptr - if ptr /= ``NULL'' - then return (TOD (int2Integer# (indexIntOffAddr# ptr# 0#)) psec) + 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))) -bottom :: (Int,Int) -bottom = error "Time.bottom" +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 isDst res + if rc /= 0 + then do + i <- cvtUnsigned res + return (TOD i psec) + else error "Time.toClockTime: can't perform conversion" + ) + where + isDst = if isdst then (1::Int) else 0 +#endif -- (copied from PosixUtil, for now) -- Allocate a mutable array of characters with no indices. -allocChars :: Int -> IO (MutableByteArray RealWorld ()) -allocChars (I# size#) = IO $ \ s# -> - case newCharArray# size# s# of - StateAndMutableByteArray# s2# barr# -> - IOok s2# (MutableByteArray bot barr#) - where - bot = error "Time.allocChars" +#ifdef __HUGS__ +allocChars :: Int -> IO (PrimMutableByteArray RealWorld) +allocChars size = primNewByteArray size -- Allocate a mutable array of words with no indices -allocWords :: Int -> IO (MutableByteArray RealWorld ()) +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 newIntArray# size# s# of - StateAndMutableByteArray# s2# barr# -> - IOok s2# (MutableByteArray bot barr#) + (# s2#, barr# #) -> + (# s2#, MutableByteArray bot bot barr# #) where bot = error "Time.allocWords" - +#endif \end{code} \begin{code} @@ -327,61 +465,62 @@ calendarTimeToString :: CalendarTime -> String calendarTimeToString = formatCalendarTime defaultTimeLocale "%c" formatCalendarTime :: TimeLocale -> String -> CalendarTime -> String -formatCalendarTime l fmt ct@(CalendarTime year mon day hour min sec sdec - wday yday tzname _ _) = +formatCalendarTime l fmt (CalendarTime year mon day hour min sec _ + wday yday tzname _ _) = doFmt fmt where doFmt ('%':c:cs) = decode c ++ doFmt cs doFmt (c:cs) = c : doFmt cs doFmt "" = "" - decode 'A' = fst (wDays l !! fromEnum wday) - decode 'a' = snd (wDays l !! fromEnum wday) - decode 'B' = fst (months l !! fromEnum mon) - decode 'b' = snd (months l !! fromEnum mon) - decode 'h' = snd (months l !! fromEnum mon) - decode 'C' = show2 (year `quot` 100) - decode 'c' = doFmt (dateTimeFmt l) + 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 - decode 'e' = show2' day - decode 'H' = show2 hour - decode 'I' = show2 (to12 hour) - decode 'j' = show3 yday - decode 'k' = show2' hour - decode 'l' = show2' (to12 hour) - decode 'M' = show2 min - decode 'm' = show2 (fromEnum mon+1) + 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) + 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 - decode 's' = show2 sec -- Implementation-dependent, sez the lib doc.. - decode 'U' = show2 ((yday + 7 - fromEnum wday) `div` 7) - decode 'u' = show (let n = fromEnum wday in + 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' = - let (week, days) = + 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' = + 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) - decode 'X' = doFmt (timeFmt l) - decode 'x' = doFmt (dateFmt l) - decode 'Y' = show year - decode 'y' = show2 (year `rem` 100) - decode 'Z' = tzname + 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)] @@ -389,15 +528,18 @@ show2' x = if x < 10 then [ ' ', intToDigit x] else show2 x show3 x = intToDigit (x `quot` 100) : show2 (x `rem` 100) -to12 h = let h' = h `mod` 12 in if h == 0 then 12 else h +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 ct@(TimeDiff year month day hour min sec psec) +formatTimeDiff l fmt (TimeDiff year month day hour min sec _) = doFmt fmt where doFmt "" = "" @@ -435,3 +577,58 @@ formatTimeDiff l fmt ct@(TimeDiff year month day hour min sec psec) c -> [c] \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" "prim_ZONE" prim_ZONE :: Bytes -> IO Addr +foreign import "libHS_cbits" "prim_GMTOFF" prim_GMTOFF :: Bytes -> IO Int + +foreign import "libHS_cbits" "sizeof_struct_tm" 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" 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 +#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 Addr +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 + +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}