summaryrefslogtreecommitdiff
path: root/module/system/repl/repl.scm
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2008-12-26 16:44:02 +0100
committerAndy Wingo <wingo@pobox.com>2008-12-26 18:07:20 +0100
commit9f0e9918f4475d1a6313a8328262e80758c7f64e (patch)
treed11c45388c841cbec7513a4387f1638565be89f5 /module/system/repl/repl.scm
parent9a9f64874a500ed0765f45a05befc71f74255e4c (diff)
downloadguile-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.scm52
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