mdw@git.distorted.org.uk Git - sod/blob - src/output-proto.lisp

   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 (export 'ensure-sequencer-item)
  58 (defgeneric ensure-sequencer-item (sequencer name)
  59   (:documentation
  60    "Arrange that SEQUENCER has a sequencer-item called NAME.
  61
  62    Returns the corresponding SEQUENCER-ITEM object.
  63
  64    Sequencer item names may may any kind of object which can be compared with
  65    EQUAL.  In particular, symbols, integers and strings are reasonable
  66    choices for atomic names, and lists work well for compound names -- so
  67    it's possible to construct a hierarchy."))
  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
  89    ordering requirments for a particular item, then the trivial
  90    constraint (NAME) will 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 (export 'hook-output)
 104 (defgeneric hook-output (object reason sequencer)
 105   (:documentation
 106    "Announces the intention to write SEQUENCER, with a particular REASON.
 107
 108    The SEQUENCER is a `sequencer' instance; the REASON will be a symbol which
 109    can be matched using an `eql'-specializer.  In response, OBJECT should add
 110    any constraints and item functions that it wishes, and pass the
 111    announcement to its sub-objects.  It is not uncommon for an object to pass
 112    a reason to its sub-objects that is different from the REASON with which
 113    it was itself invoked.")
 114
 115   (:method-combination progn)
 116   (:method progn (object reason sequencer)
 117            (declare (ignore object reason sequencer))))
 118
 119 ;;;--------------------------------------------------------------------------
 120 ;;; Useful syntax.
 121
 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 --------------------------------------------------