;;; File: new-extracted-variable-id.lisp
;;; Last saved in emacs: Time-stamp: <95/07/28 16:24:39 williams>

;;; This file contains a redefintion of the implementation for the
;;; inquiry extracted-variable-id.  This allows for conjuctions in
;;; certain positions.

;;; This has not yet been fully tested on other SPL!

(defun Extracted-Variable-ID-Code (process)
  "If NOT a process involved in a RHETORICAL-RELATION, get the parent term.
   If it is such a process, identify a point of overlap."
  (if (and (boundp process)
	   (typep (symbol-value process) 'term-graph))
      (if (term-type-p (term-graph-parent (symbol-value process)) 'rhetorical-relation)
	  (first 
	   (intersection 
	    (remove nil
		    (mapcar #'(lambda (a-feature) 
				(if (or (term-type-p (first a-feature) 'participant)
					(term-type-p (first a-feature) 'place))
				    (term-graph-symbol (rest a-feature))))
			    (term-graph-features (symbol-value process))))
	    (remove nil 
		    (mapcar #'(lambda (a-feature) 
				(if (or (term-type-p (first a-feature) 'participant)
					(term-type-p (first a-feature) 'place)
					(term-type-p (first a-feature) 'relational-process));;;To pick up other connexions
				    (term-graph-symbol (rest a-feature))))
			    (term-graph-features 
			     (symbol-value 
			      (fetch-subc-feature 
			       'domain 
			       (term-graph-parent (symbol-value
						   process)))))))))
	(if (term-type-p (term-graph-parent (symbol-value process))
			 'disjunction)
	    (progn (while (term-type-p (term-graph-parent (symbol-value process))
				       'disjunction)
		     (setq process (term-graph-parent (symbol-value process))))
		   (term-graph-symbol (symbol-value (term-graph-parent (symbol-value process)))))
	  (term-graph-symbol (symbol-value (term-graph-parent (symbol-value process))))))
    (term-graph-symbol (symbol-value (term-graph-parent (get-symbol-term process))))))
