indentation

[8sync.git] / loopy.scm

diff --git a/loopy.scm b/loopy.scm
index 60bbe85d0eee1b490ed1d846fd8f341128d02f41..22b6ac894aac168b3f6c85258e98f89899e54f70 100644 (file)
--- a/loopy.scm
+++ b/loopy.scm
@@ -39,8 +39,16 @@
             make-run-request run-request?
             run-request-proc run-request-when
 
+            <port-request>
+            make-port-request port-request port-request?
+            port-request-port
+            port-request-read port-request-write port-request-except
+
             run-it wrap run run-at run-delay
 
+            %port-request %run %run-at %run-delay
+            8port-request 8run 8run-at 8run-delay
+
             %current-agenda
             start-agenda agenda-run-once))
 
@@ -413,14 +421,15 @@ Will produce (0 . 0) instead of a negative number, if needed."
 (define-syntax-rule (%sync body args ...)
   "Run BODY asynchronously at a prompt, passing args to make-future.
 
-Pronounced `async' despite the spelling.
+Pronounced `eight-sync' despite the spelling.
 
 %sync 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! :)
 
 The % and 8 characters kind of look similar... hence this library's
-name!  (There are 8sync aliases if you prefer that name.)"
+name!  (That, and the pun 'eight-synchronous' programming.)
+There are 8sync aliases if you prefer that name."
   (abort-to-prompt (current-agenda-prompt)
                    (wrap body)
                    args ...))
@@ -449,6 +458,60 @@ name!  (There are 8sync aliases if you prefer that name.)"
   "Alias for %sync-delay"
   (8sync-delay args ...))
 
+;; Async port request and run-request meta-requests
+(define (make-async-request proc)
+  "Wrap PROC in an async-request
+
+The purpose of this is to make sure that users don't accidentally
+return the wrong thing via (8sync) and trip themselves up."
+  (cons '*async-request* proc))
+
+(define (setup-async-request resume-kont async-request)
+  "Complete an async request for agenda-run-once's continuation handling"
+  (match async-request
+    (('*async-request* . async-setup-proc)
+     (async-setup-proc resume-kont))
+    ;; TODO: deliver more helpful errors depending on what the user
+    ;;   returned
+    (_ (throw 'invalid-async-request
+              "Invalid request passed back via an (%sync) procedure."
+              async-request))))
+
+(define-syntax-rule (%run body ...)
+  (%run-at body ... #f))
+
+(define-syntax-rule (%run-at body ... when)
+  (make-async-request
+   (lambda (kont)
+     (make-run-request
+      (wrap
+       (kont
+        (begin body ...)))
+      when))))
+
+(define-syntax-rule (%run-delay body ... delay-time)
+  (%run-at body ... (tdelta delay-time)))
+
+(define-syntax-rule (%port-request add-this-port port-request-args ...)
+  (make-async-request
+   (lambda (kont)
+     (list (make-port-request port-request-args ...)
+           (make-run-request kont)))))
+
+;; TODO
+(define-syntax-rule (%run-with-return return body ...)
+  (make-async-request
+   (lambda (kont)
+     (let ((return kont))
+       (lambda ()
+         body ...)))))
+
+;; Aliases
+(define-syntax-rule (8run args ...) (%run args ...))
+(define-syntax-rule (8run-at args ...) (%run-at args ...))
+(define-syntax-rule (8run-delay args ...) (%run-delay args ...))
+(define-syntax-rule (8port-request args ...) (%port-request args ...))
+
 
 \f
 ;;; Execution of agenda, and current agenda
@@ -580,12 +643,8 @@ name!  (There are 8sync aliases if you prefer that name.)"
 based on the results"
   (define (call-proc proc)
     (call-with-prompt
-        (agenda-prompt-tag agenda)
-      (lambda ()
-        (proc))
-      (lambda* (resume-with please-run-this . args)
-        (apply request-future please-run-this resume-with
-               args))))
+     (agenda-prompt-tag agenda)
+     proc setup-async-request))
 
   (let ((queue (agenda-queue agenda))
         (next-queue (make-q)))
@@ -619,8 +678,6 @@ based on the results"
             (_ #f)))
         ;; @@: We might support delay-wrapped procedures here
         (match proc-result
-          ;; TODO: replace procedure with something that indicates
-          ;;   intent to run.  Use a (run foo) procedure
           ((results ...)
            (for-each handle-individual results))
           (one-result (handle-individual one-result)))))