mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-20 11:40:18 +02:00
default-pre-unwind-handler to scm-style-repl
* module/ice-9/boot-9.scm: * module/ice-9/deprecated.scm (default-pre-unwind-handler): Deprecate root-module definition. * module/ice-9/scm-style-repl.scm (default-pre-unwind-handler): Move here. * module/ice-9/debugging/traps.scm: * module/ice-9/debugger.scm: * module/ice-9/stack-catch.scm: Use default-pre-unwind-handler from scm-style-repl.
This commit is contained in:
parent
38008a7517
commit
fede5c8977
6 changed files with 26 additions and 11 deletions
|
@ -2674,11 +2674,6 @@ module '(ice-9 q) '(make-q q-length))}."
|
|||
;;; {Running Repls}
|
||||
;;;
|
||||
|
||||
(define (default-pre-unwind-handler key . args)
|
||||
;; Narrow by two more frames: this one, and the throw handler.
|
||||
(save-stack 2)
|
||||
(apply throw key args))
|
||||
|
||||
(define abort-hook (make-hook))
|
||||
|
||||
;; Programs can call `batch-mode?' to see if they are running as part of a
|
||||
|
|
|
@ -21,6 +21,7 @@
|
|||
#:use-module (ice-9 debugger state)
|
||||
#:use-module (ice-9 debugger utils)
|
||||
#:use-module (ice-9 debugging traps)
|
||||
#:use-module (ice-9 scm-style-repl)
|
||||
#:use-module (ice-9 format)
|
||||
#:export (debug-stack
|
||||
debug
|
||||
|
|
|
@ -26,6 +26,7 @@
|
|||
(define-module (ice-9 debugging traps)
|
||||
#:use-module (ice-9 regex)
|
||||
#:use-module (ice-9 weak-vector)
|
||||
#:use-module (ice-9 scm-style-repl)
|
||||
#:use-module (oop goops)
|
||||
#:use-module (oop goops describe)
|
||||
#:use-module (ice-9 debugging trc)
|
||||
|
|
|
@ -57,7 +57,8 @@
|
|||
set-repl-prompt!
|
||||
set-batch-mode?!
|
||||
repl
|
||||
pre-unwind-handler-dispatch)
|
||||
pre-unwind-handler-dispatch
|
||||
default-pre-unwind-handler)
|
||||
|
||||
#:replace (module-ref-submodule module-define-submodule!))
|
||||
|
||||
|
@ -621,5 +622,11 @@ the `(system repl common)' module.")
|
|||
(define (pre-unwind-handler-dispatch key . args)
|
||||
(issue-deprecation-warning
|
||||
"`pre-unwind-handler-dispatch' is deprecated. Use
|
||||
`default-pre-unwind-handler' directly.")
|
||||
(apply default-pre-unwind-handler key args))
|
||||
`default-pre-unwind-handler' from `(ice-9 scm-style-repl)' directly.")
|
||||
(apply (@ (ice-9 scm-style-repl) default-pre-unwind-handler) key args))
|
||||
|
||||
(define (default-pre-unwind-handler key . args)
|
||||
(issue-deprecation-warning
|
||||
"`default-pre-unwind-handler' is deprecated. Use it from
|
||||
`(ice-9 scm-style-repl)' if you need it.")
|
||||
(apply (@ (ice-9 scm-style-repl) default-pre-unwind-handler) key args))
|
||||
|
|
|
@ -27,6 +27,7 @@
|
|||
assert-repl-print-unspecified
|
||||
assert-repl-verbosity
|
||||
|
||||
default-pre-unwind-handler
|
||||
bad-throw
|
||||
error-catching-loop
|
||||
error-catching-repl
|
||||
|
@ -58,6 +59,13 @@
|
|||
|
||||
|
||||
|
||||
(define (default-pre-unwind-handler key . args)
|
||||
;; Narrow by two more frames: this one, and the throw handler.
|
||||
(save-stack 2)
|
||||
(apply throw key args))
|
||||
|
||||
|
||||
|
||||
(define (error-catching-loop thunk)
|
||||
(let ((status #f)
|
||||
(interactive #t))
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
;;; installed-scm-file
|
||||
|
||||
;;;; Copyright (C) 2001, 2006 Free Software Foundation, Inc.
|
||||
;;;; Copyright (C) 2001, 2006, 2010 Free Software Foundation, Inc.
|
||||
;;;;
|
||||
;;;; This library is free software; you can redistribute it and/or
|
||||
;;;; modify it under the terms of the GNU Lesser General Public
|
||||
|
@ -18,7 +18,7 @@
|
|||
;;;;
|
||||
|
||||
(define-module (ice-9 stack-catch)
|
||||
:export (stack-catch))
|
||||
#:export (stack-catch))
|
||||
|
||||
(define (stack-catch key thunk handler)
|
||||
"Like @code{catch}, invoke @var{thunk} in the dynamic context of
|
||||
|
@ -40,4 +40,7 @@ this call to @code{catch}."
|
|||
(catch key
|
||||
thunk
|
||||
handler
|
||||
default-pre-unwind-handler))
|
||||
(lambda (key . args)
|
||||
;; Narrow by two more frames: this one, and the throw handler.
|
||||
(save-stack 2)
|
||||
(apply throw key args))))
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue