/[gcl]/gcl/pcl/gcl_pcl_braid.lisp
ViewVC logotype

Diff of /gcl/pcl/gcl_pcl_braid.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.2 by camm, Sat May 7 02:52:30 2005 UTC revision 1.3 by camm, Sat Jul 23 08:55:27 2005 UTC
# Line 601  Line 601 
601      :initfunction ,(eval-form (structure-slotd-init-form slotd))))      :initfunction ,(eval-form (structure-slotd-init-form slotd))))
602    
603  (defun find-structure-class (symbol)  (defun find-structure-class (symbol)
604    (if (structure-type-p symbol)    (unless (eq symbol 'std-instance)
605        (unless (eq find-structure-class symbol)      (if (structure-type-p symbol)
606          (let ((find-structure-class symbol))          (unless (eq find-structure-class symbol)
607            (ensure-class symbol            (let ((find-structure-class symbol))
608                          :metaclass 'structure-class              (ensure-class symbol
609                          :name symbol                            :metaclass 'structure-class
610                          :direct-superclasses                            :name symbol
611                          (when (structure-type-included-type-name symbol)                            :direct-superclasses
612                            (list (structure-type-included-type-name symbol)))                            (when (structure-type-included-type-name symbol)
613                          :direct-slots                              (list (structure-type-included-type-name symbol)))
614                          (mapcar #'slot-initargs-from-structure-slotd                            :direct-slots
615                                  (structure-type-slot-description-list symbol)))))                            (mapcar #'slot-initargs-from-structure-slotd
616        (error "~S is not a legal structure class name." symbol)))                                    (structure-type-slot-description-list symbol)))))
617          (error "~S is not a legal structure class name." symbol))))
618    
619  #-cmu17  #-cmu17
620  (eval-when (compile eval)  (eval-when (compile eval)

Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26