default-pre-unwind-handler to scm-style-repl
authorAndy Wingo <wingo@pobox.com>
Fri, 18 Jun 2010 10:50:32 +0000 (12:50 +0200)
committerAndy Wingo <wingo@pobox.com>
Fri, 18 Jun 2010 10:50:32 +0000 (12:50 +0200)
* 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.

module/ice-9/boot-9.scm
module/ice-9/debugger.scm
module/ice-9/debugging/traps.scm
module/ice-9/deprecated.scm
module/ice-9/scm-style-repl.scm
module/ice-9/stack-catch.scm

index 3cc4115..e7c8441 100644 (file)
@@ -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
index 3a6c081..baece4e 100644 (file)
@@ -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
index 3df939c..5557cb3 100755 (executable)
@@ -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)
index 97e9eb2..27c70f8 100644 (file)
@@ -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))
index c316c38..9210f27 100644 (file)
@@ -27,6 +27,7 @@
              assert-repl-print-unspecified
              assert-repl-verbosity
 
+             default-pre-unwind-handler
              bad-throw
              error-catching-loop
              error-catching-repl
 
 \f
 
+(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))
+
+\f
+
 (define (error-catching-loop thunk)
   (let ((status #f)
         (interactive #t))
index f7b2075..a8912da 100644 (file)
@@ -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))))