Commit | Line | Data |
---|---|---|
dea4d055 MW |
1 | ;;; -*-lisp-*- |
2 | ;;; | |
3 | ;;; Output scheduling protocol | |
4 | ;;; | |
5 | ;;; (c) 2009 Straylight/Edgeware | |
6 | ;;; | |
7 | ||
8 | ;;;----- Licensing notice --------------------------------------------------- | |
9 | ;;; | |
10 | ;;; This file is part of the Sensble Object Design, an object system for C. | |
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 | ;;; Sequencing machinery. | |
30 | ||
31 | (export '(sequencer-item make-sequencer-item sequencer-item-p | |
32 | sequencer-item-name sequencer-item-functions)) | |
33 | (defstruct (sequencer-item | |
34 | (:constructor make-sequencer-item (name &optional functions))) | |
35 | "Represents a distinct item to be sequenced by a `sequencer'. | |
36 | ||
37 | A `sequencer-item' maintains a list of FUNCTIONS which are invoked when | |
38 | the sequencer is invoked." | |
39 | (name nil :read-only t) | |
40 | (functions nil :type list)) | |
41 | ||
42 | (export '(sequencer sequencer-constraints sequencer-table)) | |
43 | (defclass sequencer () | |
44 | ((constraints :initarg :constraints :initform nil | |
45 | :type list :accessor sequencer-constraints) | |
46 | (table :initform (make-hash-table :test #'equal) | |
47 | :reader sequencer-table)) | |
48 | (:documentation | |
49 | "A sequencer tracks items and invokes them in the proper order. | |
50 | ||
51 | The job of a SEQUENCER object is threefold. Firstly, it collects | |
52 | sequencer items and stores them in its table indexed by name. Secondly, | |
53 | it gathers CONSTRAINTS, which impose an ordering on the items. Thirdly, | |
54 | it can be instructed to invoke the items in an order compatible with the | |
55 | established constraints. | |
56 | ||
57 | Sequencer item names may may any kind of object which can be compared with | |
58 | EQUAL. In particular, symbols, integers and strings are reasonable | |
59 | choices for atomic names, and lists work well for compound names -- so | |
60 | it's possible to construct a hierarchy.")) | |
61 | ||
62 | (export 'ensure-sequencer-item) | |
63 | (defgeneric ensure-sequencer-item (sequencer name) | |
64 | (:documentation | |
65 | "Arrange that SEQUENCER has a sequencer-item called NAME. | |
66 | ||
67 | Returns the corresponding SEQUENCER-ITEM object.")) | |
68 | ||
69 | (export 'add-sequencer-constraint) | |
70 | (defgeneric add-sequencer-constraint (sequencer constraint) | |
71 | (:documentation | |
72 | "Attach the given CONSTRAINT to an SEQUENCER. | |
73 | ||
74 | The CONSTRAINT should be a list of sequencer-item names; see | |
75 | ENSURE-SEQUENCER-ITEM for what they look like. Note that the names | |
76 | needn't have been declared in advance; indeed, they needn't be mentioned | |
77 | anywhere else at all.")) | |
78 | ||
79 | (export 'add-sequencer-item-function) | |
80 | (defgeneric add-sequencer-item-function (sequencer name function) | |
81 | (:documentation | |
82 | "Arranges to call FUNCTION when the item called NAME is traversed. | |
83 | ||
84 | More than one function can be associated with a given sequencer item. | |
85 | They are called in the same order in which they were added. | |
86 | ||
87 | Note that an item must be mentioned in at least one constraint in order to | |
88 | be traversed by INVOKE-SEQUENCER-ITEMS. If there are no special ordering | |
89 | requirments for a particular item, then the trivial constraint (NAME) will | |
90 | suffice.")) | |
91 | ||
92 | (export 'invoke-sequencer-items) | |
93 | (defgeneric invoke-sequencer-items (sequencer &rest arguments) | |
94 | (:documentation | |
95 | "Invoke functions attached to the SEQUENCER's items in the right order. | |
96 | ||
97 | Each function is invoked in turn with the list of ARGUMENTS. The return | |
98 | values of the functions are discarded.")) | |
99 | ||
100 | ;;;-------------------------------------------------------------------------- | |
101 | ;;; Output preparation. | |
102 | ||
103 | (defgeneric hook-output (object reason sequencer) | |
104 | (:documentation | |
105 | "Announces the intention to write SEQUENCER, with a particular REASON. | |
106 | ||
107 | The SEQUENCER is an SEQUENCER instance; the REASON will be a symbol which | |
108 | can be matched using an EQL-specializer. In response, OBJECT should add | |
109 | any constrains and item functions that it wishes, and pass the | |
110 | announcement to its sub-objects. It is not uncommon for an object to pass | |
111 | a reason to its sub-objects that is different from the REASON with which | |
112 | it was itself invoked.") | |
113 | ||
114 | (:method-combination progn) | |
115 | (:method progn (object reason sequencer))) | |
116 | ||
117 | ;;;-------------------------------------------------------------------------- | |
118 | ;;; Useful syntax. | |
119 | ||
120 | (defmacro sequence-output | |
121 | ((streamvar sequencer) &body clauses) | |
122 | "Register output behaviour in a convenient manner. | |
123 | ||
124 | The full syntax isn't quite as described: | |
125 | ||
126 | sequence-output (STREAMVAR SEQUENCER) | |
127 | { :constrant CONSTRAINT }* | |
128 | CLAUSE* | |
129 | ||
130 | STREAMVAR ::= a symbol | |
131 | SEQUENCER ::= a sequencer object, evaluated | |
132 | CONSTRAINT ::= ( ITEM-NAME* ) | |
133 | CLAUSE ::= (ITEM-NAME FORM*) | |
134 | ITEM-NAME ::= an atom or a list of expressions | |
135 | ||
136 | An ITEM-NAME may be a self-evaluating atom (in which case it stands for | |
137 | itself, clearly), a symbol (in which case the corresponding variable value | |
138 | is used) or a list of forms (in which case the name used is the list of | |
139 | the corresponding values). | |
140 | ||
141 | The behaviour is as follows. The CONSTRAINTS, if any, are added to the | |
142 | sequencer. Then, for each CLAUSE, a function is attached to the named | |
143 | sequencer item whose behaviour is to bind STREAMVAR to the output stream | |
144 | and evaluate the FORMs as a progn." | |
145 | ||
146 | (let ((seqvar (gensym "SEQ"))) | |
147 | (labels ((convert-item-name (name) | |
148 | (if (listp name) | |
149 | (cons 'list name) | |
150 | name)) | |
151 | (convert-constraint (constraint) | |
152 | (cons 'list (mapcar #'convert-item-name constraint))) | |
153 | (process-body (clauses) | |
154 | (if (eq (car clauses) :constraint) | |
155 | (cons `(add-sequencer-constraint | |
156 | ,seqvar | |
157 | ,(convert-constraint (cadr clauses))) | |
158 | (process-body (cddr clauses))) | |
159 | (mapcar (lambda (clause) | |
160 | (let ((name (car clause)) | |
161 | (body (cdr clause))) | |
162 | `(add-sequencer-item-function | |
163 | ,seqvar | |
164 | ,(convert-item-name name) | |
165 | (lambda (,streamvar) | |
166 | ,@body)))) | |
167 | clauses)))) | |
168 | `(let ((,seqvar ,sequencer)) | |
169 | ,@(process-body clauses))))) | |
170 | ||
171 | ;;;----- That's all, folks -------------------------------------------------- |