(in-package :collection-class) (defclass collection (standard-object #+sbcl sequence) ()) (define-condition value-error () ((value :initarg :value :accessor value))) (defgeneric push-item (item collection) (:documentation "Push item onto the beginning of the collection")) (defgeneric items (collection) (:documentation "Get the items from a collection")) (defgeneric duplicate-collection (collection)) (defgeneric copy-instance (object &rest initargs &key &allow-other-keys) (:documentation "Makes and returns a shallow copy of OBJECT. An uninitialized object of the same class as OBJECT is allocated by calling ALLOCATE-INSTANCE. For all slots returned by CLASS-SLOTS, the returned object has the same slot values and slot-unbound status as OBJECT. REINITIALIZE-INSTANCE is called to update the copy with INITARGS.") (:method ((object standard-object) &rest initargs &key &allow-other-keys) (let* ((class (class-of object)) (copy (allocate-instance class))) (dolist (slot-name (mapcar #'closer-mop:slot-definition-name (closer-mop:class-slots class))) (when (slot-boundp object slot-name) (setf (slot-value copy slot-name) (slot-value object slot-name)))) (apply #'reinitialize-instance copy initargs)))) ; TODO: actually use item-class... ; TODO: finish initform handling. Have to figure out how to make initform work with push-item (defmacro define-collection ((name item-class &key (initarg :items) (initform '(list))) (&rest supers) &body ((&rest slots) &rest other-stuff)) (with-gensyms (item-slot-sym) `(progn (defclass ,name (,@supers collection) ((,item-slot-sym :initarg ,initarg :initform ,initform :accessor items) ; ,@slots) ,@other-stuff) (defmethod duplicate-collection ((collection ,name)) (let ((result (copy-instance collection))) (setf (items result) (copy-seq (items result))) result)) (defmethod push-item ((item ,item-class) (collection ,name)) (push item (items collection)))))) (defmethod random-item ((collection collection) &optional (random-state *random-state*)) (let* ((length (length (items collection))) (selected-index (random length random-state))) (elt (items collection) selected-index))) (defmethod nth-item ((collection collection) (index integer)) (if (>= index 0) (elt (items collection) index) (error 'value-error :value index)))