;;;----- 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
(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)
- (setf (gethash name table)
- (make-instance 'sequencer-item :name name)))))
+ (setf (gethash name table) (make-sequencer-item name)))))
(defmethod add-sequencer-constraint ((sequencer sequencer) (constraint list))
(let ((converted-constraint
(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 --------------------------------------------------