(in-package :snepsul)

(setq verb_trace NIL)
(setq subject_trace NIL)
(setq object_trace NIL)
(setq ind_object_trace NIL)
(setq cause_trace NIL)
(setq effect_trace NIL)


;----------------------------------------------------------------------------
;
;	function: defn_verb
;	input:	a verb to be defined
;	output: predicate structure of , with categorization of arguments;
;		causal/enablement information; eventually to include primitive 
;		act of which  is a type (if any).
;	calls:  report_bitransitive, or report_transitive, or report_reflexive,
;		or report_intransitve, as appropriate.
;	NOTE: #3! is a macro which allows snepsul commands to be invoked from
;	      within lisp functions; obviates need for references to pkgs, etc.
;	*******modified RMS 4-02******
;------------------------------------------------------------------------------
(defun defn_verb (verb)
  (setq czs (cause verb))
  (setq efs (car (effect verb)))
  (setq subject (categorize_subject verb))
  (setq object (categorize_object verb))
  (setq ind_obj (categorize_indobject verb))
  (if verb_trace
      (list (report verb czs efs subject object ind_obj)
              (report_trace))
    (report verb czs efs subject object ind_obj)))

;-----------------------------------------------------------------------------
;
;	function: report
;	input: a verb to be defined
;	output: predicate structure of , with categorization of arguments;
;		causal/enablement information; eventually to include primitive 
;		act of which  is a type (if any).
;	calls:	categorize_subject, categorize_object, categorize_indobject,
;		cause, effect, (prim_base currently undefined)
;   *************added by RMS 4-02**********
;----------------------------------------------------------------------------
(defun report (verb czs efs sub obj ind)
  (setq result (list 'a sub))
  (if obj
      (if ind
          (setq result (append 
                        result 
                        (list 'can verb 'a obj 'to 'a ind)))
        (setq result (append 
                      result
                      (list 'can verb 'a obj)))))
  (setq result (append
                result
                (list 'result= #3!((describe ~czs))
                      'enabled 'by= #3!((describe ~efs)))))
  ;	   (prim_base verb)
  )

;-----------------------------------------------------------------------------
;
;	function: report_trace
;	input: nil
;	output: which functions returned information about the verb
;	calls:nil
;   *************added by RMS 4-02**********
;----------------------------------------------------------------------------
(defun report_trace ()
  (list subject_trace object_trace ind_object_trace cause_trace effect_trace))



;------------------------------------------------------------------------------
;
;	function: categorize_subject 
;	input:  a verb to be defined
;	output: categorization of encountered subjects of  as (in order
;		of preference) 1)belonging to some basic level category,  
;		2)belonging to some subclass of animal, or 3)belonging to some
;		miscellaneous (but known) class.
;	calls:	base_cat_subj, anim_subj, some_cat_subj, emptyp
	*********modified RMS 4-02**********
;------------------------------------------------------------------------------
(defun categorize_subject (verb)
  (setq base_subj (base_cat_subj verb))
  (setq animal_subj (anim_subj verb))
  (setq some_subj (some_cat_subj verb))
  
  (cond ((emptyp (list base_subj animal_subj))
         (setq subject some_subj)
         (if verb_trace
             (setq subject_trace (list 'subject 'found 'by 'some_cat_subj)))
         (if (listp subject)
             (cathelper subject nil)
           subject))
        ((emptyp base_subj) 
         (if verb_trace
             (setq subject_trace (list 'subject 'found 'by 'anim_subj)))            
         (cathelper animal_subj nil))
        (t (if verb_trace
               (setq subject_trace (list 'subject 'found 'by 'base_cat_subj)))  
           (cathelper base_subj nil))))

;------------------------------------------------------------------------------
;
;	function: person_subj  (function not currently used in defining verb)
;	input:  a verb to be defined
;	output: the atom 'person, if a member of the class person has been
;		encountered as the subject of 
;------------------------------------------------------------------------------
(defun person_subj (verb)
     (cond ((AND #3! ((deduce agent $vsub act (build lex ~verb)))
		 #3! ((deduce member *vsub class (build lex "person"))))
	    'person)))
;-------------------------------------------------------------------------------
;
;	function: anim_subj
;	input:  a verb to be defined
;	output: a list of the kinds of animal which have been known to 
;-------------------------------------------------------------------------------
(defun anim_subj (verb)
     (cond ((AND #3! ((deduce agent $vsub1 act (build lex ~verb)))
		 #3! ((deduce member *vsub1 class (build lex "animal"))))
            (append #3! ((find (compose lex- class- ! member
                                     agent- ! act lex) ~verb))
                    #3! ((find (compose lex- class- ! members
                                     agent- ! act lex) ~verb))))
;           (#3! ((find (compose lex- class-  member
;                                agent-  act lex) ~verb))
;            (list #3! ((find (compose lex- class-  member
;                                     agent-  act lex) ~verb))))
))



