From d46183860c1f3f10095e95023adcb79b1896ab0e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Fri, 22 Mar 2019 20:11:11 +0100 Subject: Move C and Scheme code into subdirs. --- srfi/srfi-19/setters.scm | 15 --------- srfi/srfi-19/util.scm | 83 ------------------------------------------------ srfi/srfi-41/util.scm | 29 ----------------- 3 files changed, 127 deletions(-) delete mode 100644 srfi/srfi-19/setters.scm delete mode 100644 srfi/srfi-19/util.scm delete mode 100644 srfi/srfi-41/util.scm (limited to 'srfi') 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))) -- cgit v1.2.3