From a4b813ce74589e8d3c9fe2f6473deff2a08dd792 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Wed, 15 May 1991 21:18:22 +0000 Subject: [PATCH] Implement control variable REPL:ALLOW-RESTART-NOTIFICATIONS?. Change debugger to present restart notifications with same numbering as does the REP loop. --- v7/src/runtime/debug.scm | 89 +++++++++++++++++++++----------------- v7/src/runtime/rep.scm | 15 ++++--- v7/src/runtime/runtime.pkg | 5 ++- v8/src/runtime/runtime.pkg | 5 ++- 4 files changed, 67 insertions(+), 47 deletions(-) diff --git a/v7/src/runtime/debug.scm b/v7/src/runtime/debug.scm index c74bafbed..86b8870c4 100644 --- a/v7/src/runtime/debug.scm +++ b/v7/src/runtime/debug.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/debug.scm,v 14.25 1991/05/15 18:13:49 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/debug.scm,v 14.26 1991/05/15 21:18:07 cph Exp $ Copyright (c) 1988-91 Massachusetts Institute of Technology @@ -470,21 +470,35 @@ MIT in each case. |# (length subproblems) " inclusive).") (top-level-loop)))))))))) - + (define (prompt-for-nonnegative-integer prompt limit) + (prompt-for-integer prompt 0 limit)) + +(define (prompt-for-integer prompt lower upper) (let loop () (let ((expression (prompt-for-expression - (string-append prompt - (if limit - (string-append " (0 through " - (number->string (-1+ limit)) - " inclusive)") - ""))))) - (cond ((not (exact-nonnegative-integer? expression)) - (debugger-failure prompt " must be nonnegative integer.") + (string-append + prompt + (if lower + (if upper + (string-append " (" (number->string lower) + " through " + (number->string (- upper 1)) + " inclusive)") + (string-append " (minimum " (number->string lower) ")")) + (if upper + (string-append " (maximum " + (number->string (- upper 1)) + ")") + "")))))) + (cond ((not (exact-integer? expression)) + (debugger-failure prompt " must be exact integer.") (loop)) - ((and limit (>= expression limit)) + ((and lower (< expression lower)) + (debugger-failure prompt " too small.") + (loop)) + ((and upper (>= expression upper)) (debugger-failure prompt " too large.") (loop)) (else @@ -641,35 +655,30 @@ MIT in each case. |# (if (null? restarts) (debugger-failure "No options to choose from.") (let ((n-restarts (length restarts)) - (invoke-option - (lambda (n) - (invoke-restart-interactively (list-ref restarts n))))) - (presentation - (lambda () - (let ((port (current-output-port))) - (if (= n-restarts 1) - (begin - (write-string "There is only one option:" port) - (newline port) - (write-restarts restarts port) - (if (prompt-for-confirmation "Use this option") - (invoke-option 0))) - (begin - (write-string "Choose an option by number:" port) - (newline port) - (write-restarts restarts port) - (invoke-option - (prompt-for-nonnegative-integer "Option number" - n-restarts))))))))))) - -(define (write-restarts restarts port) - (do ((restarts restarts (cdr restarts)) - (index 0 (1+ index))) - ((null? restarts)) - (write-string (string-pad-left (number->string index) 3) port) - (write-string ": " port) - (write-restart-report (car restarts) port) - (newline port))) + (write-index + (lambda (index port) + (write-string (string-pad-left (number->string index) 3) port) + (write-string ":" port)))) + (let ((invoke-option + (lambda (n) + (invoke-restart-interactively + (list-ref restarts (- n-restarts n)))))) + (presentation + (lambda () + (let ((port (current-output-port))) + (if (= n-restarts 1) + (begin + (write-string "There is only one option:" port) + (write-restarts restarts port write-index) + (if (prompt-for-confirmation "Use this option") + (invoke-option 1))) + (begin + (write-string "Choose an option by number:" port) + (write-restarts restarts port write-index) + (invoke-option + (prompt-for-integer "Option number" + 1 + (+ n-restarts 1))))))))))))) ;;;; Advanced hacking commands diff --git a/v7/src/runtime/rep.scm b/v7/src/runtime/rep.scm index 4420430ef..f94e82ab8 100644 --- a/v7/src/runtime/rep.scm +++ b/v7/src/runtime/rep.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/rep.scm,v 14.19 1991/03/14 04:27:13 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/rep.scm,v 14.20 1991/05/15 21:17:51 cph Exp $ Copyright (c) 1988-91 Massachusetts Institute of Technology @@ -37,6 +37,9 @@ MIT in each case. |# (declare (usual-integrations)) +(define repl:allow-restart-notifications? + true) + (define (initialize-package!) (set! *nearest-cmdl* false) (set! with-cmdl/input-port @@ -294,13 +297,15 @@ MIT in each case. |# message)) (if condition (cmdl-message/append - (if hook/error-decision + (if (and hook/error-decision (condition/error? condition)) (cmdl-message/active (lambda (cmdl) cmdl (hook/error-decision))) (cmdl-message/null)) - (condition-restarts-message condition)) + (if repl:allow-restart-notifications? + (condition-restarts-message condition) + (cmdl-message/null))) (cmdl-message/null)) (if (eq? 'INHERIT environment) (cmdl-message/null) @@ -334,7 +339,7 @@ MIT in each case. |# ;To continue, call RESTART with an option number:" port) (write-restarts (filter-restarts (condition/restarts condition)) port (lambda (index port) - (write-string " (RESTART " port) + (write-string "; (RESTART " port) (write index port) (write-string ") =>" port))))))) @@ -358,6 +363,7 @@ MIT in each case. |# (write-string ";Choose an option by number:" port) (write-restarts restarts port (lambda (index port) + (write-string ";" port) (write-string (string-pad-left (number->string index) 3) port) (write-string ":" port))) @@ -387,7 +393,6 @@ MIT in each case. |# (do ((restarts restarts (cdr restarts)) (index (length restarts) (- index 1))) ((null? restarts)) - (write-string ";" port) (write-index index port) (write-string " " port) (write-restart-report (car restarts) port) diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg index 8f1b8d1e0..44b293e06 100644 --- a/v7/src/runtime/runtime.pkg +++ b/v7/src/runtime/runtime.pkg @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/runtime.pkg,v 14.106 1991/05/15 18:14:02 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/runtime.pkg,v 14.107 1991/05/15 21:18:22 cph Exp $ Copyright (c) 1988-91 Massachusetts Institute of Technology @@ -1706,6 +1706,7 @@ MIT in each case. |# repl/prompt repl/reader-history repl/syntax-table + repl:allow-restart-notifications? repl? restart set-cmdl/input-port! @@ -1735,6 +1736,8 @@ MIT in each case. |# repl-write/show-hash?) (export (runtime debugger-command-loop) hook/repl-environment) + (export (runtime debugger) + write-restarts) (initialization (initialize-package!))) (define-package (runtime save/restore) diff --git a/v8/src/runtime/runtime.pkg b/v8/src/runtime/runtime.pkg index 9898c9a19..d46d37402 100644 --- a/v8/src/runtime/runtime.pkg +++ b/v8/src/runtime/runtime.pkg @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/runtime.pkg,v 14.106 1991/05/15 18:14:02 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/runtime.pkg,v 14.107 1991/05/15 21:18:22 cph Exp $ Copyright (c) 1988-91 Massachusetts Institute of Technology @@ -1706,6 +1706,7 @@ MIT in each case. |# repl/prompt repl/reader-history repl/syntax-table + repl:allow-restart-notifications? repl? restart set-cmdl/input-port! @@ -1735,6 +1736,8 @@ MIT in each case. |# repl-write/show-hash?) (export (runtime debugger-command-loop) hook/repl-environment) + (export (runtime debugger) + write-restarts) (initialization (initialize-package!))) (define-package (runtime save/restore) -- 2.25.1