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

repl.scm relies on `display-backtrace' to do everything, some naming tweaks

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2008-12-26 16:44:02 +01:00
parent 9a9f64874a
commit 9f0e9918f4
5 changed files with 47 additions and 55 deletions
Download patch file Download diff file Expand all files Collapse all files

14
module/ice-9/boot-9.scm
View file

@ -2323,12 +2323,12 @@ module '(ice-9 q) '(make-q q-length))}."
(define (set-repl-prompt! v) (set! scm-repl-prompt v))
(define (default-lazy-handler key . args)
(save-stack lazy-handler-dispatch)
(define (default-pre-unwind-handler key . args)
(save-stack pre-unwind-handler-dispatch)
(apply throw key args))
(define (lazy-handler-dispatch key . args)
(apply default-lazy-handler key args))
(define (pre-unwind-handler-dispatch key . args)
(apply default-pre-unwind-handler key args))
(define abort-hook (make-hook))
@ -2405,15 +2405,15 @@ module '(ice-9 q) '(make-q q-length))}."
(else
(apply bad-throw key args)))))))
;; Note that having just `lazy-handler-dispatch'
;; Note that having just `pre-unwind-handler-dispatch'
;; here is connected with the mechanism that
;; produces a nice backtrace upon error. If, for
;; example, this is replaced with (lambda args
;; (apply lazy-handler-dispatch args)), the stack
;; (apply pre-unwind-handler-dispatch args)), the stack
;; cutting (in save-stack) goes wrong and ends up
;; saving no stack at all, so there is no
;; backtrace.
lazy-handler-dispatch)))
pre-unwind-handler-dispatch)))
(if next (loop next) status)))
(set! set-batch-mode?! (lambda (arg)

8
module/ice-9/debugger.scm
View file

@ -131,16 +131,16 @@ Indicates that the debugger should display an introductory message.
(define (debug-on-error syms)
"Enable or disable debug on error."
(set! lazy-handler-dispatch
(set! pre-unwind-handler-dispatch
(if syms
(lambda (key . args)
(if (memq key syms)
(begin
(debug-stack (make-stack #t lazy-handler-dispatch)
(debug-stack (make-stack #t pre-unwind-handler-dispatch)
#:with-introduction
#:continuable)
(throw 'abort key)))
(apply default-lazy-handler key args))
default-lazy-handler)))
(apply default-pre-unwind-handler key args))
default-pre-unwind-handler)))
;;; (ice-9 debugger) ends here.

26
module/ice-9/debugging/traps.scm
View file

@ -59,7 +59,7 @@
trap-ordering
behaviour-ordering
throw->trap-context
on-lazy-handler-dispatch
on-pre-unwind-handler-dispatch
;; Interface for authors of new <trap> subclasses.
<trap-context>
<trap>
@ -467,14 +467,14 @@ it twice."
;;; same code for certain events that are trap-like, but not actually
;;; traps in the sense of the calls made by libguile's evaluator.
;;; The main example of this is when an error is signalled. Guile
;;; doesn't yet have a 100% reliable way of hooking into errors, but
;;; in practice most errors go through a lazy-catch whose handler is
;;; lazy-handler-dispatch (defined in ice-9/boot-9.scm), which in turn
;;; calls default-lazy-handler. So we can present most errors as
;;; pseudo-traps by modifying default-lazy-handler.
;;; The main example of this is when an error is signalled. Guile
;;; doesn't yet have a 100% reliable way of hooking into errors, but in
;;; practice most errors go through a catch whose pre-unwind handler is
;;; pre-unwind-handler-dispatch (defined in ice-9/boot-9.scm), which in
;;; turn calls default-pre-unwind-handler. So we can present most errors
;;; as pseudo-traps by modifying default-pre-unwind-handler.
(define default-default-lazy-handler default-lazy-handler)
(define default-default-pre-unwind-handler default-pre-unwind-handler)
(define (throw->trap-context key args . stack-args)
(let ((ctx (make <trap-context>
@ -489,16 +489,16 @@ it twice."
(apply make-stack #t stack-args))))
ctx))
(define (on-lazy-handler-dispatch behaviour . ignored-keys)
(set! default-lazy-handler
(define (on-pre-unwind-handler-dispatch behaviour . ignored-keys)
(set! default-pre-unwind-handler
(if behaviour
(lambda (key . args)
(or (memq key ignored-keys)
(behaviour (throw->trap-context key
args
lazy-handler-dispatch)))
(apply default-default-lazy-handler key args))
default-default-lazy-handler)))
pre-unwind-handler-dispatch)))
(apply default-default-pre-unwind-handler key args))
default-default-pre-unwind-handler)))
;;; {Trap Classes}

2
module/ice-9/stack-catch.scm
View file

@ -40,4 +40,4 @@ this call to @code{catch}."
(catch key
thunk
handler
lazy-handler-dispatch))
pre-unwind-handler-dispatch))

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

@ -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