From: Chris Hanson Date: Mon, 7 Mar 1994 18:52:44 +0000 (+0000) Subject: Change browser to show just subexpression of a subproblem line, since X-Git-Tag: 20090517-FFI~7266 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=725f0443af11a81daf5e219151ca1b0c45c3f09d;p=mit-scheme.git Change browser to show just subexpression of a subproblem line, since this is what is most interesting about that line. This takes less space and is less confusing than the previous behavior, which showed the whole expression and highlighted the subexpression. --- diff --git a/v7/src/edwin/debug.scm b/v7/src/edwin/debug.scm index d396dafda..065f57bba 100644 --- a/v7/src/edwin/debug.scm +++ b/v7/src/edwin/debug.scm @@ -1,8 +1,8 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: debug.scm,v 1.26 1993/10/26 21:51:31 cph Exp $ +;;; $Id: debug.scm,v 1.27 1994/03/07 18:52:44 cph Exp $ ;;; -;;; Copyright (c) 1992-93 Massachusetts Institute of Technology +;;; Copyright (c) 1992-94 Massachusetts Institute of Technology ;;; ;;; This material was developed by the Scheme project at the ;;; Massachusetts Institute of Technology, Department of @@ -1373,7 +1373,6 @@ it has been renamed, it will not be deleted automatically.") n) (loop (cdr reductions) (+ n 1))) '())))) - (define (subproblem/write-summary bline port) (let* ((subproblem (bline/object bline)) @@ -1391,41 +1390,17 @@ it has been renamed, it will not be deleted automatically.") (cond ((debugging-info/compiled-code? expression) (write-string ";unknown compiled code" port)) ((not (debugging-info/undefined-expression? expression)) - (print-with-subexpression expression subexpression)) + (fluid-let ((*unparse-primitives-by-name?* true)) + (write + (unsyntax (if (invalid-subexpression? subexpression) + expression + subexpression))))) ((debugging-info/noise? expression) (write-string ";" port) (write-string ((debugging-info/noise expression) false) port)) (else (write-string ";undefined expression" port)))))))) - -;;;also marks the subexpression with # # -(define (print-with-subexpression expression subexpression) - (fluid-let ((*unparse-primitives-by-name?* true)) - (if (invalid-subexpression? subexpression) - (write (unsyntax expression)) - (let ((sub (write-to-string (unsyntax subexpression)))) - (write (unsyntax-with-substitutions - expression - (list - (cons subexpression - (unparser-literal/make - (string-append - subexpression-start-marker - sub - subexpression-end-marker)))))))))) - -(define subexpression-start-marker "#") -(define subexpression-end-marker "#") - -(define-structure (unparser-literal - (conc-name unparser-literal/) - (print-procedure - (lambda (state instance) - (unparse-string state - (unparser-literal/string instance)))) - (constructor unparser-literal/make)) - string) (define (subproblem/write-description bline port) (let* ((subproblem (bline/object bline))