(in-package "KPML")

;;; File: agreement-domains.lisp
;;;
;;; Adds the agreement realization operator functionality.
;;; Substantial modifications/extensions 
;;;         at 2.0.40, 2.0.52 (John, Edinburgh, 1998)
;;;         at 3.1 (John, Bremen, 2000)

;;; ----------------------------------------------------------------------
;;; New realization statement definition:

(define-realization-operators AGREEMENT)

;;; used as follows:
;;;
;;;  (... grammatical-feature
;;;           (agreement F1 F2 (f11 f21)
;;;                            (f12 f22)
;;;                            (f13 f23)
;;;                            ...))
;;; 
;;; defines an agreement/prosody domain to hold over the grammatical
;;; functions F1 and F2, such that the selection of the grammatical
;;; features f1i during the realization of function F1 constrain the
;;; automatic selection of corresponding features f2i during the
;;; realization of function F2. Note: if a dependency chain is
;;; broken (i.e., X dep Y dep Z, but Y does not appear, then the
;;; indirect dependency X dep Z is not enforced.)
;;;
;;; Variations/additions:
;;; ---------------------
;;; 
;;;   (agreement Subject Finite 
;;;                 (singular (classify singular-form)
;;;                           (classify another-singular-form))
;;;                 (plural   (inflectify plural-inflection)))
;;;                 etc.
;;;
;;; These *only take effect* when the dependent (e.g., Finite here)
;;; is actually to be realized by classification and not by traversal.
;;;
;;;  (agreement (Deictic Status Epithet)
;;;               (this-rank-feature1 deictic-f1 status-f1 epithet-f1)
;;;               (this-rank-feature2 deictic-f2 status-f2 epithet-f2)
;;;               etc.)
;;;
;;; If feature this-rank-feature-i is selected then each of Deictic, Status
;;; and Epithet (*iff* inserted) are additionally preselected for their
;;; respective features from the relevant row of agreements.
;;; ----------------------------------------------------------------------

;;; ----------------------------------------------------------------------
;;; Code for enforcing agreement domains...
;;;
;;; The best place to squirrel away the results of the agreement
;;; realizations is when constituent0 returns a constituent-pass
;;; structure. In KPML 0.8, therefore, this data structure contains
;;; an extra slot :prosodies. For a patch for KPML 0.7, however,
;;; we take a short cut relying on the more or less breadth-first
;;; generation strategy. Each constituent start resets the globals,
;;; but the ordering of realization according to agreement 
;;; dependencies is already calculated before beginning any new
;;; realization. Thus losing that information is not important.
;;; The conditional preselection information must be preserved
;;; however, for KPML 0.7 we define a further global association
;;; list:

