;;;  -*- mode: LISP; Package: CL-USER; Syntax: COMMON-LISP;  Base: 10 -*-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; 
;;; Author      : Mike Byrne
;;; Copyright   : (c)2000-2002 Rice U./Mike Byrne, All Rights Reserved
;;; Availability: public domain
;;; Address     : Rice University
;;;             : Psychology Department
;;;             : Houston,TX 77251-1892
;;;             : byrne@acm.org
;;; 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; 
;;; Filename    : pm-module.lisp
;;; Version     : 2.1b7
;;; 
;;; Description : Base class for the perceptual-motor modules.
;;; 
;;; Bugs        : 
;;; 
;;; Todo        : [] Remove state chunk stuff.
;;; 
;;; ----- History -----
;;; 01.07.27 mdb
;;;             : Started 5.0 conversion. 
;;; 02.01.21 mdb
;;;             : Removed obsolete PROC-S function, renamed slot value function
;;;             : to be PROC-S.  Added INITIAITON-COMPLETE call.
;;; 2002.05.07 mdb [b6]
;;;             : Processor wasn't being set to BUSY while preparation was
;;;             : ongoing, which made Bad Things (tm) happen.  Fixed.
;;; 2002.06.05 mdb
;;;             : Added step-hook call in RUN-MODULE to support the environment.
;;; 2002.06.27 mdb [b7]
;;;             : Moved CHECK-SPECS here and made it print an actual informative
;;;             : warning message.  Wild.
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;;; ---------------------------------------------------------------------- ;;;;
;;;; Perceptual/motor Modules base class
;;;; ---------------------------------------------------------------------- ;;;;

;;; PM-MODULE      [Class]
;;; Date        : 97.01.15, delta 99.06.24
;;; Description : Base class for the various modules, includes input
;;;             : queue and basic state information.

