(in-package :penman)


#|
----------------------------------------------------------------
Task 1. Ellipsis of Repeated Subjects in sequential clauses where paratactically related.
e.g., The implant may fail or (The implant) may wear out.
e.g., The implant may fail, (The implant) may wear out, or may be replaced.
e.g., The implant may fail, (The implant) may wear out, or the doctor may replace it.
----------------------------------------------------------------
Approach: Each clause checks to see if it is either:

  1) The Continuing element of a paratactic clause complex, and if so, whether
     the Subject of the Initiating clause has the same referent.

  2) An Initiating clause in a clause complex which is itself a continuing clause
     in a clause complex e.g., 

      /  \
      I   C
         / \
        I*  C

    In which case, the Subject of the higher level Initiating clause is checked.
----------------------------------------------------------------
Resource Modification:

  1) Added a condition to the INDICATIVE-SUBJECT-PRESUMPTION-CHOOSER to
     check if the Subject is repeated, and if so, to choose SUBJECT-IMPLICIT.

  2) Supplied the inquiry Subject-Repeated-q which basically checks if the
     last clause (paratactically related) had the same Subject referent.
     Also some lisp support functions for this inquiry.

  3) Re-wired some systems involving Subject insertion, to make this work.
     The old INDICATIVE-SUBJECT-PRESUMPTION stopped insertion if SUBJECT-IMPLICIT
     was selected, while I now have this choice *following* the subject-insertion,
    and realise SUBJECT-IMPLICIT by presuming the subject: (lexify Subject zero)

|#




(gate
   :name EXPLICIT-DECLARATIVE-SUBJECT
   :inputs (AND DECLARATIVE
                (OR INDICATIVE-NONINTERACTANT
                    METATHING-SUBJECT
                    ADDRESSEE-SUBJECT
                    SPEAKER-PLUS-SUBJECT
                    SPEAKER-SUBJECT ;**********
                    ))
   :outputs ((1.0 EXPLICIT-DECLARATIVE-SUBJECT))
   :selector CHOICE-MASTER
   :old-feature EXPLICIT-DECLARATIVE-SUBJECT
   :region MOOD
   :metafunction INTERPERSONAL)

(gate
   :name EXPLICIT-INTERROGATIVE-SUBJECT
   :inputs (AND INTERROGATIVE
                (OR SPEAKER-SUBJECT
                    SPEAKER-PLUS-SUBJECT
                    INDICATIVE-NONINTERACTANT
                    METATHING-SUBJECT
                    ADDRESSEE-SUBJECT ;*******
                    ))
   :outputs ((1.0 EXPLICIT-INTERROGATIVE-SUBJECT))
   :selector CHOICE-MASTER
   :old-feature EXPLICIT-INTERROGATIVE-SUBJECT
   :region MOOD
   :metafunction INTERPERSONAL)

(gate
   :name SUBJECT-INSERT
   :inputs (OR WH-SUBJECT
               METEOROLOGICAL
               EXISTENTIAL
               INDICATIVE-NONINTERACTANT
               METATHING-SUBJECT
               SUBJECT-SPECIFIED
               EXPLICIT-SUBJECT-ELABORATING
               INDIRECT-INDICATIVE
               FINITE-ENHANCING
               FINITE-EXTENDING
               FINITE-ELABORATING
               FINITE-RANKSHIFT
               EXPLICIT-SUBJECT
               EXPLICIT-DECLARATIVE-SUBJECT
               EXPLICIT-INTERROGATIVE-SUBJECT 
               IMPERATIVE-OTHER
               IMPERATIVE-SUBJECT-EXPLICIT
               (AND IMPERATIVE
                    (OR OBLATIVE SUGGESTIVE)))
   :outputs ((1.0 SUBJECT-INSERTED (INSERT SUBJECT)))
   :selector CHOICE-MASTER
   :old-feature SUBJECT-INSERTED
   :region MOOD
   :metafunction INTERPERSONAL)

(system
   :name INDICATIVE-SUBJECT-PRESUMPTION
   :inputs (or EXPLICIT-DECLARATIVE-SUBJECT EXPLICIT-INTERROGATIVE-SUBJECT)
   :outputs ((0.9 SUBJECT-EXPLICIT) (0.1 SUBJECT-IMPLICIT
                                     (lexify Subject ellipsiszero)))
   :chooser INDICATIVE-SUBJECT-PRESUMPTION-CHOOSER
   :selector CHOICE-MASTER
   :old-feature SUBJECT-EXPLICIT
   :region MOOD
   :metafunction INTERPERSONAL
   :comments "(DELETESYMBOL TAKEN OUT NOT NEEDED WITH SUBJECTINSERT)")


