Rename async -> %sync

[8sync.git] / loopy.scm

diff --git a/loopy.scm b/loopy.scm
index 603a75a47e19afc1be2208530ce05b0d9a078a26..68dc0c1a843abd83c602668512413b7f5d66d8af 100644 (file)
--- a/loopy.scm
+++ b/loopy.scm
@@ -37,7 +37,7 @@
             make-run-request run-request?
             run-request-proc run-request-when
 
-            run-it wrap run run-at delay
+            run-it wrap run run-at run-delay
 
             %current-agenda
             start-agenda agenda-run-once))
@@ -77,6 +77,9 @@
   (time agenda-time))
 
 (define (make-async-prompt-tag)
+  "Make an async prompt tag for an agenda.
+
+Generally done automatically for the user through (make-agenda)."
   (make-prompt-tag "prompt"))
 
 (define* (make-agenda #:key
@@ -87,10 +90,21 @@
                       (except-port-map (make-hash-table))
                       (schedule (make-schedule))
                       (time (gettimeofday)))
+  ;; TODO: document arguments
+  "Make a fresh agenda."
   (make-agenda-intern queue prompt
                       read-port-map write-port-map except-port-map
                       schedule time))
 
+(define (current-agenda-prompt)
+  "Get the prompt for the current agenda; signal an error if there isn't one."
+  (let ((current-agenda (%current-agenda)))
+    (if (not current-agenda)
+        (throw
+         'no-current-agenda
+         "Can't get current agenda prompt if there's no current agenda!")
+        (agenda-prompt-tag current-agenda))))
+
 
 \f
 ;;; Schedule
@@ -326,6 +340,8 @@ Will produce (0 . 0) instead of a negative number, if needed."
   (lambda ()
     body ...))
 
+;; @@: Do we really want `body ...' here?
+;;   what about just `body'?
 (define-syntax-rule (run body ...)
   "Run everything in BODY but wrap in a convenient procedure"
   (make-run-request (wrap body ...) #f))
@@ -334,15 +350,68 @@ Will produce (0 . 0) instead of a negative number, if needed."
   "Run BODY at WHEN"
   (make-run-request (wrap body ...) when))
 
+;; @@: Is it okay to overload the term "delay" like this?
+;;   Would `run-in' be better?
 (define-syntax-rule (run-delay body ... delay-time)
   "Run BODY at DELAY-TIME time from now"
   (make-run-request (wrap body ...) (tdelta delay-time)))
 
-(define (delay run-request delay-time)
-  "Delay a RUN-REQUEST by DELAY-TIME"
-  (set-field run-request
-             (run-request-when)
-             (tdelta delay-time)))
+
+\f
+;;; Asynchronous escape to run things
+;;; =================================
+
+;; The future's in futures
+
+(define (make-future call-first on-success on-fail on-error)
+  ;; TODO: add error stuff here
+  (lambda ()
+    (let ((call-result (call-first)))
+      ;; queue up calling the 
+      (run (on-success call-result)))))
+
+(define (agenda-on-error agenda)
+  (const #f))
+
+(define (agenda-on-fail agenda)
+  (const #f))
+
+(define* (request-future call-first on-success
+                         #:key
+                         (agenda (%current-agenda))
+                         (on-fail (agenda-on-fail agenda))
+                         (on-error (agenda-on-error agenda))  
+                         (when #f))
+  ;; TODO: error handling
+  ;; do we need some distinction between expected, catchable errors,
+  ;; and unexpected, uncatchable ones?  Probably...?
+  (make-run-request
+   (make-future call-first on-success on-fail on-error)
+   when))
+
+(define-syntax-rule (%sync body args ...)
+  "Run BODY asynchronously at a prompt, passing args to make-future.
+
+Pronounced `async' despite the spelling.
+
+8sync was chosen because (async) was already taken and could lead to
+errors, and this version of asynchronous code uses a prompt, so the `a'
+character becomes a `%' prompt :)"
+  (abort-to-prompt (current-agenda-prompt)
+                   (wrap body)
+                   args ...))
+
+(define-syntax-rule (%sync-at body when args ...)
+  (abort-to-prompt (current-agenda-prompt)
+                   (wrap body)
+                   #:when when
+                   args ...))
+
+(define-syntax-rule (%sync-delay body delay-time args ...)
+  (abort-to-prompt (current-agenda-prompt)
+                   (wrap body)
+                   #:when (tdelta delay-time)
+                   args ...))
 
 \f
 ;;; Execution of agenda, and current agenda
@@ -351,6 +420,7 @@ Will produce (0 . 0) instead of a negative number, if needed."
 (define %current-agenda (make-parameter #f))
 
 (define (update-agenda-from-select! agenda)
+  "Potentially (select) on ports specified in agenda, adding items to queue"
   (define (hash-keys hash)
     (hash-map->list (lambda (k v) k) hash))
   (define (get-wait-time)
@@ -429,6 +499,8 @@ Will produce (0 . 0) instead of a negative number, if needed."
                        #:key stop-condition
                        (get-time gettimeofday)
                        (handle-ports update-agenda-from-select!))
+  ;; TODO: Document fields
+  "Start up the AGENDA"
   (let loop ((agenda agenda))
     (let ((agenda   
            ;; @@: Hm, maybe here would be a great place to handle
@@ -463,8 +535,9 @@ based on the results"
         (agenda-prompt-tag agenda)
       (lambda ()
         (proc))
-      ;; TODO
-      (lambda (k) k)))
+      (lambda* (resume-with please-run-this . args)
+        (apply request-future please-run-this resume-with
+               args))))
 
   (let ((queue (agenda-queue agenda))
         (next-queue (make-q)))