#|
     Acts

(atrans actant object to from mode)
(cause antecedent consequent mode)
(grasp actant object mode)
(ingest actant object mode)
(mbuild actant object mode)
(mtrans actant object to from mode)
(plan actant object mode)
(ptrans actant object to from mode)
(wants actant goal mode)

|#

#|
     Attributes

(has actant object mode)
(is-at actant location mode)
(mloc mind concept mode)
(likes actant object mode)
(deceives actant object mode)
(dominate actant object mode)
(knows actant object mode)
(home actant object mode)
(food actant object mode)
(goal actant action mode)
|#

#|
     Initial facts
|#

(define-actant object)

(define-actant location
    (is-a object))

(define-actant persona
    (define-rule (ask actant1 
                                   actant2 
                                   (actname arg1 arg2 arg3 actmode) 
                                   mode)
        (preconditions (deceives actant2 actant1 no)
                                   (likes actant2 actant1 yes))
        (actions (tell actant1 actant2 (actname arg1 arg2 arg3 question) mode))
        (postconditions (add (actname arg1 arg2 arg3 mode)))))

(defmacro <- ((rule-name . args) rule-body)
    (let* ((new-name (gentemp (string rule-name)))
              (new-macro-name (symbol_append new-name '-macro))
              (new-function-name (symbol_append new-name '-function))
              (new-function-args (flatten args)))
       (eval `(defun ,new-function-name ,new-function-args
                      (fraxleval `,rule-body)))
       (eval `(put ',rule-name 
                           'macro-names 
                           (push ',new-macro-name 
                                       (get ',rule-name 'macro-names))))
       `(defmacro ,new-macro-name ,args 
            `(,new-function-name ,@new-function-args))))           

;;; the ask rule after macro expansion
(defmacro ask-1-macro (actant1 
                                             actant2 
                                             (actname arg1 arg2 arg3 actmode) 
                                             mode)
    `(ask-1-function actant1 actant2 actname arg1 arg2 arg3 actmode))
(defun ask-1-function (actant1 actant2 actname arg1 arg2 arg3 actmode)
    (fraxleval `(amb (retrieve `(deceives ',actant2 ',actant1 'yes ',actant2))
                                  (retrieve `(likes ',actant2 ',actant1 'yes ',actant2))
                                  (retrieve `(tell ',actant1 ',actant2 `(,actname ',arg1 ',arg2 ',arg3 'question 'world) 'yes 'world))
                                  `(,actname ',arg1 ',arg2 ',arg3 'yes 'world))
                                  `(,actname ',arg1 ',arg2 ',arg3 'yes ',actant1)))))
(put 'ask 'macro-names (push 'ask-1-macro (get 'ask 'macro-names)))


(define-actant yes)

(define-actant bear
    (is-a persona)
    (define-actant mind
        (is-a location))
    (define-facts
        (food honey yes)
        (food berries yes)
        (food fish yes)))

(define-actant joe
        (is-a bear)
        (define-facts
            (home cave yes)
            (is-at joe cave yes)
            (is-at irving oak-tree yes)
            (is-at water river yes)
            (is-at worm ground yes)))

(define-actant world
    (is-a location)
    (define-actant cave
        (is-a location))
    (define-actant oak-tree
        (is-a location))
    (define-actant elm-tree
        (is-a location))
    (define-actant ground
        (is-a location))
    (define-actant river
        (is-a location))
    (define-facts
        (is-at irving oak-tree yes)
        (is-a irving bird yes)
        (home irving oak-tree yes)
        (food bird worm yes)
        (is-a joe persona yes)
        (is-a irving persona yes)
        (is-a hungry goal yes)
        (is-a thirsty goal yes)
        (is-at water river yes)
        (is-at honey elm-tree yes)
        (is-at worm ground yes)
        (is-at fish river yes)
        (is-a location object)
        (is-a honey object yes)
        (is-a berries object yes)
        (is-a fish object yes)
        (is-a worm object yes)
        (is-a water object yes)))

#|
  The success of bargaining with someone by giving them food depends
  on whether the other person is honest, you don't already have the
  goal of getting the food you're going to bargain with, and you can
  get the food to the other person.
|#
(<- (bargain actant1 actant2 (actname arg1 arg2 arg3 'yes 'world) 'yes 'world)
      (and (not (retrieve (deceives actant2 actant1 'yes actant1)))
                (retrieve (food actant2 food 'yes 'world))
                (not (retrieve (has actant2 food 'yes 'world)))
                (not (retrieve (goal actant2 (has actant2 food 'yes 'world) 'yes 'world)))
                


 (<- (bargain actant1 actant2 (?ActName ?Arg1 ?Arg2 ?Arg3 'yes 'world) 'yes 'world)
       (and (not (deceives actant2 actant1 'yes actant1))
                 (food actant2 ?Food 'yes 'world)
                 (not (has actant2 ?Food 'yes 'world))
                 (not (goal actant2 (has actant2 ?Food 'yes 'world) 'yes 'world))
                 (mbuild actant1 
                                           (cause (atrans actant1 ?Food actant2 actant1 'yes 'world)
                                                         (?ActName ?Arg1 ?Arg2 ?Arg3 maybe 'world)
                                                         ?_
                                                         ?_
                                                         'yes
                                                         'world)
                                           ?_
                                           ?_
                                           'yes
                                           'world))
                 (tell actant1 
                         actant2 
                         (cause (atrans actant1 ?Food actant2 actant1 'yes 'world)
                                                         (?ActName ?Arg1 ?Arg2 ?Arg3 'yes 'world)
                                                         ?_
                                                         ?_
                                                         question
                                                         'world)
                         'yes
                         'world)
                 (dcont actant1 ?Food 'yes 'world)
                 (dprox actant1 actant1 actant2 'yes 'world)
                 (atrans actant1 ?Food actant2 actant1 'yes 'world))
                 (?ActName ?Arg1 ?Arg2 ?Arg3 'yes 'world))
                 (?ActName ?Arg1 ?Arg2 ?Arg3 'yes actant1)))
       'yes
       'world)

#|
  The success of threatening depends upon whether you dominate
  the other person.
|#
 (<- (threaten actant1 actant2 (?ActName ?Arg1 ?Arg2 ?Arg3 'yes 'world) 'yes 'world)
       (and (not (dominate actant2 actant1 'yes 'world))
                 (tell actant1 
                         actant2 
                         (cause (?ActName ?Arg1 ?Arg2 ?Arg3 no 'world)
                                       (propel actant1 hand actant2 ?_ 'yes 'world)
                                       ?_
                                       ?_
                                       'yes
                                       'world)
                         'yes
                         'world)
                 (or (?ActName ?Arg1 ?Arg2 ?Arg3 'yes 'world)
                       (propel actant1 hand actant2 ?_ 'yes 'world))))
       'yes
       'world)
              
; 'irving's knowledge about other actants and objects
(in-actant 
  'irving
  (is-at 'irving 'oak-tree 'yes)
  (is-at 'honey 'elm-tree 'yes)
  (is-at 'joe 'cave 'yes)
  (is-at 'fish 'river 'yes))