(defvar *prosodies* nil "prosodies defined during one call of say")
(defvar *fundle-hub-linkage* (make-hash-table :test #'equal))

;;; ----------------------------------------------------------------------
;;; KPML 0.7.34
;;; patch: i.e., attempts to make minimal changes to existing code.
;;;        only two functions are redefined from 0.7, with minimal
;;;        changes; the other functions are additional. Patch ends
;;;        with end>0.7.34 below.
;;;  numerous other patches now included however.
;;; ----------------------------------------------------------------------

(defvar *active-unit-dependencies* nil 
  "dependencies declared with a single traversal")
(defvar *active-conditional-preselections* nil
  "conditional preselections declared within a single traversal")
(defvar *active-self-conditional-preselections* nil
  "conditional preselections declared from self to set of children")
(defvar *agreement-trace* nil)

;;; ----------------------------------------------------------------------
;;; 2.0.40
;;; 2.0.52 : Feb99, extensions for treating classified/inflectified
;;;                 constituents fully.
;;; 3.1 : May2000,  Jiri's extension for conditional preselection for
;;;                 a set of grammatical constituents added.
;;;
;;; Includes:
;;;
;;; Minor changes in the agreement operator code, mostly for
;;; helping with debugging, and one extension to the semantics.
;;;
;;; We extend the enforcement of prosodies to involve some classify
;;; and inflectify constraints in the dependents. Dependency chains
;;; of this nature cannot be transitive since further dependents do not
;;; find any selection expression to influence them. Need to handle
;;; such things by defining two prosodies.
;;; ----------------------------------------------------------------------

(defun AGREEMENT (F1 F2 &rest conditional-preselections)
  ;; 3.1 make the basic functionality split according to F1
  (if (consp f1)
      (agreement-domain f1 (cons f2 conditional-preselections))
    (agreement-chain f1 f2 conditional-preselections)))

(defun AGREEMENT-CHAIN (F1 F2 conditional-preselections)
  ;; 3.1 this was the pre-3.1 function 'agreement'...
  (agreement-trace
   ;; 2.0.40 message improved...
   "~%In system: ~A~%~A governs ~A wrt: ~{~{~10T~A --> ~A~%~}~}"
   message-sender F1 F2 conditional-preselections)

  ;;   i.  defines a realization dependency between functions F1 and F2
  ;;       to hold for the current grammatical unit:
  ;;       i.e., 
  (pushnew (cons F1 F2) *active-unit-dependencies*)

  ;;   ii. adds the conditional preselections to an association
  ;;       list between functions and actions 
  ;;           (F2 . ((selects F1 f1i) . (preselect f2i)))
  ;;       following a cycle through the grammar, the relative
  ;;       functions F1 and F2 are replaced by absolutes.
  ;;
  (loop for conditional-preselects in conditional-preselections
	do
	(pushnew (cons F2 (cons 
			   `(selects ,F1 ,(first conditional-preselects))
			   `(preselect ,(second conditional-preselects))))
		 *active-conditional-preselections*)))

;;; ----------------------------------------------------------------------
;;; 3.1 this is the addition for Jiri...
;;; ----------------------------------------------------------------------
 ;; 3.2.27
 ;;   extension of the newer agreement operator variety so that it 
 ;;   also allows within rank classifies and inflectifies as well
 ;;   as preselects.
 ;; ----------------------------------------------------------------------

(defun AGREEMENT-DOMAIN (domain conditional-preselections)
  (agreement-trace
   ;; 2.0.40 message improved...
   "~%In system: ~A~%Agreement domain over: ~A wrt: ~{~%~10T~A~}"
   message-sender domain conditional-preselections)

  ;;    i. basic syntax check...
  (let ((length (1+ (length domain))))
    (unless (loop for c in conditional-preselections
                  always (= (length c) length))
      (warning "In system: " message-sender " malformed agreement operator!")))

  ;;   ii. adds the conditional preselections to an association
  ;;       list between functions and actions 
  ;;           (function-i . ((selects :current f1i) . (REALOP [default preselect] f2i)))
  ;;       This is list is initialized prior to each cycle through the
  ;;       grammar. It is processed directly following a cycle through
  ;;       the grammar, in constituent1, even before making up the whiteboard
  ;;       and brownboard. This means that its operation really is identical
  ;;       to that of using a preselection (or other realization statement)
  ;;       explicitly. The only check is that if a gramatical function has
  ;;       not been inserted, then we don't bother doing anything.
  ;;
  (loop for F in domain
	as count from 1
	do
	(loop for conditional-preselects in conditional-preselections
	      as effect = (nth count conditional-preselects)
	      if (symbolp effect)
	      do (pushnew (cons F
				(cons 
				 `(selects :current ,(first conditional-preselects))
				 `(preselect ,effect)))
			  *active-self-conditional-preselections*)
	      else 
	      if (consp effect)
	      do (pushnew (cons F
				(cons 
				 `(selects :current ,(first conditional-preselects))
				 `(,(first effect) ,(second effect))))
			  *active-self-conditional-preselections*)))
  )

(defun MULTIPLE-CONDITIONAL-PRESELECTION-ACCORDING-TO (selection-expression)
  ;;       We must now additionally take a peek at the list of 
  ;;       *active-self-conditional-preselections* to see if the constituent
  ;;       about to be realized has any auto-firing preselections. We then
  ;;       check whether the grammatical functions have been inserted, and
  ;;       if so, then add in a preselection statement to the blackboard.
  ;;       3.2.27 changed so that we do not only do preselections...
  ;;            Structure of active-self-preselections is
  ;;           (function-i . ((selects :current f1i) . (REALOP [default preselect] f2i)))
  ;;
  (let ((pending-preselections
	 (loop for (mf . p) in *active-self-conditional-preselections*
	       when (member (third (car p)) selection-expression)
	       collect (list mf (second (cdr p)) (first (cdr p))))))
    (if pending-preselections
	(agreement-trace
	 "~%Adding in conditional preselections. Full list is: ~{~{~10Tfor: ~A : ~A~%~}~}"
	 pending-preselections)
      (agreement-trace "~%No conditional preselections from agreement."))
    (setf blackboard
	  (append
	   blackboard
	   (loop for (mf p realop) in pending-preselections
		 when (insert-p blackboard mf)
		 collect 
		 (progn
		   (agreement-trace "~%    Adding ~A constraint in ~A for ~A" realop p mf)
		   `(,realop ,mf ,p)))))))

;;; ----------------------------------------------------------------------
;;; First function makes sure that sister constituents are realized in the
;;; correct order for making dependencies work... This function can
;;; use the globals that are valid for a single traversal, since it
;;; is called prior to entering the further loop in allpart0 where
;;; expansion occurs. Note also that is works by SIDE-EFFECTING the
;;; datastructure given as argument.
;;; ----------------------------------------------------------------------

(defstruct CONSTITUENT-TO-GENERATE "a whiteboard-brownboard pair"
  (wbe nil)(bs nil)(status nil))

(defun MAKE-SUBCONSTITUENT-LIST (constituent-pass-data)
  (loop for wbe in (constituent-pass-whiteboard  Constituent-pass-data)
      as bs in (constituent-pass-brownboard Constituent-pass-data)
      collect (make-constituent-to-generate
	       :wbe wbe :bs bs :status nil)))

(defun AGREEMENT-DOMAIN-ENFORCEMENT (constituent-pass-data)
  (let* ((brownboard-elements (constituent-pass-brownboard Constituent-pass-data))
	 (wbe-bs-pairs (make-subconstituent-list constituent-pass-data))
	 (result nil)
	 (cycle-threat t))
	 
    (when *agreement-trace*
	  (format *trace-output*
		  "~%list of constituents pre-dependency ordering:~% ~{~S~}~%"
		  (mapcar #'(lambda (bs) (first (list-of-brownboard-elt BS))) 
			  brownboard-elements)))

    (unless *active-unit-dependencies* 
	    (return-from agreement-domain-enforcement nil))
    (loop while (loop for c in wbe-bs-pairs 
		      thereis (null (constituent-to-generate-status c)))
	  do
	  (setf cycle-threat t)
	  (loop for c in wbe-bs-pairs do
		(cond ((constituent-to-generate-status c) nil)
		      ((let  ((deps (agreement-dependees c)))
			 (or (not deps)
			     (loop for c2 in (candidate-constits-of
					      deps wbe-bs-pairs)
				   always
				   (constituent-to-generate-status c2))))
		       (setf cycle-threat nil)
		       (setf result (append result (list c)))
		       (setf (constituent-to-generate-status c) :processed))
		      (t nil)))

	  (when cycle-threat
		(warning "Agreement dependency cycle: not enforcing")
		(return-from agreement-domain-enforcement nil)))

    (setf (constituent-pass-whiteboard  Constituent-pass-data)
	  (mapcar #'constituent-to-generate-wbe result))
    (setf (constituent-pass-brownboard Constituent-pass-data)
	  (mapcar #'constituent-to-generate-bs result))

    (make-prosody-information-absolute *active-conditional-preselections*)

    (setf result (mapcar #'(lambda (bs) (first (list-of-brownboard-elt BS))) 
			 (constituent-pass-brownboard 
			  constituent-pass-data)))

    (when *agreement-trace*
	  (format *trace-output*
		  "~%list of constituents post-ordering:~% ~{~S~}~%"
		  result))

    result))


;;; ----------------------------------------------------------------------
;;; Following function takes a whiteboard-brownboard pair (i.e., 
;;; something that will become a constituent when all-parts0 decides
;;; it is to be realized) and sees whether there is an active 
;;; dependency defined on the microfunction the constituent
;;; represents: i.e., it comes first in a dependency pair!
;;; (btw: microfunction space name used to strip off the numbering
;;; but in 4.0 we use the single standard function: remove-fn-tag)
;;; ----------------------------------------------------------------------

(defun AGREEMENT-DEPENDED-ON-P (candidate-constituent)
  (let ((micro-function-labels
	 (mapcar #'remove-fn-tag
		 (first (list-of-brownboard-elt 
			 (constituent-to-generate-bs 
			  candidate-constituent))))))
    (loop for label in micro-function-labels
	  thereis (member label 
			  (mapcar #'car *active-unit-dependencies*)))))


;;; ----------------------------------------------------------------------
;;; Following function returns all those microfunctions on which 
;;; the given microfunction depends. That is, if called for a
;;; microfunction F1, returns all those microfunctions for which
;;; an agreement domain `F* F1' has been declared. This means
;;; that F* must be realized prior to F1.
;;; --- this breaks down to all those cars for which the
;;; given function is a cdr. (Complicated since we're not using
;;; the alias functions.)
;;; ----------------------------------------------------------------------

(defun AGREEMENT-DEPENDEES (candidate-constituent)
  (let ((micro-function-labels
	 (mapcar #'remove-fn-tag
		 (first (list-of-brownboard-elt 
			 (constituent-to-generate-bs 
			  candidate-constituent)))))
	(results nil))
    (when *agreement-trace*
	  (format *trace-output* "~%Returning dependees for: ~A" 
		  micro-function-labels))
    (loop for label in micro-function-labels do
	  (loop for dependency in *active-unit-dependencies* 
		when (eq label (cdr dependency))
		do (pushnew (car dependency) results)))
    (when *agreement-trace*
	  (format *trace-output* "~%...dependees are: ~A" results))
    results))

(defun CANDIDATE-CONSTITS-OF (microfunctions wbe-bs-pairs)
  (remove 
   nil
   (flatten
    (loop for mf in microfunctions 
	  collect
	  (loop for pair in wbe-bs-pairs when
		(member mf
			(mapcar #'remove-fn-tag
				(first (list-of-brownboard-elt 
					(constituent-to-generate-bs pair)))))
		collect pair)))))

;;; ----------------------------------------------------------------------
;;; Following function makes the traversal-dependent form of
;;; conditional preselections absolute... Structure of entries
;;; on the list is: (F2 . ((selects F1 f1i) . (preselect f2i)))
;;; It is to be interpreted as follows: obtaining all the assocs
;;; of a given function provides a set of conditional preselections.
;;; ----------------------------------------------------------------------

(defun MAKE-PROSODY-INFORMATION-ABSOLUTE (conditional-preselects)
  (setf *prosodies*
	(append *prosodies* 
		(number-functions conditional-preselects))))

;;; ----------------------------------------------------------------------
;;; Following function tests whether the current constituent (as
;;; indicated by the brownboard element bs) is also one of the
;;; declared prosody/agreement dependent constituents for this
;;; rank. It also has to be the case that the dependee of the
;;; dependent actually exists at this rank. This is handled
;;; in feature-selected-p however, since it is there that we have
;;; easy access to the dependees. This is not particularly efficient
;;; or well placed, but will do for now until the agreement
;;; realization operator is more properly integrated.
;;; ----------------------------------------------------------------------

(defun AGREEMENT-DOMAIN-DEPENDENT-P (bs dependent-ids one-rank)
  (declare (ignore one-rank))
  (intersection (first (list-of-brownboard-elt bs))
		dependent-ids))
    
;;; ----------------------------------------------------------------------
;;; 2.0.40+52
;;; To make things easier, all dependents are placed on an extra list
;;; in allparts0. Then, when a member of this list is to be realized,
;;; we must collect the conditional preselects (assocs from
;;; *prosodies*) and add the preselections that are to hold. This can
;;; no longer be done exactly as if the preselections had been done
;;; normally, since this information is some where on the whiteboard:
;;; so we make use of globally maintained association of absolute
;;; grammatical function (i.e., with numbers) and the conditional
;;; preselections.  This function then has to find the selection
;;; expressions of the depended on microfunctions, ascertain if those
;;; involved in conditional preselections obtain, and if so, push the
;;; entailed preselections onto the preselection list of the about to
;;; realized unit.  
;;;
;;; N.B. the following function must really change the data
;;; structures passed in as wbe and bs else it will have no effect
;;; on subsequent generation...
;;; ----------------------------------------------------------------------

  ;; 3.2.13
  ;;  there is something not quite thought out right with the managing of the association table
  ;;  in the following. Rebinding the association table to the table of the parent was causing
  ;;  previous semantic lexicalization information to be inaccessible rather than guaranteeing
  ;;  that it was accessible as intended... have to watch this to see if there are special
  ;;  cases that require it... for now rebind to the same value as it would have anyway...

(defun AGREEMENT-DOMAIN-DEPENDENT-ACTIONS (wbe bs order one-rank)
  (let* ((dependent-ids		; collect those preselects that apply...
	  (first (list-of-brownboard-elt bs)))
	 (conditionals (loop for cp in *prosodies* 
			   when (member (car cp) dependent-ids)
			   collect (cdr cp))))
    (declare (special *parent-associations-table*))
    (when *agreement-trace*
      (format *trace-output* "~%Dependency actions triggered...")
      (loop for c in conditionals do
	    (format *trace-output* 
		    "~%Action time: if unit ~A has selected feature
~A, then auto-preselect unit ~A to have ~A" (second (car c)) (third (car c)) 
dependent-ids (second (cdr c)))))

    (when conditionals
      (loop for c in conditionals
	    when 
	    (feature-selected-p :feature (third (car c))
			        :unit    (second (car c))
			        :in-units one-rank :by-order order)
	    
	    ;; 2.0.40 need to pass the brownboard element on too in order
	    ;;       to handle inflectifies that are conditioned by
	    ;;       the prosody constraint...
	    do (preselect-feature (second (cdr c)) wbe bs))
    
      ;; 2.0.52 when done, run over the effected constituents again to
      ;;        make sure that no lexical classifications have to be corrected.
      ;; 2.1    Jiri complains that when agreements are present, then
      ;;        the :lex of SPLs is ignored. Although 2.0.3/8 should have made
      ;;        this all :lex sensitive, realize-classify was not getting the hubs
      ;;        identified, and so was not finding its way back to any
      ;;        :lex in any SPL. This is because when this runs, we
      ;;        are well away from the cycle where the relevant information
      ;;        linking grammatical functions and their semantics is
      ;;        current. But if all we are correcting here are lexical
      ;;        classifications, then we should never undo lexicalization
      ;;        that was done on semantic grounds in any case... trouble is, we don't
      ;;        know which was semantic and which not... Indeed, the distinction
      ;;        is tricky, because we can have SPLs influence lexical choice
      ;;        even when we do not do a term-resolve. Seems like the only
      ;;        way to really make this work is to ensure that the link between
      ;;        the hub/SPL-term and the function we are lexicalizing here does
      ;;        not get lost. So we need to remember this during generation...
      ;; 3.1    ... so we do it by rebinding the associations during this
      ;;        particular use of realize-classify to be the associations of
      ;;        the parent node, i.e., the one where the associations for the
      ;;        items over which the dependency prosodies are defined are actually
      ;;        set: because it is only there that we can find out about 
      ;;        any lexicalizations that may have already been done.
      (setf (whiteboard-elt-realization wbe) 
            (let ((*associations-table* 
		   (if (> (hash-table-count *parent-associations-table*) 0)
		       ;; 3.2.13 this is the problem case... if this is never needed then
		       ;;        it can disappear: but I put it in for a purpose so it must
		       ;;        have done something at some stage!!
		       *associations-table* ;;*parent-associations-table*
		     *associations-table*)))
              (declare (special *associations-table*))
              (realize-classify bs))))
      ))

;;; ----------------------------------------------------------------------
;;; Following function checks to see whether the feature has been
;;; selected for the grammatical unit: relies on us knowing
;;; the order in which constituents were created (as given
;;; by the dependency ordering and passed on here in by-order).
;;; Note that if the unit has not been inserted, then the feature
;;; is considered by definition not to have been inserted. 
;;;
;;; 2.0.52
;;; extension: allowing dependees to be classified/inflectified units...
;;; ----------------------------------------------------------------------

(defun FEATURE-SELECTED-P (&key (feature nil)(unit nil)(in-units nil)
				(by-order nil))
  (let ((dependee (loop for element in by-order
			as constituent in in-units
			do (when (member unit element)
				 (return constituent)))))
    (unless dependee (return-from feature-selected-p nil))
    (agreement-trace "~%Constituent pass information for unit ~A found." unit)
    (cond ((constituent-pass-selection-expression dependee)
	   ;; dependee has been realized by grammar traversal...
	   (member feature
		   (constituent-pass-selection-expression dependee)))
	  (t
	   ;; dependee may only have classify-inflectify info, take this
	   ;; from the feature-list slot of its whiteboard info...
	   (member feature
		   (collect-classify-inflectify-info
		    unit
		    (constituent-pass-whiteboard dependee)))))))

;;; ----------------------------------------------------------------------
;;; Following function adds the given preselection to the unit
;;; about to be realized; this is done by pushing the features
;;; on to the (whiteboard-elt-featurelist whiteboard-element)
;;; ...
;;;
;;; 2.0.40+52
;;; extension to include enforcement of dependent classify/inflectify
;;; constraints...
;;;
;;; Agreement-domain-dependent-p is also called on units which will
;;; not require traversal through the network. This is recognizeable
;;; by there not being any preselect information on the blackboard
;;; feature-spec slot. (Assuming nonsystemic morphology of course.)
;;; This will in any case return T if the constituent that is to
;;; be realized by classification is a dependent. 
;;;
;;; When this case holds, preselect-feature will want to do something
;;; about the entailed prosody. We now handle this by extending the
;;; syntax of the agreement realization operator as follows:
;;;
;;;   (agreement Subject Finite 
;;;                 (singular (classify singular-form)
;;;                           (classify another-singular-form))
;;;                 (plural (inflectify plural-inflection)))
;;; etc.
;;; These *only take effect* when the dependent (e.g., Finite here)
;;; is actually to be realized by classification and not by traversal.
;;; Here the wbe should be of the form:
;;;
;;; (#S(WHITEBOARD-ELT :ID CLASSIFY :ALIASFN |THING#2|
;;;        :FEATURELIST
;;;             (OUTCLASSIFY-PROPERNOUN
;;;              NOUN ...)
;;;        :REALIZATION "formula "
;;;        :HUB AC-53586 :INDEX NIL))
;;;
;;; Note that this is not yet enough... can only do classify *or* inflectify
;;; but really we need to back up and get at the whole whiteboard for this
;;; constituent... how do they look if there is both classify and inflectify
;;; information? inflectifies are only on the brownboard, when do they
;;; processed then?
;;;
;;; Have to find the place to add this information in...
;;; Classifies are ok, since they look like preselects... The bs
;;; feature-spec *may* be ok, if this is still in time to affect subsequent
;;; behaviour... 
;;;
;;; 2.0.52 <==============================
;;; Feb99. No, the brownboard was not in time to effect subsequent behaviour
;;;        because agreement domains are checked at the beginning of a 
;;;        pass while lexical filling in via classifies/inflectifies is
;;;        done at the *end of the preceding cycle*. So we make proper
;;;        changes to the whiteboard and the brownboard to make the
;;;        agreement-enforced constraints identical to those that could
;;;        have arisen in the grammar...
;;;
;;;     bs looks like:
;;; #S(BROWNBOARD-ELT :FUNCTIONLIST
;;;                  #S(CONFLATION :ALIAS |VOICEDEPENDENT#1|
;;;                                :OTHERNODES (|LEXVERB#1| |PROCESS#1|))
;;;                  :FEATURESPECS
;;;                  (#S(SELECTION-DEF :ID INFLECTIFY :FN |VOICEDEPENDENT#1|
;;;                                    :FEATURES ADJECTIVAL-GROUP)))
;;; 
;;;        and then have to redo any lexical classifications that were
;;;        done before.
;;; ----------------------------------------------------------------------

(defun PRESELECT-FEATURE (feature wbe bs)
  (when *agreement-trace*
	(format *trace-output*
		;; 2.0.40 message improved...
		"~%~5TAutopreselection firing for: ~A" feature))
  (typecase feature
    (cons
     (agreement-trace "~%~10T classifying/inflectifying constraint.")
     (unless (eq (whiteboard-elt-id wbe) 'classify)
       (warning "Prosody constraint requests a classified realization for "
		(whiteboard-elt-aliasfn wbe) " by virtue of constraint "
		feature  " but grammar wants a traversal."))
     (case (first feature)
       ;; 2.0.52 behaviour extended...
       ((classify inflectify)
	(let* ((fn-name (conflation-alias (brownboard-elt-functionlist bs)))
	       (new-constraint 
		(make-selection-def :id (first feature)
				    :fn fn-name
				    :features (second feature))))
	  (pushnew (second feature) (whiteboard-elt-featurelist wbe))
	  (if (brownboard-elt-featurespecs bs)
	      (push new-constraint (brownboard-elt-featurespecs bs))
	    (setf (brownboard-elt-featurespecs bs) (list new-constraint)))))
       (t
	(warning "Unrecognized prosody constraint type in: " feature))))
    (t
     (pushnew feature (whiteboard-elt-featurelist wbe)))))


;;; ----------------------------------------------------------------------
;;; Sorting out dependent constituents and tidying up...
;;; (2.0 some more code moved back here out of all-parts0).
;;; ----------------------------------------------------------------------

(defun EXTRACT-PROSODIES (dependency-ordering)
  (let ((dependents 
	 (filter-prosodies-against-units-present
	  (number-functions 
	   (remove-duplicates (mapcar #'cdr *active-unit-dependencies*)))
	  dependency-ordering)))
    (when *agreement-trace*
      (format *trace-output*
	      "~%For this rank, following units are dependents: ~A" 
	      dependents))
    dependents))

(defun FILTER-PROSODIES-AGAINST-UNITS-PRESENT 
  (potential-dependents units-present)
  (loop for dependent in potential-dependents
	when (loop for u in units-present thereis (member dependent u))
	collect dependent))

;;; ----------------------------------------------------------------------
;;; New utilities at 2.0.52
;;; ----------------------------------------------------------------------

(defun AGREEMENT-TRACE (&rest args)
  (when *agreement-trace* (apply #'format (cons *trace-output* args))))

;;; ----------------------------------------------------------------------
;;; Go through the whiteboard elements of an unrealized unit and collect
;;; the classify constraints that apply to unit. This assumes that the
;;; unit is always the alias function, this may need to be altered. We
;;; also need to consider what to do with inflectify information, whether
;;; this needs to be done separately or just at the same time.
;;; ----------------------------------------------------------------------

(defun COLLECT-CLASSIFY-INFLECTIFY-INFO (unit list-wbe) 
  (loop for wbe in list-wbe
      when (and (equal unit (whiteboard-elt-aliasfn wbe))
		(equal (whiteboard-elt-id wbe) 'classify))
      append (whiteboard-elt-featurelist wbe)))


