diff options
author | Hugo Hörnquist <hugo@hornquist.se> | 2020-02-03 19:15:27 +0100 |
---|---|---|
committer | Hugo Hörnquist <hugo@hornquist.se> | 2020-02-03 19:15:27 +0100 |
commit | 033cf78ee6102ca104b04460abfbbfa84cf22cbf (patch) | |
tree | c6462a533bbe143430cf90cdfa00b7c8a810746f /module/srfi/srfi-19/alt.scm | |
parent | Work. (diff) | |
download | calp-033cf78ee6102ca104b04460abfbbfa84cf22cbf.tar.gz calp-033cf78ee6102ca104b04460abfbbfa84cf22cbf.tar.xz |
Fix date<=.
Diffstat (limited to 'module/srfi/srfi-19/alt.scm')
-rw-r--r-- | module/srfi/srfi-19/alt.scm | 31 |
1 files changed, 25 insertions, 6 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<) |