;-------------------------------------------------------------------------------
;
;	function: base_cat_subj
;	input:  a verb to be defined
;	output: a list of basic level categs. which have been known to 
;-------------------------------------------------------------------------------
(defun base_cat_subj (verb)
     (cond ((AND #3! ((deduce agent $vsub2 act (build lex ~verb)))
		 (OR #3! ((deduce member *vsub2 class $vbasic))
		     #3! ((deduce members *vsub2 class $vbasic)))
		 #3! ((deduce object1 *vbasic rel "ISA" 
                             object2 (build lex "basic ctgy"))))
            (append #3! ((find (compose lex- class- ! member
                                     agent- ! act lex) ~verb))
                   #3! ((find (compose lex- class- ! members
                                     agent- ! act lex) ~verb))))))
;-------------------------------------------------------------------------------
;
;	function: some_cat_subj
;	input:  a verb to be defined
;	output: a list of the kinds of things which have been known to 
;		or the atom 'something, if nothing known about what can .
;-------------------------------------------------------------------------------
(defun some_cat_subj (verb)
     (cond ((AND #3! ((deduce agent $vsub3 act (build lex ~verb)))
	         (OR #3! ((deduce object1 *vsub3 rel "ISA" object2 $somecat))
	             #3! ((deduce objects1 *vsub3 rel "ARE" object2 $somecat))))
            (append #3! ((find (compose lex- object2- ! object1
				     agent- ! act lex) ~verb))
                    #3! ((find (compose lex- object2- ! objects1
				     agent- ! act lex) ~verb))))
;           (#3! ((find (compose lex- object2-  object1
;	                	agent-  act lex) ~verb))
;            (list #3! ((find (compose lex- object2-  object1
;				     agent-  act lex) ~verb))))
           (t 'something)))



;-----------------------------------------------------------------------------
;
;	function: categorize_object 
;	input:  a verb to be defined
;	output: categorization of encountered objects of  as (in order
;		of preference) 1)belonging to some basic level category,  
;		2)belonging to some subclass of animal, or 3)belonging to some
;		miscellaneous (but known) class.
;	calls:	base_cat_obj, anim_obj, some_cat_obj, emptyp
;    ***********modified RMS 4-02***************
;------------------------------------------------------------------------------
(defun categorize_object (verb)
  (setq base_obj (base_cat_obj verb))
  (setq animal_obj (anim_obj verb))
  (setq some_obj (some_cat_obj verb))
  
  (cond ((emptyp (list base_obj animal_obj))
         (setq object some_obj)
         (if verb_trace
             (setq object_trace (list 'object 'found 'by 'some_cat_obj)))
         (if (listp object)
             (cathelper object nil)
           object))
        ((emptyp base_obj) 
         (if verb_trace
             (setq object_trace (list 'object 'found 'by 'anim_obj)))            
         (cathelper animal_obj nil))
        (t (if verb_trace
               (setq object_trace (list 'object 'found 'by 'base_cat_obj)))  
           (cathelper base_obj nil))))

