X-Git-Url: https://jxself.org/git/?a=blobdiff_plain;f=loopy.scm;h=3d2ec34ed459526522b2bcaabeb0a781b3d5428f;hb=a9e17c36a7f160896138c0322e3ecc58b7f4774a;hp=1b5e29dea7510e139ad591d81367646962446785;hpb=e892174a7c1aa9ab2567462b430718af7cdcfce8;p=8sync.git

diff --git a/loopy.scm b/loopy.scm
index 1b5e29d..3d2ec34 100644
--- a/loopy.scm
+++ b/loopy.scm
@@ -1,17 +1,33 @@
-(use-modules (srfi srfi-9)
-             (srfi srfi-9 gnu)
-             (ice-9 q)
-             (ice-9 match))
+(define-module (loopy agenda)
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-9 gnu)
+  #:use-module (ice-9 q)
+  #:use-module (ice-9 match))
 
 ;; @@: Using immutable agendas here, so wouldn't it make sense to
 ;;   replace this queue stuff with using pfds based immutable queues?
 
+;;; The agenda consists of:
+;;;  - a queue of immediate items to handle
+;;;  - sheduled future events to be added to a future queue
+;;;  - a tag by which running processes can escape for some asynchronous
+;;;    operation (from which they can be returned later)
+;;;  - a mapping of ports to various handler procedures
+;;;
+;;; The goal, eventually, is for this all to be immutable and functional.
+;;; However, we aren't there yet.  Some tricky things:
+;;;  - The schedule needs to be immutable, yet reasonably efficient.
+;;;  - Need to use immutable queues (ijp's pfds library?)
+;;;  - Modeling reading from ports as something repeatable,
+;;;    and with reasonable separation from functional components?
+
 (define-immutable-record-type <agenda>
-  (make-agenda-intern queue prompt-tag port-mapping)
+  (make-agenda-intern queue prompt-tag port-mapping schedule)
   agenda?
   (queue agenda-queue)
   (prompt-tag agenda-prompt-tag)
-  (port-mapping agenda-port-mapping))
+  (port-mapping agenda-port-mapping)
+  (schedule agenda-schedule))
 
 (define (make-async-prompt-tag)
   (make-prompt-tag "prompt"))
@@ -19,8 +35,70 @@
 (define* (make-agenda #:key
                       (queue (make-q))
                       (prompt (make-prompt-tag))
-                      (port-mapping (make-port-mapping)))
-  (make-agenda-intern queue prompt port-mapping))
+                      (port-mapping (make-port-mapping))
+                      (schedule (make-schedule)))
+  (make-agenda-intern queue prompt port-mapping schedule))
+
+
+;;; Schedule
+;;;
+;;; This is where we handle timed events for the future
+
+;; This section totally borrows from SICP
+;; <3 <3 <3
+
+;; NOTE: time is a cons of (seconds . microseconds)
+
+(define-record-type <time-segment>
+  (make-time-segment-intern time queue)
+  time-segment?
+  (time time-segment-time)
+  (queue time-segment-queue time-segment-set-queue!))
+
+(define (time-segment-right-format time)
+  (match time
+    ;; time is already a cons of second and microsecnd
+    (((? integer? s) (? integer? u)) time)
+    ;; time was just an integer (just the second)
+    ((? integer? _) (cons time 0))
+    (_ (throw 'invalid-time "Invalid time" time))))
+
+(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))
+         #t)
+        ((and (= (car time1)
+                 (car time2))
+              (< (cdr time1)
+                 (cdr time2)))
+         #t)
+        (else #f)))
+
+(define (time-= time1 time2)
+  (and (= (car time1) (car time2))
+       (= (cdr time1) (cdr time2))))
+
+(define (schedule-add! time proc schedule)
+  (let ((time (time-segment-right-format time)))
+    (define (belongs-before? segments)
+      (or (null? segments)
+          (error))
+    )
+
+  ;; Find and add a schedule segment
+  (error)))
+
+(define (schedule-empty? schedule)
+  (eq? schedule '()))
+
+
+;;; Port handling
 
 (define (make-port-mapping)
   (make-hash-table))
@@ -47,6 +125,9 @@
   "Whether this port-mapping contains any elements"
   (not (port-mapping-empty? port-mapping)))
 
+
+;;; Execution of agenda, and current agenda
+
 (define %current-agenda (make-parameter #f))
 
 (define* (start-agenda agenda #:optional stop-condition)