diff options
-rw-r--r-- | module/ice-9/boot-9.scm | 5 | ||||
-rw-r--r-- | module/ice-9/debugger.scm | 1 | ||||
-rwxr-xr-x | module/ice-9/debugging/traps.scm | 1 | ||||
-rw-r--r-- | module/ice-9/deprecated.scm | 13 | ||||
-rw-r--r-- | module/ice-9/scm-style-repl.scm | 8 | ||||
-rw-r--r-- | module/ice-9/stack-catch.scm | 9 |
6 files changed, 26 insertions, 11 deletions
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm index 3cc41157e..e7c844107 100644 --- a/module/ice-9/boot-9.scm +++ b/module/ice-9/boot-9.scm @@ -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 diff --git a/module/ice-9/debugger.scm b/module/ice-9/debugger.scm index 3a6c08151..baece4e08 100644 --- a/module/ice-9/debugger.scm +++ b/module/ice-9/debugger.scm @@ -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 diff --git a/module/ice-9/debugging/traps.scm b/module/ice-9/debugging/traps.scm index 3df939cfb..5557cb3ea 100755 --- a/module/ice-9/debugging/traps.scm +++ b/module/ice-9/debugging/traps.scm @@ -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) diff --git a/module/ice-9/deprecated.scm b/module/ice-9/deprecated.scm index 97e9eb2ac..27c70f8c2 100644 --- a/module/ice-9/deprecated.scm +++ b/module/ice-9/deprecated.scm @@ -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)) diff --git a/module/ice-9/scm-style-repl.scm b/module/ice-9/scm-style-repl.scm index c316c382c..9210f2708 100644 --- a/module/ice-9/scm-style-repl.scm +++ b/module/ice-9/scm-style-repl.scm @@ -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)) diff --git a/module/ice-9/stack-catch.scm b/module/ice-9/stack-catch.scm index f7b207535..a8912da06 100644 --- a/module/ice-9/stack-catch.scm +++ b/module/ice-9/stack-catch.scm @@ -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)))) |