agenda: Update copyright header.
[8sync.git] / 8sync / agenda.scm
index af5ef3ce31b516bbeb2d9df05404926e9d0fa336..c417a40e28fdad25cf811d796a92381d4efa71e8 100644 (file)
@@ -1,5 +1,5 @@
 ;;; 8sync --- Asynchronous programming for Guile
-;;; Copyright (C) 2015 Christopher Allan Webber <cwebber@dustycloud.org>
+;;; Copyright (C) 2015, 2016 Christopher Allan Webber <cwebber@dustycloud.org>
 ;;;
 ;;; This file is part of 8sync.
 ;;;
 
             run-it wrap wrap-apply run run-at run-delay
 
-            %8sync %8sync-delay
-            %8sync-run %8sync-run-at %8sync-run-delay
-            %8sync-port %8sync-port-remove
+            8sync 8sync-delay
+            8sync-run 8sync-run-at 8sync-run-delay
+            8sync-port 8sync-port-remove
+            8sync-nowait
             
-            catch-8sync catch-%8sync
+            catch-8sync
 
             ;; used for introspecting the error, but a method for making
             ;; is not exposed
@@ -138,7 +139,7 @@ Generally done automatically for the user through (make-agenda)."
                       (schedule (make-schedule))
                       (time (gettimeofday))
                       (catch-handler #f)
-                      (pre-unwind-handler #f))
+                      (pre-unwind-handler print-error-and-continue))
   ;; TODO: document arguments
   "Make a fresh agenda."
   (make-agenda-intern queue prompt
@@ -471,7 +472,7 @@ Will produce (0 . 0) instead of a negative number, if needed."
 ;;; Asynchronous escape to run things
 ;;; =================================
 
-(define-syntax-rule (%8sync-abort-to-prompt async-request)
+(define-syntax-rule (8sync-abort-to-prompt async-request)
   (abort-to-prompt (current-agenda-prompt)
                    async-request))
 
@@ -480,7 +481,7 @@ Will produce (0 . 0) instead of a negative number, if needed."
   "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."
+return the wrong thing via (8sync) and trip themselves up."
   (cons '*async-request* proc))
 
 (define (setup-async-request resume-kont async-request)
@@ -491,7 +492,7 @@ return the wrong thing via (%8sync) and trip themselves up."
     ;; TODO: deliver more helpful errors depending on what the user
     ;;   returned
     (_ (throw 'invalid-async-request
-              "Invalid request passed back via an (%8sync) procedure."
+              "Invalid request passed back via an (8sync) procedure."
               async-request))))
 
 (define-record-type <wrapped-exception>
@@ -510,22 +511,22 @@ return the wrong thing via (%8sync) and trip themselves up."
                (wrapped-exception-stacks body-result))
         body-result)))
 
-(define-syntax %8sync
+(define-syntax 8sync
   (syntax-rules ()
     "Run BODY asynchronously (8synchronously?) at a prompt, then return.
 
 Possibly specify WHEN as the second argument."
-    ((%8sync body)
-     (%8sync-run body))
-    ((%8sync body when)
-     (%8sync-run-at body when))))
+    ((8sync body)
+     (8sync-run body))
+    ((8sync body when)
+     (8sync-run-at body when))))
 
-(define-syntax-rule (%8sync-run body ...)
-  (%8sync-run-at body ... #f))
+(define-syntax-rule (8sync-run body ...)
+  (8sync-run-at body ... #f))
 
-(define-syntax-rule (%8sync-run-at body ... when)
+(define-syntax-rule (8sync-run-at body ... when)
   (propagate-%async-exceptions
-   (%8sync-abort-to-prompt
+   (8sync-abort-to-prompt
     ;; Send an asynchronous request to apply a continuation to the
     ;; following function, then handle that as a request to the agenda
     (make-async-request
@@ -564,14 +565,14 @@ Possibly specify WHEN as the second argument."
                 (set! exception-stack (make-stack #t 1 0)))))))
         when))))))
 
-(define-syntax-rule (%8sync-run-delay body ... delay-time)
-  (%8sync-run-at body ... (tdelta delay-time)))
+(define-syntax-rule (8sync-run-delay body ... delay-time)
+  (8sync-run-at body ... (tdelta delay-time)))
 
-(define-syntax-rule (%8sync-delay args ...)
-  (%8sync-run-delay args ...))
+(define-syntax-rule (8sync-delay args ...)
+  (8sync-run-delay args ...))
 
-(define-syntax-rule (%8sync-port port port-request-args ...)
-  (%8sync-abort-to-prompt
+(define-syntax-rule (8sync-port port port-request-args ...)
+  (8sync-abort-to-prompt
    (make-async-request
     (lambda (kont)
       (list (make-port-request port port-request-args ...)
@@ -581,28 +582,28 @@ Possibly specify WHEN as the second argument."
              ;; "Zero values returned to single-valued continuation""
              (wrap (kont #f)) #f))))))
 
-(define-syntax-rule (%8sync-port-remove port)
-  (%8sync-abort-to-prompt
+(define-syntax-rule (8sync-port-remove port)
+  (8sync-abort-to-prompt
    (make-async-request
     (lambda (kont)
       (list (make-port-remove-request port)
             (make-run-request
-             ;; See comment in %8sync-port
+             ;; See comment in 8sync-port
              (wrap (kont #f)) #f))))))
 
 
 ;; TODO: Write (%run-immediately)
 
-(define-syntax-rule (%8sync-immediate body)
+(define-syntax-rule (8sync-nowait body)
   "Run body asynchronously but ignore its result...
 forge ahead in our current function!"
-  (%8sync-abort-to-prompt
+  (8sync-abort-to-prompt
    (make-async-request
     (lambda (kont)
       (list (make-run-request
-             ;; See comment in %8sync-port
+             ;; See comment in 8sync-port
              (wrap (kont #f)) #f)
-            (make-run-request body #f))))))
+            (make-run-request (lambda () body) #f))))))
 
 (define-syntax-rule (catch-8sync exp (handler-key handler) ...)
   (catch '8sync-caught-error
@@ -616,10 +617,6 @@ forge ahead in our current function!"
        (else (raise '8sync-caught-error
                     orig-key orig-args orig-stacks))))))
 
-;; Alias...?
-(define-syntax-rule (catch-%8sync rest ...)
-  (catch-8sync rest ...))
-
 
 \f
 ;;; Execution of agenda, and current agenda
@@ -746,7 +743,7 @@ Also handles sleeping when all we have to do is wait on the schedule."
                        #:key
                        ;; @@: Should we make stop-on-nothing-to-do
                        ;;   the default stop-condition?
-                       stop-condition
+                       (stop-condition stop-on-nothing-to-do)
                        (get-time gettimeofday)
                        (handle-ports update-agenda-from-select!))
   ;; TODO: Document fields