[project @ 2000-12-12 12:19:57 by simonmar]
[ghc-hetmet.git] / ghc / lib / std / Time.lhs
index b4adb21..302fca2 100644 (file)
@@ -1,6 +1,9 @@
+% ------------------------------------------------------------------------------
+% $Id: Time.lhs,v 1.24 2000/12/12 12:19:58 simonmar Exp $
 %
-% (c) The GRASP/AQUA Project, Glasgow University, 1995-99
+% (c) The University of Glasgow, 1995-2000
 %
+
 \section[Time]{Haskell 1.4 Time of Day Library}
 
 The {\em Time} library provides standard functionality for
@@ -8,6 +11,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 <michael.weber@post.rwth-aachen.de>:
+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 
@@ -19,9 +77,11 @@ module Time
      , getClockTime
 
      ,  TimeDiff(..)
+     ,  noTimeDiff      -- non-standard (but useful when constructing TimeDiff vals.)
      ,  diffClockTimes
      ,  addToClockTime
 
+     ,  normalizeTimeDiff -- non-standard
      ,  timeDiffToString  -- non-standard
      ,  formatTimeDiff    -- non-standard
 
@@ -37,13 +97,21 @@ module Time
 #ifdef __HUGS__
 import PreludeBuiltin
 #else
-import PrelBase
-import PrelIOBase
-import PrelHandle
-import PrelArr
-import PrelST
-import PrelAddr
-import PrelPack        ( unpackCString )
+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 PrelAddr                ( Addr )
+
 #endif
 
 import Ix
@@ -78,7 +146,10 @@ external calendar time @CalendarTime@.
 -- 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 Integer deriving (Eq, Ord)
+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}
 
@@ -95,11 +166,21 @@ we use the C library routines based on 32 bit integers.
 instance Show ClockTime
 #else
 instance Show ClockTime where
