diff options
author | Ludovic Courtès <ludo@gnu.org> | 2008-09-10 22:33:40 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2008-09-10 22:33:40 +0200 |
commit | 4a4849dbe0ae1b731b408167f90222e05d1ca2bd (patch) | |
tree | caa909b99ffb221e43408a3d19ad3e8209e3a96b /srfi | |
parent | 3ec17f28b8f96fa43218db83656c0d85b4f69d7c (diff) | |
parent | 032913739218c756f673bfb9c8f66ef9f8f02330 (diff) | |
download | guile-4a4849dbe0ae1b731b408167f90222e05d1ca2bd.tar.gz |
Merge commit '032913739218c756f673bfb9c8f66ef9f8f02330' into boehm-demers-weiser-gc
Conflicts:
libguile/gc.c
libguile/srcprop.c
libguile/srcprop.h
Diffstat (limited to 'srfi')
-rw-r--r-- | srfi/ChangeLog | 43 | ||||
-rw-r--r-- | srfi/srfi-19.scm | 97 | ||||
-rw-r--r-- | srfi/srfi-60.c | 2 |
3 files changed, 66 insertions, 76 deletions
diff --git a/srfi/ChangeLog b/srfi/ChangeLog index 1d77d7747..fbc5e5d0f 100644 --- a/srfi/ChangeLog +++ b/srfi/ChangeLog @@ -1,3 +1,34 @@ +2007-02-04 Ludovic Courtès <ludovic.courtes@laas.fr> + + * srfi/srfi-19.scm (priv:locale-abbr-weekday): Add one to the day + number before invoking `locale-day-short'. Failing to do so + resulted in days shifted by one in the result of `date->string', + or in the failure of `date->string' when the day is zero. + (priv:locale-long-weekday): Likewise. + +2007-01-31 Ludovic Courtès <ludovic.courtes@laas.fr> + + * srfi-19.scm: Use `(ice-9 i18n)'. + (priv:locale-abbr-weekday-vector, priv:locale-long-weekday-vector, + priv:locale-abbr-month-vector, priv:locale-long-month-vector): + Removed. + (priv:locale-number-separator, priv:locale-pm, priv:locale-am, + priv:locale-abbr-weekday, priv:locale-long-weekday, + priv:locale-abbr-month, priv:locale-long-month): Aliases for their + respective `(ice-9 i18n)' equivalent. + (priv:vector-find): Removed, replaced by... + (priv:date-reverse-lookup): New procedure. Updated callers. + (priv:locale-am/pm): Use `priv:locale-pm' and `priv:locale-am' as + procedures. + (priv:directives): Use `priv:locale-number-separator' as a + procedure. + +2006-12-02 Kevin Ryde <user42@zip.com.au> + + * srfi-60.c (scm_srfi60_copy_bit): Should be long not int for fixnum + bitshift, fixes 64-bit systems setting a bit between 32 and 63. + Reported by Aaron M. Ucko, Debian bug 396119. + 2006-05-28 Kevin Ryde <user42@zip.com.au> * srfi-1.scm, srfi-1.c, srfi-1.h (append-reverse, append-reverse!): @@ -282,7 +313,7 @@ 2004-08-02 Kevin Ryde <user42@zip.com.au> * srfi-13.c (scm_string_every): Correction to initial "res" value, - return should be #t for an empty string. Reported by Andreas Vögele. + return should be #t for an empty string. Reported by Andreas Vögele. 2004-07-10 Marius Vollmer <marius.vollmer@uni-dortmund.de> @@ -505,7 +536,7 @@ * srfi-14.h (SCM_CHARSET_GET): Cast IDX to unsigned char so that it works for 8-bit characters. Thanks to Matthias Koeppe! No, - make that "Köppe". + make that "Köppe". 2002-04-24 Marius Vollmer <mvo@zagadka.ping.de> @@ -558,7 +589,7 @@ 2002-02-22 Neil Jerram <neil@ossau.uklinux.net> * srfi-19.scm (priv:year-day): Index into priv:month-assoc using - month number, not day number. (Thanks to Sébastien de Menten de + month number, not day number. (Thanks to Sébastien de Menten de Horne for reporting the problem.) 2002-02-11 Marius Vollmer <marius.vollmer@uni-dortmund.de> @@ -977,7 +1008,7 @@ 2001-05-28 Michael Livshin <mlivshin@bigfoot.com> * srfi-19.scm: removed a stray open parenthesis. (thanks to - Matthias Köppe for the report). + Matthias Köppe for the report). 2001-05-23 Rob Browning <rlb@cs.utexas.edu> @@ -1233,3 +1264,7 @@ * Started guile-srfi-13 package. Files are copied from the guile-gdbm and slightly modified. + +;; Local Variables: +;; coding: utf-8 +;; End: diff --git a/srfi/srfi-19.scm b/srfi/srfi-19.scm index 896dd035f..1b71a16bd 100644 --- a/srfi/srfi-19.scm +++ b/srfi/srfi-19.scm @@ -41,7 +41,8 @@ (define-module (srfi srfi-19) :use-module (srfi srfi-6) :use-module (srfi srfi-8) - :use-module (srfi srfi-9)) + :use-module (srfi srfi-9) + :use-module (ice-9 i18n)) (begin-deprecated ;; Prevent `export' from re-exporting core bindings. This behaviour @@ -150,48 +151,9 @@ ;;-- LOCALE dependent constants -(define priv:locale-number-separator ".") - -(define priv:locale-abbr-weekday-vector - (vector "Sun" "Mon" "Tue" "Wed" "Thu" "Fri" "Sat")) - -(define priv:locale-long-weekday-vector - (vector - "Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday")) - -;; note empty string in 0th place. -(define priv:locale-abbr-month-vector - (vector "" - "Jan" - "Feb" - "Mar" - "Apr" - "May" - "Jun" - "Jul" - "Aug" - "Sep" - "Oct" - "Nov" - "Dec")) - -(define priv:locale-long-month-vector - (vector "" - "January" - "February" - "March" - "April" - "May" - "June" - "July" - "August" - "September" - "October" - "November" - "December")) - -(define priv:locale-pm "PM") -(define priv:locale-am "AM") +(define priv:locale-number-separator locale-decimal-point) +(define priv:locale-pm locale-pm-string) +(define priv:locale-am locale-am-string) ;; See date->string (define priv:locale-date-time-format "~a ~b ~d ~H:~M:~S~z ~Y") @@ -964,38 +926,33 @@ (define (priv:last-n-digits i n) (abs (remainder i (expt 10 n)))) -(define (priv:locale-abbr-weekday n) - (vector-ref priv:locale-abbr-weekday-vector n)) - -(define (priv:locale-long-weekday n) - (vector-ref priv:locale-long-weekday-vector n)) - -(define (priv:locale-abbr-month n) - (vector-ref priv:locale-abbr-month-vector n)) - -(define (priv:locale-long-month n) - (vector-ref priv:locale-long-month-vector n)) - -(define (priv:vector-find needle haystack comparator) - (let ((len (vector-length haystack))) - (define (priv:vector-find-int index) - (cond - ((>= index len) #f) - ((comparator needle (vector-ref haystack index)) index) - (else (priv:vector-find-int (+ index 1))))) - (priv:vector-find-int 0))) +(define (priv:locale-abbr-weekday n) (locale-day-short (+ 1 n))) +(define (priv:locale-long-weekday n) (locale-day (+ 1 n))) +(define priv:locale-abbr-month locale-month-short) +(define priv:locale-long-month locale-month) + +(define (priv:date-reverse-lookup needle haystack-ref haystack-len + same?) + ;; Lookup NEEDLE (a string) using HAYSTACK-REF (a one argument procedure + ;; that returns a string corresponding to the given index) by passing it + ;; indices lower than HAYSTACK-LEN. + (let loop ((index 1)) + (cond ((> index haystack-len) #f) + ((same? needle (haystack-ref index)) + index) + (else (loop (+ index 1)))))) (define (priv:locale-abbr-weekday->index string) - (priv:vector-find string priv:locale-abbr-weekday-vector string=?)) + (priv:date-reverse-lookup string priv:locale-abbr-weekday 7 string=?)) (define (priv:locale-long-weekday->index string) - (priv:vector-find string priv:locale-long-weekday-vector string=?)) + (priv:date-reverse-lookup string priv:locale-long-weekday 7 string=?)) (define (priv:locale-abbr-month->index string) - (priv:vector-find string priv:locale-abbr-month-vector string=?)) + (priv:date-reverse-lookup string priv:locale-abbr-month 12 string=?)) (define (priv:locale-long-month->index string) - (priv:vector-find string priv:locale-long-month-vector string=?)) + (priv:date-reverse-lookup string priv:locale-long-month 12 string=?)) ;; FIXME: mkoeppe: Put a symbolic time zone in the date structs. @@ -1003,10 +960,8 @@ (define (priv:locale-print-time-zone date port) (priv:tz-printer (date-zone-offset date) port)) -;; FIXME: we should use strftime to determine this dynamically if possible. -;; Again, locale specific. (define (priv:locale-am/pm hr) - (if (> hr 11) priv:locale-pm priv:locale-am)) + (if (> hr 11) (priv:locale-pm) (priv:locale-am))) (define (priv:tz-printer offset port) (cond @@ -1069,7 +1024,7 @@ (le (string-length ns))) (if (> le 2) (begin - (display priv:locale-number-separator port) + (display (priv:locale-number-separator) port) (display (substring ns 2 le) port))))))) (cons #\h (lambda (date pad-with port) (display (date->string date "~b") port))) diff --git a/srfi/srfi-60.c b/srfi/srfi-60.c index 257b1387f..f631c6447 100644 --- a/srfi/srfi-60.c +++ b/srfi/srfi-60.c @@ -86,7 +86,7 @@ SCM_DEFINE (scm_srfi60_copy_bit, "copy-bit", 3, 0, 0, if (ii < SCM_LONG_BIT-1) { nn &= ~(1L << ii); /* zap bit at index */ - nn |= (bb << ii); /* insert desired bit */ + nn |= ((long) bb << ii); /* insert desired bit */ return scm_from_long (nn); } else |