| 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 Sensible 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 :initform nil :type list :accessor sequencer-constraints) |
| 45 | (table :initform (make-hash-table :test #'equal) |
| 46 | :reader sequencer-table)) |
| 47 | (:documentation |
| 48 | "A sequencer tracks items and invokes them in the proper order. |
| 49 | |
| 50 | The job of a `sequencer' object is threefold. Firstly, it collects |
| 51 | sequencer items and stores them in its table indexed by name. Secondly, |
| 52 | it gathers CONSTRAINTS, which impose an ordering on the items. Thirdly, |
| 53 | it can be instructed to invoke the items in an order compatible with the |
| 54 | established constraints.")) |
| 55 | |
| 56 | (export 'ensure-sequencer-item) |
| 57 | (defgeneric ensure-sequencer-item (sequencer name) |
| 58 | (:documentation |
| 59 | "Arrange that SEQUENCER has a sequencer-item called NAME. |
| 60 | |
| 61 | Returns the corresponding SEQUENCER-ITEM object. |
| 62 | |
| 63 | Sequencer item names may may any kind of object which can be compared with |
| 64 | EQUAL. In particular, symbols, integers and strings are reasonable |
| 65 | choices for atomic names, and lists work well for compound names -- so |
| 66 | it's possible to construct a hierarchy.")) |
| 67 | |
| 68 | (export 'add-sequencer-constraint) |
| 69 | (defgeneric add-sequencer-constraint (sequencer constraint) |
| 70 | (:documentation |
| 71 | "Attach the given CONSTRAINT to an SEQUENCER. |
| 72 | |
| 73 | The CONSTRAINT should be a list of sequencer-item names; see |
| 74 | `ensure-sequencer-item' for what they look like. Note that the names |
| 75 | needn't have been declared in advance; indeed, they needn't be mentioned |
| 76 | anywhere else at all.")) |
| 77 | |
| 78 | (export 'add-sequencer-item-function) |
| 79 | (defgeneric add-sequencer-item-function (sequencer name function) |
| 80 | (:documentation |
| 81 | "Arranges to call FUNCTION when the item called NAME is traversed. |
| 82 | |
| 83 | More than one function can be associated with a given sequencer item. |
| 84 | They are called in the same order in which they were added. |
| 85 | |
| 86 | Note that an item must be mentioned in at least one constraint in order to |
| 87 | be traversed by `invoke-sequencer-items'. If there are no special |
| 88 | ordering requirments for a particular item, then the trivial |
| 89 | constraint (NAME) will suffice.")) |
| 90 | |
| 91 | (export 'invoke-sequencer-items) |
| 92 | (defgeneric invoke-sequencer-items (sequencer &rest arguments) |
| 93 | (:documentation |
| 94 | "Invoke functions attached to the SEQUENCER's items in the right order. |
| 95 | |
| 96 | Each function is invoked in turn with the list of ARGUMENTS. The return |
| 97 | values of the functions are discarded.")) |
| 98 | |
| 99 | ;;;-------------------------------------------------------------------------- |
| 100 | ;;; Output preparation. |
| 101 | |
| 102 | (export 'hook-output) |
| 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 a `sequencer' instance; the REASON will be a symbol which |
| 108 | can be matched using an `eql'-specializer. In response, OBJECT should add |
| 109 | any constraints 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 | (declare (ignore object reason sequencer)))) |
| 117 | |
| 118 | ;;;-------------------------------------------------------------------------- |
| 119 | ;;; Useful syntax. |
| 120 | |
| 121 | (export 'sequence-output) |
| 122 | (defmacro sequence-output |
| 123 | ((streamvar sequencer) &body clauses) |
| 124 | "Register output behaviour in a convenient manner. |
| 125 | |
| 126 | The full syntax isn't quite as described: |
| 127 | |
| 128 | sequence-output (STREAMVAR SEQUENCER) |
| 129 | { :constraint CONSTRAINT }* |
| 130 | CLAUSE* |
| 131 | |
| 132 | STREAMVAR ::= a symbol |
| 133 | SEQUENCER ::= a sequencer object, evaluated |
| 134 | CONSTRAINT ::= ( ITEM-NAME* ) |
| 135 | CLAUSE ::= (ITEM-NAME FORM*) |
| 136 | ITEM-NAME ::= an atom or a list of expressions |
| 137 | |
| 138 | An ITEM-NAME may be a self-evaluating atom (in which case it stands for |
| 139 | itself, clearly), a symbol (in which case the corresponding variable value |
| 140 | is used), or a list of forms (in which case the name used is the list of |
| 141 | the corresponding values). |
| 142 | |
| 143 | The behaviour is as follows. The CONSTRAINTS, if any, are added to the |
| 144 | sequencer. Then, for each CLAUSE, a function is attached to the named |
| 145 | sequencer item whose behaviour is to bind STREAMVAR to the output stream |
| 146 | and evaluate the FORMs as a progn." |
| 147 | |
| 148 | (let ((seqvar (gensym "SEQ"))) |
| 149 | (labels ((convert-item-name (name) |
| 150 | (if (listp name) |
| 151 | (cons 'list name) |
| 152 | name)) |
| 153 | (convert-constraint (constraint) |
| 154 | (cons 'list (mapcar #'convert-item-name constraint))) |
| 155 | (process-body (clauses) |
| 156 | (if (eq (car clauses) :constraint) |
| 157 | (cons `(add-sequencer-constraint |
| 158 | ,seqvar |
| 159 | ,(convert-constraint (cadr clauses))) |
| 160 | (process-body (cddr clauses))) |
| 161 | (mapcar (lambda (clause) |
| 162 | (let ((name (car clause)) |
| 163 | (body (cdr clause))) |
| 164 | `(add-sequencer-item-function |
| 165 | ,seqvar |
| 166 | ,(convert-item-name name) |
| 167 | (lambda (,streamvar) |
| 168 | ,@body)))) |
| 169 | clauses)))) |
| 170 | `(let ((,seqvar ,sequencer)) |
| 171 | ,@(process-body clauses))))) |
| 172 | |
| 173 | ;;;----- That's all, folks -------------------------------------------------- |