(chooser
 :name INDICATIVE-SUBJECT-PRESUMPTION-CHOOSER 
 :definition ((ASK (FORMAL-REGISTER-Q ONUS)
                   (FORMAL (CHOOSE SUBJECT-EXPLICIT))
                   (NONFORMAL
                    (ASK (Subject-Repeated-q SUBJECT)
                         (repeated (CHOOSE SUBJECT-IMPLICIT))
                         (notrepeated (ASK (STATEMENT-Q SPEECHACT)
                                         (STATEMENT
                                          (ASK (MEMBER-SET-Q SPEAKER SUBJECT)
                                               (INCLUDED
                                                (ASK (EXPRESS-SPEAKER-Q SPEAKER ONUS)
                                                     (EXPRESSSPEAKER (CHOOSE SUBJECT-EXPLICIT))
                                                     (WITHHOLDSPEAKER (CHOOSE SUBJECT-IMPLICIT))))
                                               (NOTINCLUDED (CHOOSE SUBJECT-EXPLICIT))))
                                         (NONSTATEMENT
                                          (ASK (QUESTION-Q SPEECHACT)
                                               (QUESTION
                                                (ASK (MEMBER-SET-QQ HEARER SUBJECT)
                                                     (INCLUDED
                                                      (ASK (EXPRESS-HEARER-Q HEARER ONUS)
                                                           (EXPRESSHEARER (CHOOSE SUBJECT-EXPLICIT))
                                                           (WITHHOLDHEARER (CHOOSE SUBJECT-IMPLICIT))))
                                                     (NOTINCLUDED (CHOOSE SUBJECT-EXPLICIT))))
                                               (NONQUESTION))))))))
              (* CM "23-Jan-86 10:37:14"))
 :comments ""
 :editor ""
 :date "8-4-1992 15:51:33 at IPSI.")

(askoperator 
   :name subject-repeated-q
   :domain TP
   :mode IMPLEMENTED
   :parameters (Subject)
   :english ("Does the Subject " Subject " express the entity already expressed" 
             " as the subject of the prior clause in a paratactic complex?")
   :operatorcode subject-repeated-q-code
   :parameterassociationtypes (CONCEPT)
   :answerset (repeated notrepeated)
   :trivialdefault nil
   )

  
;;;;;;;;;;;;;;;;;;

