Add guarantors for DECODED-TIME? and TIME-ZONE?.

diff --git a/v7/src/runtime/datime.scm b/v7/src/runtime/datime.scm
index eaae4a27de41a4c9e49dd91684907377f0743d26..55fa2999daa08bb5de2dee50fd34514e3709adbd 100644 (file)
--- a/v7/src/runtime/datime.scm
+++ b/v7/src/runtime/datime.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: datime.scm,v 14.45 2008/08/25 08:37:32 cph Exp $
+$Id: datime.scm,v 14.46 2008/08/26 05:57:14 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -55,12 +55,14 @@ USA.
   (daylight-savings-time #f read-only #t)
   (zone #f))
 
+(define-guarantee decoded-time "decoded time")
+
 (define (make-decoded-time second minute hour day month year #!optional zone)
   (check-decoded-time-args second minute hour day month year
                           'MAKE-DECODED-TIME)
   (let ((zone (if (default-object? zone) #f zone)))
-    (if (and zone (not (time-zone? zone)))
-       (error:wrong-type-argument zone "time zone" 'MAKE-DECODED-TIME))
+    (if zone
+       (guarantee-time-zone zone 'MAKE-DECODED-TIME))
     (if zone
        (%make-decoded-time second minute hour day month year
                            (compute-day-of-week day month year)
@@ -163,6 +165,8 @@ USA.
        (<= -24 object 24)
        (integer? (* 3600 object))))
 
+(define-guarantee time-zone "time zone")
+
 (define (decoded-time/daylight-savings-time? dt)
   (> (decoded-time/daylight-savings-time dt) 0))
 \f
@@ -293,8 +297,7 @@ USA.
   (decoded-time->file-time (string->decoded-time string)))
 \f
 (define (time-zone->string tz)
-  (if (not (time-zone? tz))
-      (error:wrong-type-argument tz "time zone" 'TIME-ZONE->STRING))
+  (guarantee-time-zone tz 'TIME-ZONE->STRING)
   (let ((minutes (round (* 60 (- tz)))))
     (let ((qr (integer-divide (abs minutes) 60)))
       (string-append (if (< minutes 0) "-" "+")
@@ -303,9 +306,9 @@ USA.
 
 (define (string->time-zone string)
   (let ((entry
-        (list-search-positive named-time-zones
-          (lambda (zone)
-            (string-ci=? string (car zone))))))
+        (find (lambda (zone)
+                (string-ci=? (car zone) string))
+              named-time-zones)))
     (if entry
        (cadr entry)
        (let ((n (string->number string)))
@@ -354,9 +357,8 @@ USA.
 (define (ctime-string->decoded-time string #!optional zone)
   (let ((zone (if (default-object? zone) #f zone))
        (lose (lambda () (error "Ill-formed ctime() string:" string))))
-    (if (not (or (not zone) (time-zone? zone)))
-       (error:wrong-type-argument zone "time zone"
-                                  'CTIME-STRING->DECODED-TIME))
+    (if zone
+       (guarantee-time-zone zone 'CTIME-STRING->DECODED-TIME))
     (let ((tokens (burst-string string #\space #t)))
       (if (not (fix:= 5 (length tokens)))
          (lose))
@@ -681,11 +683,4 @@ USA.
          (else n))))
 
 (define (d2 n)
-  (string-pad-left (number->string n) 2 #\0))
-
-;; Upwards compatibility
-(define decode-universal-time universal-time->local-decoded-time)
-(define encode-universal-time decoded-time->universal-time)
-(define get-decoded-time local-decoded-time)
-(define universal-time->string universal-time->local-time-string)
-(define file-time->string file-time->local-time-string)
\ No newline at end of file
+  (string-pad-left (number->string n) 2 #\0))
\ No newline at end of file

diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index 27cb1ddd83b687db51e79ec54d882c02b58eeb83..d960eb063c4547f0d635bbb07658d944af35efaa 100644 (file)
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.663 2008/08/25 20:53:33 cph Exp $
+$Id: runtime.pkg,v 14.664 2008/08/26 05:57:18 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -1247,12 +1247,16 @@ USA.
   (files "datime")
   (parent (runtime))
   (export ()
+         (decode-universal-time universal-time->local-decoded-time)
+         (encode-universal-time decoded-time->universal-time)
+         (file-time->string file-time->local-time-string)
+         (get-decoded-time local-decoded-time)
+         (universal-time->string universal-time->local-time-string)
          ctime-string->decoded-time
          ctime-string->file-time
          ctime-string->universal-time
          day-of-week/long-string
          day-of-week/short-string
-         decode-universal-time
          decoded-time->ctime-string
          decoded-time->http-string
          decoded-time->iso8601-string
@@ -1270,8 +1274,9 @@ USA.
          decoded-time/year
          decoded-time/zone
          decoded-time?
-         encode-universal-time
          epoch
+         error:not-decoded-time
+         error:not-time-zone
          file-time->global-ctime-string
          file-time->global-iso8601-string
          file-time->global-time-string
@@ -1279,10 +1284,10 @@ USA.
          file-time->local-ctime-string
          file-time->local-iso8601-string
          file-time->local-time-string
-         file-time->string
-         get-decoded-time
          get-universal-time
          global-decoded-time
+         guarantee-decoded-time
+         guarantee-time-zone
          iso8601-separate-with-t?
          iso8601-string->decoded-time
          iso8601-string->file-time
@@ -1309,8 +1314,7 @@ USA.
          universal-time->local-ctime-string
          universal-time->local-decoded-time
          universal-time->local-iso8601-string
-         universal-time->local-time-string
-         universal-time->string))
+         universal-time->local-time-string))
 
 (define-package (runtime debugger)
   (files "debug")