From 53090f783a00a2e03540cd2237c107097f9d1d3e Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 26 Aug 2008 05:57:18 +0000
Subject: [PATCH] Add guarantors for DECODED-TIME? and TIME-ZONE?.

---
 v7/src/runtime/datime.scm  | 33 ++++++++++++++-------------------
 v7/src/runtime/runtime.pkg | 18 +++++++++++-------
 2 files changed, 25 insertions(+), 26 deletions(-)

diff --git a/v7/src/runtime/datime.scm b/v7/src/runtime/datime.scm
index eaae4a27d..55fa2999d 100644
--- 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))
 
@@ -293,8 +297,7 @@ USA.
   (decoded-time->file-time (string->decoded-time string)))
 
 (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 27cb1ddd8..d960eb063 100644
--- 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")
-- 
2.25.1