---

Natural Language Processing For Multi-User Virtual Worlds

    "You remove %di from the games chest."

  (unless (boundp 'unifgram-loaded)
    (load "../paip/auxfns")
    (requires "unifgram")
    (setf unifgram-loaded t))
  (clear-db)

  ;; Declarative statement: Fred gives Mary the book.
  (rule (Statement ?pred) -->
	(NP ?agr ?subj)
	(VP (finite ?agr) ?subj ?pred))

  ;; Imperative command: Give Mary the book.  The missing subject is
  ;; "I", i.e. the speaker.  This is a little different from commands in
  ;; ordinary speech, where the subject is "you"; here, the command is
  ;; given to one's virtual self.
  (rule (Command ?pred) -->
	(VP nonfinite speaker ?pred))

  ;; Intransitive verb: [Fred] sleeps.
  (rule (VP ?infl ?subj ?pred) -->
	(Verb/intr ?infl (participant ?subj) ?pred))

  ;; Transitive verb: [Fred] kisses Mary.
  (rule (VP ?infl ?subj ?pred) -->
	(Verb/tr ?infl (participant ?subj) ?pred (participant ?obj))
	(NP ?any-agr ?obj))

  ;; Ditransitive verb: [Fred] gives Mary the book.
  (rule (VP ?infl ?subj ?pred) -->
	(Verb/ditr ?infl (participant ?subj) ?pred
		   (participant ?obj) (participant ?goal))
	(NP ?any-other-agr ?goal)
	(NP ?any-agr ?obj))

  ;; Transitive verb with "to" complement: [Fred] gives the book to Mary.
  (rule (VP ?infl ?subj ?pred) -->
	(Verb/trans2 ?infl (participant ?subj) ?pred
		     (participant ?obj) (participant ?goal))
	(NP ?any-agr ?obj)
	(:word to)
	(NP ?any-other-agr ?goal))

  ;; The verb "make", in the "compel" sense:
  ;;   [Fred] makes Mary give the book to the boy.
  (rule (VP ?infl ?subj ?pred) -->
	;; Note that the object is a participant of the task, so it
	;; doesn't need to also be a participant of the "make" event.
	(Verb/make ?infl (participant ?subj) ?pred ?obj ?task)
	(NP ?any-agr ?obj)
	(VP nonfinite ?obj ?task)) 

  (rule (Verb/intr nonfinite ?x (sleep ?x)) --> (:word sleep))
  (rule (Verb/intr (finite ~3sg) ?x (sleep ?x)) --> (:word sleep))
  (rule (Verb/intr (finite 3sg) ?x (sleep ?x)) --> (:word sleeps))

  (rule (Verb/tr nonfinite ?x (kiss ?x ?y) ?y) --> (:word kiss))
  (rule (Verb/tr (finite ~3sg) ?x (kiss ?x ?y) ?y) --> (:word kiss))
  (rule (Verb/tr (finite 3sg) ?x (kiss ?x ?y) ?y) --> (:word kisses))

  (rule (Verb/ditr nonfinite ?x (give ?x ?y ?z) ?y ?z) --> (:word give))
  (rule (Verb/ditr (finite ~3sg) ?x (give ?x ?y ?z) ?y ?z) --> (:word give))
  (rule (Verb/ditr (finite 3sg) ?x (give ?x ?y ?z) ?y ?z) --> (:word gives))

  (rule (Verb/trans2 nonfinite ?x (give2 ?x ?y ?z) ?y ?z) --> (:word give))
  (rule (Verb/trans2 (finite ~3sg) ?x (give2 ?x ?y ?z) ?y ?z) --> (:word give))
  (rule (Verb/trans2 (finite 3sg) ?x (give2 ?x ?y ?z) ?y ?z) --> (:word gives))

  (rule (Verb/make nonfinite ?x (make ?x ?y ?z) ?y ?z) --> (:word make))
  (rule (Verb/make (finite ~3sg) ?x (make ?x ?y ?z) ?y ?z) --> (:word make))
  (rule (Verb/make (finite 3sg) ?x (make ?x ?y ?z) ?y ?z) --> (:word makes))

  (rule (NP ?agr ?sem) --> (Pron ?agr ?sem))
  (rule (NP ?agr ?sem) --> (Name ?agr ?sem))
  (rule (NP ?agr (?det-sem ?noun-sem)) -->
	(Det ?agr ?det-sem)
	(Noun ?agr ?noun-sem))

  (rule (Pron ~3sg listener) --> (:word you))
  (rule (Pron ~3sg speaker) --> (:word me))

  (rule (Name 3sg (person Fred)) --> (:word Fred))
  (rule (Name 3sg (person Mary))  --> (:word Mary))

  (rule (Det ?any the)  --> (:word the))
  (rule (Det 3sg a) --> (:word a))

  (rule (Noun 3sg (young male human))           --> (:word boy))
  (rule (Noun 3sg (young female human))         --> (:word girl))
  (rule (Noun ~3sg (group (young male human)))   --> (:word boys))
  (rule (Noun ~3sg (group (young female human))) --> (:word girls))

  (rule (Noun 3sg (object ball))                   --> (:word ball))
  (rule (Noun ~3sg (group (object ball)))          --> (:word balls))
  (rule (Noun 3sg (object book))                   --> (:word book))
  (rule (Noun ~3sg (group (object book)))          --> (:word books))

  ;; Process ?command, given by ?speaker, into ?desc as seen by
  ;; ?observer.  The first two arguments are inputs, and the last two
  ;; are outputs (although ?observer may also be input).  One
  ;; description will be generated for each participant, as well as a
  ;; generic third-party description.
  (<- (process-command ?command ?speaker ?observer ?desc)
      (parse-command ?command ?speaker ?event)
      (describe-event ?event ?observer ?desc))

  ;; Parse ?command given by ?speaker into a resultant ?event.
  (<- (parse-command ?command ?speaker ?event)
      (Command ?sem ?command ())
      ;; Replace 'speaker with the actual speaker object.
      (subst ?sem speaker ?speaker ?event))

  ;; Describe ?event to ?observer as ?desc.
  (<- (describe-event ?event ?observer ?desc)
      ;; For each participant in the event, recast the event with it as
      ;; the observer.
      (or (and (participant ?event ?observer)
	       ;; Replace the observer with 'listener.
	       (subst ?event ?observer listener ?subjective-event))
	  (and (or (not (participant ?event ?observer))
		   (= ?observer third-party))
	       ;; Third party description-- keep it neutral.
	       (= ?event ?subjective-event)))
      ;; Generate the description(s).
      (Statement ?subjective-event ?desc ()))

  ;; The participants of an event.  An event is a list of the form
  ;; (?action . ?rest), where ?rest is a list of either subevents or
  ;; (participant ?participant) lists.
  (<- (participant (?action (participant ?participant) . ?rest) ?participant))
  (<- (participant (?action ?subevent . ?rest) ?participant)
      (participant ?subevent ?participant))
  (<- (participant (?action ?other . ?rest) ?participant)
      (participant (?action . ?rest) ?participant))

  ;; Substitute (recursively) occurrences of ?x with ?y.  The cut is
  ;; used to ensure that *all* occurrences are replaced, not each one
  ;; separately.  e.g. (subst (a a) a x ?l) will bind ?l to (x x) once,
  ;; rather than to (x x), (x a), (a x), and (a a) in turn.
  (<- (subst ?x ?x ?y ?y))
  (<- (subst (?car . ?cdr) ?x ?y (?subst-car . ?subst-cdr))
      (subst ?car ?x ?y ?subst-car)
      !
      (subst ?cdr ?x ?y ?subst-cdr))
  (<- (subst ?z ?x ?y ?z))

  ;; Utility predicates, from PAIP.
  (<- (member ?x (?x . ?l)))
  (<- (member ?x (?y . ?l)) (member ?x ?l))

  (<- (or ?a ?b) (call ?a))
  (<- (or ?a ?b) (call ?b))

  (<- (and ?a ?b) (call ?a) (call ?b))

  ;; The front end.
  (defparameter speaker '(person Fred))
  (defmacro try (&rest cmd)
    `(top-level-prove '((process-command ,cmd ,speaker ?who ?desc))))