[project @ 1999-09-19 19:15:26 by sof]
[ghc-hetmet.git] / ghc / lib / std / Time.lhs
index 562f6f5..b9bd4ca 100644 (file)
@@ -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,35 +11,41 @@ its use of Coordinated Universal Time (UTC).
 \begin{code}
 {-# OPTIONS -#include "cbits/timezone.h" -#include "cbits/stgio.h"  #-}
 module Time 
-       (
-        Month(..),
-       Day(..),
+     (
+        Month(..)
+     ,  Day(..)
 
-       ClockTime(..), -- non-standard, lib. report gives this as abstract
-       getClockTime, 
+     ,  ClockTime(..) -- non-standard, lib. report gives this as abstract
+     , getClockTime
 
-        TimeDiff(TimeDiff),
-       diffClockTimes,
-       addToClockTime,
-       timeDiffToString, -- non-standard
-       formatTimeDiff,   -- non-standard
+     ,  TimeDiff(..)
+     ,  diffClockTimes
+     ,  addToClockTime
 
-        CalendarTime(CalendarTime),
-       toCalendarTime, 
-       toUTCTime, 
-       toClockTime,
-        calendarTimeToString, 
-       formatCalendarTime
+     ,  timeDiffToString  -- non-standard
+     ,  formatTimeDiff    -- non-standard
 
-       ) where
+     ,  CalendarTime(..)
+     , toCalendarTime
+     ,  toUTCTime
+     ,  toClockTime
+     ,  calendarTimeToString
+     ,  formatCalendarTime
 
+     ) where
+
+#ifdef __HUGS__
+import PreludeBuiltin
+#else
 import PrelBase
+import PrelShow
 import PrelIOBase
+import PrelHandle
 import PrelArr
 import PrelST
-import PrelUnsafe      ( unsafePerformIO )
 import PrelAddr
-import PrelPack        ( unpackCString )
+import PrelPack        ( unpackCString, new_ps_array )
+#endif
 
 import Ix
 import Char            ( intToDigit )
@@ -57,7 +63,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)
 
@@ -68,7 +74,13 @@ Clock times may be compared, converted to strings, or converted to an
 external calendar time @CalendarTime@.
 
 \begin{code}
+#ifdef __HUGS__
+-- I believe Int64 is more than big enough.
+-- In fact, I think one of Int32 or Word32 would do. - ADR
+data ClockTime = TOD Int64 Int64 deriving (Eq, Ord)
+#else
 data ClockTime = TOD Integer Integer deriving (Eq, Ord)
+#endif
 \end{code}
 
 When a @ClockTime@ is shown, it is converted to a string of the form
@@ -79,14 +91,21 @@ 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 ->
+    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 <- showTime (I# s#) d# buf
            return (unpackCString str)
 
     showList = showList__ (showsPrec 0)
+#endif
 \end{code}
 
 
@@ -122,7 +141,11 @@ data CalendarTime
      ctHour    :: Int,
      ctMin     :: Int,
      ctSec     :: Int,
+#ifdef __HUGS__
+     ctPicosec :: Int64,
+#else
      ctPicosec :: Integer,
+#endif
      ctWDay    :: Day,
      ctYDay    :: Int,
      ctTZName  :: String,
@@ -145,7 +168,11 @@ 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)
 \end{code}
@@ -157,7 +184,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
@@ -166,25 +193,29 @@ getClockTime = do
        else
            constructErrorAndFail "getClockTime"
   where
+#ifdef __HUGS__
+    malloc1 = primNewByteArray sizeof_int64
+    cvtUnsigned arr = primReadInt64Array arr 0
+#else
     malloc1 = IO $ \ s# ->
        case newIntArray# 1# s# of 
