Changeset 10666


Ignore:
Timestamp:
Sep 8, 2008, 4:09:25 PM (11 years ago)
Author:
gz
Message:

in make-instantiate-lambda-for-class-cell, don't bind class slot definitions if don't need 'em

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0711/ccl/level-1/l1-clos.lisp

    r10534 r10666  
    22072207                     (location (slot-definition-location slot))
    22082208                     (location-var nil)
     2209                     (class-init-p nil)
    22092210                     (one-initarg-p (null (cdr initargs)))
    22102211                     (name (slot-definition-name slot))
    22112212                     (type (slot-definition-type slot)))
    22122213                (when (consp location)
    2213                   (setq location-var (gensym "LOCATION"))
    2214                   (class-binds `(,location-var
    2215                                  (load-time-value
    2216                                   (slot-definition-location ',slot)))))
     2214                  (setq location-var (gensym "LOCATION")))
    22172215                (when initfunction
    22182216                  (setq initform
     
    22252223                                  (generate-type-check initform type)
    22262224                                  `(%slot-unbound-marker))))
    2227                          (if (consp location)
     2225                         (if location-var
    22282226                             (when initfunction
     2227                                 (setq class-init-p t)
    22292228                                 (class-slot-inits
    22302229                                  `(when (eq (%slot-unbound-marker) (cdr ,location-var))
     
    22412240                                       (if (and initfunction
    22422241                                                one-initarg-p
    2243                                                 (atom location))
     2242                                                (null location-var))
    22442243                                           initform
    22452244                                           (progn
     
    22512250                                                             "-P"))))
    22522251                                             (and one-initarg-p
    2253                                                   (atom location)
     2252                                                  (null location-var)
    22542253                                                  (if initfunction
    22552254                                                      initform
     
    22662265                                 (keys (list*
    22672266                                        (list initarg name)
    2268                                         (if (and default one-initarg-p (atom location))
     2267                                        (if (and default one-initarg-p (null location-var))
    22692268                                            default
    22702269                                            initial-value-form)
    22712270                                        (if spvar (list spvar))))
    22722271                                 (if one-initarg-p
    2273                                      (if (consp location)
     2272                                     (if location-var
     2273                                       (progn
     2274                                         (setq class-init-p t)
    22742275                                         (class-slot-inits
    22752276                                          `(if ,spvar
     
    22862287                                                         (setf (cdr ,location-var)
    22872288                                                               ,(generate-type-check
    2288                                                                  initform type)))))))
     2289                                                                 initform type))))))))
    22892290                                         (forms `,(generate-type-check name type spvar)))
    22902291                                     (progn (cond-clauses `(,spvar ,name))
     
    22952296                               (when last-cond-clause
    22962297                                 (cond-clauses last-cond-clause))
    2297                                (cond ((atom location)
     2298                               (cond ((null location-var)
    22982299                                      (unless last-cond-clause
    22992300                                        (cond-clauses `(t ,initform)))
     
    23122313                                                    initform
    23132314                                                    `(%slot-unbound-marker)))))
     2315                                        (setq class-init-p t)
    23142316                                        (class-slot-inits
    23152317                                         `(let* (,@(and initform-p-var
     
    23262328                                                                        (%slot-unbound-marker)))))
    23272329                                                     t)
    2328                                                 (setf (cdr ,location-var) ,value-var)))))))))))))))
     2330                                                (setf (cdr ,location-var) ,value-var))))))))))))
     2331                (when class-init-p
     2332                  (class-binds `(,location-var
     2333                                 (load-time-value
     2334                                  (slot-definition-location ',slot))))))))
    23292335          (let* ((cell (make-symbol "CLASS-CELL"))
    23302336                 (args (make-symbol "ARGS"))
Note: See TracChangeset for help on using the changeset viewer.