;------------------------------------------------------------------------------
;
;	function: person_obj  (function not currently used in defining verb)
;	input:  a verb to be defined
;	output: the atom 'person, if a member of the class person has been
;		encountered as the object of 
;------------------------------------------------------------------------------
(defun person_obj (verb)
     (cond ((AND #3! ((deduce object $vobj agent $vsub4 act (build lex ~verb)))
		 #3! ((deduce member *vobj class (build lex "person"))))
	    'person)))



;-------------------------------------------------------------------------------
;
;	function: base_cat_obj
;	input:  a verb to be defined
;	output: a list of basic categs. of things known to have been ed.
;-------------------------------------------------------------------------------
(defun base_cat_obj (verb)
     (cond ((AND #3! ((deduce object $vobj1 agent $vsub5 act (build lex ~verb)))
		 #3! ((deduce member *vobj1 class $vbasic1))
		 #3! ((deduce object1 *vbasic1 rel "ISA" 
			     object2 (build lex "basic ctgy"))))
            (append #3! ((find (compose lex- class- ! member
				     object- ! act lex) ~verb))
                    #3! ((find (compose lex- class- ! members
				     object- ! act lex) ~verb))))
;           (#3! ((find (compose lex- class-  member
;				     object-  act lex) ~verb))
;            (list #3! ((find (compose lex- class-  member
;				     object-  act lex) ~verb))))
))
;-------------------------------------------------------------------------------
;
;	function: anim_obj
;	input:  a verb to be defined
;	output: a list of the kinds of animals known to have been ed.
;-------------------------------------------------------------------------------
(defun anim_obj (verb)
     (cond ((AND #3! ((deduce agent $vsub6 object $vobj2 act (build lex ~verb)))
		 #3! ((deduce member *vobj2 class (build lex "animal"))))
            (append #3! ((find (compose lex- class- ! member
				     object- ! act lex) ~verb))
                    #3! ((find (compose lex- class- ! members
				     object- ! act lex) ~verb))))))



;-------------------------------------------------------------------------------
;
;	function: some_cat_obj
;	input:  a verb to be defined
;	output: a list of the kinds of things known to have been ed,
;		or the atom 'something, if nothing known about what can
;		be ed.
; *********Modified RMS 4-02****************
;-------------------------------------------------------------------------------

(defun some_cat_obj (verb)
     (cond ((AND #3! ((deduce agent $vsub7 object $vobj3 act (build lex ~verb)))
	         (OR #3! ((deduce object1 *vobj3 rel "ISA" object2 *somecat))
	             #3! ((deduce objects1 *vobj3 rel "ARE" object2 *somecat))))
            (append #3! ((find (compose lex- object2- ! object1
			  	     object- ! act lex) ~verb))
                    #3! ((find (compose lex- object2- ! objects1
			  	     object- ! act lex) ~verb))))