(defclass pm-module ()
  ((input-queue :accessor input-q :initform nil)
   (modality-state :accessor mode-s :initform 'FREE :initarg :modality)
   (processor-state :accessor proc-s :initform 'FREE :initarg :processor)
   (preparation-state :accessor prep-s :initform 'FREE :initarg :preparation)
   (execution-state :accessor exec-s :initform 'FREE :initarg :execution)
   (state-change-flag :accessor state-change :initarg :state-change
                      :initform nil)
   (state-dmo :accessor state-dmo :initarg :state-dmo :initform nil)
   (module-name :accessor my-name :initarg :name :initform nil)
   (last-command :accessor last-cmd :initform nil :initarg :last-command)
   (last-prep :accessor last-prep :initarg :last-prep :initform nil)
   (exec-queue :accessor exec-queue :initarg :exec-queue :initform nil)
   (feature-prep-time :accessor feat-prep-time  :initarg :feat-prep-time 
                      :initform 0.050 :allocation :class)
   (movement-initiation-time :accessor init-time :initarg :init-time
                             :initform 0.050 :allocation :class)
   (init-stamp :accessor init-stamp :initarg :init-stamp :initform -0.1)
   (burst-time :accessor burst-time :initarg :burst-time :initform 0.050
               :allocation :class )
   (waiting-for-proc-p :accessor waiting-for-proc-p :allocation :class
                       :initarg :waiting-for-proc-p :initform nil)
))

#|
(defmethod proc-s ((module pm-module))
  (if (or (eq (prep-s module) 'busy)
          (and (eq (exec-s module) 'busy) (eq (prep-s module) 'free)
               (< (mp-time *mp*) (+ (init-stamp module) (init-time module)))))
    'busy
    'free))


(defmethod proc-s ((mod pm-module))
  (proc-stub mod))
|#
 

(defmethod new-message ((module pm-module) (entry input-queue-entry))
  (setf (input-q module) (queue-insert entry (input-q module))))


;;; RUN-MODULE      [Method]
;;; Date        : 97.01.17
;;; Description : Running a module means processing the items in the input
;;;             : queue that have a current time tag.  Once that's been done,
;;;             : we need to update the state of declarative memory in the
;;;             : Cognitive Layer.

(defgeneric run-module (module the-time)
  (:documentation  "Runs a PM module up to time <the-time>."))

(defmethod run-module ((module pm-module) the-time)
  (setf (state-change module) nil)
  (while (and (input-q module)
              (>= (ms-round the-time)
                  (ms-round (time-tag (first (input-q module))))))
    (let* ((input-entry (pop (input-q module)))
           (the-cmd (first (params input-entry))))
      (when (functionp (step-hook *mp*))
        (funcall (step-hook *mp*) input-entry))
      (when (and (act-cmd-p input-entry)
                 (not (eql (last-cmd module) the-cmd)))
        (change-state module :last the-cmd))
      (when (trace-modules *mp*)
        (pm-output the-time "Module ~S running command ~S"
                   (my-name module) the-cmd the-time))
      (apply the-cmd (append (list module) (rest (params input-entry))))))
  (when (state-change module)
    (update-dm-state module)))


(defgeneric pm-install-module (mstr-proc module &optional warn)
  (:documentation "Installs <module> into <mstr-proc>.  Set <warn> to NIL to disable interactive warnings."))

(defmethod pm-install-module ((mp master-process) (module pm-module)
                                 &optional (warn t))
  (let ((name (my-name module)))
    (awhen (assoc name (module-lst mp))
      (awhen (and (neq module (rest it)) warn)
        (pm-warning "Overwrite current ~S module?  [y/n] " name)
        (let ((char (read-char)))
          (when (not (or (eq char #\y) (eq char #\Y)))
            (return-from pm-install-module nil))))
      (setf (module-lst mp) (delete name (module-lst mp) :key #'first)))
    (push (cons name module) (module-lst mp))))


;;; UPDATE-DM-STATE      [Method]
;;; Date        : 97.01.17
;;; Description : Updates the state DMO for a module.

(defgeneric update-dm-state (module)
  (:documentation  "Updates the state DMO for a PM module."))

(defmethod update-dm-state ((module pm-module))
  (set-attributes (state-dmo module) 
                  `(modality ,(mode-s module) processor ,(proc-s module)
                             preparation ,(prep-s module) 
                             execution ,(exec-s module)
                             last-command ,(last-cmd module))))


;;; CHANGE-STATE      [Method]
;;; Date        : 97.02.10
;;; Description : Change one or more of a module's state flags.

(defgeneric change-state (module &key proc exec prep last)
  (:documentation  "Change one or more of a module's state flags."))

(defmethod change-state ((module pm-module) &key proc exec prep last)
  (when proc (setf (proc-s module) proc))
  (when exec (setf (exec-s module) exec))
  (when prep (setf (prep-s module) prep))
  (when last (setf (last-cmd module) last))
  (if (or (eq (proc-s module) 'busy) (eq (exec-s module) 'busy)
          (eq (prep-s module) 'busy))
    (setf (mode-s module) 'busy)
    (setf (mode-s module) 'free))
  (update-dm-state module)
  (setf (state-change module) t))


;;; PRINT-INPUT-QUEUE      [Method]
;;; Date        : 97.01.21

(defgeneric print-input-queue (module)
  (:documentation  "Prints out all the entries in a PM module's input queue."))

(defmethod print-input-queue ((module pm-module))
  (dolist (entry (input-q module))
    (print-entry entry)))


;;; TEST-MOD-MSG      [Method]
;;; Date        : 97.01.24
;;; Description : Runs a test to make sure the module is processing messages
;;;             : Correctly.

(defgeneric test-mod-msg (module &rest params)
  (:documentation  "Prints out the PM module name, the parameters passed, and the time."))

(defmethod test-mod-msg ((module pm-module) &rest params)
  (pm-output (mp-time *mp*) "Module ~S ran test with params ~S"
             (my-name module) params))


;;; CLEAR      [Method]
;;; Date        : 97.03.03
;;; Description : Clears a module's state, takes one feature prep time.

#| CLEAR is already a generic function in MCL.
(defgeneric clear (module)
  (:documentation  "Clears a PM module."))
|#

(defmethod clear ((module pm-module))
  (when (not (check-jam module))
    (change-state module :prep 'busy)
    (queue-command :time 0.050 :where (my-name module) :command 'change-state
                   :params '(:last none :prep free))
    (setf (last-prep module) nil)
    (setf (exec-queue module) nil)
    (setf (init-stamp module) -0.1)
    ))


;;; CHECK-JAM      [Method]
;;; Date        : 97.02.18
;;; Description : Modules can't take certain types of commands if they are
;;;             : already busy, and this checks the preparation state of a
;;;             : module for just this problem. 

(defgeneric check-jam (module)
  (:documentation "Returns NIL if the PM module is free, otherwise prints an error message and returns T."))

(defmethod check-jam ((module pm-module))
  (if (not (eq (prep-s module) 'busy))
    nil
    (progn
      (pm-warning "Module ~S jammed at time ~S~%"
              (my-name module) (mp-time *mp*))
      t)))


;;; RESET-MODULE      [Method]
;;; Date        : 97.02.18
;;; Description : When a module needs to be reset, that means both that all
;;;             : state indicators should be set to FREE and the input queue
;;;             : should be cleared.

(defgeneric reset-module (module)
  (:documentation "Resets a PM module to base state:  all flags free, empty input queue."))

(defmethod reset-module ((module pm-module))
  (setf (proc-s module) 'free)
  (setf (exec-s module) 'free)
  (setf (prep-s module) 'free)
  (setf (mode-s module) 'free)
  (setf (last-cmd module) nil)
  (update-dm-state module)  
  (setf (input-q module) nil)
  (setf (last-prep module) nil)
  (setf (exec-queue module) nil)
  (setf (init-stamp module) -0.1)
  )

;;; UPDATE-MODULE      [Method]
;;; Date        : 98.05.28
;;; Description : Called each time the PS is run.  This will update the 
;;;             : module's state.  If a specific module has other things
;;;             : that need to be updated besides the DME state of that
;;;             : module, define :BEFORE or :AFTER methods.

(defgeneric update-module (module)
  (:documentation "Update the state of a PM module."))

(defmethod update-module ((mod pm-module))
  (update-dm-state mod))



;;; PRINT-MODULE-STATE      [Method]
;;; Date        : 98.05.28
;;; Description : For debugging help, this prints the state of the module
;;;             : to stdout.

(defgeneric print-module-state (module)
  (:documentation "Prints a representation of a PM module's state."))

(defmethod print-module-state ((mod pm-module))
  (format t "~& State of module ~S" (my-name mod))
  (format t "~% Modality:     ~S" (mode-s mod))
  (format t "~% Preparation:  ~S" (prep-s mod))
  (format t "~% Processor:    ~S" (proc-s mod))
  (format t "~% Execution:    ~S" (exec-s mod))
  (format t "~% Last command: ~S" (last-cmd mod)))



(defgeneric check-state (module &key modality preparation 
                                   execution processor last-command)
  (:documentation "Does a quick test of the state of a PM module, returning T iff all the specified states match."))


(defmethod check-state ((mod pm-module) &key modality preparation 
                          execution processor last-command)
  (cond ((and modality (not (eq modality (mode-s mod)))) nil)
        ((and preparation (not (eq preparation (prep-s mod)))) nil)
        ((and execution (not (eq execution (exec-s mod)))) nil)
        ((and processor (not (eq processor (proc-s mod)))) nil)
        ((and last-command (not (eq last-command (last-cmd mod)))) nil)
        (t t)))


(defgeneric silent-events (module)
  (:documentation "Returns NIL if there are no non-queue events for a module."))

(defmethod silent-events ((mod pm-module))
  nil)


;;;; ---------------------------------------------------------------------- ;;;;
;;;; preparation and execution stuff



;;; PREPARATION-COMPLETE      [Method]
;;; Date        : 98.07.22
;;; Description : When movement preparation completes: change the prep
;;;             : state, check to see if the movement just prepared wants
;;;             : to execute right away, and then possibly execute a 
;;;             : movement.

(defgeneric preparation-complete (module)
  (:documentation "Method to be called when movement preparation is complete."))

(defmethod preparation-complete ((module pm-module))
  (change-state module :prep 'free)
  (when (and (last-prep module)
             (exec-immediate-p (last-prep module)))
    (setf (exec-queue module)
          (append (exec-queue module) (mklist (last-prep module)))))
  (maybe-execute-movement module))


;;; FINISH-MOVEMENT      [Method]
;;; Date        : 98.07.22
;;; Description : When a movement completes, FREE the execution state, and
;;;             : check to see if there were any movements queued.

(defgeneric finish-movement (module)
  (:documentation "Method called when a movement finishes completely."))

(defmethod finish-movement ((module pm-module))
  (change-state module :exec 'free)
  (maybe-execute-movement module))


;;; MAYBE-EXECUTE-MOVEMENT      [Method]
;;; Date        : 98.07.22
;;; Description : If there is a movement queued and the motor state is FREE,
;;;             : then execute the movment.  Also, free the processor state
;;;             : with an event if necessary.

(defgeneric maybe-execute-movement (module)
  (:documentation "If there are any movements in <module>'s execution queue, execute one."))

(defmethod maybe-execute-movement ((module pm-module))
  (when (and (exec-queue module) (eq (exec-s module) 'FREE))
    (perform-movement module (pop (exec-queue module)))))


;;; PREPARE      [Method]
;;; Date        : 98.08.21
;;; Description : Build a movement style instance via APPLY, set it to not
;;;             : automatically execute itself, and prepare it.

(defgeneric prepare (module &rest params)
  (:documentation "Prepare a movement to be executed, but don't execute it. The first of <params> should be the name of a movement style class."))

(defmethod prepare ((module pm-module) &rest params)
  (let ((inst (apply #'make-instance params)))
    (setf (exec-immediate-p inst) nil)
    (prepare-movement module inst)))


;;; EXECUTE      [Method]
;;; Date        : 98.08.21
;;; Description : Executing the previously prepared command requires
;;;             : [1] A previously-prepared command, and
;;;             : [2] No command currently being prepared.
;;;             : If those are OK, put the current style instance in the
;;;             : execution queue and go for it.

(defgeneric execute (module)
  (:documentation "Tells <module> to execute the last movement prepared."))

(defmethod execute ((module pm-module))
  (cond ((not (last-prep module))
         (pm-warning "Motor Module has no movement to EXECUTE."))
        ((eq (prep-s module) 'BUSY)
         (pm-warning "Motor Module cannot EXECUTE features being prepared."))
        (t
         (setf (exec-queue module)
               (append (exec-queue module) (mklist (last-prep module))))
         (maybe-execute-movement module))))


;;; PM-PREPARE-MOTOR-MTH      [Method]
;;; Date        : 98.09.24
;;; Description : If RPM is to begin a run with features already prepared,
;;;             : this is the method to do it.  Create a movement instance,
;;;             : kill the exec-immediate, and set the last prepared movement
;;;             : to the created movement.

(defgeneric pm-prepare-mvmt-mth (module params)
  (:documentation "Create the movement specified in <params>, which should begin with the name of a movement style, and consider it prepared. To be called only at model initialization."))

(defmethod pm-prepare-mvmt-mth ((module pm-module) params)
  (let ((inst (apply #'make-instance params)))
    (setf (exec-immediate-p inst) nil)
    (setf (last-prep module) inst)))





;;;; ---------------------------------------------------------------------- ;;;;
;;;; MOVEMENT-STYLE class and methods
;;;; ---------------------------------------------------------------------- ;;;;

(defclass movement-style ()
  ((fprep-time :accessor fprep-time :initform nil :initarg :fprep-time)
   (exec-time :accessor exec-time :initform nil :initarg :exec-time)
   (finish-time :accessor finish-time :initform nil :initarg :finish-time)
   (exec-immediate-p :accessor exec-immediate-p :initform t
                     :initarg :exec-immediate-p)
   (num-features :accessor num-features :initform nil
                 :initarg :num-features)
   (style-name :accessor style-name :initarg :style-name :initform nil)
   (feature-slots :accessor feature-slots :initarg :feature-slots 
                  :initform nil)
   (set-proc-p :accessor set-proc-p :initarg :set-proc-p :initform nil)
))


;;; PREPARE-MOVEMENT      [Method]
;;; Date        : 98.07.22
;;; Description : Change the prep state, compute the feature prep time,
;;;             : note that we're the last feature the MM has prepared,
;;;             : and queue the preparation complete event.

(defgeneric prepare-movement (module movement)
  (:documentation "Tell <module> to prepare <movement>."))

(defmethod prepare-movement ((module pm-module) (mvmt movement-style))
  (change-state module :prep 'BUSY :proc 'BUSY)
  (setf (fprep-time mvmt) 
        (rand-time (compute-prep-time module mvmt)))
  (setf (last-prep module) mvmt)
  (queue-command :command 'preparation-complete :where (my-name module)
                 :time (fprep-time mvmt) :randomize nil)
  (when (and (waiting-for-proc-p module) (null (exec-queue module))
             (exec-immediate-p mvmt))
    (setf (set-proc-p mvmt) t)
    (queue-command :time (+ (fprep-time mvmt) (init-time module))
                   :where (my-name module) :command 'change-state 
                   :params '(:proc free) :randomize nil)))



;;; COMPUTE-PREP-TIME      [Method]
;;; Date        : 98.07.22
;;; Description : Computing the prep time.  If this is a different kind of
;;;             : movement or a totall new movement, then just return the
;;;             : number of features times the time per feature.  If the
;;;             : old movement is similar, compute the differences (a 
;;;             : method for this must be supplied).

(defgeneric compute-prep-time (module movement)
  (:documentation "Return the feature preparation time for <movement>."))

(defmethod compute-prep-time ((module pm-module) (mvmt movement-style))
  (if (or (null (last-prep module))
          (not (eq (style-name mvmt) (style-name (last-prep module)))))
    (* (feat-prep-time module) (num-to-prepare mvmt))
    (* (feat-prep-time module)
       (feat-differences mvmt (last-prep module)))))




;;; PERFORM-MOVEMENT      [Method]
;;; Date        : 98.07.22
;;; Description : Performing a movement has several pieces to it.  First,
;;;             : bookkeeping (exec state and start time).  Next we need
;;;             : to compute times.  Then, queue the events (movement
;;;             : specific) that reflect our output, and finally queue
;;;             : the event indicating completion of the movement.

(defgeneric perform-movement (module movement)
  (:documentation "Have <module> perform <movement>."))

(defmethod perform-movement ((module pm-module) (mvmt movement-style))
  (queue-command :time (init-time module) :where (my-name module) 
                 :command 'INITIATION-COMPLETE)
  (change-state module :proc 'BUSY :exec 'BUSY)
  (setf (init-stamp module) (mp-time *mp*))
  (setf (exec-time mvmt) (compute-exec-time module mvmt))
  (setf (finish-time mvmt) (compute-finish-time module mvmt))
  (queue-output-events module mvmt)
  (queue-finish-event module mvmt))


(defmethod initiation-complete ((module pm-module))
  (change-state module :proc 'FREE))


;;; COMPUTE-FINISH-TIME      [Method]
;;; Date        : 98.07.22
;;; Description : Default finish time is simply execution time plus the
;;;             : burst time--some styles will need to override this.

(defgeneric compute-finish-time (module movement)
  (:documentation "Return the finish time of <movement>."))

(defmethod compute-finish-time ((module pm-module) (mvmt movement-style))
  "Return the finish time of the movement."
  (+ (burst-time module) (exec-time mvmt)))


;;; QUEUE-FINISH-EVENT      [Method]
;;; Date        : 98.07.22
;;; Description : Queue the event that frees the exec of the MM.

(defgeneric queue-finish-event (module movement)
  (:documentation "Queue the FINISH-MOVEMENT associated with <movement>."))

(defmethod queue-finish-event ((module pm-module) (mvmt movement-style))
  (queue-command :time (finish-time mvmt) :command 'finish-movement
                 :where (my-name module)))


;;; Stubs that require overrides.

(defgeneric compute-exec-time (module movement)
  (:documentation "Return the execution time of <movement>."))

(defmethod compute-exec-time ((module pm-module) (mvmt movement-style))
  (error "No method defined for COMPUTE-EXEC-TIME."))


(defgeneric queue-output-events (module movement)
  (:documentation "Queue the events--not including the FINISH-MOVEMENT--that <movement> will generate."))

(defmethod queue-output-events ((module pm-module) (mvmt movement-style))
  (error "No method defined for QUEUE-OUTPUT-EVENTS."))


(defgeneric feat-differences (movement1 movement2)
  (:documentation "Return the number of different features that need to be prepared."))

(defmethod feat-differences ((move1 movement-style) (move2 movement-style))
  ;(declare (ignore move1 move2))
  (error "No method defined for FEAT-DIFFERENCES."))




(defgeneric num-possible-feats (movement)
  (:documentation "Return the maximum number of features that could possibly need to be prepared."))

(defmethod num-possible-feats ((mvmt movement-style))
  (1+ (length (feature-slots mvmt))))


(defgeneric num-to-prepare (movement)
  (:documentation "Return the number of features actually needed to prepare <movement>."))

(defmethod num-to-prepare ((mvmt movement-style))
  (1+ (length (remove :DUMMY
                      (remove nil
                              (mapcar #'(lambda (name)
                                          (slot-value mvmt name))
                                      (feature-slots mvmt)))))))



(defmacro defstyle (name base-class &rest params)
  "Macro that defines new motor movement styles.  Pass in the name and the base class 
[if NIL is passed, it will default to MOVEMENT-STYLE] and the base parameters.  
This will create a class and a method for any PM Module for the class."
  `(progn
     (defclass ,name (,(if (not base-class) 'movement-style base-class))
       ,(build-accessors params)
       (:default-initargs
         :style-name ,(sym->key name)
         :feature-slots ',params))
     (defmethod ,name ((module pm-module) &key ,@params)
       (unless (or (check-jam module) (check-specs ',name ,@params))
         (prepare-movement module
                           (make-instance ',name
                             ,@(build-initializer params)))))))

(defun check-specs (name &rest specs)
  "If there is an invalid specification, return something, else NIL"
  (when (member nil specs)
    (pm-warning "NIL specification passed to a PM command ~S: ~S" name specs)
    t))

;;; BUILD-ACCESSORS      [Function]
;;; Date        : 98.11.02
;;; Description : Helper function for DEFSTYLE.

(defun build-accessors (params)
  "From a list of parameters, a list of slot definitions."
  (let ((accum nil))
    (dolist (param params (nreverse accum))
      (push (list param :accessor param :initarg (sym->key param)
                  :initform nil) accum))))


;;; BUILD-INITIALIZER      [Function]
;;; Date        : 98.11.02
;;; Description : Helper function for DEFSTYLE.

(defun build-initializer (params)
  "From a list of parameters, build a list for the make-instance initializer."
  (let ((accum nil))
    (dolist (param params (nreverse accum))
      (push (sym->key param) accum)
      (push param accum))))


;;;; ---------------------------------------------------------------------- ;;;;
;;;; Attentional modules
;;;; ---------------------------------------------------------------------- ;;;;

;;; ATTN-MODULE      [Class]
;;; Date        : 00.06.09
;;; Description : Class for modules that have attentional capability.
;;;             : CURRENTLY-ATTENDED hold the focus object
;;;             : SOURCE-ACTIVATION tells how much source activation the focus
;;;             : object gets
;;;             : CURRENT-MARKER denotes the location/event currently attended

(defclass attn-module (pm-module)
  ((currently-attended :accessor currently-attended 
                       :initarg :currently-attended :initform nil)
   (source-activation :accessor source-act :initarg :source-act :initform 1.0)
   (current-marker :accessor current-marker :initarg :current-marker 
                   :initform nil)
   ))


(defmethod reset-module ((module attn-module))
  (call-next-method)
  (clear-attended module)
  (setf (current-marker module) nil)
  )  

(defmethod clear ((module attn-module))
  (call-next-method)
  (setf (current-marker module) nil)
  (clear-attended module))


;;; the bizarre machinations here with CLEAR-ATTENDED and 
;;; PARTIAL-CLEAR-ATTENDED have to do with activation management in ACT-R.
;;; They get handled slightly differently by ACT-R, so they have to be 
;;; separate methods.  Really.

(defgeneric clear-attended (module)
  (:documentation "Set <module> so that it is attending nothing."))

(defmethod clear-attended ((module attn-module))
  (partial-clear-attended module))


(defgeneric partial-clear-attended (module)
  (:documentation "Actually clear the CURRENTLY-ATTENDED slot for <module>."))

(defmethod partial-clear-attended ((module attn-module))
  (setf (currently-attended module) nil))


(defgeneric set-attended (module object)
  (:documentation "Note that <module> is now attending <object>."))

(defmethod set-attended ((module attn-module) obj)
  (partial-clear-attended module)
  (setf (currently-attended module) obj))