patch to quote some args in debug frames

[Miles Bader <miles@cogsci.edinburgh.ac.uk>]

Here's a simple change that quotes non-self-evaluating arguments when
printing debug-frames, so that they look more like real function calls (I
think the current behavior is somewhat confusing).  It adds two exported
functions to extensions.lisp (and deletes two from disassem.lisp).

The same probably ought to be done to trace.

-Miles

--
Miles Bader  --  HCRC, University of Edinburgh  --  miles@cogsci.ed.ac.uk
Nothing is sacred

*** code/debug.lisp.~1~	Wed Apr  1 14:53:49 1992
--- code/debug.lisp	Wed Apr  1 15:18:22 1992
***************
*** 240,246 ****
  (defun frame-call-arg (var location frame)
    (lambda-var-dispatch var location
      (make-unprintable-object "unused-arg")
!     (di:debug-variable-value var frame)
      (make-unprintable-object "unavailable-arg")))
  
  
--- 240,246 ----
  (defun frame-call-arg (var location frame)
    (lambda-var-dispatch var location
      (make-unprintable-object "unused-arg")
!     (ext:quote-unless-self-evaluating (di:debug-variable-value var frame))
      (make-unprintable-object "unavailable-arg")))
  
  
*** code/extensions.lisp.~1~	Wed Apr  1 14:56:11 1992
--- code/extensions.lisp	Wed Apr  1 15:16:10 1992
***************
*** 22,28 ****
  		read-char-no-edit listen-skip-whitespace concat-pnames
  		iterate once-only collect do-anonymous undefined-value
  		required-argument define-hash-cache defun-cached
! 		cache-hash-eq))
  
  (import 'lisp::whitespace-char-p)
  
--- 22,28 ----
  		read-char-no-edit listen-skip-whitespace concat-pnames
  		iterate once-only collect do-anonymous undefined-value
  		required-argument define-hash-cache defun-cached
! 		cache-hash-eq self-evaluating-p quote-unless-self-evaluating))
  
  (import 'lisp::whitespace-char-p)
  
***************
*** 568,570 ****
--- 568,589 ----
    course) change at arbitary times."
    (the fixnum (ash (truly-the fixnum (%primitive lisp::make-fixnum x)) -3)))
  
+ 
+ ;;; SELF-EVALUATING-P  -- Public
+ ;;;
+ (defun self-evaluating-p (form)
+   "Returns T if FORM would evaluate to itself."
+   (typecase form
+     (null t)
+     (keyword t)
+     (symbol (eq form t))
+     (cons nil)
+     (t t)))
+ 
+ ;;; QUOTE-UNLESS-SELF-EVALUATING  -- Public
+ ;;;
+ (defun quote-unless-self-evaluating (form)
+   "Returns FORM, quoted if it's not self-evaluating."
+   (if (self-evaluating-p form)
+       form
+       `',form))
*** compiler/disassem.lisp.~1~	Wed Apr  1 14:57:26 1992
--- compiler/disassem.lisp	Wed Apr  1 15:17:23 1992
***************
*** 80,86 ****
  	  print-current-address
  	  print-bytes print-words
  	  prin1-short
- 	  prin1-quoted-short
  	  ))
  
  ;;; This file implements a retargetable disassembler, that uses simple hooks
--- 80,85 ----
***************
*** 560,575 ****
  
  ;;; ----------------------------------------------------------------
  
- (defun self-evaluating-p (x)
-   (typecase x
-     (null t)
-     (keyword t)
-     (symbol (eq x t))
-     (cons nil)
-     (t t)))
- 
- ;;; ----------------------------------------------------------------
- 
  (defstruct (field-type (:conc-name ftype-))
    (name nil :type symbol)
    ;; if printer is T or NIL, the number is printed, if a vector, the Nth
--- 559,564 ----
***************
*** 3243,3253 ****
    (with-print-restrictions
      (prin1 thing stream)))
  
- (defun prin1-quoted-short (thing stream)
-   (if (self-evaluating-p thing)
-       (prin1-short thing stream)
-       (prin1-short `',thing stream)))
- 
  (defun note-code-constant (byte-offset dstate)
    "Store a note about the lisp constant located BYTE-OFFSET bytes from the
    current code-component, to be printed as an end-of-line comment after the
--- 3232,3237 ----
***************
*** 3258,3264 ****
        (get-code-constant byte-offset dstate)
      (when valid
        (note #'(lambda (stream)
! 		(disassem:prin1-quoted-short const stream))
  	    dstate))
      const))
  
--- 3242,3250 ----
        (get-code-constant byte-offset dstate)
      (when valid
        (note #'(lambda (stream)
! 		(disassem:prin1-short
! 		 (ext:quote-unless-self-evaluating const)
! 		 stream))
  	    dstate))
      const))
  
***************
*** 3289,3295 ****
  	   (type disassem-state dstate))
    (let ((obj (get-nil-indexed-object nil-byte-offset)))
      (note #'(lambda (stream)
! 	      (prin1-quoted-short obj stream))
  	  dstate)
      t))
  
--- 3275,3281 ----
  	   (type disassem-state dstate))
    (let ((obj (get-nil-indexed-object nil-byte-offset)))
      (note #'(lambda (stream)
! 	      (prin1-short (ext:quote-unless-self-evaluating obj) stream))
  	  dstate)
      t))