(in-package "PENMAN")

;;; *additive* runs on trivial default code at present, because "switching it on" 
;;; interferes with three of the older examples

;(defun additive-Q-Code (reln)
;  "Decides if the RELN is additive or causal."
;  (if  (term-type-p reln 'jointly-regarded) 'additive 'nonadditive))


(defun Circular-Q-Code (reln range)
  "Depends on type of RELN."
  (declare (ignore range)) 
  (if (term-type-p reln 'circular-extent) 'circular
      (if (or (term-type-p reln 'noncircular-extent)
		   (term-type-p reln 'nonparallel-extent)) 'noncircular)))

(defun kind-of-add-Q-Code (reln)
  "Chooses the lexeme for expressing the conjunctive relation."
  (if (and (term-type-p reln 'additive)
	  (term-type-p reln 'joint)) 'and-add 'also-add))

(defun Noncirculard-Q-Code (reln range)
  "Depends on type of RELN."
  (declare (ignore range)) 
  (if (term-type-p reln 'noncircular-extent) '3-d
      (if (term-type-p reln 'nonparallel-extent) '1-2-d)))

(defun partellipsis-Q-Code (item)
  "Decides if ITEM is elided partially or in full."
  (if  (term-type-p item 'moodellipsis) 'part 'full))

;;; *predicatorellipsis* runs with trivial default code for now, not sure if it should get proper code
;;; system has input "mood-unit" and options "elided" and "present"

;;; *theme* region (i.e. for mood adjuncts) doesn't seem to need operator code as most of the 
;;; comparable existing examples work either with trivial default code or without any code at all

(defun whichpartelided-Q-Code (item)
  "Decides if elided ITEM corresponds to Subject or Finite."
  (if  (term-type-p item 'partellipsis) 'subject 'finite))

;;; the following is copied from German, but does't work for older instances 
;;; realised by 'destination' key word in SPLs (e.g., "towards" or some"to"s), so it runs on
;;; trivial default for now as well

;(defun spacelocative-rel-ID-Code (process)
;  "Return the static-spatial feature plus relation, bundled up together."
;  (let ((ss (fetch-relation-spec process 'static-spatial 'spacelocative-id)))
;    (if ss
;	ss
;      (let ((sl (fetch-relation-spec process 'spatial-locating 'spacelocative-id))
;	    (sd (fetch-relation-spec process 'source-destination 'spacelocative-id)))
;	(if (not (equal sl sd))
;	    sl)))))
;  
;(defun space-direction-circumstance-q-code (process)
;  "is there a spatial location?"
;  (if (and 
;       (not (term-type-p process 'two-place-relation)) 
;       (fetch-relation 'source-destination process))
;      'space-direction))

;(defun spacedirection-rel-ID-Code (process)
;  "Return the static-spatial feature plus relation, bundled up together."
;  (or ;; (fetch-relation-spec process 'spatial-locating 'spacelocative-id)
;      (fetch-relation-spec process 'source-destination 'spacelocative-id)))


