Implement WITH-RESTART to replace BIND-RESTART. WITH-RESTART takes an

additional argument that specifies the interactor -- this is no longer
done by means of a restart property.

diff --git a/v7/src/edwin/comred.scm b/v7/src/edwin/comred.scm
index a19b2f4a073d716a8b0f0d9550e1742f7d5d0ca1..6fe6c500d4de870d1494f2cc4a43df55e7ee3e34 100644 (file)
--- a/v7/src/edwin/comred.scm
+++ b/v7/src/edwin/comred.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Id: comred.scm,v 1.109 1993/10/26 18:42:29 cph Exp $
+;;;    $Id: comred.scm,v 1.110 1993/12/17 00:09:21 cph Exp $
 ;;;
 ;;;    Copyright (c) 1986, 1989-93 Massachusetts Institute of Technology
 ;;;
@@ -129,7 +129,7 @@
 (define (bind-abort-editor-command thunk)
   (call-with-current-continuation
    (lambda (continuation)
-     (bind-restart 'ABORT-EDITOR-COMMAND "Return to the editor command loop."
+     (with-restart 'ABORT-EDITOR-COMMAND "Return to the editor command loop."
         (lambda (#!optional input)
           (within-continuation continuation
             (lambda ()
@@ -137,7 +137,8 @@
                   (begin
                     (reset-command-state!)
                     (apply-input-event input))))))
-       (lambda (restart) restart (thunk))))))
+        values
+       thunk))))
 
 (define (return-to-command-loop condition)
   (let ((restart (find-restart 'ABORT-EDITOR-COMMAND)))

diff --git a/v7/src/edwin/schmod.scm b/v7/src/edwin/schmod.scm
index 4fc0816fd1bfbaf69fa71d6cf6c24f47c4001e0e..cb54151d9479af1250a4b56c28eb8de9d90cd704 100644 (file)
--- a/v7/src/edwin/schmod.scm
+++ b/v7/src/edwin/schmod.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Id: schmod.scm,v 1.35 1993/12/10 19:25:09 cph Exp $
+;;;    $Id: schmod.scm,v 1.36 1993/12/17 00:09:14 cph Exp $
 ;;;
 ;;;    Copyright (c) 1986, 1989-93 Massachusetts Institute of Technology
 ;;;
@@ -210,7 +210,7 @@ The following commands evaluate Scheme expressions:
            (WITHIN-CONTINUATION . 1)
 
            (MAKE-CONDITION-TYPE . 3)
-           (BIND-RESTART . 3)
+           (WITH-RESTART . 4)
            (WITH-SIMPLE-RESTART . 2)
            (BIND-CONDITION-HANDLER . 2)
            (LIST-TRANSFORM-POSITIVE . 1)

diff --git a/v7/src/runtime/advice.scm b/v7/src/runtime/advice.scm
index 1269e46a597a14517e40ec2aea2e9c4f048912da..f8671eff6b5e5cd30b5e08563aec5fc849a2b201 100644 (file)
--- a/v7/src/runtime/advice.scm
+++ b/v7/src/runtime/advice.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: advice.scm,v 14.13 1993/10/21 11:49:41 cph Exp $
+$Id: advice.scm,v 14.14 1993/12/17 00:05:20 cph Exp $
 
 Copyright (c) 1988-93 Massachusetts Institute of Technology
 
@@ -228,13 +228,12 @@ MIT in each case. |#
        (call-with-current-continuation
         (lambda (continuation)
           (fluid-let ((advice-continuation continuation))
-            (bind-restart 'USE-VALUE
+            (with-restart 'USE-VALUE
                 "Return a value from the advised procedure."
                 continuation
-              (lambda (restart)
-                (restart/put! restart 'INTERACTIVE
-                  (lambda ()
-                    (prompt-for-evaluated-expression "Procedure value")))
+                (lambda ()
+                  (prompt-for-evaluated-expression "Procedure value"))
+              (lambda ()
                 (for-each (lambda (advice)
                             (with-simple-restart 'CONTINUE
                                 "Continue with advised procedure."

diff --git a/v7/src/runtime/error.scm b/v7/src/runtime/error.scm
index 88c4710665238ece14f281404834747f2c0a4616..45b7a4d33578d6638d29206d33673170feffa6aa 100644 (file)
--- a/v7/src/runtime/error.scm
+++ b/v7/src/runtime/error.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: error.scm,v 14.40 1993/12/17 00:03:57 cph Exp $
+$Id: error.scm,v 14.41 1993/12/17 00:11:59 cph Exp $
 
 Copyright (c) 1988-93 Massachusetts Institute of Technology
 
@@ -316,7 +316,7 @@ MIT in each case. |#
                                 'WITH-RESTART))
   (let ((restart (%make-restart name reporter effector interactor)))
     (fluid-let ((*bound-restarts* (cons restart *bound-restarts*)))
-      (receiver restart))))
+      (thunk))))
 
 (define (with-simple-restart name reporter thunk)
   (call-with-current-continuation
@@ -355,7 +355,7 @@ MIT in each case. |#
 
 (define (restart/put! restart key datum)
   (if (eq? key 'INTERACTIVE)
-      (set-restart/interactor! restart datum)
+      (set-%restart/interactor! restart datum)
       (1d-table/put! (restart/properties restart) key datum)))
 
 (define (bind-restart name reporter effector receiver)

diff --git a/v7/src/runtime/rep.scm b/v7/src/runtime/rep.scm
index 7b04464d6ea9ffc83d9ce08223d89bb0c99d6190..fb229a18dd3efd69a27625f9c03a369e17bec349 100644 (file)
--- a/v7/src/runtime/rep.scm
+++ b/v7/src/runtime/rep.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: rep.scm,v 14.45 1993/12/06 19:34:06 cph Exp $
+$Id: rep.scm,v 14.46 1993/12/17 00:09:03 cph Exp $
 
 Copyright (c) 1988-93 Massachusetts Institute of Technology
 
@@ -189,7 +189,7 @@ MIT in each case. |#
 (define (bind-abort-restart cmdl thunk)
   (call-with-current-continuation
    (lambda (continuation)
-     (bind-restart 'ABORT
+     (with-restart 'ABORT
         (string-append "Return to "
                        (if (repl? cmdl)
                            "read-eval-print"
@@ -206,10 +206,14 @@ MIT in each case. |#
                (port/set-default-directory port
                                            (working-directory-pathname))))
             (if (default-object? message) "Abort!" message))))
-       (lambda (restart)
-        (restart/put! restart cmdl-abort-restart-tag cmdl)
+        values
+       (lambda ()
+        (restart/put! (first-bound-restart) cmdl-abort-restart-tag cmdl)
         (thunk))))))
 
+(define (cmdl-abort-restart? restart)
+  (restart/get restart cmdl-abort-restart-tag))
+
 (define *nearest-cmdl*)
 
 (define (nearest-cmdl)
@@ -363,7 +367,7 @@ MIT in each case. |#
 
 (define (invoke-abort restart message)
   (let ((effector (restart/effector restart)))
-    (if (restart/get restart cmdl-abort-restart-tag)
+    (if (cmdl-abort-restart? restart)
        (effector message)
        (effector))))
 
@@ -599,12 +603,13 @@ MIT in each case. |#
   (let loop ((restarts restarts))
     (if (null? restarts)
        '()
-       (cons (car restarts)
-             (if (restart/get (car restarts) cmdl-abort-restart-tag)
-                 (list-transform-positive (cdr restarts)
-                   (lambda (restart)
-                     (restart/get restart cmdl-abort-restart-tag)))
-                 (loop (cdr restarts)))))))
+       (let ((rest
+              (if (cmdl-abort-restart? (car restarts))
+                  (list-transform-positive (cdr restarts) cmdl-abort-restart?)
+                  (loop (cdr restarts)))))
+         (if (restart/interactor (car restarts))
+             (cons (car restarts) rest)
+             rest)))))
 \f
 (define-structure (repl-state
                   (conc-name repl-state/)
@@ -820,13 +825,13 @@ MIT in each case. |#
   (call-with-current-continuation
    (lambda (restart-continuation)
      (let ((continuation (or continuation restart-continuation)))
-       (bind-restart 'CONTINUE
+       (with-restart 'CONTINUE
           (if (string=? "bkpt>" prompt)
               "Return from BKPT."
               "Continue from breakpoint.")
           (lambda () (restart-continuation unspecific))
-        (lambda (restart)
-          restart
+          values
+        (lambda ()
           (call-with-values
               (lambda ()
                 (get-breakpoint-environment continuation environment message))

diff --git a/v7/src/runtime/uerror.scm b/v7/src/runtime/uerror.scm
index e1b78cac5d58c1f08707201f6a7c732e2cb46b9c..3fedc5410cd1ec29c01fc1827b78edfe081febea 100644 (file)
--- a/v7/src/runtime/uerror.scm
+++ b/v7/src/runtime/uerror.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: uerror.scm,v 14.36 1993/12/14 22:22:49 cph Exp $
+$Id: uerror.scm,v 14.37 1993/12/17 00:05:57 cph Exp $
 
 Copyright (c) 1988-93 Massachusetts Institute of Technology
 
@@ -93,7 +93,7 @@ MIT in each case. |#
 ;;;; Restart Bindings
 
 (define (unbound-variable/store-value continuation environment name thunk)
-  (bind-restart 'STORE-VALUE
+  (with-restart 'STORE-VALUE
       (lambda (port)
        (write-string "Define " port)
        (write name port)
@@ -101,15 +101,13 @@ MIT in each case. |#
       (lambda (value)
        (local-assignment environment name value)
        (continuation unspecific))
-    (lambda (restart)
-      (restart/put! restart 'INTERACTIVE
-       (let ((prompt (string-append "Define " (write-to-string name) " as")))
-         (lambda ()
-           (values (prompt-for-evaluated-expression prompt environment)))))
-      (thunk))))
+      (let ((prompt (string-append "Define " (write-to-string name) " as")))
+       (lambda ()
+         (values (prompt-for-evaluated-expression prompt environment))))
+    thunk))
 
 (define (unassigned-variable/store-value continuation environment name thunk)
-  (bind-restart 'STORE-VALUE
+  (with-restart 'STORE-VALUE
       (lambda (port)
        (write-string "Set " port)
        (write name port)
@@ -117,46 +115,40 @@ MIT in each case. |#
       (lambda (value)
        (environment-assign! environment name value)
        (continuation unspecific))
-    (lambda (restart)
-      (restart/put! restart 'INTERACTIVE
-       (let ((prompt (string-append "Set " (write-to-string name) " to")))
-         (lambda ()
-           (values (prompt-for-evaluated-expression prompt environment)))))
-      (thunk))))
+      (let ((prompt (string-append "Set " (write-to-string name) " to")))
+       (lambda ()
+         (values (prompt-for-evaluated-expression prompt environment))))
+    thunk))
 
 (define (variable/use-value continuation environment name thunk)
   (let ((continuation (continuation/next-continuation continuation)))
     (if continuation
-       (bind-restart 'USE-VALUE
+       (with-restart 'USE-VALUE
            (lambda (port)
              (write-string "Specify a value to use instead of " port)
              (write name port)
              (write-string "." port))
            continuation
-         (lambda (restart)
-           (restart/put! restart 'INTERACTIVE
-             (let ((prompt
-                    (string-append "Value to use instead of "
-                                   (write-to-string name))))
-               (lambda ()
-                 (values
-                  (prompt-for-evaluated-expression prompt environment)))))
-           (thunk)))
+           (let ((prompt
+                  (string-append "Value to use instead of "
+                                 (write-to-string name))))
+             (lambda ()
+               (values
+                (prompt-for-evaluated-expression prompt environment))))
+         thunk)
        (thunk))))
 
 (define (inapplicable-object/use-value continuation operands thunk)
   (let ((continuation (continuation/next-continuation continuation)))
     (if continuation
-       (bind-restart 'USE-VALUE "Specify a procedure to use in its place."
+       (with-restart 'USE-VALUE "Specify a procedure to use in its place."
            (lambda (operator)
              (within-continuation continuation
                (lambda ()
                  (apply operator operands))))
-         (lambda (restart)
-           (restart/put! restart 'INTERACTIVE
-             (lambda ()
-               (values (prompt-for-evaluated-expression "New procedure"))))
-           (thunk)))
+           (lambda ()
+             (values (prompt-for-evaluated-expression "New procedure")))
+         thunk)
        (thunk))))
 \f
 (define (illegal-arg-signaller type)
@@ -169,17 +161,15 @@ MIT in each case. |#
 (define (illegal-argument/use-value continuation operator operands index thunk)
   (let ((continuation (continuation/next-continuation continuation)))
     (if continuation
-       (bind-restart 'USE-VALUE "Specify an argument to use in its place."
+       (with-restart 'USE-VALUE "Specify an argument to use in its place."
            (lambda (operand)
              (within-continuation continuation
                (lambda ()
                  (apply operator
                         (substitute-element operands index operand)))))
-         (lambda (restart)
-           (restart/put! restart 'INTERACTIVE
-             (lambda ()
-               (values (prompt-for-evaluated-expression "New argument"))))
-           (thunk)))
+           (lambda ()
+             (values (prompt-for-evaluated-expression "New argument")))
+         thunk)
        (thunk))))
 
 (define (file-operation-signaller)
@@ -198,36 +188,33 @@ MIT in each case. |#
                                  verb noun thunk)
   (let ((continuation (continuation/next-continuation continuation)))
     (if continuation
-       (bind-restart 'USE-VALUE
+       (with-restart 'USE-VALUE
            (string-append "Try to " verb " a different " noun ".")
            (lambda (operand)
              (within-continuation continuation
                (lambda ()
                  (apply operator
                         (substitute-element operands index operand)))))
-         (let ((prompt
-                (string-append "New "
-                               noun
-                               " name (an expression to be evaluated)")))
-           (lambda (restart)
-             (restart/put! restart 'INTERACTIVE
-               (lambda ()
-                 (values (prompt-for-evaluated-expression prompt))))
-             (thunk))))
+           (let ((prompt
+                  (string-append "New "
+                                 noun
+                                 " name (an expression to be evaluated)")))
+             (lambda ()
+               (values (prompt-for-evaluated-expression prompt))))
+         thunk)
        (thunk))))
 
 (define (file-operation/retry continuation operator operands verb noun thunk)
   (let ((continuation (continuation/next-continuation continuation)))
     (if continuation
-       (bind-restart 'RETRY
+       (with-restart 'RETRY
            (string-append "Try to " verb " the same " noun " again.")
            (lambda ()
              (within-continuation continuation
                (lambda ()
                  (apply operator operands))))
-         (lambda (restart)
-           (restart/put! restart 'INTERACTIVE values)
-           (thunk)))
+           values
+         thunk)
        (thunk))))
 
 (define (substitute-element list index element)

diff --git a/v8/src/runtime/runtime.pkg b/v8/src/runtime/runtime.pkg
index c04c16c846566338e5511d6fed17e962e9477383..08d0eb37b3f76037d5b7560c6497f7cb30472d9d 100644 (file)
--- a/v8/src/runtime/runtime.pkg
+++ b/v8/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.220 1993/12/05 06:15:14 cph Exp $
+$Id: runtime.pkg,v 14.221 1993/12/17 00:05:06 cph Exp $
 
 Copyright (c) 1988-1993 Massachusetts Institute of Technology
 
@@ -609,6 +609,7 @@ MIT in each case. |#
          error:wrong-type-argument
          error:wrong-type-datum
          find-restart
+         first-bound-restart
          format-error-message
          hook/invoke-condition-handler
          ignore-errors
@@ -619,6 +620,7 @@ MIT in each case. |#
          muffle-warning
          restart/effector
          restart/get
+         restart/interactor
          restart/name
          restart/properties
          restart/put!
@@ -632,6 +634,7 @@ MIT in each case. |#
          store-value
          use-value
          warn
+         with-restart
          with-simple-restart
          write-condition-report
          write-restart-report)