projects
/
8sync.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
a9e17c3
)
export things, break into sections
author
Christopher Allan Webber
<cwebber@dustycloud.org>
Wed, 18 Nov 2015 19:14:12 +0000
(13:14 -0600)
committer
Christopher Allan Webber
<cwebber@dustycloud.org>
Wed, 18 Nov 2015 19:14:12 +0000
(13:14 -0600)
loopy.scm
patch
|
blob
|
history
diff --git
a/loopy.scm
b/loopy.scm
index 3d2ec34ed459526522b2bcaabeb0a781b3d5428f..405ede178c363e3ec01753b24d428bca4e21bd18 100644
(file)
--- a/
loopy.scm
+++ b/
loopy.scm
@@
-2,11
+2,37
@@
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-9 gnu)
#:use-module (ice-9 q)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-9 gnu)
#:use-module (ice-9 q)
- #:use-module (ice-9 match))
+ #:use-module (ice-9 match)
+ #:export (make-agenda
+ agenda?
+ agenda-queue agenda-prompt-tag
+ agenda-port-pmapping agenda-schedule
+
+ make-async-prompt-tag
+
+ make-time-segment
+ time-segment?
+ time-segment-time time-segment-queue
+
+ time-< time-=
+
+ make-schedule
+ schedule-add! schedule-empty?
+
+ make-port-mapping
+ port-mapping-set! port-mapping-remove!
+ port-mapping-empty? port-mapping-non-empty?
+
+ %current-agenda
+ start-agenda agenda-run-once))
;; @@: Using immutable agendas here, so wouldn't it make sense to
;; replace this queue stuff with using pfds based immutable queues?
;; @@: Using immutable agendas here, so wouldn't it make sense to
;; replace this queue stuff with using pfds based immutable queues?
+
\f
+;;; Agenda definition
+;;; =================
+
;;; The agenda consists of:
;;; - a queue of immediate items to handle
;;; - sheduled future events to be added to a future queue
;;; The agenda consists of:
;;; - a queue of immediate items to handle
;;; - sheduled future events to be added to a future queue
@@
-40,8
+66,10
@@
(make-agenda-intern queue prompt port-mapping schedule))
(make-agenda-intern queue prompt port-mapping schedule))
+
\f
;;; Schedule
;;; Schedule
-;;;
+;;; ========
+
;;; This is where we handle timed events for the future
;; This section totally borrows from SICP
;;; This is where we handle timed events for the future
;; This section totally borrows from SICP
@@
-53,7
+81,7
@@
(make-time-segment-intern time queue)
time-segment?
(time time-segment-time)
(make-time-segment-intern time queue)
time-segment?
(time time-segment-time)
- (queue time-segment-queue
time-segment-set-queue!
))
+ (queue time-segment-queue))
(define (time-segment-right-format time)
(match time
(define (time-segment-right-format time)
(match time
@@
-66,9
+94,6
@@
(define* (make-time-segment time #:optional (queue (make-q)))
(make-time-segment-intern time queue))
(define* (make-time-segment time #:optional (queue (make-q)))
(make-time-segment-intern time queue))
-(define (make-schedule)
- '())
-
(define (time-< time1 time2)
(cond ((< (car time1)
(car time2))
(define (time-< time1 time2)
(cond ((< (car time1)
(car time2))
@@
-84,6
+109,9
@@
(and (= (car time1) (car time2))
(= (cdr time1) (cdr time2))))
(and (= (car time1) (car time2))
(= (cdr time1) (cdr time2))))
+(define (make-schedule)
+ '())
+
(define (schedule-add! time proc schedule)
(let ((time (time-segment-right-format time)))
(define (belongs-before? segments)
(define (schedule-add! time proc schedule)
(let ((time (time-segment-right-format time)))
(define (belongs-before? segments)
@@
-98,7
+126,9
@@
(eq? schedule '()))
(eq? schedule '()))
+
\f
;;; Port handling
;;; Port handling
+;;; =============
(define (make-port-mapping)
(make-hash-table))
(define (make-port-mapping)
(make-hash-table))
@@
-126,7
+156,9
@@
(not (port-mapping-empty? port-mapping)))
(not (port-mapping-empty? port-mapping)))
+
\f
;;; Execution of agenda, and current agenda
;;; Execution of agenda, and current agenda
+;;; =======================================
(define %current-agenda (make-parameter #f))
(define %current-agenda (make-parameter #f))