src/output-{proto,impl}.lisp: `sequencer''s :constraints initarg takes names.

The `constraints' slot of a `sequencer' object maintains a list of
constraints, each of which is a list of `sequencer-item' objects, and
this list is ordered with the most-recently added constraint first.

Previously the :constraints initarg just set this list directly, which
isn't really very satisfactory.  Instead, handle the initarg specially,
reversing it, and converting item names into the actual items, interning
them properly.

This isn't completely right, because there's no way at this time to
attach handler functions to the implicitly created items, but it's way
better than nothing.

diff --git a/src/output-impl.lisp b/src/output-impl.lisp
index df42115b25aeac1801dfc450c34b867b52b54c9e..7c3f43659564f269af140555eb0696c4e6fe3812 100644 (file)
--- a/src/output-impl.lisp
+++ b/src/output-impl.lisp
@@ -32,6 +32,18 @@ (defmethod print-object ((item sequencer-item) stream)
   (print-unreadable-object (item stream :type t)
     (prin1 (sequencer-item-name item) stream)))
 
   (print-unreadable-object (item stream :type t)
     (prin1 (sequencer-item-name item) stream)))
 

+(defmethod shared-initialize ((sequencer sequencer) slot-names
+                             &key (constraints nil constraintsp))
+  (call-next-method)
+  (when constraintsp
+    (setf (slot-value sequencer 'constraints)
+         (mapcar (lambda (constraint)
+                   (mapcar (lambda (name)
+                             (ensure-sequencer-item sequencer name))
+                           constraint))
+                 (reverse constraints))))
+  sequencer)
+

 (defmethod ensure-sequencer-item ((sequencer sequencer) name)
   (with-slots (table) sequencer
     (or (gethash name table)
 (defmethod ensure-sequencer-item ((sequencer sequencer) name)
   (with-slots (table) sequencer
     (or (gethash name table)

diff --git a/src/output-proto.lisp b/src/output-proto.lisp
index 65068f3f3d511073facc368286fbd92e264904cd..a87c7c0760ed9c9ff6d1d65044492e617d0174a4 100644 (file)
--- a/src/output-proto.lisp
+++ b/src/output-proto.lisp
@@ -41,8 +41,7 @@ (defstruct (sequencer-item
 
 (export '(sequencer sequencer-constraints sequencer-table))
 (defclass sequencer ()
 
 (export '(sequencer sequencer-constraints sequencer-table))
 (defclass sequencer ()

-  ((constraints :initarg :constraints :initform nil
-               :type list :accessor sequencer-constraints)
+  ((constraints :initform nil :type list :accessor sequencer-constraints)

    (table :initform (make-hash-table :test #'equal)
          :reader sequencer-table))
   (:documentation
    (table :initform (make-hash-table :test #'equal)
          :reader sequencer-table))
   (:documentation