projects
/
8sync.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
actors: Fix hive-actor-local? to check the hive id, not whether actor exists.
[8sync.git]
/
8sync
/
agenda.scm
diff --git
a/8sync/agenda.scm
b/8sync/agenda.scm
index 3bd5787962ff4f25b3c62c9421b4bdcf55331e92..05a999617db1d29173678e6217af0a406a3ebd45 100644
(file)
--- a/
8sync/agenda.scm
+++ b/
8sync/agenda.scm
@@
-1,5
+1,5
@@
;;; 8sync --- Asynchronous programming for Guile
;;; 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.
;;;
;;;
;;; This file is part of 8sync.
;;;
@@
-68,11
+68,12
@@
run-it wrap wrap-apply run run-at run-delay
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
;; 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)
(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
;; 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
;;; =================================
;;; 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))
(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
"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)
(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
;; 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>
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)))
(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."
(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
(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
;; 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))))))
(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-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-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)
;; 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!"
"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)
(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
(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))))))
(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
\f
;;; Execution of agenda, and current agenda
@@
-738,9
+743,11
@@
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?
#: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)
(get-time gettimeofday)
- (handle-ports update-agenda-from-select!))
+ (handle-ports update-agenda-from-select!)
+ ;; For live hacking madness, etc
+ (post-run-hook #f))
;; TODO: Document fields
"Start up the AGENDA"
(let loop ((agenda agenda))
;; TODO: Document fields
"Start up the AGENDA"
(let loop ((agenda agenda))
@@
-749,6
+756,11
@@
Also handles sleeping when all we have to do is wait on the schedule."
;; select'ing on ports.
;; We could compose over agenda-run-once and agenda-read-ports
(agenda-run-once agenda)))
;; select'ing on ports.
;; We could compose over agenda-run-once and agenda-read-ports
(agenda-run-once agenda)))
+ ;; @@: This relies on mutation at present on the queue, in the rare
+ ;; event it's used. If we ever switch to something more immutable,
+ ;; it should return a new modified agenda instead.
+ (if post-run-hook
+ (post-run-hook agenda))
(if (and stop-condition (stop-condition agenda))
'done
(let* ((agenda
(if (and stop-condition (stop-condition agenda))
'done
(let* ((agenda