Hi Dave,
find a patch for the srfi-19 egg attached to this email. When applied
to the trunk of the chicken3 egg it will happily install on chicken
4. This has been sent to Kon for review, so don't consider this one
blessed by the original author. Maybe Kon will get around to commit
this soon.
Kind regards,
Christian
Index: srfi-19.meta
===================================================================
--- srfi-19.meta (revision 15226)
+++ srfi-19.meta (working copy)
@@ -6,7 +6,7 @@
(author "Kon Lovett")
(egg "srfi-19.egg")
(license "BSD")
- (needs numbers miscmacros locale misc-extn lookup-table srfi-29)
+ (needs numbers miscmacros locale lookup-table srfi-29)
(doc-from-wiki)
(files
"tests"
Index: srfi-19-io.scm
===================================================================
--- srfi-19-io.scm (revision 15226)
+++ srfi-19-io.scm (working copy)
@@ -26,8 +26,15 @@
;; IMPLIED, INCLUDING BUT NOT LIMITED TO ANY WARRANTY THAT THE USE OF THE
;; INFORMATION HEREIN WILL NOT INFRINGE ANY RIGHTS OR ANY IMPLIED WARRANTIES OF
;; MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE.
+(module srfi-19-io
+( format-date
+ scan-date
+ ;; SRFI-19
+ date->string
+ string->date)
-(eval-when (compile)
+(import chicken scheme)
+
(declare
(not usual-integrations
+ - * /
@@ -53,9 +60,9 @@
scan-date
;; SRFI-19
date->string
- string->date) ) )
+ string->date) )
-(use srfi-1 srfi-13 srfi-29 locale numbers srfi-19-core)
+(use srfi-1 srfi-13 srfi-29 locale numbers srfi-19-core ports data-structures)
;;;
@@ -699,4 +706,4 @@
newdate ) ) )
(define (string->date src . template-string)
- (scan-date src (optional template-string (%item@ LOCALE-DATE-TIME-FORMAT))) )
+ (scan-date src (optional template-string (%item@ LOCALE-DATE-TIME-FORMAT)))
) )
Index: srfi-19-core.scm
===================================================================
--- srfi-19-core.scm (revision 15226)
+++ srfi-19-core.scm (working copy)
@@ -81,8 +81,182 @@
;; IMPLIED, INCLUDING BUT NOT LIMITED TO ANY WARRANTY THAT THE USE OF THE
;; INFORMATION HEREIN WILL NOT INFRINGE ANY RIGHTS OR ANY IMPLIED WARRANTIES OF
;; MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE.
+(module srfi-19-core
+( ; SRFI-19
+ time-tai
+ time-utc
+ time-monotonic
+ time-thread
+ time-process
+ time-duration
+ time-gc
+ current-date
+ current-julian-day
+ current-modified-julian-day
+ current-time
+ time-resolution
+ make-time time?
+ time-type
+ time-nanosecond
+ time-second
+ set-time-type!
+ set-time-nanosecond!
+ set-time-second!
+ copy-time
+ time<=?
+ time<?
+ time=?
+ time>=?
+ time>?
+ time-difference
+ time-difference!
+ add-duration
+ add-duration!
+ subtract-duration
+ subtract-duration!
+ make-date
+ date?
+ date-nanosecond
+ date-second
+ date-minute
+ date-hour
+ date-day
+ date-month
+ date-year
+ date-zone-offset
+ leap-year? ; Actually part of SRFI 19 but not in original document
+ date-year-day
+ date-week-day
+ date-week-number
+ date->julian-day
+ date->modified-julian-day
+ date->time-monotonic
+ date->time-tai
+ date->time-utc
+ julian-day->date
+ julian-day->time-monotonic
+ julian-day->time-tai
+ julian-day->time-utc
+ modified-julian-day->date
+ modified-julian-day->time-monotonic
+ modified-julian-day->time-tai
+ modified-julian-day->time-utc
+ time-monotonic->date
+ time-monotonic->julian-day
+ time-monotonic->modified-julian-day
+ time-monotonic->time-tai
+ time-monotonic->time-tai!
+ time-monotonic->time-utc
+ time-monotonic->time-utc!
+ time-tai->date
+ time-tai->julian-day
+ time-tai->modified-julian-day
+ time-tai->time-monotonic
+ time-tai->time-monotonic!
+ time-tai->time-utc
+ time-tai->time-utc!
+ time-utc->date
+ time-utc->julian-day
+ time-utc->modified-julian-day
+ time-utc->time-monotonic
+ time-utc->time-monotonic!
+ time-utc->time-tai
+ time-utc->time-tai!
+ ; Extensions
+ ONE-SECOND-DURATION
+ ONE-NANOSECOND-DURATION
+ time-type?
+ make-duration
+ divide-duration
+ divide-duration!
+ multiply-duration
+ multiply-duration!
+ srfi-19:current-time
+ srfi-19:time?
+ time->srfi-18-time
+ srfi-18-time->time
+ time-max
+ time-min
+ time-negative?
+ time-positive?
+ time-zero?
+ time-abs
+ time-abs!
+ time-negate
+ time-negate!
+ seconds->time/type
+ seconds->date/type
+ time->nanoseconds
+ nanoseconds->time
+ nanoseconds->seconds
+ read-leap-second-table
+ time->milliseconds
+ milliseconds->time
+ milliseconds->seconds
+ time->date
+ make-timezone-locale
+ timezone-locale?
+ timezone-locale-name
+ timezone-locale-offset
+ timezone-locale-dst?
+ local-timezone-locale
+ utc-timezone-locale
+ default-date-clock-type
+ date-zone-name
+ date-dst?
+ copy-date
+ date->time
+ date-difference
+ date-add-duration
+ date-subtract-duration
+ date=?
+ date>?
+ date<?
+ date>=?
+ date<=?
+ time->julian-day
+ time->modified-julian-day
+ date-compare
+ time-compare
+ ; Internal API, for srfi-19-io & srfi-19-period
+ tm:date-day-set!
+ tm:date-hour-set!
+ tm:date-minute-set!
+ tm:date-month-set!
+ tm:date-nanosecond-set!
+ tm:date-second-set!
+ tm:date-year-set!
+ tm:date-zone-offset-set!
+ tm:make-incomplete-date
+ tm:check-date
+ tm:check-exploded-date
+ tm:time-type
+ tm:check-time
+ tm:make-empty-time
+ tm:as-empty-time
+ tm:time-monotonic->time-tai
+ tm:time-utc->time-tai
+ tm:time-tai->time-monotonic
+ tm:time-utc->time-monotonic
+ tm:time-monotonic->time-utc
+ tm:time-tai->time-utc
+ tm:week-day
+ tm:days-before-first-week
+ tm:subtract-duration
+ tm:add-duration
+ tm:time=?
+ tm:time<?
+ tm:time>?
+ tm:time<=?
+ tm:time>=?
+ tm:time-max
+ tm:time-min
+ tm:check-duration
+ tm:time-difference)
-(eval-when (compile)
+(import chicken scheme)
+(use srfi-18 data-structures ports extras locale-components locale-builtin)
+
(declare
(not usual-integrations
+ - * /
@@ -101,9 +275,6 @@
(inline)
(generic)
(no-procedure-checks)
- (import
- ; SRFI-18 - This is a hack, works because Unit srfi-18 is part of the
Chicken core.
- seconds->time)
(bound-to-procedure
##sys#slot
seconds->time
@@ -279,16 +450,12 @@
tm:time-max
tm:time-min
tm:check-duration
- tm:time-difference) ) )
+ tm:time-difference) )
-(require-extension srfi-6 srfi-8 srfi-9 posix miscmacros numbers locale
misc-extn-record)
+(require-extension posix miscmacros numbers locale)
(register-feature! 'srfi-19)
-; Re-defining a macro symbol!
-(eval-when (compile)
- (undefine-macro! 'time) )
-
(include "srfi-19-common")
;;;
@@ -480,18 +647,35 @@
;; Macros to inline the leap-second-delta algorithm
; 'leap-second-item' is like the 'it' in the anaphoric 'if'
-(define-macro ($find-leap-second-delta ?secs ?ls ?tst)
- (let ((lsvar (gensym)))
- `(let loop ((,lsvar ,?ls))
- (if (null? ,lsvar) 0
- (let ((leap-second-item (car ,lsvar)))
- (if ,?tst (cdr leap-second-item)
- (loop (cdr ,lsvar)) ) ) ) ) ) )
+;(define-macro ($find-leap-second-delta ?secs ?ls ?tst)
+; (let ((lsvar (gensym)))
+; `(let loop ((,lsvar ,?ls))
+; (if (null? ,lsvar) 0
+; (let ((leap-second-item (car ,lsvar)))
+; (if ,?tst (cdr leap-second-item)
+; (loop (cdr ,lsvar)) ) ) ) ) ) )
+(define-syntax ($find-leap-second-delta form rename cmp)
+ (let (
+ (secs (cadr form))
+ (ls (caddr form))
+ (tst (caddr form)) )
+ `(,(rename 'let) ,(rename 'loop) ((,(rename 'lsvar) ,ls))
+ (,(rename 'if) (,(rename 'null?) ,(rename 'lsvar)) 0
+ (,(rename 'let) ((,(rename 'leap-second-item) (,(rename 'car)
,(rename 'lsvar))))
+ (,(rename 'if) ,tst ( ,(rename 'cdr) ,(rename 'leap-second-item)
+ (,(rename 'loop) (,(rename 'cdr) ,(rename 'lsvar)) ) ) ) ) ) )
) )
-(define-macro ($leap-second-delta ?secs ?tst)
- `(if (< ,?secs LEAP-START) 0
- ($find-leap-second-delta ,?secs tm:leap-second-table ,?tst) ) )
+;(define-macro ($leap-second-delta ?secs ?tst)
+; `(if (< ,?secs LEAP-START) 0
+; ($find-leap-second-delta ,?secs tm:leap-second-table ,?tst) ) )
+(define-syntax ($leap-second-delta form rename cmp)
+ (let (
+ (secs (cadr form))
+ (tst (caddr form)) )
+ `(,(rename 'if) (,(rename '<) ,secs ,(rename 'LEAP-START) ) 0
+ (,(rename '$find-leap-second-delta) ,secs ,(rename
'tm:leap-second-table) ,tst) ) ) )
+
;; Going from utc seconds ...
(define-inline (%leap-second-delta utc-seconds)
@@ -543,7 +727,7 @@
;; tm:... - argument processing then %...
;; ... - argument checking then tm:...
-(define-record-type/unsafe-inline-unchecked time
+(define-record-type time
(%make-time timtyp ns sec)
%time?
(timtyp %time-type %set-time-type!)
@@ -1147,7 +1331,7 @@
;;; Date Object (Public Immutable)
-(define-record-type/unsafe-inline-unchecked date
+(define-record-type date
(%make-date ns sec min hr dy mn yr tzo tzn dstf wdy ydy jdy)
%date?
(ns %date-nanosecond %date-nanosecond-set!)
@@ -1790,4 +1974,4 @@
(time-utc->julian-day (tm:current-time-utc)) )
(define (current-modified-julian-day)
- (time-utc->modified-julian-day (tm:current-time-utc)) )
+ (time-utc->modified-julian-day (tm:current-time-utc)) ) )
Index: srfi-19.setup
===================================================================
--- srfi-19.setup (revision 15226)
+++ srfi-19.setup (working copy)
@@ -1,15 +1,23 @@
-(include "setup-header")
+(compile srfi-19-core.scm -s -O2 -d1 -j srfi-19-core)
+(compile srfi-19-core.import.scm -s -O2 -d0)
+(compile srfi-19-io.scm -s -O2 -d1 -j srfi-19-io)
+(compile srfi-19-io.import.scm -s -O2 -d0)
+(compile srfi-19-period.scm -s -O2 -d1 -j srfi-19-period)
+(compile srfi-19-period.import.scm -s -O2 -d0)
+(compile srfi-19.scm -s -O2 -d1 -j srfi-19)
+(compile srfi-19.import.scm -s -O2 -d0)
-#+(or macosx windows)
-(required-chicken-version 2.610)
+(define (*file-copy fn dn)
+ (let ([fn (->string fn)])
+ (copy-file fn (make-pathname dn fn)) ) )
-(required-extension-version
- 'locale "0.5.0"
- 'misc-extn "3.2.0"
- 'srfi-29 "1.14.0"
- 'miscmacros "2.4"
- 'numbers "1.8")
+(define (copy-to-repository fn)
+ (*file-copy (->string fn) REPOSITORY-DIRECTORY) )
+(define REPOSITORY-DIRECTORY (repository-path))
+(define (make-repository-pathname bn)
+ (make-pathname REPOSITORY-DIRECTORY bn) )
+
(define srfi-29-bundles-path (make-repository-pathname "srfi-29-bundles"))
(unless (directory? srfi-29-bundles-path)
(error 'srfi-19.setup "missing SRFI-29 bundles directory; please
re-install SRFI-29"))
@@ -22,17 +30,20 @@
(make-pathname "." bundle-name)
(make-pathname srfi-29-bundles-path bundle-name))))
-;FIXME should have a bundle dir & walk it
+;;FIXME should have a bundle dir & walk it
(copy-bundle "en")
(copy-bundle "es")
(copy-bundle "nl")
-;For Windows since doesn't make parent
+;;For Windows since doesn't make parent
(create-directory (make-pathname srfi-29-bundles-path "pt"))
(copy-bundle (make-pathname "pt" "br"))
(copy-to-repository "tai-utc.dat")
-(install-dynld srfi-19-core *version* (documentation "srfi-19.html"))
-(install-dynld srfi-19-io *version* (documentation "srfi-19.html"))
-(install-dynld srfi-19-period *version* (documentation "srfi-19.html"))
-(install-syntax+docu srfi-19 *version* (require-at-runtime srfi-19-core
srfi-19-io srfi-19-period))
+(install-extension
+ 'srfi-19
+ '("srfi-19.so" "srfi-19.import.so" "srfi-19-core.so" "srfi-19-core.import.so"
+ "srfi-19-io.so" "srfi-19-io.import.so" "srfi-19-period.so"
+ "srfi-19-period.import.so")
+ '((version "trunk")
+ (documentation "srfi-19.html")))
Index: srfi-19-period.scm
===================================================================
--- srfi-19-period.scm (revision 15226)
+++ srfi-19-period.scm (working copy)
@@ -1,7 +1,37 @@
;;;; srfi-19-period.scm
;;;; Chicken port, Kon Lovett, Apr '07
+(module srfi-19-period
+ ( time-period?
+ time-period-null?
+ time-period-compare
+ time-period=?
+ time-period<?
+ time-period>?
+ time-period<=?
+ time-period>=?
+ time-period-type
+ time-period-begin
+ time-period-end
+ time-period-last
+ time-period-length
+ make-null-time-period
+ make-time-period
+ copy-time-period
+ time-period-contains/period?
+ time-period-contains/time?
+ time-period-contains/date?
+ time-period-contains?
+ time-period-intersects?
+ time-period-intersection
+ time-period-union
+ time-period-span
+ time-period-shift
+ time-period-shift!
+ time-period-preceding
+ time-period-succeeding)
-(eval-when (compile)
+(import chicken scheme)
+
(declare
(not usual-integrations
+ - * /
@@ -49,9 +79,9 @@
time-period-shift
time-period-shift!
time-period-preceding
- time-period-succeeding) ) )
+ time-period-succeeding) )
-(use srfi-8 srfi-19-core misc-extn-record)
+(use srfi-19-core extras)
;;;
@@ -76,7 +106,7 @@
;;; Time Period
-(define-record-type/unsafe-inline-unchecked time-period
+(define-record-type time-period
(%make-time-period beg end)
%time-period?
(beg %time-period-begin)
@@ -355,4 +385,4 @@
(define (time-period-shift! per dur)
(%check-time-period 'time-period-shift! per)
(tm:check-duration 'time-period-shift! dur)
- (tm:time-period-shift per dur per) )
+ (tm:time-period-shift per dur per) ) )
Index: srfi-19.scm
===================================================================
--- srfi-19.scm (revision 15226)
+++ srfi-19.scm (working copy)
@@ -1,3 +1,209 @@
;;;; srfi-19.scm
+(module srfi-19
+( ; SRFI-19
+ time-tai
+ time-utc
+ time-monotonic
+ time-thread
+ time-process
+ time-duration
+ time-gc
+ current-date
+ current-julian-day
+ current-modified-julian-day
+ current-time
+ time-resolution
+ make-time time?
+ time-type
+ time-nanosecond
+ time-second
+ set-time-type!
+ set-time-nanosecond!
+ set-time-second!
+ copy-time
+ time<=?
+ time<?
+ time=?
+ time>=?
+ time>?
+ time-difference
+ time-difference!
+ add-duration
+ add-duration!
+ subtract-duration
+ subtract-duration!
+ make-date
+ date?
+ date-nanosecond
+ date-second
+ date-minute
+ date-hour
+ date-day
+ date-month
+ date-year
+ date-zone-offset
+ leap-year? ; Actually part of SRFI 19 but not in original document
+ date-year-day
+ date-week-day
+ date-week-number
+ date->julian-day
+ date->modified-julian-day
+ date->time-monotonic
+ date->time-tai
+ date->time-utc
+ julian-day->date
+ julian-day->time-monotonic
+ julian-day->time-tai
+ julian-day->time-utc
+ modified-julian-day->date
+ modified-julian-day->time-monotonic
+ modified-julian-day->time-tai
+ modified-julian-day->time-utc
+ time-monotonic->date
+ time-monotonic->julian-day
+ time-monotonic->modified-julian-day
+ time-monotonic->time-tai
+ time-monotonic->time-tai!
+ time-monotonic->time-utc
+ time-monotonic->time-utc!
+ time-tai->date
+ time-tai->julian-day
+ time-tai->modified-julian-day
+ time-tai->time-monotonic
+ time-tai->time-monotonic!
+ time-tai->time-utc
+ time-tai->time-utc!
+ time-utc->date
+ time-utc->julian-day
+ time-utc->modified-julian-day
+ time-utc->time-monotonic
+ time-utc->time-monotonic!
+ time-utc->time-tai
+ time-utc->time-tai!
+ ; Extensions
+ ONE-SECOND-DURATION
+ ONE-NANOSECOND-DURATION
+ time-type?
+ make-duration
+ divide-duration
+ divide-duration!
+ multiply-duration
+ multiply-duration!
+ srfi-19:current-time
+ srfi-19:time?
+ time->srfi-18-time
+ srfi-18-time->time
+ time-max
+ time-min
+ time-negative?
+ time-positive?
+ time-zero?
+ time-abs
+ time-abs!
+ time-negate
+ time-negate!
+ seconds->time/type
+ seconds->date/type
+ time->nanoseconds
+ nanoseconds->time
+ nanoseconds->seconds
+ read-leap-second-table
+ time->milliseconds
+ milliseconds->time
+ milliseconds->seconds
+ time->date
+ make-timezone-locale
+ timezone-locale?
+ timezone-locale-name
+ timezone-locale-offset
+ timezone-locale-dst?
+ local-timezone-locale
+ utc-timezone-locale
+ default-date-clock-type
+ date-zone-name
+ date-dst?
+ copy-date
+ date->time
+ date-difference
+ date-add-duration
+ date-subtract-duration
+ date=?
+ date>?
+ date<?
+ date>=?
+ date<=?
+ time->julian-day
+ time->modified-julian-day
+ date-compare
+ time-compare
+ ; Internal API, for srfi-19-io & srfi-19-period
+ tm:date-day-set!
+ tm:date-hour-set!
+ tm:date-minute-set!
+ tm:date-month-set!
+ tm:date-nanosecond-set!
+ tm:date-second-set!
+ tm:date-year-set!
+ tm:date-zone-offset-set!
+ tm:make-incomplete-date
+ tm:check-date
+ tm:check-exploded-date
+ tm:time-type
+ tm:check-time
+ tm:make-empty-time
+ tm:as-empty-time
+ tm:time-monotonic->time-tai
+ tm:time-utc->time-tai
+ tm:time-tai->time-monotonic
+ tm:time-utc->time-monotonic
+ tm:time-monotonic->time-utc
+ tm:time-tai->time-utc
+ tm:week-day
+ tm:days-before-first-week
+ tm:subtract-duration
+ tm:add-duration
+ tm:time=?
+ tm:time<?
+ tm:time>?
+ tm:time<=?
+ tm:time>=?
+ tm:time-max
+ tm:time-min
+ tm:check-duration
+ tm:time-difference
+ format-date
+ scan-date
+ ;; SRFI-19
+ date->string
+ string->date
+ time-period?
+ time-period-null?
+ time-period-compare
+ time-period=?
+ time-period<?
+ time-period>?
+ time-period<=?
+ time-period>=?
+ time-period-type
+ time-period-begin
+ time-period-end
+ time-period-last
+ time-period-length
+ make-null-time-period
+ make-time-period
+ copy-time-period
+ time-period-contains/period?
+ time-period-contains/time?
+ time-period-contains/date?
+ time-period-contains?
+ time-period-intersects?
+ time-period-intersection
+ time-period-union
+ time-period-span
+ time-period-shift
+ time-period-shift!
+ time-period-preceding
+ time-period-succeeding)
-(use srfi-19-core srfi-19-io srfi-19-period)
+(import chicken scheme)
+(use srfi-19-core srfi-19-io srfi-19-period) )
_______________________________________________
Chicken-users mailing list
Chicken-users@nongnu.org
http://lists.nongnu.org/mailman/listinfo/chicken-users
