Implement procedures to return strings for weekdays.

diff --git a/v7/src/runtime/datime.scm b/v7/src/runtime/datime.scm
index 65db21be0d0cf66713be5c48817dd9afd81235ec..85607562e0829b10daefedb3dd483fe009386c8f 100644 (file)
--- a/v7/src/runtime/datime.scm
+++ b/v7/src/runtime/datime.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: datime.scm,v 14.10 1995/04/23 03:19:48 cph Exp $
+$Id: datime.scm,v 14.11 1995/04/23 05:43:43 cph Exp $
 
 Copyright (c) 1988-95 Massachusetts Institute of Technology
 
@@ -79,29 +79,6 @@ MIT in each case. |#
     ((ucode-primitive decode-time 2) dt ((ucode-primitive encode-time 1) dt))
     dt))
 
-(define (month/max-days month)
-  (guarantee-month month 'MONTH/MAX-DAYS)
-  (vector-ref '#(31 29 31 30 31 30 31 31 30 31 30 31) (- month 1)))
-
-(define (month/short-string month)
-  (guarantee-month month 'MONTH/SHORT-STRING)
-  (vector-ref '#("Jan" "Feb" "Mar" "Apr" "May" "Jun"
-                      "Jul" "Aug" "Sep" "Oct" "Nov" "Dec")
-             (- month 1)))
-
-(define (month/long-string month)
-  (guarantee-month month 'MONTH/LONG-STRING)
-  (vector-ref '#("January" "February" "March" "April" "May" "June"
-                          "July" "August" "September" "October"
-                          "November" "December")
-             (- month 1)))
-
-(define (guarantee-month month name)
-  (if (not (exact-integer? month))
-      (error:wrong-type-argument month "month integer" name))
-  (if (not (<= 1 month 12))
-      (error:bad-range-argument month name)))
-\f
 (define (decode-universal-time time)
   (let ((result (allocate-decoded-time)))
     ((ucode-primitive decode-time 2) result time)
@@ -116,20 +93,23 @@ MIT in each case. |#
 (define (get-decoded-time)
   (decode-universal-time (get-universal-time)))
 
+(define (time-zone? object)
+  (and (number? object)
+       (exact? object)
+       (<= -24 object 24)
+       (integer? (* 3600 object))))
+
+(define (decoded-time/daylight-savings-time? dt)
+  (> (decoded-time/daylight-savings-time dt) 0))
+\f
 (define (decoded-time/date-string time)
-  (string-append
-   (if (decoded-time/day-of-week time)
-       (string-append
-       (vector-ref '#("Monday" "Tuesday" "Wednesday" "Thursday" "Friday"
-                               "Saturday" "Sunday")
-                   (decoded-time/day-of-week time))
-       " ")
-       "")
-   (month/long-string (decoded-time/month time))
-   " "
-   (number->string (decoded-time/day time))
-   ", "
-   (number->string (decoded-time/year time))))
+  (string-append (weekday/long-string (decoded-time/day-of-week time))
+                " "
+                (month/long-string (decoded-time/month time))
+                " "
+                (number->string (decoded-time/day time))
+                ", "
+                (number->string (decoded-time/year time))))
 
 (define (decoded-time/time-string time)
   (let ((second (decoded-time/second time))
@@ -146,12 +126,6 @@ MIT in each case. |#
                   " "
                   (if (< hour 12) "AM" "PM"))))
 
-(define (time-zone? object)
-  (and (number? object)
-       (exact? object)
-       (<= -24 object 24)
-       (integer? (* 3600 object))))
-
 (define (time-zone->string tz)
   (if (not (time-zone? tz))
       (error:wrong-type-argument tz "time zone" 'TIME-ZONE->STRING))
@@ -162,5 +136,41 @@ MIT in each case. |#
                     (d2 (integer-divide-quotient qr))
                     (d2 (integer-divide-remainder qr))))))
 
-(define (decoded-time/daylight-savings-time? dt)
-  (> (decoded-time/daylight-savings-time dt) 0))
\ No newline at end of file
+(define (month/max-days month)
+  (guarantee-month month 'MONTH/MAX-DAYS)
+  (vector-ref '#(31 29 31 30 31 30 31 31 30 31 30 31) (- month 1)))
+
+(define (month/short-string month)
+  (guarantee-month month 'MONTH/SHORT-STRING)
+  (vector-ref '#("Jan" "Feb" "Mar" "Apr" "May" "Jun"
+                      "Jul" "Aug" "Sep" "Oct" "Nov" "Dec")
+             (- month 1)))
+
+(define (month/long-string month)
+  (guarantee-month month 'MONTH/LONG-STRING)
+  (vector-ref '#("January" "February" "March" "April" "May" "June"
+                          "July" "August" "September" "October"
+                          "November" "December")
+             (- month 1)))
+
+(define (guarantee-month month name)
+  (if (not (exact-integer? month))
+      (error:wrong-type-argument month "month integer" name))
+  (if (not (<= 1 month 12))
+      (error:bad-range-argument month name)))
+
+(define (day-of-week/short-string day)
+  (guarantee-day-of-week day 'DAY-OF-WEEK/SHORT-STRING)
+  (vector-ref '#("Mon" "Tue" "Wed" "Thu" "Fri" "Sat" "Sun") day-of-week))
+
+(define (day-of-week/long-string day)
+  (guarantee-day-of-week day 'DAY-OF-WEEK/LONG-STRING)
+  (vector-ref '#("Monday" "Tuesday" "Wednesday" "Thursday" "Friday"
+                         "Saturday" "Sunday")
+             day-of-week))
+
+(define (guarantee-day-of-week day name)
+  (if (not (exact-integer? day))
+      (error:wrong-type-argument day "day-of-week integer" name))
+  (if (not (<= 0 day 6))
+      (error:bad-range-argument day name)))
\ No newline at end of file

diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index fda3995f5a37c959c7ea6d83874ed22809c043b0..a48e77d7b5ed2c6c0e030ab65bbbbd5423177bc0 100644 (file)
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.253 1995/04/22 23:37:23 cph Exp $
+$Id: runtime.pkg,v 14.254 1995/04/23 05:43:50 cph Exp $
 
 Copyright (c) 1988-95 Massachusetts Institute of Technology
 
@@ -371,6 +371,8 @@ MIT in each case. |#
   (files "datime")
   (parent ())
   (export ()
+         day-of-week/long-string
+         day-of-week/short-string
          decode-universal-time
          decoded-time/date-string
          decoded-time/day

diff --git a/v8/src/runtime/runtime.pkg b/v8/src/runtime/runtime.pkg
index fda3995f5a37c959c7ea6d83874ed22809c043b0..a48e77d7b5ed2c6c0e030ab65bbbbd5423177bc0 100644 (file)
--- a/v8/src/runtime/runtime.pkg
+++ b/v8/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.253 1995/04/22 23:37:23 cph Exp $
+$Id: runtime.pkg,v 14.254 1995/04/23 05:43:50 cph Exp $
 
 Copyright (c) 1988-95 Massachusetts Institute of Technology
 
@@ -371,6 +371,8 @@ MIT in each case. |#
   (files "datime")
   (parent ())
   (export ()
+         day-of-week/long-string
+         day-of-week/short-string
          decode-universal-time
          decoded-time/date-string
          decoded-time/day