Ignore:
Timestamp:
Oct 2, 2008, 6:43:48 PM (12 years ago)
Author:
gz
Message:

Propagate r10938:r10941 (duplicate definition warnings) to trunk

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/level-1/l1-clos-boot.lisp

    r10937 r10942  
    175175
    176176
    177 (defun %slot-definition-class (slotd)
    178   (standard-slot-definition.class slotd))
    179 
    180177(defun %slot-definition-location (slotd)
    181178  (standard-effective-slot-definition.location slotd))
     
    279276
    280277;;; This becomes (apply #'make-instance <method-class> &rest args).
    281 (defun %make-method-instance (class &key
    282                                     qualifiers
    283                                     specializers
    284                                     function                               
    285                                     name
    286                                     lambda-list
    287                                     &allow-other-keys)
    288   (let* ((method
    289           (%instance-vector (%class-own-wrapper class)
    290                             qualifiers
    291                             specializers
    292                             function
    293                             nil
    294                             name
    295                             lambda-list)))
    296     (when function
    297       (let* ((inner (closure-function function)))
    298         (unless (eq inner function)
    299           (copy-method-function-bits inner function)))
    300       (lfun-name function method))
    301     method))
     278(fset '%make-method-instance
     279      (nlambda bootstrapping-%make-method-instance (class &key
     280                                                          qualifiers
     281                                                          specializers
     282                                                          function
     283                                                          name
     284                                                          lambda-list
     285                                                          &allow-other-keys)
     286        (let* ((method
     287                (%instance-vector (%class-own-wrapper class)
     288                                  qualifiers
     289                                  specializers
     290                                  function
     291                                  nil
     292                                  name
     293                                  lambda-list)))
     294          (when function
     295            (let* ((inner (closure-function function)))
     296              (unless (eq inner function)
     297                (copy-method-function-bits inner function)))
     298            (lfun-name function method))
     299          method)))
    302300 
    303301       
     
    872870
    873871;; Redefined in l1-clos.lisp
    874 (defun maybe-remove-make-instance-optimization (gfn method)
    875   (declare (ignore gfn method))
    876   nil)
     872(fset 'maybe-remove-make-instance-optimization
     873      (nlambda bootstrapping-maybe-remove-make-instance-optimization (gfn method)
     874        (declare (ignore gfn method))
     875        nil))
    877876
    878877(defun %add-standard-method-to-standard-gf (gfn method)
     
    13281327
    13291328
    1330 (defun set-find-class (name class)
    1331   (clear-type-cache)
    1332   (let* ((cell (find-class-cell name t))
    1333          (old-class (class-cell-class cell)))
    1334     (when class
    1335       (if (eq name (%class.name class))
    1336         (setf (info-type-kind name) :instance)))
    1337     (setf (class-cell-class cell) class)
    1338     (update-class-proper-names name old-class class)
    1339     class))
     1329(fset 'set-find-class (nfunction bootstrapping-set-find-class ; redefined below
     1330                                 (lambda (name class)
     1331                                   (clear-type-cache)
     1332                                   (let* ((cell (find-class-cell name t))
     1333                                          (old-class (class-cell-class cell)))
     1334                                     (when class
     1335                                       (if (eq name (%class.name class))
     1336                                         (setf (info-type-kind name) :instance)))
     1337                                     (setf (class-cell-class cell) class)
     1338                                     (update-class-proper-names name old-class class)
     1339                                     class))))
    13401340
    13411341
    13421342;;; bootstrapping definition. real one is in "sysutils.lisp"
    1343 
    1344 (defun built-in-type-p (name)
    1345   (or (type-predicate name)
    1346       (memq name '(signed-byte unsigned-byte mod
    1347                    values satisfies member and or not))
    1348       (typep (find-class name nil) 'built-in-class)))
     1343(fset 'built-in-type-p (nfunction boostrapping-built-in-typep-p
     1344                                  (lambda (name)
     1345                                    (or (type-predicate name)
     1346                                        (memq name '(signed-byte unsigned-byte mod
     1347                                                     values satisfies member and or not))
     1348                                        (typep (find-class name nil) 'built-in-class)))))
    13491349
    13501350
     
    25192519;;; Bootstrapping version of union
    25202520(unless (fboundp 'union)
    2521 (defun union (l1 l2)
    2522   (dolist (e l1)
    2523     (unless (memq e l2)
    2524       (push e l2)))
    2525   l2)
     2521  (fset 'union (nlambda bootstrapping-union (l1 l2)
     2522                 (dolist (e l1)
     2523                   (unless (memq e l2)
     2524                     (push e l2)))
     2525                 l2))
    25262526)
    25272527
Note: See TracChangeset for help on using the changeset viewer.