Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv3550
Modified Files: print.lisp Log Message: Have macros in the run-time.
--- /project/movitz/cvsroot/movitz/losp/muerte/print.lisp 2006/05/02 20:04:15 1.23 +++ /project/movitz/cvsroot/movitz/losp/muerte/print.lisp 2008/03/15 20:58:15 1.24 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld frodef@acm.org ;;;; Created at: Mon Sep 3 11:48:19 2001 ;;;; -;;;; $Id: print.lisp,v 1.23 2006/05/02 20:04:15 ffjeld Exp $ +;;;; $Id: print.lisp,v 1.24 2008/03/15 20:58:15 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------
@@ -230,29 +230,31 @@ ((or cons tag5) (let ((level *print-level*)) (cond - ((and level (minusp level)) - (write-char ## stream)) - ((and (eq 'quote (car object)) - (not (cddr object))) - (write-char #' stream) - (write (cadr object))) - (t (labels ((write-cons (c stream length) - (cond - ((and length (= 0 length)) - (write-string "...)")) - (t (write (car c)) - (typecase (cdr c) - (null - (write-char #) stream)) - (cons - (write-char #\space stream) - (write-cons (cdr c) stream (minus-if length 1))) - (t - (write-string " . " stream) - (write (cdr c)) - (write-char #) stream))))))) - (write-char #( stream) - (write-cons object stream *print-length*)))))) + ((and (not do-escape-p) + level + (minusp level)) + (write-char ## stream)) + ((and (eq 'quote (car object)) + (not (cddr object))) + (write-char #' stream) + (write (cadr object))) + (t (labels ((write-cons (c stream length) + (cond + ((and length (= 0 length)) + (write-string "...)")) + (t (write (car c)) + (typecase (cdr c) + (null + (write-char #) stream)) + (cons + (write-char #\space stream) + (write-cons (cdr c) stream (minus-if length 1))) + (t + (write-string " . " stream) + (write (cdr c)) + (write-char #) stream))))))) + (write-char #( stream) + (write-cons object stream *print-length*)))))) (integer (write-integer object stream *print-base* *print-radix*)) (string @@ -326,6 +328,9 @@ (standard-gf-instance (print-unreadable-object (object stream) (format stream "gf ~S" (funobj-name object)))) + (macro-function + (print-unreadable-object (object stream) + (format stream "macro-function ~S" (funobj-name object)))) (compiled-function (print-unreadable-object (object stream) (format stream "function ~S" (funobj-name object))))