conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

the debugger now propagates nonserious conditions upwards instead of 

trapping on them.
This commit is contained in:
Abdulaziz Ghuloum 2009-06-26 11:33:32 +03:00
parent 1803f9f23c
commit 30ac7870de
2 changed files with 28 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

50
scheme/ikarus.debugger.ss
View File

@ -249,29 +249,33 @@
(define (guarded-start proc) (define (guarded-start proc)
(with-exception-handler (with-exception-handler
(lambda (con) (lambda (con)
(define (help) (define (enter-debugger con)
(printf "Exception trapped by debugger.\n") (define (help)
(print-condition con) (printf "Exception trapped by debugger.\n")
(printf "~a\n" (print-condition con)
(string-append (printf "~a\n"
"[t] Trace. " (string-append
"[r] Reraise exception. " "[t] Trace. "
"[c] Continue. " "[r] Reraise exception. "
"[q] Quit. " "[c] Continue. "
"[?] Help. "))) "[q] Quit. "
(help) "[?] Help. ")))
((call/cc (help)
(lambda (k) ((call/cc
(new-cafe (lambda (k)
(lambda (x) (new-cafe
(case x (lambda (x)
[(R r) (k (lambda () (raise-continuable con)))] (case x
[(Q q) (exit 0)] [(R r) (k (lambda () (raise-continuable con)))]
[(T t) (print-all-traces)] [(Q q) (exit 0)]
[(C c) (k void)] [(T t) (print-all-traces)]
[(?) (help)] [(C c) (k void)]
[else (printf "invalid option\n")]))) [(?) (help)]
void)))) [else (printf "invalid option\n")])))
void))))
(if (serious-condition? con)
(enter-debugger con)
(raise-continuable con)))
proc)) proc))
) )

2
scheme/last-revision
View File

@ -1 +1 @@
1810 1811