mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-29 14:30:34 +02:00
Code Activity

backtraces on meta-commands too

Browse source 
* module/system/repl/repl.scm (call-with-backtrace): New helper.
  (start-repl): Use the helper, for normal expressions *and* for
  meta-commands.
This commit is contained in:
Andy Wingo 2008-08-09 14:30:52 +02:00
parent 707b812ef4
commit 67c4505e7a
1 changed files with 20 additions and 14 deletions
Download patch file Download diff file Expand all files Collapse all files

34
module/system/repl/repl.scm
View file

@ -90,6 +90,12 @@
(else (else
(apply bad-throw args)))) (apply bad-throw args))))
(define (call-with-backtrace thunk)
(catch #t
thunk
default-catch-handler
default-pre-unwind-handler))
(eval-case (eval-case
((compile-toplevel) ((compile-toplevel)
(define-macro (start-stack tag expr) (define-macro (start-stack tag expr)
@ -102,23 +108,23 @@
(let ((exp (prompting-meta-read repl))) (let ((exp (prompting-meta-read repl)))
(cond (cond
((eq? exp meta-command-token) ((eq? exp meta-command-token)
(meta-command repl (read-line))) (call-with-backtrace
(lambda ()
(meta-command repl (read-line)))))
((eof-object? exp) ((eof-object? exp)
(throw 'quit)) (throw 'quit))
(else (else
(catch #t (call-with-backtrace
(lambda () (lambda ()
(call-with-values (lambda () (call-with-values (lambda ()
(run-hook before-eval-hook exp) (run-hook before-eval-hook exp)
(start-stack repl-eval (start-stack repl-eval
(repl-eval repl exp))) (repl-eval repl exp)))
(lambda l (lambda l
(for-each (lambda (v) (for-each (lambda (v)
(run-hook before-print-hook v) (run-hook before-print-hook v)
(repl-print repl v)) (repl-print repl v))
l)))) l)))))))
default-catch-handler
default-pre-unwind-handler)))
(next-char #f) ;; consume trailing whitespace (next-char #f) ;; consume trailing whitespace
(prompt-loop))))) (prompt-loop)))))