;           (#3! ((find (compose lex- object2-  object1
;			  	     agent-  act lex) ~verb))
;            (list #3! ((find (compose lex- object2-  object1
;			  	     agent-  act lex) ~verb))))
	   (t 'something)))




;-----------------------------------------------------------------------------
;
;	function: categorize_indobject 
;	input:  a verb to be defined
;	output: categorization of encountered indirect objects of  as 
;		(in order of preference) 1)belonging to some basic level 
;		category, 2)belonging to some subclass of animal, or 
;		3)belonging to some miscellaneous (but known) class.
;	calls:	base_cat_indobj, anim_indobj, some_cat_indobj, emptyp
;  *******************modified RMS 4-02********************
;------------------------------------------------------------------------------
(defun categorize_indobject (verb)
  (setq base_ind_obj (base_cat_indobj verb))
  (setq animal_ind_obj (anim_indobj verb))
  (setq some_ind_obj (some_cat_indobj verb))
  
  (cond ((emptyp (list base_ind_obj animal_ind_obj))
         (setq ind_object some_ind_obj)
         (if verb_trace
             (setq ind_object_trace (list 'indirect 'object 'found 'by 'some_cat_indobj)))
         (if (listp ind_object)
             (cathelper ind_object nil)
           ind_object))
        ((emptyp base_ind_obj) 
         (if verb_trace
             (setq ind_object_trace (list 'indirect 'object 'found 'by 'anim_indobj)))            
         (cathelper animal_ind_obj nil))
        (t (if verb_trace
               (setq ind_object_trace (list 'indirect 'object 'found 'by 'base_cat_indobj)))  
           (cathelper base_ind_obj nil))))

  
;------------------------------------------------------------------------------
;
;	function: person_indobj  (function not currently used in defining verb )
;	input:  a verb to be defined
;	output: the atom 'person, if a member of the class person has been
;		encountered as the indirect object of 
;------------------------------------------------------------------------------
(defun person_indobj (verb)
     (cond ((AND #3! ((deduce indobj $vindobj object $vobj4
			     agent $vsub8 act (build lex ~verb)))
		 #3! ((deduce member *vindobj class (build lex "person"))))
	    'person)))



;-------------------------------------------------------------------------------
;
;	function: base_cat_indobj
;	input:  a verb to be defined
;	output: a list of basic categs. of things encountered as indirect 
;		object of 
;-------------------------------------------------------------------------------
(defun base_cat_indobj (verb)
     (cond ((AND #3! ((deduce object $vobj5 agent $vsub9
			     indobj $vindobj1 act (build lex ~verb)))
		 #3! ((deduce member *vindobj1 class $vbasic1))
		 #3! ((deduce object1 *vbasic1 rel "ISA" 
                             object2 (build lex "basic ctgy"))))
            (append #3! ((find (compose lex- class- ! member
				     indobj- ! act lex) ~verb))
                    #3! ((find (compose lex- class- ! members
				     indobj- ! act lex) ~verb))))
;           (#3! ((find (compose lex- class- member
;				     indobj- act lex) ~verb))
;            (list #3! ((find (compose lex- class- member
;				     indobj- act lex) ~verb))))
))
;-------------------------------------------------------------------------------
;
;	function: anim_indobj
;	input:  a verb to be defined
;	output: a list of the kinds of animals known to have been the indirect
;		object of .
;-------------------------------------------------------------------------------
(defun anim_indobj (verb)
     (cond ((AND #3! ((deduce agent $vsub9 object $vobj6
			     indobj $vindobj2 act (build lex ~verb)))
		 #3! ((deduce member *vindobj2 class (build lex "animal"))))
            (append #3! ((find (compose lex- class- ! member
				     indobj- ! act lex) ~verb))
                    #3! ((find (compose lex- class- ! members
				     indobj- ! act lex) ~verb))))
))



;-------------------------------------------------------------------------------
;
;	function: some_cat_indobj
;	input:  a verb to be defined
;	output: a list of the kinds of things known to have been the indirect
;		object of , if any;  
;		the atom 'something if nothing known about what can be the
;		indirect object of 
; *********Modified RMS 4-02****************
;-------------------------------------------------------------------------------
(defun some_cat_indobj (verb)
     (cond ((AND #3! ((deduce agent $vsub10 object $vobj7
			     indobj $vindobj3 act (build lex ~verb)))
	         (OR #3! ((deduce object1 *vindobj3 rel "ISA" object2 *somecat))
	             #3! ((deduce objects1 *vindobj3 rel "ARE" object2 *somecat))))
            (append #3! ((find (compose lex- object2- ! object1
				     indobj- ! act lex) ~verb))
                    #3! ((find (compose lex- object2- ! objects1
				     indobj- ! act lex) ~verb))))