(defun subject-repeated-q-code (Subject)
  "Returns 'repeated' if the Subject expresses the entity expressed as the
Subject of the immediately prior clause, where that clause is part of a
paratactic clause complex with the present clause."
  (if (Same-As-Q-Code (fetch-prior-role-hub 'Subject alias-function-stack)
                      Subject)
    'repeated
    'notrepeated))

;------------------
;;; Support Code
;------------------

(defun fetch-prior-role-hub (Function role-chain)
  "Returns the Hub of the Function, occuring in the immediately prior
   clause in a paratactic clause complex."

  (let* ((current-function (car role-chain))
         prior-clause)
    
    (case (strip-role-number current-function)
      (continuing ; Fetch the role in the Initiating clause
       (and (setq prior-clause (fetch-unit-role (fetch-parent (cdr role-chain)) 'Initiating))
            (fetch-unit-hub prior-clause Function)))
      
      (Initiating ; check if the same condition is true for the cc as a whole
       (fetch-prior-role-hub Function (cdr role-chain) )))))


;;;(defun fetch-unit-hub (struct Gram-function)
;;;  (function-association-concept 
;;;   (find Gram-function (constituent-pass-associations struct)
;;;         :key 'function-association-function)))

;;; Susan modified this to avoid a "non structure passed to structure
;;; reference error:
;;; (I don't know yet whether this is the right thing to do.)
 (defun fetch-unit-hub (struct Gram-function)
  (let ((find-result (find Gram-function (constituent-pass-associations struct)
			   :key 'function-association-function)))
    (when find-result
	  (function-association-concept find-result))))
;;; Later comment:  Mick says the fix is good.  (July, 29, 1995)

(defun fetch-unit-role (struct role)
  "Returns the constituent-pass structure for the designated role."
  (let ((role-name (find role (car (constituent-pass-sequences struct))
                         :key 'strip-role-number))
        WBE index)

    (unless role-name
      (warning "fetch-unit-role : No role of name " role " in unit")
      (return-from fetch-unit-role nil))

    (and (setq WBE (find role-name (constituent-pass-whiteboard struct)
                    :key 'whiteboard-elt-aliasfn :test 'equal))
         (setq index (whiteboard-elt-index WBE))
         (gethash index show-pass-hash-table))))


(defun fetch-parent (alias-path)
  "Returns the constituent-pass structure of the parent of the current-grammatical-unit,
   given a role-chain (alias-path) as input."
  (setq alias-path (cdr (reverse alias-path)))
  (if (null alias-path)
    ;at the top
    (gethash  1 show-pass-hash-table)
    ;a constituent
    (fetch-struct-from-path (car alias-path) (cdr alias-path) 
                              (gethash  1 show-pass-hash-table))))


(defun fetch-struct-from-path (child-funct alias-path struct )
  (let (child-struct WBE index)
    (unless (setq child-struct (and (setq WBE (find child-funct (constituent-pass-whiteboard struct)
                                                    :key 'whiteboard-elt-aliasfn :test 'equal))
                                    (setq index (whiteboard-elt-index WBE))
                                    (gethash index show-pass-hash-table)))
        (warning "fetch-struct-from-path : Function not found in struct")
        (return-from fetch-struct-from-path nil))
    
    ; we now have the terminal structure in 'struct'
    (if alias-path
      (fetch-struct-from-path (car alias-path) (cdr alias-path) child-struct)
      child-struct)))

;(setq alias-function-stack '(continuing initiating))

     
(defun constituent-label (unit)
  (or (second (find 'penman::expanded-object (penman::constituent-pass-blackboard unit) :key #'car))
      (penman::whiteboard-elt-aliasfn (car (penman::constituent-pass-whiteboard unit)))))

(defun stripped-constituent-label (unit)
  (strip-role-number (constituent-label Unit)))

(defun strip-role-number (role)
  (intern (subseq (string  role) 0 (search "#" (string  role) ))
          :penman))

           

;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;; Modal-Ellipsis

#| As above, but in addaition, ellipse the Modal if it is repeating from the
prior clause.

e.g., The implant may fail or (The implant may) wear out.
e.g., The implant may fail, (The implant may) wear out, or may be replaced.
e.g., The implant may fail, (The implant may) wear out, or the doctor may replace it.

Problem: Needs to be extended to all cases of Auxillary repetition.

----------------------------------------------------------------
Approach: Each clause checks to see if it is either:

  1) The Continuing element of a paratactic clause complex, and if so, whether
     the Finite of the Initiating clause expresses the same modality.

  2) An Initiating clause in a clause complex which is itself a continuing clause
     in a clause complex. In which case, the Finite of the higher level Initiating 
     clause is checked.
----------------------------------------------------------------
Resource Modification:

  1) Added a system MODAL-presumption which is activated only when the subject was
     ellipsed. This checks if the present clause's finite (the Modal) expresses
     the same type of modality as the preceding clause.

  2) Supplied a chooser&inquiry which select appropriately.
----------------------------------------------------------------
|#

(system
   :name MODAL-presumption
   :inputs (and SUBJECT-IMPLICIT MODAL)
   :outputs ((1 modal-presumed (lexify Finite ellipsiszero) )
             (1 modal-not-presumed))
   :chooser MODAL-presumption-CHOOSER
   :selector CHOICE-MASTER
   :region tense
   :metafunction LOGICAL)

(chooser
 :name MODAL-presumption-CHOOSER 
 :definition ((ASK (modal-repeated-q Finite)
                   (repeated (CHOOSE modal-presumed))
                   (notrepeated (CHOOSE modal-not-presumed))))
 :comments ""
 :editor ""
 :date "8-4-1992 15:49:14 at IPSI.")

(askoperator 
   :name modal-repeated-q
   :domain TP
   :mode IMPLEMENTED
   :parameters (Finite)
   :english ("Is the Modal element the same as in the last clause in a paratactic sequence?")
   :operatorcode modal-repeated-q-code
   :parameterassociationtypes (CONCEPT)
   :answerset (repeated notrepeated))

(defun Modal-repeated-q-code (Finite &aux Prior-Modal-Hub)
  "Returns 'repeated' if the Subject expresses the entity expressed as the
Subject of the immediately prior clause, where that clause is part of a
paratactic clause complex with the present clause."
  ;(break)
  (if (and (setq Prior-Modal-Hub (fetch-prior-role-hub 'Finite alias-function-stack))
           (equal (term-type Prior-Modal-Hub)
                  (term-type Finite)))
    'repeated
    'notrepeated))
