chiark - git - mdw - 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 (export 'sequence-output)
 123 (defmacro sequence-output
 124     ((streamvar sequencer) &body clauses)
 125   "Register output behaviour in a convenient manner.
 126
 127    The full syntax isn't quite as described:
 128
 129         sequence-output (STREAMVAR SEQUENCER)
 130           { :constraint CONSTRAINT }*
 131           CLAUSE*
 132
 133         STREAMVAR ::= a symbol
 134         SEQUENCER ::= a sequencer object, evaluated
 135         CONSTRAINT ::= ( ITEM-NAME* )
 136         CLAUSE ::= (ITEM-NAME FORM*)
 137         ITEM-NAME ::= an atom or a list of expressions
 138
 139    An ITEM-NAME may be a self-evaluating atom (in which case it stands for
 140    itself, clearly), a symbol (in which case the corresponding variable value
 141    is used), or a list of forms (in which case the name used is the list of
 142    the corresponding values).
 143
 144    The behaviour is as follows.  The CONSTRAINTS, if any, are added to the
 145    sequencer.  Then, for each CLAUSE, a function is attached to the named
 146    sequencer item whose behaviour is to bind STREAMVAR to the output stream
 147    and evaluate the FORMs as a progn."
 148
 149   (let ((seqvar (gensym "SEQ")))
 150     (labels ((convert-item-name (name)
 151                (if (listp name)
 152                    (cons 'list name)
 153                    name))
 154              (convert-constraint (constraint)
 155                (cons 'list (mapcar #'convert-item-name constraint)))
 156              (process-body (clauses)
 157                (if (eq (car clauses) :constraint)
 158                    (cons `(add-sequencer-constraint
 159                            ,seqvar
 160                            ,(convert-constraint (cadr clauses)))
 161                          (process-body (cddr clauses)))
 162                    (mapcar (lambda (clause)
 163                              (let ((name (car clause))
 164                                    (body (cdr clause)))
 165                                `(add-sequencer-item-function
 166                                  ,seqvar
 167                                  ,(convert-item-name name)
 168                                  (lambda (,streamvar)
 169                                    ,@body))))
 170                            clauses))))
 171       `(let ((,seqvar ,sequencer))
 172          ,@(process-body clauses)))))
 173
 174 ;;;----- That's all, folks --------------------------------------------------