Changeset 8609


Ignore:
Timestamp:
02/20/05 14:11:53 (16 years ago)
Author:
piso
Message:

Defined a PRINT-OBJECT method for structures.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/j/src/org/armedbear/lisp/print-object.lisp

    r6497 r8609  
    11;;; print-object.lisp
    22;;;
    3 ;;; Copyright (C) 2003-2004 Peter Graves
    4 ;;; $Id: print-object.lisp,v 1.6 2004-04-15 15:46:54 piso Exp $
     3;;; Copyright (C) 2003-2005 Peter Graves
     4;;; $Id: print-object.lisp,v 1.7 2005-02-20 14:11:53 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    1818;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
    1919
    20 (in-package "SYSTEM")
     20(in-package #:system)
    2121
    2222(require 'clos)
     
    2525  (fmakunbound 'print-object))
    2626
    27 (defgeneric print-object (instance stream))
     27(defgeneric print-object (object stream))
    2828
    29 (defmethod print-object ((x t) stream)
    30   (print-unreadable-object (x stream :type t :identity t)))
     29(defmethod print-object ((object t) stream)
     30  (print-unreadable-object (object stream :type t :identity t)))
    3131
    32 (defmethod print-object ((instance standard-object) stream)
    33   (print-unreadable-object (instance stream :identity t)
    34                            (format stream "~S"
    35                                    (class-name (class-of instance))))
     32(defmethod print-object ((object structure-object) stream)
     33  (write-string (%write-to-string object) stream))
     34
     35(defmethod print-object ((object standard-object) stream)
     36  (print-unreadable-object (object stream :identity t)
     37    (format stream "~S" (class-name (class-of object))))
    3638  instance)
    3739
    3840(defmethod print-object ((class standard-class) stream)
    3941  (print-unreadable-object (class stream :identity t)
    40                            (format stream "~S ~S"
    41                                    (class-name (class-of class))
    42                                    (class-name class)))
     42    (format stream "~S ~S"
     43            (class-name (class-of class))
     44            (class-name class)))
    4345  class)
    4446
    4547(defmethod print-object ((gf standard-generic-function) stream)
    4648  (print-unreadable-object (gf stream :identity t)
    47                            (format stream "~S ~S"
    48                                    (class-name (class-of gf))
    49                                    (generic-function-name gf)))
     49    (format stream "~S ~S"
     50            (class-name (class-of gf))
     51            (generic-function-name gf)))
    5052  gf)
    5153
    5254(defmethod print-object ((method standard-method) stream)
    5355  (print-unreadable-object (method stream :identity t)
    54                            (format stream "~S ~S~{ ~S~} ~S"
    55                                    (class-name (class-of method))
    56                                    (generic-function-name
    57                                     (method-generic-function method))
    58                                    (method-qualifiers method)
    59                                    (mapcar #'class-name
    60                                            (method-specializers method))))
     56    (format stream "~S ~S~{ ~S~} ~S"
     57            (class-name (class-of method))
     58            (generic-function-name
     59             (method-generic-function method))
     60            (method-qualifiers method)
     61            (mapcar #'class-name
     62                    (method-specializers method))))
    6163  method)
    6264
     
    6466  (if *print-escape*
    6567      (print-unreadable-object (restart stream :type t :identity t)
    66                                (prin1 (restart-name restart) stream))
     68        (prin1 (restart-name restart) stream))
    6769      (restart-report restart stream)))
    6870
Note: See TracChangeset for help on using the changeset viewer.