Fix date<=.

2 files changed, 30 insertions, 11 deletions

diff --git a/module/srfi/srfi-19/alt.scm b/module/srfi/srfi-19/alt.scm
index a9359a32..0d70a4f9 100644
--- a/module/srfi/srfi-19/alt.scm
+++ b/module/srfi/srfi-19/alt.scm
@@ -174,6 +174,17 @@
      (and (date<% first second)
           (apply date< second rest))]))
 
+(define (date<=% a b)
+  (or (date= a b)
+      (date< a b)))
+
+(define-public date<=
+  (match-lambda*
+    [() #t]
+    [(_) #t]
+    [(first second . rest)
+     (and (date<=% first second)
+          (apply date<= second rest))]))
 
 (define-public (time< a b)
   (let ((ah (hour a))
@@ -186,12 +197,20 @@
               (< am bm)))
         (< ah bh))))
 
+(define-public (time<= a b)
+  (or (time= a b)
+      (time< a b)))
 
 (define-public (datetime< a b)
   (if (date= (get-date a) (get-date b))
       (time< (get-time a) (get-time b))
       (date< (get-date a) (get-date b))))
 
+(define-public (datetime<= a b)
+  (if (date= (get-date a) (get-date b))
+      (time<= (get-time a) (get-time b))
+      (date<= (get-date a) (get-date b))))
+
 (define-public (date/-time< a b)
   (if (date< (as-date a) (as-date b))
       #t
@@ -200,18 +219,18 @@
 (define-many define-public
   (date<?) date<
   (date> date>?) (swap date<)
-  (date<= date<=?) (negate date>)
-  (date>= date>=?) (negate date<)
+  (date<=?) date<=
+  (date>= date>=?) (swap date<=)
 
   (time<?) time<
   (time> time>?) (swap time<)
-  (time<= time<=?) (negate time>)
-  (time>= time>=?) (negate time<)
+  (time<=?) time<=
+  (time>= time>=?) (swap time<=)
 
   (datetime<?) datetime<
   (datetime> datetime>?) (swap datetime<)
-  (datetime<= datetime<=?) (negate datetime>)
-  (datetime>= datetime>=?) (negate datetime<)
+  (datetime<=?) datetime<=
+  (datetime>= datetime>=?) (swap datetime<=)
 
   (date/-time<?) date/-time<
   (date/-time> date/-time>?) (swap date/-time<)
diff --git a/module/srfi/srfi-19/alt/util.scm b/module/srfi/srfi-19/alt/util.scm
index ba1d8dd8..8299c6cb 100644
--- a/module/srfi/srfi-19/alt/util.scm
+++ b/module/srfi/srfi-19/alt/util.scm
@@ -163,9 +163,9 @@
 
 (define-public (in-date-range? start-date end-date)
   (lambda (date)
-    (format (current-error-port) "in-date-range? ~a < ~a < ~a = ~a~%"
-            (date->string start-date)
-            (date->string date)
-            (date->string end-date)
-            (date<= start-date date end-date) )
+    ;; (format (current-error-port) "in-date-range? ~a < ~a < ~a = ~a~%"
+    ;;         (date->string start-date)
+    ;;         (date->string date)
+    ;;         (date->string end-date)
+    ;;         (date<= start-date date end-date) )
     (date<= start-date date end-date)))