diff options
author | Andy Wingo <wingo@pobox.com> | 2008-12-26 16:44:02 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2008-12-26 18:07:20 +0100 |
commit | 9f0e9918f4475d1a6313a8328262e80758c7f64e (patch) | |
tree | d11c45388c841cbec7513a4387f1638565be89f5 /module/system/repl/repl.scm | |
parent | 9a9f64874a500ed0765f45a05befc71f74255e4c (diff) | |
download | guile-9f0e9918f4475d1a6313a8328262e80758c7f64e.tar.gz |
repl.scm relies on `display-backtrace' to do everything, some naming tweaks
* module/ice-9/boot-9.scm (default-pre-unwind-handler): Rename from
default-lazy-handler.
(pre-unwind-handler-dispatch): Rename from lazy-hadler-dispatch.
(error-catching-loop): Adjust caller.
* module/system/repl/repl.scm (default-pre-unwind-handler): Remove this
definition, in favor of the default one in boot-9.
(default-catch-handler): Don't do a vm-backtrace, as we will soon be
relying on core machinery to do that for us.
(call-with-backtrace): Start a new stack for the thunk.
(with-backtrace): Macro version of call-with-backtrace.
(start-repl): Use with-backtrace for brevity. Start a stack with #t as
the tag instead of repl-eval, because all traces of repl-eval are gone
after it does a tail-call.
* module/ice-9/debugger.scm:
* module/ice-9/debugging/traps.scm:
* module/ice-9/stack-catch.scm: Adapt to s/lazy/pre-unwind/ in
boot-9.scm.
Diffstat (limited to 'module/system/repl/repl.scm')
-rw-r--r-- | module/system/repl/repl.scm | 52 |
1 files changed, 22 insertions, 30 deletions
diff --git a/module/system/repl/repl.scm b/module/system/repl/repl.scm index 379b52647..60659f9db 100644 --- a/module/system/repl/repl.scm +++ b/module/system/repl/repl.scm @@ -51,11 +51,6 @@ (with-fluid* current-reader (meta-reader lread) (lambda () (repl-reader (lambda () (repl-prompt repl))))))) -(define (default-pre-unwind-handler key . args) - (save-stack default-pre-unwind-handler) - (vm-save-stack (the-vm)) - (apply throw key args)) - (define (default-catch-handler . args) (pmatch args ((quit . _) @@ -66,8 +61,6 @@ (apply format #t msg args) (newline)) ((,key ,subr ,msg ,args . ,rest) - (vm-backtrace (the-vm)) - (newline) (let ((cep (current-error-port))) (cond ((not (stack? (fluid-ref the-last-stack)))) ((memq 'backtrace (debug-options-interface)) @@ -93,43 +86,42 @@ (define (call-with-backtrace thunk) (catch #t - thunk + (lambda () (%start-stack #t thunk)) default-catch-handler - default-pre-unwind-handler)) + pre-unwind-handler-dispatch)) + +(define-macro (with-backtrace form) + `(call-with-backtrace (lambda () ,form))) (define (start-repl lang) (let ((repl (make-repl lang)) (status #f)) (repl-welcome repl) (let prompt-loop () - (let ((exp (call-with-backtrace - (lambda () (prompting-meta-read repl))))) + (let ((exp (with-backtrace (prompting-meta-read repl)))) (cond ((eqv? exp (if #f #f))) ; read error, pass ((eq? exp meta-command-token) - (call-with-backtrace - (lambda () - (meta-command repl (read-line))))) + (with-backtrace (meta-command repl (read-line)))) ((eof-object? exp) (newline) (set! status '())) (else - (call-with-backtrace - (lambda () - (catch 'quit - (lambda () - (call-with-values (lambda () - (run-hook before-eval-hook exp) - (start-stack repl-eval - (repl-eval repl - (repl-parse repl exp)))) - (lambda l - (for-each (lambda (v) - (run-hook before-print-hook v) - (repl-print repl v)) - l)))) - (lambda (k . args) - (set! status args))))))) + (with-backtrace + (catch 'quit + (lambda () + (call-with-values + (lambda () + (run-hook before-eval-hook exp) + (start-stack #t + (repl-eval repl (repl-parse repl exp)))) + (lambda l + (for-each (lambda (v) + (run-hook before-print-hook v) + (repl-print repl v)) + l)))) + (lambda (k . args) + (set! status args)))))) (or status (begin (next-char #f) ;; consume trailing whitespace |