diff options
author | Hugo Hörnquist <hugo@lysator.liu.se> | 2019-03-22 20:11:11 +0100 |
---|---|---|
committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2019-03-22 20:17:52 +0100 |
commit | d46183860c1f3f10095e95023adcb79b1896ab0e (patch) | |
tree | dd331a0efe9777bfe84160139da1e39df3226b71 /srfi/srfi-19/util.scm | |
parent | Add stuff to test.scm. (diff) | |
download | calp-d46183860c1f3f10095e95023adcb79b1896ab0e.tar.gz calp-d46183860c1f3f10095e95023adcb79b1896ab0e.tar.xz |
Move C and Scheme code into subdirs.
Diffstat (limited to 'srfi/srfi-19/util.scm')
-rw-r--r-- | srfi/srfi-19/util.scm | 83 |
1 files changed, 0 insertions, 83 deletions
diff --git a/srfi/srfi-19/util.scm b/srfi/srfi-19/util.scm deleted file mode 100644 index a4b704b0..00000000 --- a/srfi/srfi-19/util.scm +++ /dev/null @@ -1,83 +0,0 @@ -(define-module (srfi srfi-19 util) - #:use-module (srfi srfi-9 gnu) - #:use-module (srfi srfi-19) - #:use-module (srfi srfi-19 setters) - #:export (copy-date - drop-time! drop-time - in-day? today? - ;; seconds minutes hours days weeks - ;; time-add - make-duration - time->string - add-day remove-day)) - -#; -(define (copy-date date) - "Returns a copy of the given date structure" - (let* ((date-type (@@ (srfi srfi-19) date)) - (access (lambda (field) ((record-accessor date-type field) date)))) - (apply make-date (map access (record-type-fields date-type))))) - -(define (drop-time! date) - "Sets the hour, minute, second and nanosecond attribute of date to 0." - (set! (hour date) 0) - (set! (minute date) 0) - (set! (second date) 0) - (set! (nanosecond date) 0) - date) - -(define (drop-time date) - "Returns a copy of date; with the hour, minute, second and nanosecond -attribute set to 0. Can also be seen as \"Start of day\"" - (set-fields date - ((date-hour) 0) - ((date-minute) 0) - ((date-second) 0) - ((date-nanosecond) 0))) - -(define (make-duration s) - (make-time time-duration 0 s)) - -(define (in-day? day-date time) - (let* ((now (date->time-utc (drop-time day-date))) - (then (add-duration now (make-duration (* 60 60 24))))) - (and (time<=? now time) - (time<=? time then)))) - -(define (today? time) - (in-day? (current-date) time)) - -(define* (time->string time #:optional (format "~1 ~3")) - (date->string (time-utc->date time) format)) - - -(define (add-day time) - (add-duration time (make-time time-duration 0 (* 60 60 24)))) - -(define (remove-day time) - (add-duration time (make-time time-duration 0 (- (* 60 60 24))))) - -;; A B C D ¬E -;; |s1| : |s2| : |s1| : |s2| : |s1| -;; | | : | | : | ||s2| : |s1|| | : | | -;; | ||s2| : |s1|| | : | || | : | || | : -;; | | : | | : | || | : | || | : |s2| -;; | | : | | : | | : | | : | | -(define-public (timespan-overlaps? s1-begin s1-end s2-begin s2-end) - "Return whetever or not two timespans overlap." - (or - ;; A - (and (time<=? s2-begin s1-end) - (time<=? s1-begin s2-end)) - - ;; B - (and (time<=? s1-begin s2-end) - (time<=? s2-begin s1-end)) - - ;; C - (and (time<=? s1-begin s2-begin) - (time<=? s2-end s1-end)) - - ;; D - (and (time<=? s2-begin s1-begin) - (time<=? s1-end s2-end)))) |