3 ;;; Output scheduling protocol
5 ;;; (c) 2009 Straylight/Edgeware
8 ;;;----- Licensing notice ---------------------------------------------------
10 ;;; This file is part of the Sensble Object Design, an object system for C.
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 ;;;--------------------------------------------------------------------------
29 ;;; Sequencing machinery.
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'.
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))
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))
49 "A sequencer tracks items and invokes them in the proper order.
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.
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."))
62 (export 'ensure-sequencer-item)
63 (defgeneric ensure-sequencer-item (sequencer name)
65 "Arrange that SEQUENCER has a sequencer-item called NAME.
67 Returns the corresponding SEQUENCER-ITEM object."))
69 (export 'add-sequencer-constraint)
70 (defgeneric add-sequencer-constraint (sequencer constraint)
72 "Attach the given CONSTRAINT to an SEQUENCER.
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."))
79 (export 'add-sequencer-item-function)
80 (defgeneric add-sequencer-item-function (sequencer name function)
82 "Arranges to call FUNCTION when the item called NAME is traversed.
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.
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
92 (export 'invoke-sequencer-items)
93 (defgeneric invoke-sequencer-items (sequencer &rest arguments)
95 "Invoke functions attached to the SEQUENCER's items in the right order.
97 Each function is invoked in turn with the list of ARGUMENTS. The return
98 values of the functions are discarded."))
100 ;;;--------------------------------------------------------------------------
101 ;;; Output preparation.
103 (defgeneric hook-output (object reason sequencer)
105 "Announces the intention to write SEQUENCER, with a particular REASON.
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.")
114 (:method-combination progn)
115 (:method progn (object reason sequencer)))
117 ;;;--------------------------------------------------------------------------
120 (defmacro sequence-output
121 ((streamvar sequencer) &body clauses)
122 "Register output behaviour in a convenient manner.
124 The full syntax isn't quite as described:
126 sequence-output (STREAMVAR SEQUENCER)
127 { :constrant CONSTRAINT }*
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
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).
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."
146 (let ((seqvar (gensym "SEQ")))
147 (labels ((convert-item-name (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
157 ,(convert-constraint (cadr clauses)))
158 (process-body (cddr clauses)))
159 (mapcar (lambda (clause)
160 (let ((name (car clause))
162 `(add-sequencer-item-function
164 ,(convert-item-name name)
168 `(let ((,seqvar ,sequencer))
169 ,@(process-body clauses)))))
171 ;;;----- That's all, folks --------------------------------------------------