Changeset 4342


Ignore:
Timestamp:
10/13/03 12:08:23 (18 years ago)
Author:
piso
Message:

COMPUTE-APPLICABLE-METHODS

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/j/src/org/armedbear/lisp/defclass.lisp

    r4337 r4342  
    22;;;
    33;;; Copyright (C) 2003 Peter Graves
    4 ;;; $Id: defclass.lisp,v 1.19 2003-10-12 19:14:23 piso Exp $
     4;;; $Id: defclass.lisp,v 1.20 2003-10-13 12:08:23 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    12401240                            (class-slots (class-of new))))))
    12411241    (apply #'shared-initialize new added-slots initargs)))
     1242
     1243;;;
     1244;;;  Methods having to do with class metaobjects.
     1245;;;
     1246
     1247(defmethod print-object ((class standard-class) stream)
     1248  (print-unreadable-object (class stream :identity t)
     1249                           (format stream "~:(~S~) ~S"
     1250                                   (class-name (class-of class))
     1251                                   (class-name class)))
     1252  class)
     1253
     1254(defmethod initialize-instance :after ((class standard-class) &rest args)
     1255  (apply #'std-after-initialization-for-classes class args))
     1256
     1257;;; Finalize inheritance
     1258
     1259(defgeneric finalize-inheritance (class))
     1260(defmethod finalize-inheritance ((class standard-class))
     1261  (std-finalize-inheritance class)
     1262  (values))
     1263
     1264;;; Class precedence lists
     1265
     1266(defgeneric compute-class-precedence-list (class))
     1267(defmethod compute-class-precedence-list ((class standard-class))
     1268  (std-compute-class-precedence-list class))
     1269
     1270;;; Slot inheritance
     1271
     1272(defgeneric compute-slots (class))
     1273(defmethod compute-slots ((class standard-class))
     1274  (std-compute-slots class))
     1275
     1276(defgeneric compute-effective-slot-definition (class direct-slots))
     1277(defmethod compute-effective-slot-definition
     1278  ((class standard-class) direct-slots)
     1279  (std-compute-effective-slot-definition class direct-slots))
     1280
     1281;;;
     1282;;; Methods having to do with generic function metaobjects.
     1283;;;
     1284
     1285(defmethod print-object ((gf standard-generic-function) stream)
     1286  (print-unreadable-object (gf stream :identity t)
     1287                           (format stream "~:(~S~) ~S"
     1288                                   (class-name (class-of gf))
     1289                                   (generic-function-name gf)))
     1290  gf)
     1291
     1292(defmethod initialize-instance :after ((gf standard-generic-function) &key)
     1293  (finalize-generic-function gf))
     1294
     1295;;;
     1296;;; Methods having to do with method metaobjects.
     1297;;;
     1298
     1299(defmethod print-object ((method standard-method) stream)
     1300  (print-unreadable-object (method stream :identity t)
     1301                           (format stream "~:(~S~) ~S~{ ~S~} ~S"
     1302                                   (class-name (class-of method))
     1303                                   (generic-function-name
     1304                                    (method-generic-function method))
     1305                                   (method-qualifiers method)
     1306                                   (mapcar #'class-name
     1307                                           (method-specializers method))))
     1308  method)
     1309
     1310(defmethod initialize-instance :after ((method standard-method) &key)
     1311  (setf (method-function method) (compute-method-function method)))
     1312
     1313;;;
     1314;;; Methods having to do with generic function invocation.
     1315;;;
     1316
     1317(defgeneric compute-discriminating-function (gf))
     1318(defmethod compute-discriminating-function ((gf standard-generic-function))
     1319  (std-compute-discriminating-function gf))
     1320
     1321(defgeneric method-more-specific-p (gf method1 method2 required-classes))
     1322(defmethod method-more-specific-p
     1323  ((gf standard-generic-function) method1 method2 required-classes)
     1324  (std-method-more-specific-p gf method1 method2 required-classes))
     1325
     1326(defgeneric compute-effective-method-function (gf methods))
     1327(defmethod compute-effective-method-function
     1328  ((gf standard-generic-function) methods)
     1329  (std-compute-effective-method-function gf methods))
     1330
     1331(defgeneric compute-method-function (method))
     1332(defmethod compute-method-function ((method standard-method))
     1333  (std-compute-method-function method))
     1334
     1335(defgeneric compute-applicable-methods (gf args))
     1336(defmethod compute-applicable-methods ((gf standard-generic-function) args)
     1337  (compute-applicable-methods-using-classes gf (mapcar #'class-of args)))
Note: See TracChangeset for help on using the changeset viewer.