;            (#3! ((find (compose lex- object2- object1
;				     indobj- act lex) ~verb))
;            (list #3! ((find (compose lex- object2- object1
;				     indobj- act lex) ~verb))))
	   (t 'something)))



;-----------------------------------------------------------------------------
;
;	function: cause
;	input:	a verb to be defined
;	output: a list containing the result of .  List will contain 
;	either propositions (molecular nodes) or patterns for them, 
;	from rules (pattern node).
;   **************modified RMS 4-02*****************
;-----------------------------------------------------------------------------
(defun cause (verb)
  (setq cz1 #3! ((find (compose cq- ! ant act lex) ~verb)))
  (setq cz2 #3! ((find (compose cq- ! &ant act lex) ~verb)))
  
  (cond (#3! ((deduce object1 (build agent *vsub11 act (build lex ~verb))
		      rel (build lex "enable")
		      object2 $goal))
	     (cond ((and cz1 cz2)
		    (if verb_trace
			(setq cause_trace '(cause found both enabled verbs
					    and cqs from ants and &ants)))
		    (list cz1 'or 'cz2 'or 'to 'enable 
			  #3! ((find (compose lex- act- object2- ! rel lex) "enable"
				     (compose lex- act- object2- ! object1 act lex) 
				     ~verb))))
		   (cz1
		    (if verb_trace
			(setq cause_trace '(cause found both enabled verbs
					    and cqs from ants)))
		    (list cz1 'or 'to 'enable 
			  #3! ((find (compose lex- act- object2- ! rel lex) "enable"
				     (compose lex- act- object2- ! object1 act lex) 
				     ~verb))))
		   (cz2
		    (if verb_trace
			(setq cause_trace '(cause found both enabled verbs
					    and cqs from &ants)))
		    (list cz2 'or 'to 'enable 
			  #3! ((find (compose lex- act- object2- ! rel lex) "enable"
				     (compose lex- act- object2- ! object1 act lex) 
				     ~verb))))
		   (t 
		    (if verb_trace
			(setq cause_trace '(cause found enabled verbs)))
		    (list 'to 'enable 
			  #3! ((find (compose lex- act- object2- ! rel lex) 
				     "enable"
				     (compose lex- act- object2- ! object1 act lex) 
				     ~verb))))))
	
	(#3! ((deduce mode (build lex "presumably")
		      object (build object1 (build agent *vsub11 
						   act (build lex ~verb)
						   time $vtime)
				    rel (build lex "enable")
				    object2 $goal)))
	     (cond ((and cz1 cz2)
		    (if verb_trace
			(setq cause_trace '(cause found both presumably
					    enabled verbs and cqs from
					    ants and &ants)))
		    (list cz1 'or cz2
			  'or 'to 'enable 
			  #3! ((find (compose lex- act- object2- rel lex) "enable"
				     (compose lex- act- object2- object1 act lex) ~verb
				     (compose lex- act- object2- object- ! mode lex)
				     "presumably"))))
		   (cz1
		    (if verb_trace
			(setq cause_trace '(cause found both presumably
					    enabled verbs and cqs from
					    ants)))
		    (list cz1 
			  'or 'to 'enable 
			  #3! ((find (compose lex- act- object2- rel lex) "enable"
				     (compose lex- act- object2- object1 act lex) ~verb
				     (compose lex- act- object2- object- ! mode lex)
				     "presumably"))))
		   (cz2
		    (if verb_trace
			(setq cause_trace '(cause found both presumably
					    enabled verbs and cqs from
					    &ants)))
		    (list cz2
			  'or 'to 'enable 
			  #3! ((find (compose lex- act- object2- rel lex) "enable"
				     (compose lex- act- object2- object1 act lex) ~verb
				     (compose lex- act- object2- object- ! mode lex)
				     "presumably"))))
		   (t 
		    (if verb_trace
			(setq cause_trace '(cause found presumably enabled verbs)))
		    (list 'to 'enable 
			  #3! ((find (compose lex- act- object2- rel lex) "enable"
				     (compose lex- act- object2- object1 act lex) ~verb
				     (compose lex- act- object2- object- ! mode lex)
				     "presumably"))))))
	
	((and cz1 cz2)
	 (if verb_trace
	     (setq cause_trace '(cause found cqs from ants and &ants)))
	 (list cz1 cz2))

	(cz1
	 (if verb_trace
	     (setq cause_trace '(cause found cqs from ants)))
	 (list cz1))
	
	(cz2
	 (if verb_trace
	     (setq cause_trace '(cause found cqs from &ants)))
	 (list cz2))
	
	(#3! ((deduce cause (build agent $vsub11 act (build lex ~verb))
		      effect $result))
	     (if verb_trace
		 (setq cause_trace '(cause found effects)))
	     (list #3! ((find (compose effect- cause act lex) ~verb))))
	(t
	 (if verb_trace
	     (setq cause_trace '(no causes found)))
	 NIL)))






;-----------------------------------------------------------------------------
;
;	function: effect
;	input:	a verb to be defined
;	output: a list containing the enabling conditions
;		of .  List will contain either propositions (molecular
;		nodes) or patterns for them, from rules (pattern node).
;*******************modified RMS 4-02****************
;-----------------------------------------------------------------------------
(defun effect (verb)
  (setq ef1 #3! ((find (compose ant- ! cq act lex) ~verb)))
  (setq ef2 #3! ((find (compose &ant- ! cq act lex) ~verb)))
  
  (cond  ((and ef1 ef2)
	  (if verb_trace
	      (setq effect_trace '(effects found at ants and &ants)))
	  (list ef1 ef2))
	 (ef1
	  (if verb_trace
	      (setq effect_trace '(effects found at ants)))
	  (list ef1))
	 (ef2
	  (if verb_trace
	      (setq effect_trace '(effects found at &ants)))
	  (list ef2))
	 (t
	  (if verb_trace
	      (setq effect_trace '(no effects found)))
	  NIL)))

;-----------------------------------------------------------------------------

(defun prim_base (verb) '(not set yet))

;-----------------------------------------------------------------------------
;
;	function: emptyp  (a predicate)
;	input: a list
;	output: t if the input list is empty, or a list* of empty lists,
;		nil if list contains any elements which are non-null.
;----------------------------------------------------------------------------
(defun emptyp (lst)
     (cond ((null lst) t)
           ((AND (listp lst) (emptyp (car lst))) (emptyp (cdr lst)))))

(defun cathelper (lst aset)
   (cond ((null lst) aset)
	 (t (cathelper (cdr lst) (adjoin (car lst) aset)))))
;-----------------------------------------------------------------------------





;-----------------------------------------------------------------------------
;
;	function: report_bitransitive
;	input: a verb to be defined
;	output: predicate structure of , with categorization of arguments;
;		causal/enablement information; eventually to include primitive 
;		act of which  is a type (if any).
;	calls:	categorize_subject, categorize_object, categorize_indobject,
;		cause, effect, (prim_base currently undefined)
;----------------------------------------------------------------------------
(defun report_bitransitive (verb czs efs)
     (list 'a
           (categorize_subject verb)
	   'can verb 'a
           (categorize_object verb)
	   'to 'a
           (categorize_indobject verb)
	   'result= #3!((describe ~czs))
	   'enabled 'by= #3!((describe ~efs))
;	   (prim_base verb)
))



;-----------------------------------------------------------------------------
;
;	function: report_transitive
;	input:  a verb to be defined
;	output: predicate structure of , with categorization of arguments;
;		causal/enablement information; eventually to include primitive 
;		act of which  is a type (if any).
;	calls:	categorize_subject, categorize_object, cause, effect, 
;		(prim_base currently undefined)
;----------------------------------------------------------------------------
(defun report_transitive (verb czs efs)
     (list 'a
	   (categorize_subject verb)
	   'can verb 'a
           (categorize_object verb)
		
	   'result= czs
	   'enabled 'by= #3!((describe ~efs))
;	   (prim_base verb)
))



;-----------------------------------------------------------------------------
;
;	function: report_reflexive
;	input:  a verb to be defined
;	output: predicate structure of , with categorization of arguments;
;		causal/enablement information; eventually to include primitive 
;		act of which  is a type (if any).
;	calls:	categorize_subject, cause, effect, 
;		(prim_base currently undefined)
;----------------------------------------------------------------------------
(defun report_reflexive (verb czs efs)
     (list 'a
	   (categorize_subject verb)
           'can verb 'itself
	   'result= #3!((describe ~czs))
	   'enabled 'by= #3!((describe ~efs))
;	   (prim_base verb)
))




;-----------------------------------------------------------------------------
;
;	function: report_intransitive
;	input:  a verb to be defined
;	output: predicate structure of , with categorization of argument;
;		causal/enablement information; eventually to include primitive 
;		act of which  is a type (if any).
;	calls:	categorize_subject, cause, effect, 
;		(prim_base currently undefined)
;----------------------------------------------------------------------------
(defun report_intransitive (verb czs efs)
     (list 'a
	   (categorize_subject verb)
	   'can verb
	   'result= #3!((describe ~czs))
	   'enabled 'by= #3!((describe ~efs))
;	   'result= czs 
;	   'enabled 'by= efs
;	   (prim_base verb)
))