Commit | Line | Data |
---|---|---|
1f1d88f5 MW |
1 | ;;; -*-lisp-*- |
2 | ;;; | |
3 | ;;; Method combinations | |
4 | ;;; | |
5 | ;;; (c) 2009 Straylight/Edgeware | |
6 | ;;; | |
7 | ||
8 | ;;;----- Licensing notice --------------------------------------------------- | |
9 | ;;; | |
10 | ;;; This file is part of the Simple Object Definition system. | |
11 | ;;; | |
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. | |
16 | ;;; | |
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. | |
21 | ;;; | |
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. | |
25 | ||
26 | (cl:in-package #:sod) | |
27 | ||
28 | ;;;-------------------------------------------------------------------------- | |
29 | ;;; Common behaviour. | |
30 | ||
31 | (defclass simple-message (basic-message) | |
32 | () | |
33 | (:documentation | |
34 | "Base class for messages with `simple' method combinations. | |
35 | ||
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. | |
40 | ||
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 | |
43 | pointer.")) | |
44 | ||
45 | (defclass simple-effective-method (basic-effective-method) | |
77027cca MW |
46 | ((primary-methods :initarg :primary-methods :initform nil |
47 | :type list :reader effective-method-primary-methods)) | |
1f1d88f5 MW |
48 | (:documentation |
49 | "Effective method counterpart to SIMPLE-MESSAGE.")) | |
50 | ||
51 | (defgeneric primary-method-class (message) | |
52 | (:documentation | |
53 | "Return the name of the primary direct method class for MESSAGE.")) | |
54 | ||
55 | (defgeneric simple-method-body (method codegen target) | |
56 | (:documentation | |
57 | "Generate the body of a simple effective method. | |
58 | ||
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.")) | |
61 | ||
62 | (defmethod sod-message-method-class | |
63 | ((message standard-message) (class sod-class) pset) | |
64 | (if (get-property pset :role :keyword nil) | |
65 | (call-next-method) | |
66 | (primary-method-class message))) | |
67 | ||
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) | |
77 | method | |
78 | (setf primary-methods primary | |
79 | before-methods before | |
80 | after-methods (reverse after) | |
81 | around-methods around)))) | |
82 | ||
83 | (defmethod compute-effective-method-entry-functions | |
84 | ((method standard-effective-method)) | |
85 | (if (effective-method-primary-methods method) | |
86 | (call-next-method) | |
87 | nil)) | |
88 | ||
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 | |
93 | (lambda (target) | |
94 | (simple-method-body method | |
95 | codegen | |
96 | target))))) | |
97 | ||
98 | ;;;-------------------------------------------------------------------------- | |
99 | ;;; Standard method combination. | |
100 | ||
101 | (defclass standard-message (simple-message) | |
102 | () | |
103 | (:documentation | |
104 | "Message class for standard method combination. | |
105 | ||
106 | Standard method combination is a simple method combination where the | |
107 | primary methods are invoked as a delegation chain, from most- to | |
108 | least-specific.")) | |
109 | ||
110 | (defclass standard-effective-method (simple-effective-method) | |
111 | () | |
112 | (:documentation | |
113 | "Effective method counterpart to STANDARD-MESSAGE.")) | |
114 | ||
115 | (defmethod primary-method-class ((message standard-message)) | |
116 | 'delegating-direct-method) | |
117 | ||
118 | (defmethod message-effective-method-class ((message standard-message)) | |
119 | 'standard-effective-method) | |
120 | ||
121 | (defmethod simple-method-body | |
122 | ((method standard-effective-method) codegen target) | |
123 | (invoke-delegation-chain codegen | |
124 | target | |
125 | (effective-method-basic-argument-names method) | |
126 | (effective-method-primary-methods method) | |
127 | nil)) | |
128 | ||
129 | ;;;----- That's all, folks -------------------------------------------------- |