;;; File new-conjunctive-extension-q-code.lisp
;;; Last saved in emacs: Time-stamp: <95/08/02 10:37:35 williams>
;;; Susan Williams, August 1, 1995 (at FAW)

;;; This file contains a redefinition of Conjunctive-Extension-Q-Code
;;; which contains all the additions that Brigitte, Mick, and Susan
;;; have made.  No doubt there will be many more.....

(in-package :penman)

#|
;;; this is Brigitte's version:
(defun Conjunctive-Extension-Q-Code (initiating continuing)
  "If type of continuing is SET, or the pair are elements of a set, then conjunctive.
   Also, if INITIATING & CONTINUING are related by CONJUNCTION."
  (if (or (and (term-type-p continuing 'um-set)
	       (not (term-type-p continuing 'disjunctive-set)))
	  (term-type-p initiating 'conjunction)
	  (dolist (graph *plan-graphs*)
		  (if (and (term-type-p graph 'um-set)
			   (not (term-type-p graph 'disjunctive-set));;hinzugefuegt!
			   (consp (term-graph-symbol (symbol-value graph)))
;      		           (member initiating (term-graph-symbol (symbol-value graph)))
			   (member continuing (term-graph-symbol (symbol-value graph))))
		      (return 't))
		  (if (and (term-type-p graph 'conjunction)
			   (term-eq-p initiating (fetch-subc-feature 'domain graph))
			   (term-eq-p continuing (fetch-subc-feature 'range graph)))
		      (return 't))))
      'conjunctive 
    'nonconjunctive))

;;; This is my (Susan's) old version:
(defun Conjunctive-Extension-Q-Code (initiating continuing)
  "If type of continuing is SET, or the pair are elements of a set, then conjunctive.
   Also, if INITIATING & CONTINUING are related by CONJUNCTION."
  (if (or (term-type-p continuing 'set)
	  (term-type-p initiating 'conjunction)
	  ;; Susan's addition to look for rst-whereas-contrastive
	  (eq (term-graph-type (symbol-value initiating)) 'rst-whereas-contrastive)
	  (dolist (graph *plan-graphs*)
	    (if (and (term-type-p graph 'set)
		     (consp (term-graph-symbol (symbol-value graph)))
;		     (member initiating (term-graph-symbol (symbol-value graph)))
		     (member continuing (term-graph-symbol (symbol-value graph))))
		(return 't))
	    (if (and (term-type-p graph 'conjunction)
		     (term-eq-p initiating (fetch-subc-feature 'domain graph))
		     (term-eq-p continuing (fetch-subc-feature 'range graph)))
		(return 't))))
      'conjunctive 
      'nonconjunctive))

;;; And this is Mick's version from mick-adv-patch, which is currently
;;; not working (the whole patch, not the rewrite of the -q-code):
(defun Conjunctive-Extension-Q-Code (initiating continuing)
  "If type of continuing is SET, or the pair are elements of a set, then conjunctive.
   Also, if INITIATING & CONTINUING are related by CONJUNCTION." 

  (if (or (and (term-type-p continuing 'set)
               (not (term-type-p continuing 'disjunctive-set)))
	  (term-type-p initiating 'conjunction)
	  ;; Susan's addition to look for rst-whereas-contrastive
	  (eq (term-graph-type (symbol-value initiating)) 'rst-whereas-contrastive)
	  (dolist (graph *plan-graphs*)
	    (if (and (term-type-p graph 'set)
                     (not (term-type-p graph 'disjunctive-set))  ;;;;;MICK********
		     (consp (term-graph-symbol (symbol-value graph)))
;		     (member initiating (term-graph-symbol (symbol-value graph)))
		     (member continuing (term-graph-symbol (symbol-value graph))))
		(return 't))
	    (if (and (term-type-p graph 'conjunction)
		     (term-eq-p initiating (fetch-subc-feature 'domain graph))
		     (term-eq-p continuing (fetch-subc-feature 'range graph)))
		(return 't))))
      'conjunctive 
      'nonconjunctive))
|#


;;; And this should be the version that works for both kpml and penman
;;; and with all the patches:
(defun Conjunctive-Extension-Q-Code (initiating continuing)
  "If type of continuing is SET, or the pair are elements of a set, then conjunctive.
   Also, if INITIATING & CONTINUING are related by CONJUNCTION."
  (if (or (and (or (term-type-p continuing 'um-set)
		   (term-type-p continuing 'set))
	       (not (term-type-p continuing 'disjunctive-set)))
	  (term-type-p initiating 'conjunction)
	  ;; Susan's addition to look for rst-whereas-contrastive
	  (eq (term-graph-type (symbol-value initiating)) 'rst-whereas-contrastive)
	  (dolist (graph *plan-graphs*)
		  (if (and (or (term-type-p graph 'um-set)
			       (term-type-p graph 'set))
			   (not (term-type-p graph 'disjunctive-set));;hinzugefuegt!
			   (consp (term-graph-symbol (symbol-value graph)))
			  ;(member initiating (term-graph-symbol (symbol-value graph)))
			   (member continuing (term-graph-symbol (symbol-value graph))))
		      (return 't))
		  (if (and (term-type-p graph 'conjunction)
			   (term-eq-p initiating (fetch-subc-feature 'domain graph))
			   (term-eq-p continuing (fetch-subc-feature 'range graph)))
		      (return 't))))
      'conjunctive 
    'nonconjunctive))
