X-Git-Url: https://jxself.org/git/?p=8sync.git;a=blobdiff_plain;f=8sync%2Fagenda.scm;h=c417a40e28fdad25cf811d796a92381d4efa71e8;hp=3bd5787962ff4f25b3c62c9421b4bdcf55331e92;hb=6e23866dbd9991dea49c8e97fb13cc47f3a148d3;hpb=40c22324febda345a3a8b50fe9293b2f29ee43d4 diff --git a/8sync/agenda.scm b/8sync/agenda.scm index 3bd5787..c417a40 100644 --- a/8sync/agenda.scm +++ b/8sync/agenda.scm @@ -1,5 +1,5 @@ ;;; 8sync --- Asynchronous programming for Guile -;;; Copyright (C) 2015 Christopher Allan Webber +;;; Copyright (C) 2015, 2016 Christopher Allan Webber ;;; ;;; This file is part of 8sync. ;;; @@ -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,37 +565,45 @@ 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 ...) - (make-run-request kont #f)))))) - -(define-syntax-rule (%8sync-port-remove port) - (%8sync-abort-to-prompt + (make-run-request + ;; What's with returning #f to kont? + ;; Otherwise we sometimes get errors like + ;; "Zero values returned to single-valued continuation"" + (wrap (kont #f)) #f)))))) + +(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 kont #f)))))) + (make-run-request + ;; 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 kont #f) - (make-run-request body #f)))))) + (list (make-run-request + ;; See comment in 8sync-port + (wrap (kont #f)) #f) + (make-run-request (lambda () body) #f)))))) (define-syntax-rule (catch-8sync exp (handler-key handler) ...) (catch '8sync-caught-error @@ -608,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 @@ -738,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