3 ;;; Method combinations
5 ;;; (c) 2009 Straylight/Edgeware
8 ;;;----- Licensing notice ---------------------------------------------------
10 ;;; This file is part of the Simple Object Definition system.
12 ;;; SOD is free software; you can redistribute it and/or modify
13 ;;; it under the terms of the GNU General Public License as published by
14 ;;; the Free Software Foundation; either version 2 of the License, or
15 ;;; (at your option) any later version.
17 ;;; SOD is distributed in the hope that it will be useful,
18 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;;; GNU General Public License for more details.
22 ;;; You should have received a copy of the GNU General Public License
23 ;;; along with SOD; if not, write to the Free Software Foundation,
24 ;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
28 ;;;--------------------------------------------------------------------------
31 (defclass simple-message (basic-message)
34 "Base class for messages with `simple' method combinations.
36 A simple method combination is one which has only one method role other
37 than the `before', `after' and `around' methods provided by BASIC-MESSAGE.
38 We call these `primary' methods, and the programmer designates them by not
39 specifying an explicit role.
41 If the programmer doesn't define any primary methods then the effective
42 method is null -- i.e., the method entry pointer shows up as a null
45 (defclass simple-effective-method (basic-effective-method)
46 ((primary-methods :initarg :primary-methods :initform nil
47 :type list :reader effective-method-primary-methods))
49 "Effective method counterpart to SIMPLE-MESSAGE."))
51 (defgeneric primary-method-class (message)
53 "Return the name of the primary direct method class for MESSAGE."))
55 (defgeneric simple-method-body (method codegen target)
57 "Generate the body of a simple effective method.
59 The function is invoked on an effective METHOD, with a CODEGEN to which it
60 should emit code delivering the method's value to TARGET."))
62 (defmethod sod-message-method-class
63 ((message standard-message) (class sod-class) pset)
64 (if (get-property pset :role :keyword nil)
66 (primary-method-class message)))
68 (defmethod shared-initialize :after
69 ((method simple-effective-method) slot-names &key direct-methods)
70 (declare (ignore slot-names))
71 (categorize (method direct-methods :bind ((role (sod-method-role method))))
72 ((primary (null role))
73 (before (eq role :before))
74 (after (eq role :after))
75 (around (eq role :around)))
76 (with-slots (primary-methods before-methods after-methods around-methods)
78 (setf primary-methods primary
80 after-methods (reverse after)
81 around-methods around))))
83 (defmethod compute-effective-method-entry-functions
84 ((method standard-effective-method))
85 (if (effective-method-primary-methods method)
89 (defmethod compute-effective-method-body
90 ((method simple-effective-method) codegen target)
91 (with-slots (message basic-argument-names primary-methods) method
92 (basic-effective-method-body codegen target method
94 (simple-method-body method
98 ;;;--------------------------------------------------------------------------
99 ;;; Standard method combination.
101 (defclass standard-message (simple-message)
104 "Message class for standard method combination.
106 Standard method combination is a simple method combination where the
107 primary methods are invoked as a delegation chain, from most- to
110 (defclass standard-effective-method (simple-effective-method)
113 "Effective method counterpart to STANDARD-MESSAGE."))
115 (defmethod primary-method-class ((message standard-message))
116 'delegating-direct-method)
118 (defmethod message-effective-method-class ((message standard-message))
119 'standard-effective-method)
121 (defmethod simple-method-body
122 ((method standard-effective-method) codegen target)
123 (invoke-delegation-chain codegen
125 (effective-method-basic-argument-names method)
126 (effective-method-primary-methods method)
129 ;;;----- That's all, folks --------------------------------------------------