doc/concepts.tex: Typeset method rôle names as identifiers.

[sod] / src / output-impl.lisp

diff --git a/src/output-impl.lisp b/src/output-impl.lisp
index df42115b25aeac1801dfc450c34b867b52b54c9e..96cfa205a6cb3d9a18419690e266aede072964ad 100644 (file)
--- a/src/output-impl.lisp
+++ b/src/output-impl.lisp
@@ -7,7 +7,7 @@
 
 ;;;----- Licensing notice ---------------------------------------------------
 ;;;
-;;; This file is part of the Sensble Object Design, an object system for C.
+;;; This file is part of the Sensible Object Design, an object system for C.
 ;;;
 ;;; SOD is free software; you can redistribute it and/or modify
 ;;; it under the terms of the GNU General Public License as published by
@@ -32,6 +32,18 @@ (defmethod print-object ((item sequencer-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)
@@ -43,15 +55,27 @@ (defmethod add-sequencer-constraint ((sequencer sequencer) (constraint list))
                   (ensure-sequencer-item sequencer name))
                 constraint)))
     (with-slots (constraints) sequencer
-      (pushnew converted-constraint constraints :test #'equal))))
+      (pushnew converted-constraint constraints))))
 
 (defmethod add-sequencer-item-function ((sequencer sequencer) name function)
   (let ((item (ensure-sequencer-item sequencer name)))
     (pushnew function (sequencer-item-functions item))))
 
 (defmethod invoke-sequencer-items ((sequencer sequencer) &rest arguments)
-  (dolist (item (merge-lists (reverse (sequencer-constraints sequencer))))
-    (dolist (function (reverse (sequencer-item-functions item)))
-      (apply function arguments))))
+  #+debug
+  (format *debug-io* "~@<;; ~@;Constraints: ~_~
+                     ~<~@{~<  * ~;~@{~S~^, ~:_~}~:>~:@_~}~:>~:>"
+         (mapcar (lambda (constraint)
+                   (mapcar #'sequencer-item-name constraint))
+                 (sequencer-constraints sequencer)))
+  (let ((seen (make-hash-table)))
+    (dolist (item (merge-lists (reverse (sequencer-constraints sequencer))))
+      (setf (gethash item seen) t)
+      (dolist (function (reverse (sequencer-item-functions item)))
+       (apply function arguments)))
+    (maphash (lambda (name item)
+              (unless (gethash item seen)
+                (warn "Unused output item ~S" name)))
+            (sequencer-table sequencer))))
 
 ;;;----- That's all, folks --------------------------------------------------