X-Git-Url: https://jxself.org/git/?p=8sync.git;a=blobdiff_plain;f=8sync%2Fagenda.scm;h=f20fffe889507a936a1e13df3d70f51c82c5a2ac;hp=af5ef3ce31b516bbeb2d9df05404926e9d0fa336;hb=ac6b7ab9cd36a5960f8289d6225a1c187debe777;hpb=e7161a37ba465d41bb9fde3ba1d3a7a3f4f8da42 diff --git a/8sync/agenda.scm b/8sync/agenda.scm index af5ef3c..f20fffe 100644 --- a/8sync/agenda.scm +++ b/8sync/agenda.scm @@ -68,11 +68,12 @@ 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 @@ -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 ...)) - ;;; 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