[project @ 2001-01-12 15:48:56 by simonmar]

[ghc-hetmet.git] / ghc / lib / std / Time.lhs

diff --git a/ghc/lib/std/Time.lhs b/ghc/lib/std/Time.lhs
index b4adb21..1cb55f1 100644 (file)
--- a/ghc/lib/std/Time.lhs
+++ b/ghc/lib/std/Time.lhs
@@ -1,6 +1,9 @@
+% ------------------------------------------------------------------------------
+% $Id: Time.lhs,v 1.25 2001/01/11 17:25:57 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
 \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).
 
 "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 
 \begin{code}
 {-# OPTIONS -#include "cbits/timezone.h" -#include "cbits/stgio.h"  #-}
 module Time 

@@ -19,9 +77,11 @@ module Time
      , getClockTime
 
      ,  TimeDiff(..)
      , getClockTime
 
      ,  TimeDiff(..)

+     ,  noTimeDiff      -- non-standard (but useful when constructing TimeDiff vals.)

      ,  diffClockTimes
      ,  addToClockTime
 
      ,  diffClockTimes
      ,  addToClockTime
 

+     ,  normalizeTimeDiff -- non-standard

      ,  timeDiffToString  -- non-standard
      ,  formatTimeDiff    -- non-standard
 
      ,  timeDiffToString  -- non-standard
      ,  formatTimeDiff    -- non-standard
 

@@ -37,13 +97,21 @@ module Time
 #ifdef __HUGS__
 import PreludeBuiltin
 #else
 #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 PrelPtr
+

 #endif
 
 import Ix
 #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
 -- 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}
 
 #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
 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
       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
 
     showList = showList__ (showsPrec 0)
 #endif

@@ -133,7 +214,7 @@ field indicates whether Daylight Savings Time would be in effect.
 data CalendarTime 
  = CalendarTime  {
      ctYear    :: Int,
 data CalendarTime 
  = CalendarTime  {
      ctYear    :: Int,

-     ctMonth   :: Int,
+     ctMonth   :: Month,

      ctDay     :: Int,
      ctHour    :: Int,
      ctMin     :: Int,
      ctDay     :: Int,
      ctHour    :: Int,
      ctMin     :: Int,

@@ -172,17 +253,19 @@ data TimeDiff
 #endif
    }
    deriving (Eq,Ord,Read,Show)
 #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}
 \end{code}
 
 @getClockTime@ returns the current time in its internal representation.
 
 \begin{code}

-#ifdef __HUGS__

 getClockTime :: IO ClockTime
 getClockTime = do
     i1 <- malloc1
     i2 <- malloc1
 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
     if rc == 0 
        then do
            sec  <- cvtUnsigned i1

@@ -190,41 +273,30 @@ getClockTime = do
            return (TOD sec (nsec * 1000))
        else
            constructErrorAndFail "getClockTime"
            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
 #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}
 
 #endif
 \end{code}
 

@@ -236,49 +308,71 @@ t2} as a @TimeDiff@.
 
 
 \begin{code}
 
 
 \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) 
 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  :: 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
   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
   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
 \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
     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
             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
         )
     where
      isDst = if isdst then (1::Int) else 0

+

 #else
 toCalendarTime :: ClockTime -> IO CalendarTime
 #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
     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
      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
        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
                            (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
        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
        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
                          (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
         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
             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
 
 #endif
 

-bottom :: (Int,Int)
-bottom = error "Time.bottom"
-

 
 -- (copied from PosixUtil, for now)
 -- Allocate a mutable array of characters with no indices.
 
 -- (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
 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
 
 
 -- 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# ->
 allocWords (I# size#) = IO $ \ s# ->

-    case newIntArray# size# s# of 
+    case newByteArray# (wORD_SCALE size#) s# of 

       (# s2#, barr# #) -> 
       (# s2#, barr# #) -> 

-       (# s2#, MutableByteArray bot barr# #)
+       (# s2#, MutableByteArray bot bot barr# #)

   where
     bot = error "Time.allocWords"
 #endif
   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
 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 "" = ""
 
         doFmt (c:cs) = c : doFmt cs
         doFmt "" = ""
 

@@ -531,10 +639,12 @@ timeDiffToString :: TimeDiff -> String
 timeDiffToString = formatTimeDiff defaultTimeLocale "%c"
 
 formatTimeDiff :: TimeLocale -> String -> 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 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
 
    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)
       '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
       '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]
 
       '%' -> "%"
       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}
 \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
 -- 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 (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
 #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}
 \end{code}