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 | |
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')
-rw-r--r-- | srfi/srfi-19/setters.scm | 15 | ||||
-rw-r--r-- | srfi/srfi-19/util.scm | 83 | ||||
-rw-r--r-- | srfi/srfi-41/util.scm | 29 |
3 files changed, 0 insertions, 127 deletions
diff --git a/srfi/srfi-19/setters.scm b/srfi/srfi-19/setters.scm deleted file mode 100644 index 45876382..00000000 --- a/srfi/srfi-19/setters.scm +++ /dev/null @@ -1,15 +0,0 @@ -(define-module (srfi srfi-19 setters) - #:use-module (srfi srfi-19) ; Date/Time - ;; (record-type-fields (@@ (srfi srfi-19) date)) - #:export (nanosecond second minute hour day month year zone-offset)) - - -(define nanosecond (make-procedure-with-setter date-nanosecond (@@ (srfi srfi-19) set-date-nanosecond!))) -(define second (make-procedure-with-setter date-second (@@ (srfi srfi-19) set-date-second!))) -(define minute (make-procedure-with-setter date-minute (@@ (srfi srfi-19) set-date-minute!))) -(define hour (make-procedure-with-setter date-hour (@@ (srfi srfi-19) set-date-hour!))) -(define day (make-procedure-with-setter date-day (@@ (srfi srfi-19) set-date-day!))) -(define month (make-procedure-with-setter date-month (@@ (srfi srfi-19) set-date-month!))) -(define year (make-procedure-with-setter date-year (@@ (srfi srfi-19) set-date-year!))) -(define zone-offset (make-procedure-with-setter date-zone-offset (@@ (srfi srfi-19) set-date-zone-offset!))) - 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)))) diff --git a/srfi/srfi-41/util.scm b/srfi/srfi-41/util.scm deleted file mode 100644 index 5bef95cb..00000000 --- a/srfi/srfi-41/util.scm +++ /dev/null @@ -1,29 +0,0 @@ -(define-module (srfi srfi-41 util) - #:use-module (srfi srfi-1) - #:use-module (srfi srfi-41) - #:use-module (util) ; let*, find-min - #:export (stream-car+cdr interleave-streams)) - -(define (stream-car+cdr stream) - (values (stream-car stream) - (stream-cdr stream))) - -;; Merges a number of totally ordered streams into a single -;; totally ordered stream. -;; ((≺, stream)) → (≺, stream) -(define (interleave-streams < streams) - ;; Drop all empty streams - (let ((streams (remove stream-null? streams))) - ;; If all streams where empty, end the output stream - (if (null? streams) - stream-null - (let* ((min other (find-min < stream-car streams)) - (m ms (stream-car+cdr min))) - (stream-cons m (interleave-streams < (cons ms other))))))) - -;;; Varför är allting så långsamt‽‽‽‽‽‽‽‽ - -(define-public (filter-sorted-stream proc stream) - (stream-take-while - proc (stream-drop-while - (negate proc) stream))) |