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