--- /dev/null
+;;; -*-lisp-*-
+;;;
+;;; Output scheduling protocol
+;;;
+;;; (c) 2009 Straylight/Edgeware
+;;;
+
+;;;----- Licensing notice ---------------------------------------------------
+;;;
+;;; This file is part of the Sensble Object Design, an object system for C.
+;;;
+;;; SOD is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; SOD is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with SOD; if not, write to the Free Software Foundation,
+;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+(cl:in-package #:sod)
+
+;;;--------------------------------------------------------------------------
+;;; Sequencing machinery.
+
+(export '(sequencer-item make-sequencer-item sequencer-item-p
+ sequencer-item-name sequencer-item-functions))
+(defstruct (sequencer-item
+ (:constructor make-sequencer-item (name &optional functions)))
+ "Represents a distinct item to be sequenced by a `sequencer'.
+
+ A `sequencer-item' maintains a list of FUNCTIONS which are invoked when
+ the sequencer is invoked."
+ (name nil :read-only t)
+ (functions nil :type list))
+
+(export '(sequencer sequencer-constraints sequencer-table))
+(defclass sequencer ()
+ ((constraints :initarg :constraints :initform nil
+ :type list :accessor sequencer-constraints)
+ (table :initform (make-hash-table :test #'equal)
+ :reader sequencer-table))
+ (:documentation
+ "A sequencer tracks items and invokes them in the proper order.
+
+ The job of a SEQUENCER object is threefold. Firstly, it collects
+ sequencer items and stores them in its table indexed by name. Secondly,
+ it gathers CONSTRAINTS, which impose an ordering on the items. Thirdly,
+ it can be instructed to invoke the items in an order compatible with the
+ established constraints."))
+
+(export 'ensure-sequencer-item)
+(defgeneric ensure-sequencer-item (sequencer name)
+ (:documentation
+ "Arrange that SEQUENCER has a sequencer-item called NAME.
+
+ Returns the corresponding SEQUENCER-ITEM object.
+
+ Sequencer item names may may any kind of object which can be compared with
+ EQUAL. In particular, symbols, integers and strings are reasonable
+ choices for atomic names, and lists work well for compound names -- so
+ it's possible to construct a hierarchy."))
+
+(export 'add-sequencer-constraint)
+(defgeneric add-sequencer-constraint (sequencer constraint)
+ (:documentation
+ "Attach the given CONSTRAINT to an SEQUENCER.
+
+ The CONSTRAINT should be a list of sequencer-item names; see
+ ENSURE-SEQUENCER-ITEM for what they look like. Note that the names
+ needn't have been declared in advance; indeed, they needn't be mentioned
+ anywhere else at all."))
+
+(export 'add-sequencer-item-function)
+(defgeneric add-sequencer-item-function (sequencer name function)
+ (:documentation
+ "Arranges to call FUNCTION when the item called NAME is traversed.
+
+ More than one function can be associated with a given sequencer item.
+ They are called in the same order in which they were added.
+
+ Note that an item must be mentioned in at least one constraint in order to
+ be traversed by INVOKE-SEQUENCER-ITEMS. If there are no special ordering
+ requirments for a particular item, then the trivial constraint (NAME) will
+ suffice."))
+
+(export 'invoke-sequencer-items)
+(defgeneric invoke-sequencer-items (sequencer &rest arguments)
+ (:documentation
+ "Invoke functions attached to the SEQUENCER's items in the right order.
+
+ Each function is invoked in turn with the list of ARGUMENTS. The return
+ values of the functions are discarded."))
+
+;;;--------------------------------------------------------------------------
+;;; Output preparation.
+
+(defgeneric hook-output (object reason sequencer)
+ (:documentation
+ "Announces the intention to write SEQUENCER, with a particular REASON.
+
+ The SEQUENCER is an SEQUENCER instance; the REASON will be a symbol which
+ can be matched using an EQL-specializer. In response, OBJECT should add
+ any constraints and item functions that it wishes, and pass the
+ announcement to its sub-objects. It is not uncommon for an object to pass
+ a reason to its sub-objects that is different from the REASON with which
+ it was itself invoked.")
+
+ (:method-combination progn)
+ (:method progn (object reason sequencer)))
+
+;;;--------------------------------------------------------------------------
+;;; Useful syntax.
+
+(defmacro sequence-output
+ ((streamvar sequencer) &body clauses)
+ "Register output behaviour in a convenient manner.
+
+ The full syntax isn't quite as described:
+
+ sequence-output (STREAMVAR SEQUENCER)
+ { :constraint CONSTRAINT }*
+ CLAUSE*
+
+ STREAMVAR ::= a symbol
+ SEQUENCER ::= a sequencer object, evaluated
+ CONSTRAINT ::= ( ITEM-NAME* )
+ CLAUSE ::= (ITEM-NAME FORM*)
+ ITEM-NAME ::= an atom or a list of expressions
+
+ An ITEM-NAME may be a self-evaluating atom (in which case it stands for
+ itself, clearly), a symbol (in which case the corresponding variable value
+ is used), or a list of forms (in which case the name used is the list of
+ the corresponding values).
+
+ The behaviour is as follows. The CONSTRAINTS, if any, are added to the
+ sequencer. Then, for each CLAUSE, a function is attached to the named
+ sequencer item whose behaviour is to bind STREAMVAR to the output stream
+ and evaluate the FORMs as a progn."
+
+ (let ((seqvar (gensym "SEQ")))
+ (labels ((convert-item-name (name)
+ (if (listp name)
+ (cons 'list name)
+ name))
+ (convert-constraint (constraint)
+ (cons 'list (mapcar #'convert-item-name constraint)))
+ (process-body (clauses)
+ (if (eq (car clauses) :constraint)
+ (cons `(add-sequencer-constraint
+ ,seqvar
+ ,(convert-constraint (cadr clauses)))
+ (process-body (cddr clauses)))
+ (mapcar (lambda (clause)
+ (let ((name (car clause))
+ (body (cdr clause)))
+ `(add-sequencer-item-function
+ ,seqvar
+ ,(convert-item-name name)
+ (lambda (,streamvar)
+ ,@body))))
+ clauses))))
+ `(let ((,seqvar ,sequencer))
+ ,@(process-body clauses)))))
+
+;;;----- That's all, folks --------------------------------------------------
~mdw / sod / blobdiff