summary |
shortlog |
log |
commit | commitdiff |
tree
raw |
patch |
inline | side by side (from parent 1:
8736abc)
* 8sync/agenda.scm (%8sync, %8sync-delay, %8sync-run, %8sync-run-at)
(%8sync-run-delay, %8sync-port, %8sync-port-remove, catch-%8sync):
Rename, removing % sign. Rename all references to other %8sync-foo
in definitions and comments as well.
(catch-8sync): Removed aliased version.
(make-async-request, setup-async-request): Rename references of
%8sync-foo to 8sync-foo.
* 8sync/systems/irc.scm (make-basic-irc-handler):
* 8sync/systems/web.scm (receive-http-conn):
* tests/test-agenda.scm: Rename all %8sync-foo to 8sync-foo.
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
- 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
;;; 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))
"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)
;; 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>
(wrapped-exception-stacks body-result))
body-result)))
(wrapped-exception-stacks body-result))
body-result)))
(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
;; 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
(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 ...)
;; "Zero values returned to single-valued continuation""
(wrap (kont #f)) #f))))))
;; "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
(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)
(wrap (kont #f)) #f))))))
;; TODO: Write (%run-immediately)
-(define-syntax-rule (%8sync-immediate body)
+(define-syntax-rule (8sync-immediate 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
(make-async-request
(lambda (kont)
(list (make-run-request
(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))))))
(wrap (kont #f)) #f)
(make-run-request body #f))))))
(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
;; reset buffer
(set! buffer '())
;; run it
;; reset buffer
(set! buffer '())
;; run it
socket
ready-line
username))))
socket
ready-line
username))))
((client-conn . socket-address)
(define (close-and-dequeue)
(close client-conn)
((client-conn . socket-address)
(define (close-and-dequeue)
(close client-conn)
- (%8sync-port-remove client-conn))
+ (8sync-port-remove client-conn))
(lambda ()
(call-with-values
(lambda ()
(lambda ()
(call-with-values
(lambda ()
- ;; @@: Is it useful to wrap this in %8sync-run?
+ ;; @@: Is it useful to wrap this in 8sync-run?
;; It's more indirection but might give breathing
;; room to other requests...
(handler request request-body))
;; It's more indirection but might give breathing
;; room to other requests...
(handler request request-body))
(test-equal (run-request-when run-two-squared) '(88 . 0)))
(test-equal (run-request-when run-two-squared) '(88 . 0)))
-;;; %run, %8sync and friends tests
+;;; %run, 8sync and friends tests
;;; ==============================
(define-syntax-rule (run-in-fake-agenda
;;; ==============================
(define-syntax-rule (run-in-fake-agenda
'("applesauce"))))))
(test-%run-and-friends (run-in-fake-agenda
'("applesauce"))))))
(test-%run-and-friends (run-in-fake-agenda
- (%8sync (string-concatenate '("apple" "sauce"))))
+ (8sync (string-concatenate '("apple" "sauce"))))
#f)
(test-%run-and-friends (run-in-fake-agenda
#f)
(test-%run-and-friends (run-in-fake-agenda
- (%8sync (string-concatenate '("apple" "sauce"))
+ (8sync (string-concatenate '("apple" "sauce"))
'(8 . 0)))
'(8 . 0))
(test-%run-and-friends (run-in-fake-agenda
'(8 . 0)))
'(8 . 0))
(test-%run-and-friends (run-in-fake-agenda
- (%8sync-delay (string-concatenate '("apple" "sauce"))
+ (8sync-delay (string-concatenate '("apple" "sauce"))
8))
;; whoa, I'm surprised equal? can
;; compare records like this
(tdelta 8))
;; TODO: test %port-request
8))
;; whoa, I'm surprised equal? can
;; compare records like this
(tdelta 8))
;; TODO: test %port-request
-;; TODO: test %8sync and friends!
+;; TODO: test 8sync and friends!
(speaker "Today I went to the zoo and I saw...\n")
(speaker
(string-concatenate
(speaker "Today I went to the zoo and I saw...\n")
(speaker
(string-concatenate
- `("A " ,(symbol->string (%8sync (return-monkey))) "!\n"))))
+ `("A " ,(symbol->string (8sync (return-monkey))) "!\n"))))
(begin
(set! speaker (speak-it))
(begin
(set! speaker (speak-it))
(define (indirection-remote-func-breaks)
(speaker "bebop\n")
(define (indirection-remote-func-breaks)
(speaker "bebop\n")
- (%8sync (remote-func-breaks))
+ (8sync (remote-func-breaks))
(speaker "bidop\n"))
(define* (local-func-gets-break #:key with-indirection)
(speaker "Time for exception fun!\n")
(let ((caught-exception #f))
(catch-8sync
(speaker "bidop\n"))
(define* (local-func-gets-break #:key with-indirection)
(speaker "Time for exception fun!\n")
(let ((caught-exception #f))
(catch-8sync
- (%8sync-run (if with-indirection
+ (8sync-run (if with-indirection
(indirection-remote-func-breaks)
(remote-func-breaks)))
('numerical-overflow
(indirection-remote-func-breaks)
(remote-func-breaks)))
('numerical-overflow