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
49 :reader effective-method-primary-methods))
51 "Effective method counterpart to SIMPLE-MESSAGE."))
53 (defgeneric primary-method-class (message)
55 "Return the name of the primary direct method class for MESSAGE."))
57 (defgeneric simple-method-body (method codegen target)
59 "Generate the body of a simple effective method.
61 The function is invoked on an effective METHOD, with a CODEGEN to which it
62 should emit code delivering the method's value to TARGET."))
64 (defmethod sod-message-method-class
65 ((message standard-message) (class sod-class) pset)
66 (if (get-property pset :role :keyword nil)
68 (primary-method-class message)))
70 (defmethod shared-initialize :after
71 ((method simple-effective-method) slot-names &key direct-methods)
72 (declare (ignore slot-names))
73 (categorize (method direct-methods :bind ((role (sod-method-role method))))
74 ((primary (null role))
75 (before (eq role :before))
76 (after (eq role :after))
77 (around (eq role :around)))
78 (with-slots (primary-methods before-methods after-methods around-methods)
80 (setf primary-methods primary
82 after-methods (reverse after)
83 around-methods around))))
85 (defmethod compute-effective-method-entry-functions
86 ((method standard-effective-method))
87 (if (effective-method-primary-methods method)
91 (defmethod compute-effective-method-body
92 ((method simple-effective-method) codegen target)
93 (with-slots (message basic-argument-names primary-methods) method
94 (basic-effective-method-body codegen target method
96 (simple-method-body method
100 ;;;--------------------------------------------------------------------------
101 ;;; Standard method combination.
103 (defclass standard-message (simple-message)
106 "Message class for standard method combination.
108 Standard method combination is a simple method combination where the
109 primary methods are invoked as a delegation chain, from most- to
112 (defclass standard-effective-method (simple-effective-method)
115 "Effective method counterpart to STANDARD-MESSAGE."))
117 (defmethod primary-method-class ((message standard-message))
118 'delegating-direct-method)
120 (defmethod message-effective-method-class ((message standard-message))
121 'standard-effective-method)
123 (defmethod simple-method-body
124 ((method standard-effective-method) codegen target)
125 (invoke-delegation-chain codegen
127 (effective-method-basic-argument-names method)
128 (effective-method-primary-methods method)
131 ;;;----- That's all, folks --------------------------------------------------