projects
/
8sync.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
print out quoted key with print-error-and-continue
[8sync.git]
/
eightsync
/
agenda.scm
diff --git
a/eightsync/agenda.scm
b/eightsync/agenda.scm
index edade135c09499e7b08beaf86c573c01d5fb3e1e..7ee0ec4d9dd11d24350905eabcb90f2199e18896 100644
(file)
--- a/
eightsync/agenda.scm
+++ b/
eightsync/agenda.scm
@@
-67,6
+67,12
@@
catch-8sync catch-%8sync
catch-8sync catch-%8sync
+ ;; used for introspecting the error, but a method for making
+ ;; is not exposed
+ wrapped-exception?
+ wrapped-exception-key wrapped-exception-args
+ wrapped-exception-stacks
+
print-error-and-continue
%current-agenda
print-error-and-continue
%current-agenda
@@
-479,7
+485,7
@@
return the wrong thing via (%8sync) and trip themselves up."
(define-syntax-rule (propagate-%async-exceptions body)
(let ((body-result body))
(if (wrapped-exception? body-result)
(define-syntax-rule (propagate-%async-exceptions body)
(let ((body-result body))
(if (wrapped-exception? body-result)
- (throw '
%
8sync-caught-error
+ (throw '8sync-caught-error
(wrapped-exception-key body-result)
(wrapped-exception-args body-result)
(wrapped-exception-stacks body-result))
(wrapped-exception-key body-result)
(wrapped-exception-args body-result)
(wrapped-exception-stacks body-result))
@@
-512,10
+518,9
@@
return the wrong thing via (%8sync) and trip themselves up."
;; If something bad happened and we didn't catch it,
;; we'll wrap it up in such a way that the continuation
;; can address it
;; If something bad happened and we didn't catch it,
;; we'll wrap it up in such a way that the continuation
;; can address it
- ;; @@: For this stack to work doesn't it have to be
(lambda (key . args)
(cond
(lambda (key . args)
(cond
- ((eq? key '
%
8sync-caught-error)
+ ((eq? key '8sync-caught-error)
(match args
((orig-key orig-args orig-stacks)
(make-wrapped-exception
(match args
((orig-key orig-args orig-stacks)
(make-wrapped-exception
@@
-546,7
+551,7
@@
return the wrong thing via (%8sync) and trip themselves up."
body ...)))))
(define-syntax-rule (catch-8sync exp (handler-key handler) ...)
body ...)))))
(define-syntax-rule (catch-8sync exp (handler-key handler) ...)
- (catch '
%
8sync-caught-error
+ (catch '8sync-caught-error
(lambda ()
exp)
(lambda (_ orig-key orig-args orig-stacks)
(lambda ()
exp)
(lambda (_ orig-key orig-args orig-stacks)
@@
-554,7
+559,7
@@
return the wrong thing via (%8sync) and trip themselves up."
((or (eq? handler-key #t)
(eq? orig-key handler-key))
(apply handler orig-stacks orig-args)) ...
((or (eq? handler-key #t)
(eq? orig-key handler-key))
(apply handler orig-stacks orig-args)) ...
- (else (raise '
%
8sync-caught-error
+ (else (raise '8sync-caught-error
orig-key orig-args orig-stacks))))))
;; Alias...?
orig-key orig-args orig-stacks))))))
;; Alias...?
@@
-693,10
+698,11
@@
return the wrong thing via (%8sync) and trip themselves up."
(agenda-queue agenda))
(loop agenda))))))
(agenda-queue agenda))
(loop agenda))))))
-(define (print-error-and-continue . args)
+(define (print-error-and-continue
key
. args)
"Frequently used as pre-unwind-handler for agenda"
"Frequently used as pre-unwind-handler for agenda"
- (format (current-error-port) "\n*** Caught exception with arguments: ~s ***\n"
- args)
+ (format (current-error-port)
+ "\n*** Caught exception with key '~s and arguments: ~s ***\n"
+ key args)
(display-backtrace (make-stack #t 1 0)
(current-error-port))
(newline (current-error-port)))
(display-backtrace (make-stack #t 1 0)
(current-error-port))
(newline (current-error-port)))