-          StateAndMutableByteArray# s2# barr# -> 
-               IOok s2# (MutableByteArray bottom barr#)
+          (# 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.
+    -- although (J# 1# (ptr to 0#)) is probably acceptable to gmp.
 
     cvtUnsigned (MutableByteArray _ arr#) = IO $ \ s# ->
        case readIntArray# arr# 0# s# of 
-         StateAndInt# s2# r# ->
+         (# s2#, r# #) ->
             if r# ==# 0# 
-               then IOok s2# 0
+               then (# s2#, 0 #)
                else case unsafeFreezeByteArray# arr# s2# of
-                        StateAndByteArray# s3# frozen# -> 
-                               IOok s3# (J# 1# 1# frozen#)
-
+                        (# s3#, frozen# #) -> 
+                               (# s3#, J# 1# frozen# #)
+#endif
 \end{code}
 
 @addToClockTime@ {\em d} {\em t} adds a time difference {\em d} and a
@@ -195,33 +226,47 @@ 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(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#))
+    res <- allocWords sizeof_int64
+    rc <- 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 <- stToIO (newIntArray (0,sizeof_time_t))
+    rc <- toClockSec year mon day hour min sec (0::Int) res 
+    if rc /= 0
+     then do
+          diff_sec_i <- stToIO (readIntArray res 0)
+          let
+           diff_sec  = int2Integer (case diff_sec_i of I# i# -> i#)
            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
 
 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) 
           (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}
@@ -234,47 +279,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)
 
@@ -286,15 +332,84 @@ 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 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
+       return (CalendarTime (1900+year) mon mday hour min sec psec 
+                           (toEnum wday) yday tzname tz (isdst /= (0::Int)))
+
+toUTCTime :: ClockTime -> CalendarTime
+toUTCTime (TOD (S# i) psec) 
+  = case int2Integer# i of (# s, d #) -> toUTCTime (TOD (J# s d) psec)
+toUTCTime  (TOD (J# s# d#) psec) = unsafePerformIO $ do
+       res    <- allocWords sizeof_struct_tm
+       zoneNm <- allocChars 32
+       prim_SETZONE res zoneNm
+       rc     <-  prim_toUTCTime (I# s#) d# res
+       if rc == 0
+       then error "Time.toUTCTime: out of range"
+        else do
+           sec   <- get_tm_sec res
+           min   <- get_tm_min res
+           hour  <- get_tm_hour res
+           mday  <- get_tm_mday res
+           mon   <- get_tm_mon res
+           year  <- get_tm_year res
+           wday  <- get_tm_wday res
+           yday  <- get_tm_yday res
+            return (CalendarTime (1900+year) mon mday hour min sec psec 
+                         (toEnum wday) yday "UTC" 0 False)
+
+toClockTime :: CalendarTime -> ClockTime
+toClockTime (CalendarTime year mon mday hour min sec psec _wday _yday _tzname tz isdst) =
+    if psec < 0 || psec > 999999999999 then
+        error "Time.toClockTime: picoseconds out of range"
+    else if tz < -43200 || tz > 43200 then
+        error "Time.toClockTime: timezone offset out of range"
+    else
+        unsafePerformIO ( do
+           res <- stToIO (newIntArray (0, sizeof_time_t))
+           rc  <- toClockSec year mon mday hour min sec isDst res
+            if rc /= 0
+             then do
+              i <- stToIO (readIntArray res 0)
+              return (TOD (int2Integer (case i of I# i# -> i#)) psec)
             else error "Time.toClockTime: can't perform conversion"
         )
     where
      isDst = if isdst then (1::Int) else 0
+#endif
 
 bottom :: (Int,Int)
 bottom = error "Time.bottom"
@@ -303,24 +418,28 @@ bottom = error "Time.bottom"
 -- (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 barr# #)
   where
     bot = error "Time.allocWords"
-
+#endif
 \end{code}
 
 \begin{code}
@@ -328,61 +447,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)]
 
@@ -390,15 +510,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 ""         = ""
@@ -436,3 +559,57 @@ 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"   get_tm_sec   :: MBytes -> IO Int
+foreign import "libHS_cbits" "get_tm_min"   get_tm_min   :: MBytes -> IO Int
+foreign import "libHS_cbits" "get_tm_hour"  get_tm_hour  :: MBytes -> IO Int
+foreign import "libHS_cbits" "get_tm_mday"  get_tm_mday  :: MBytes -> IO Int
+foreign import "libHS_cbits" "get_tm_mon"   get_tm_mon   :: MBytes -> IO Int
+foreign import "libHS_cbits" "get_tm_year"  get_tm_year  :: MBytes -> IO Int
+foreign import "libHS_cbits" "get_tm_wday"  get_tm_wday  :: MBytes -> IO Int
+foreign import "libHS_cbits" "get_tm_yday"  get_tm_yday  :: MBytes -> IO Int
+foreign import "libHS_cbits" "get_tm_isdst" 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" prim_SETZONE :: MBytes -> MBytes -> IO Int
+#ifdef __HUGS__
+foreign import "libHS_cbits" "prim_toLocalTime"  prim_toLocalTime :: Int64 -> MBytes -> IO Int
+foreign import "libHS_cbits" "prim_toUTCTime"    prim_toUTCTime   :: Int64 -> MBytes -> IO Int
+#else
+foreign import "libHS_cbits" "toLocalTime"  prim_toLocalTime :: Int -> Bytes -> MBytes -> IO Int
+foreign import "libHS_cbits" "toUTCTime"    prim_toUTCTime   :: Int -> Bytes -> MBytes -> IO Int
+#endif
+
+foreign import "libHS_cbits" "get_ZONE"  get_ZONE    :: MBytes -> IO Addr
+foreign import "libHS_cbits" "GMTOFF"   get_GMTOFF   :: MBytes -> IO Int
+
+
+foreign import "libHS_cbits" "toClockSec"
+            toClockSec   :: Int -> Int -> Int -> Int -> Int 
+                        -> Int -> Int -> MBytes -> IO Int
+
+foreign import "libHS_cbits" "prim_getClockTime" 
+           primGetClockTime :: MutableByteArray RealWorld Int
+                           -> MutableByteArray RealWorld Int
+                           -> IO Int
+foreign import "libHS_cbits" "showTime" 
+           showTime :: Int
+                   -> Bytes
+                   -> MBytes
+                   -> IO Addr{-packed C string -}
+\end{code}