;;; File: new-rst.lisp
;;; This file contains new rst relations
;;; Susan Williams, May 31, 1995
;;; Last modified: June 12, 1995

(in-package :penman)

(penman-kb::defreified-relation RST-whereas-contrastive
  :is (:and penman-kb::asymmetric-rhetorical-relation
	    penman-kb::logical-condition
	    :primitive))

(defun Temporal-Definiteness-Specification-Q-Code (process)
  "Look for an event-time feature of the entry term."
  (if (or (fetch-subc-feature 'event-time process)
	  (if (get-symbol-term process) 
	      (fetch-subc-feature 'event-time (get-symbol-term process)))
	  ;; Susan's addition for RST-WHEREAS-CONTRASTIVE  (and now rst-in-which):
	  (eq 'rst-in-which
	      (term-graph-type (symbol-value (term-graph-parent (symbol-value process)))))
	  (eq 'rst-whereas-contrastive
	      (term-graph-type (symbol-value (term-graph-parent (symbol-value process))))))
      'specified 
      'notspecified))

(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  (and now rst-in-which)
	  (eq (term-graph-type (symbol-value initiating)) 'rst-whereas-contrastive)
	  (eq (term-graph-type (symbol-value initiating)) 'rst-in-which)
	  (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))

;;; This modification will give the correct answer for RST-LOGICAL-CONDITION
;;; so that no boundary will be hit.
(defun Disjunctive-Extension-Q-Code (initiating continuing)
  "If type of continuing is DISJUNCTIVE-SET (SPL) or DISJUNCTION (UM), then DISJUNCTIVE."

  (if (or (term-type-p continuing 'disjunctive-set)
	  (term-type-p continuing 'disjunction)
	  ;; Susan's addition to look for rst-logical-condition
	  (eq (term-graph-type (symbol-value initiating)) 'rst-logical-condition)
	  ;; Susan' extra addition (still in testing) so that we don't hit boundaries on disjunctions:
	  (term-type-p initiating 'disjunction)
	  (dolist (graph *plan-graphs*)
	    (if (and (term-type-p graph 'disjunctive-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 'disjunction)
		     (term-eq-p initiating (fetch-subc-feature 'domain graph))
		     (term-eq-p continuing (fetch-subc-feature 'range graph)))
		(return 't))))
      'disjunctive 
      'nondisjunctive))


