;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ATN.lisp
;; based on code by Mark Watson © 1990
;; Modified by Lee Spector, 1994

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; globals

;; part-of-speech lexicon
(defvar *nouns* nil
  "A list of all nouns known to the system.")
(defvar *verbs* nil
  "A list of all verbs known to the system.")
(defvar *adjs* nil
  "A list of all adjectives known to the system.")
(defvar *preps* nil
  "A list of all prepositions known to the system.")

(setq *nouns* '(dog I block))
(setq *verbs* '(grab see is))
(setq *adjs* '(blue green large red the))
(setq *preps* '(behind under))

;; special-purpose globals
(defvar *sentence* nil
  "The remaining part of the sentence 
currently being parsed.")

(defvar *subject* nil
  "The subject of the sentence currently 
being parsed.")

(defvar *last-noun* nil
  "The last word found to be a noun by 
isNoun?")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; part-of-speech testers

(defun isNoun? (word)
  "Returns non-NIL if the given word is 
a noun. Also sets *last-noun* if the word 
is a noun."
  (if (member word *nouns*)
    (setq *last-noun* word)))

(defun isVerb? (word)
  "Returns non-NIL if the given word is a 
verb."
  (member word *verbs*))

(defun isAdj? (word)
  "Returns non-NIL if the given word is 
a adjective."
  (member word *adjs*))
  
(defun isPrep? (word)
  "Returns non-NIL if the given word is a
preposition."
  (member word *preps*))

(defun word? (part-of-speech)
  "Returns non-NIL and removes the first 
word from *sentence* if the first word in 
*sentence* is of the given part-of-speech."
  (let ((the-word (car *sentence*))
        (test-fn (case part-of-speech
                   (noun #'isNoun?)
                   (verb #'isVerb?)
                   (adjective #'isAdj?)
                   (preposition #'isPrep?))))
    (when (funcall test-fn the-word)
      (setq *sentence* (cdr *sentence*))
      t)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; parsing networks

(defun np? ()
  "Parses a noun phrase from *sentence*."
  (let ((save *sentence*)
        (success (or (and (word? 'adjective)
                          (or (np?)
                              (word? 'noun)))
                     (word? 'noun))))
    (cond (success (when (null *subject*)
                     (setq *subject* *last-noun*))
                   t)
          (t (setq *sentence* save)
             nil))))

(defun prepp? ()
  "Parses a prepositional phrase from *sentence*."
  (let ((save *sentence*)
        (success (and (word? 'preposition)
                      (np?))))
    (cond (success t)
          (t (setq *sentence* save)
             nil))))

(defun vp? ()
  "Parses a verb phrase from *sentence*."
  (let* ((save *sentence*)
         (success (or (and (word? 'verb)
                           (np?))
                      (progn (setq *sentence* save)
                             (word? 'verb)))))
    (cond (success t)
          (t (setq *sentence* save)
             nil))))

(defun sentence? ()
  "Parses a sentence from *sentence*."
  (let* ((save *sentence*)
         (success (or (and (np?)
                           (vp?)
                           (prepp?))
                      (progn (setq *sentence* save)
                             (and (np?)
                                  (vp?))))))
    (cond (success t)
          (t (setq *sentence* save)
             nil))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; test code
#|
(setq *sentence*
      '(i see the large red block under the
        large dog))

(sentence?)
--> T

*sentence*
--> NIL

;; still returns t but leaves residue in *sentence*
(setq *sentence*
      '(i see the large red block under the
        large red))

(sentence?)
--> T

*sentence*
--> (UNDER THE LARGE RED)

;; another ok one
(setq *sentence*
      '(the large red block is the dog))

(sentence?)
--> T

*sentence*
--> NIL

;; not legit
(setq *sentence*
      '(the large dog block is the dog))

(sentence?)
--> NIL

*sentence*
--> (THE LARGE DOG BLOCK IS THE DOG)

;; use these to see the details
(trace isNoun? isVerb? isAdj? isPrep? np?
       prepp? vp? sentence?)

(setq *sentence* '(the block is the dog))

(sentence?)
 Calling (SENTENCE?) 
  Calling (NP?) 
   Calling (ISADJ? THE) 
   ISADJ? returned (THE)
   Calling (ISADJ? BLOCK) 
   ISADJ? returned NIL
   Calling (ISNOUN? BLOCK) 
   ISNOUN? returned BLOCK
  NP? returned T
  Calling (VP?) 
   Calling (ISVERB? IS) 
   ISVERB? returned (IS)
   Calling (NP?) 
    Calling (ISADJ? THE) 
    ISADJ? returned (THE)
    Calling (ISADJ? DOG) 
    ISADJ? returned NIL
    Calling (ISNOUN? DOG) 
    ISNOUN? returned DOG
   NP? returned T
  VP? returned T
  Calling (PREPP?) 
   Calling (ISPREP? NIL) 
   ISPREP? returned NIL
  PREPP? returned NIL
  Calling (NP?) 
   Calling (ISADJ? THE) 
   ISADJ? returned (THE)
   Calling (ISADJ? BLOCK) 
   ISADJ? returned NIL
   Calling (ISNOUN? BLOCK) 
   ISNOUN? returned BLOCK
  NP? returned T
  Calling (VP?) 
   Calling (ISVERB? IS) 
   ISVERB? returned (IS)
   Calling (NP?) 
    Calling (ISADJ? THE) 
    ISADJ? returned (THE)
    Calling (ISADJ? DOG) 
    ISADJ? returned NIL
    Calling (ISNOUN? DOG) 
    ISNOUN? returned DOG
   NP? returned T
  VP? returned T
 SENTENCE? returned T
--> T
|#