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-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 --------------------------------------------------