Changeset 12665
- Timestamp:
- 05/10/10 21:13:26 (13 years ago)
- File:
-
- 1 edited
-
trunk/abcl/src/org/armedbear/lisp/clos.lisp (modified) (16 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/abcl/src/org/armedbear/lisp/clos.lisp
r12586 r12665 54 54 (export '(class-precedence-list class-slots)) 55 55 (defconstant +the-standard-class+ (find-class 'standard-class)) 56 (defconstant +the-standard-object-class+ (find-class 'standard-object)) 57 (defconstant +the-standard-method-class+ (find-class 'standard-method)) 58 (defconstant +the-standard-reader-method-class+ 59 (find-class 'standard-reader-method)) 60 (defconstant +the-standard-generic-function-class+ 61 (find-class 'standard-generic-function)) 62 (defconstant +the-T-class+ (find-class 'T)) 56 63 57 64 ;; Don't use DEFVAR, because that disallows loading clos.lisp … … 557 564 &allow-other-keys) 558 565 (let ((supers (or direct-superclasses 559 (list (find-class 'standard-object)))))566 (list +the-standard-object-class+)))) 560 567 (setf (class-direct-superclasses class) supers) 561 568 (dolist (superclass supers) … … 580 587 (getf canonical-slot :name)) 581 588 582 (defvar *extensible-built-in-classes* (list (find-class 'sequence) (find-class 'java:java-object))) 589 (defvar *extensible-built-in-classes* 590 (list (find-class 'sequence) 591 (find-class 'java:java-object))) 583 592 584 593 (defun ensure-class (name &rest all-keys &key metaclass &allow-other-keys) … … 741 750 (set-generic-function-classes-to-emf-table gf new-value)) 742 751 743 (defvar the-class-standard-method (find-class 'standard-method))744 745 752 (defun (setf method-lambda-list) (new-value method) 746 753 (set-method-lambda-list method new-value)) … … 851 858 &key 852 859 lambda-list 853 (generic-function-class (find-class 'standard-generic-function))854 (method-class the-class-standard-method)860 (generic-function-class +the-standard-generic-function-class+) 861 (method-class +the-standard-method-class+) 855 862 (method-combination 'standard) 856 863 (argument-precedence-order nil apo-p) … … 886 893 :format-control "~A already names an ordinary function, macro, or special operator." 887 894 :format-arguments (list function-name))) 888 (setf gf (apply (if (eq generic-function-class (find-class 'standard-generic-function))895 (setf gf (apply (if (eq generic-function-class +the-standard-generic-function-class+) 889 896 #'make-instance-standard-generic-function 890 897 #'make-instance) … … 899 906 (set-funcallable-instance-function 900 907 gf 901 (funcall (if (eq (class-of gf) (find-class 'standard-generic-function))908 (funcall (if (eq (class-of gf) +the-standard-generic-function-class+) 902 909 #'std-compute-discriminating-function 903 910 #'compute-discriminating-function) … … 934 941 documentation) 935 942 (declare (ignore generic-function-class)) 936 (let ((gf (std-allocate-instance (find-class 'standard-generic-function))))943 (let ((gf (std-allocate-instance +the-standard-generic-function-class+))) 937 944 (%set-generic-function-name gf name) 938 945 (setf (generic-function-lambda-list gf) lambda-list) … … 1163 1170 (setf gf (ensure-generic-function name :lambda-list method-lambda-list))) 1164 1171 (let ((method 1165 (if (eq (generic-function-method-class gf) the-class-standard-method)1172 (if (eq (generic-function-method-class gf) +the-standard-method-class+) 1166 1173 (apply #'make-instance-standard-method gf all-keys) 1167 1174 (apply #'make-instance (generic-function-method-class gf) all-keys)))) … … 1178 1185 fast-function) 1179 1186 (declare (ignore gf)) 1180 (let ((method (std-allocate-instance the-class-standard-method)))1187 (let ((method (std-allocate-instance +the-standard-method-class+))) 1181 1188 (setf (method-lambda-list method) lambda-list) 1182 1189 (setf (method-qualifiers method) qualifiers) … … 1367 1374 methods 1368 1375 (sort methods 1369 (if (eq (class-of gf) (find-class 'standard-generic-function))1376 (if (eq (class-of gf) +the-standard-generic-function-class+) 1370 1377 #'(lambda (m1 m2) 1371 1378 (std-method-more-specific-p m1 m2 required-classes … … 1420 1427 (let ((applicable-methods (%compute-applicable-methods gf args))) 1421 1428 (if applicable-methods 1422 (let ((emfun (funcall (if (eq (class-of gf) (find-class 'standard-generic-function))1429 (let ((emfun (funcall (if (eq (class-of gf) +the-standard-generic-function-class+) 1423 1430 #'std-compute-effective-method-function 1424 1431 #'compute-effective-method-function) … … 1431 1438 (let ((applicable-methods (%compute-applicable-methods gf (list arg)))) 1432 1439 (if applicable-methods 1433 (let ((emfun (funcall (if (eq (class-of gf) (find-class 'standard-generic-function))1440 (let ((emfun (funcall (if (eq (class-of gf) +the-standard-generic-function-class+) 1434 1441 #'std-compute-effective-method-function 1435 1442 #'compute-effective-method-function) … … 1517 1524 (let ((next-emfun 1518 1525 (funcall 1519 (if (eq (class-of gf) (find-class 'standard-generic-function))1526 (if (eq (class-of gf) +the-standard-generic-function-class+) 1520 1527 #'std-compute-effective-method-function 1521 1528 #'compute-effective-method-function) … … 1767 1774 slot-name) 1768 1775 (declare (ignore gf)) 1769 (let ((method (std-allocate-instance (find-class 'standard-reader-method))))1776 (let ((method (std-allocate-instance +the-standard-reader-method-class+))) 1770 1777 (setf (method-lambda-list method) lambda-list) 1771 1778 (setf (method-qualifiers method) qualifiers) … … 1818 1825 :lambda-list '(new-value object) 1819 1826 :qualifiers () 1820 :specializers (list (find-class 't)class)1827 :specializers (list +the-T-class+ class) 1821 1828 ;; :function `(function ,method-function) 1822 1829 :function (if (autoloadp 'compile)
Note: See TracChangeset
for help on using the changeset viewer.