-    showsPrec _ (TOD (J# _ s# d#) _nsec) = 
+    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
-           buf <- allocChars 38 -- exactly enough for error message
-           str <- _ccall_ showTime (I# s#) d# buf
-           return (unpackCString str)
+            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
@@ -133,7 +214,7 @@ 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,
@@ -172,17 +253,19 @@ data TimeDiff
 #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}
-#ifdef __HUGS__
 getClockTime :: IO ClockTime
 getClockTime = do
     i1 <- malloc1
     i2 <- malloc1
-    rc <- prim_getClockTime i1 i2
+    rc <- primGetClockTime i1 i2
     if rc == 0 
        then do
            sec  <- cvtUnsigned i1
@@ -190,41 +273,30 @@ getClockTime = do
            return (TOD sec (nsec * 1000))
        else
            constructErrorAndFail "getClockTime"
-  where
-    malloc1 = primNewByteArray sizeof_int64
-    cvtUnsigned arr = primReadInt64Array arr 0
+
+#ifdef __HUGS__
+malloc1 = primNewByteArray sizeof_int64
+cvtUnsigned arr = primReadInt64Array arr 0
 #else
-getClockTime :: IO ClockTime
-getClockTime = do
-    i1 <- malloc1
-    i2 <- malloc1
-    rc <- _ccall_ getClockTime i1 i2
-    if rc == (0 ::Int)
-       then do
-           sec  <- cvtUnsigned i1
-           nsec <- cvtUnsigned i2
-           return (TOD sec (nsec * 1000))
-       else
-           constructErrorAndFail "getClockTime"
-  where
-    malloc1 = IO $ \ s# ->
-       case newIntArray# 1# s# of 
-          (# s2#, barr# #) -> 
-               (# 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 
-         (# s2#, r# #) ->
-            if r# ==# 0# 
-               then (# s2#, 0 #)
-               else case unsafeFreezeByteArray# arr# s2# of
-                        (# s3#, frozen# #) -> 
-                               (# s3#, J# 1# 1# frozen# #)
+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}
 
@@ -236,49 +308,71 @@ t2} as a @TimeDiff@.
 
 
 \begin{code}
-#ifdef __HUGS__
-addToClockTime  :: TimeDiff  -> ClockTime -> ClockTime
-addToClockTime (TimeDiff year mon day hour min sec psec) 
-              (TOD c_sec c_psec) = unsafePerformIO $ do
-    res <- allocWords sizeof_int64
-    rc <- prim_toClockSec year mon day hour min sec 0 res 
-    if rc /= (0::Int)
-     then do
-            diff_sec <- primReadInt64Array res 0
-           let diff_psec = psec
-            return (TOD (c_sec + diff_sec) (c_psec + diff_psec))
-     else
-          error "Time.addToClockTime: can't perform conversion of TimeDiff"
-#else
 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::Int) res 
-    let (A# ptr#) = ptr
-    if ptr /= nullAddr
-     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"
-#endif
+              (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 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) 
-          (mon_a  - 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
@@ -343,7 +437,7 @@ toClockTime (CalendarTime year mon mday hour min sec psec wday yday tzname tz is
     else
         unsafePerformIO ( do
            res <- allocWords sizeof_int64
-           rc <- prim_toClockSec year mon mday hour min sec isDst res
+           rc <- toClockSec year (fromEnum mon) mday hour min sec isDst res
             if rc /= (0::Int)
              then do
                tm <- primReadInt64Array res 0
@@ -352,49 +446,63 @@ 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 (J# _ s# d#) psec) = do
-    res    <- allocWords (``sizeof(struct tm)''::Int)
+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
-    _casm_ ``SETZONE((struct tm *)%0,(char *)%1); '' res zoneNm
-    tm     <- _ccall_ toLocalTime (I# s#) d# res
-    if tm == nullAddr
+    prim_SETZONE res zoneNm
+    rc     <- prim_toLocalTime (I# s#) d# 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
+       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
-       return (CalendarTime (1900+year) mon mday hour min sec psec 
+           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 (J# _ s# d#) psec) = unsafePerformIO $ do
-       res    <- allocWords (``sizeof(struct tm)''::Int)
+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
-       _casm_ ``SETZONE((struct tm *)%0,(char *)%1); '' res zoneNm
-       tm     <-  _ccall_ toUTCTime (I# s#) d# res
-       if tm == nullAddr
+       prim_SETZONE res zoneNm
+       rc     <-  prim_toUTCTime (I# s#) d# 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
-            return (CalendarTime (1900+year) mon mday hour min sec psec 
+           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
@@ -405,20 +513,23 @@ toClockTime (CalendarTime year mon mday hour min sec psec _wday _yday _tzname tz
         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 /= nullAddr
-             then return (TOD (int2Integer (indexIntOffAddr# ptr# 0#)) psec)
+           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 = 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
 
-bottom :: (Int,Int)
-bottom = error "Time.bottom"
-
 
 -- (copied from PosixUtil, for now)
 -- Allocate a mutable array of characters with no indices.
@@ -432,21 +543,16 @@ allocChars size = primNewByteArray size
 allocWords :: Int -> IO (PrimMutableByteArray RealWorld)
 allocWords size = primNewByteArray size
 #else
-allocChars :: Int -> IO (MutableByteArray RealWorld ())
-allocChars (I# size#) = IO $ \ s# ->
-    case newCharArray# size# s# of 
-      (# s2#, barr# #) -> 
-       (# s2#, MutableByteArray bot barr# #)
-  where
-    bot = error "Time.allocChars"
+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 ())
+allocWords :: Int -> IO (MutableByteArray RealWorld Int)
 allocWords (I# size#) = IO $ \ s# ->
-    case newIntArray# size# s# of 
+    case newByteArray# (wORD_SCALE size#) s# of 
       (# s2#, barr# #) -> 
-       (# s2#, MutableByteArray bot barr# #)
+       (# s2#, MutableByteArray bot bot barr# #)
   where
     bot = error "Time.allocWords"
 #endif
@@ -460,7 +566,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 "" = ""
 
@@ -531,10 +639,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
 
@@ -543,6 +653,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
@@ -568,36 +679,69 @@ 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}
-#ifdef __HUGS__
-foreign import stdcall "libHS_cbits.so" "get_tm_sec"   get_tm_sec   :: Bytes -> IO Int
-foreign import stdcall "libHS_cbits.so" "get_tm_min"   get_tm_min   :: Bytes -> IO Int
-foreign import stdcall "libHS_cbits.so" "get_tm_hour"  get_tm_hour  :: Bytes -> IO Int
-foreign import stdcall "libHS_cbits.so" "get_tm_mday"  get_tm_mday  :: Bytes -> IO Int
-foreign import stdcall "libHS_cbits.so" "get_tm_mon"   get_tm_mon   :: Bytes -> IO Int
-foreign import stdcall "libHS_cbits.so" "get_tm_year"  get_tm_year  :: Bytes -> IO Int
-foreign import stdcall "libHS_cbits.so" "get_tm_wday"  get_tm_wday  :: Bytes -> IO Int
-foreign import stdcall "libHS_cbits.so" "get_tm_yday"  get_tm_yday  :: Bytes -> IO Int
-foreign import stdcall "libHS_cbits.so" "get_tm_isdst" get_tm_isdst :: Bytes -> IO Int
-
-foreign import stdcall "libHS_cbits.so" "prim_ZONE"    prim_ZONE    :: Bytes -> IO Addr
-foreign import stdcall "libHS_cbits.so" "prim_GMTOFF"  prim_GMTOFF  :: Bytes -> IO Int
-
-foreign import stdcall "libHS_cbits.so" "prim_SETZONE" prim_SETZONE :: Bytes -> Bytes -> IO Int
-
-foreign import stdcall "libHS_cbits.so" "sizeof_word"      sizeof_word      :: Int
-foreign import stdcall "libHS_cbits.so" "sizeof_struct_tm" sizeof_struct_tm :: Int
-foreign import stdcall "libHS_cbits.so" "sizeof_time_t"    sizeof_time_t    :: Int
+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 stdcall "libHS_cbits.so" "prim_getClockTime" prim_getClockTime :: Bytes -> Bytes -> IO Int
-foreign import stdcall "libHS_cbits.so" "prim_toClockSec"   prim_toClockSec   :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> Bytes -> IO Int
-foreign import stdcall "libHS_cbits.so" "prim_toLocalTime"  prim_toLocalTime  :: Int64 -> Bytes -> IO Int
-foreign import stdcall "libHS_cbits.so" "prim_toUTCTime"    prim_toUTCTime    :: Int64 -> Bytes -> IO 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 Addr
+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 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 -> 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}