/[cmucl]/src/pcl/macros.lisp
ViewVC logotype

Diff of /src/pcl/macros.lisp

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

revision 1.7 by pw, Thu Feb 6 21:24:14 1997 UTC revision 1.7.2.1 by pw, Tue Jun 23 11:25:35 1998 UTC
# Line 279  Line 279 
279                                    form                                    form
280                                    (if (symbolp (cdr pat)) (cdr pat) form))                                    (if (symbolp (cdr pat)) (cdr pat) form))
281                         ,@(nreverse                         ,@(nreverse
282                             (destructure-internal                             (destructure-internal (car pat) gensym)))
                              (if (consp pat) (car pat) pat)  
                              gensym)))  
283                      setqs)                      setqs)
284                (when (symbolp (cdr pat))                (when (symbolp (cdr pat))
285                  (push (cdr pat) *destructure-vars*)                  (push (cdr pat) *destructure-vars*)
# Line 501  Line 499 
499          (setf (find-class-cell-class cell) new-value)          (setf (find-class-cell-class cell) new-value)
500          (when (or (eq *boot-state* 'complete)          (when (or (eq *boot-state* 'complete)
501                    (eq *boot-state* 'braid))                    (eq *boot-state* 'braid))
502            #+cmu17            (when (and new-value (class-wrapper new-value))
503            (let ((lclass (kernel:layout-class (class-wrapper new-value))))              (setf (find-class-cell-predicate cell)
504              (setf (lisp:class-name lclass) (class-name new-value))                    (symbol-function (class-predicate-name new-value))))
             (unless (eq (lisp:find-class symbol nil) lclass)  
               (setf (lisp:find-class symbol) lclass)))  
   
           (setf (find-class-cell-predicate cell)  
                 (symbol-function (class-predicate-name new-value)))  
505            (when (and new-value (not (forward-referenced-class-p new-value)))            (when (and new-value (not (forward-referenced-class-p new-value)))
506    
507              (dolist (keys+aok (find-class-cell-make-instance-function-keys cell))              (dolist (keys+aok (find-class-cell-make-instance-function-keys cell))
508                (update-initialize-info-internal                (update-initialize-info-internal
509                 (initialize-info new-value (car keys+aok) nil (cdr keys+aok))                 (initialize-info new-value (car keys+aok) nil (cdr keys+aok))
510                 'make-instance-function)))))                 'make-instance-function))))
511            new-value)
512        (error "~S is not a legal class name." symbol)))        (error "~S is not a legal class name." symbol)))
513    
514  #-setf  #-setf

Legend:
Removed from v.1.7  
changed lines
  Added in v.1.7.2.1

  ViewVC Help
Powered by ViewVC 1.1.5