;;; File: more-inquiry-implementations.lisp
;;; This file contains modifications of inquiry implementation code.
;;; Susan Williams
;;; Last saved in emacs: Time-stamp: <95/08/01 16:22:38 williams>

(in-package :penman)

(defun Formal-Register-Q-Code (reln)
  "Look for a between feature."
  (if (or (term-type-p reln 'formal)
	  (eq reln 'of-matter))    ; So that :of-matter really
                                   ;    produces "of" and not "about"
      'formal 'nonformal))

;;; I had to add to this to account for plurals in disjunctive sets.
(defun Multiplicity-Q-Code (thing)
  "Look for number.  If THING isn't a plan, look for a plan for it.
   Even if it isn't a plan, look at other TERM-EQ-P plans for multiplicity
   (this is important for agreement in number in deopendent clauses)."
  (if (and (symbolp thing)
	   (boundp thing)
	   (typep (symbol-value thing) 'term-graph))
      (if (or (eq (fetch-feature-symbol 'number thing) 'multiple)
	      (and (fetch-subc-feature 'quantity-ascription thing)
		   (numberp (fetch-subc-feature 'quantity-ascription thing))
		   (< 1 (fetch-subc-feature 'quantity-ascription thing)))
	      (term-type-p thing 'set)
	      ;; Susan's addition to account for plurals in disjunctive sets:
	      (if (term-type-p thing 'disjunctive-set)
		  (remove-if #'null 
			     (mapcar 
			      #'(lambda (x)
				  (when x
					(eq (cdr (assoc 'multiplicity-q 
							    (term-graph-features 
							     (symbol-value x)))) 
					    'multiple)))
			      (term-graph-symbol (symbol-value thing)))))
	      ;; end of Susan's additions
	      (dolist (graph *plan-graphs*)
		      (if (and (not (eq thing graph))
			       (term-eq-p thing graph)
			       (or (eq (fetch-feature 'multiplicity-q graph) 'multiple)
				   (eq (fetch-feature-symbol 'number graph) 'multiple)
				   (term-type-p graph 'set)))
			  (return t))))
	  'multiple)
    (if (null thing)
	nil
      (Multiplicity-Q-Code
       (dolist (graph *plan-graphs*)
	       (if (term-eq-p graph thing)
		   (return)))))))

;;;-----------------------------
;;; Added: August 1, 1995:


;;; This has been changed to allow for the possibility that the parent
;;; is a disjunction or conjunction, in which case, we should use the
;;; grand-parent to decide:
(defun Report-Q-Code (process)
  "Use the parent of process to decide."
  (if (or (term-type-p (term-graph-parent (symbol-value process)) 'disjunction)
	  (term-type-p (term-graph-parent (symbol-value process)) 'conjunction))
      (report-q-code (term-graph-parent (symbol-value process)))
    (if (or (term-type-p (term-graph-parent (symbol-value process)) 'verbal-process)
	    (term-type-p (term-graph-parent (symbol-value process)) 'mental-process))
	'report
      'nonreport)))

;;; This has been changed for the same reason as above.
(defun Proposal-Q-Code (action)
  "If the type of the projector of ACTION is Non-Addressee-Oriented, then not proposal."
  (if (or (term-type-p (term-graph-parent (symbol-value action)) 'disjunction)
	  (term-type-p (term-graph-parent (symbol-value action)) 'conjunction))
      (proposal-q-code (term-graph-parent (symbol-value action)))
    (if (or (and (term-type-p (term-graph-parent (symbol-value action)) 
			      'Mental-Process)
		 (not (term-type-p (term-graph-parent (symbol-value action)) 
				   'reaction))
		 (fetch-subc-feature 'event-time action))
	    (term-type-p (term-graph-parent (symbol-value action)) 
			 'Non-Addressee-Oriented-Verbal-Process))
	'notproposal
      'proposal)))
