;;;======================================================================

;;; Parser:BUParser
;;; NLP code for use with Natural Language Understanding, 2nd ed.
;;; Copyright (C) 1994 James F. Allen
;;; This program is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 2, or (at your option)
;;; any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program; if not, write to the Free Software
;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
;;;=====================================================================

;;
;;  THE BASIC BU PARSER
;;    This uses the left corner algorithm to build a chart "bottom-up"
;;    To run the parser, you must have made a lexicon and grammar "active" using the
;;    functions make-grammar and make-lexicon. (see file "GrammarandLexicon" for code)
;;
;;  e.g.,  Here is a sample session, assumign *lexicon1* and *grammar1* are
;;              appropriately defined
;;          (make-lexicon *lexicon1*)
;;          (make-grammar *grammar1*)
;;          (BU-parse '(the dog barks))
;;


;;=========================================================================
;;THE AGENDA
;;   The agenda is a simple stack for the basic parser. These functions all
;;    use the variable AGENDA

(let ((agenda nil))

  (defun add-to-agenda (k)
    (if k
      (setq agenda (cons k agenda))))

  (defun get-next-entry nil
    (let ((k (car agenda)))
      (setq agenda (cdr agenda))
      k))
  
  ;;  INIT-AGENDA - takes a sentence and creates a list of constituents by looking
  ;; up each word in the lexicon
  
  (defun init-agenda (sentence)
    (setq agenda (gen-agenda sentence 0)))
  
  ;; GEN-AGENDA looks up each word in the sentence and adds it to the agenda
  ;;   with its sentence position
  (defun gen-agenda (sentence n)
    (if sentence
      (append (lookupword (car sentence) n) (gen-agenda (cdr sentence) (+ n 1)))))

  (defun empty-agenda nil
    (null agenda))

)  ;; end of scope for variable AGENDA


;;===========================================================================
;;   The B U PARSER

(defun BU-parse (sentence)
  (if (unknown-word sentence) 
    (Format t "~%~%*****Warning****** Unknown word ~s~%" (unknown-word sentence)))
  (init-agenda sentence)
  (make-chart sentence)
  (loop (if (empty-agenda) (return (if (> (tracelevel) 0) (show-chart) T)))
        (add-entry-to-chart (get-next-entry))))

;; ADD-ENTRY-TO-CHART inserts a new entry into the chart, adding any new
;;    active arcs introduced by grammar rules that can start with the
;;    constituent, and extending any existing arcs that can be extended by
;;    the consituent. Note that PUT-IN-CHART checks if an identical entry
;;    already exists and returns t only if the entry truly is new.

(defun add-entry-to-chart (entry)
  (when (put-in-chart entry)
    (trace-entry "Entering constituent ~s from ~s to ~s~%" (entry-name entry)
               (entry-start entry) 
               (entry-end  entry))
    (Make-New-BU-Active-Arcs entry (entry-name entry) (getGrammar))
    (Chart-Extend entry (entry-name entry))
    ))

;;  MAKE-NEW-BU-ACTIVE-ARCS
;;  creates new active arcs by checking the grammar for rules that start
;;      with the constitituent in the new entry with the specified name.

(defun Make-New-BU-Active-Arcs (entry name grammar)
  (let ((c (entry-constit entry)))
    (mapcar #'(lambda (x)
                (let ((bndgs (Constit-Match (car (rule-rhs x)) C)))
                  (if bndgs 
                    (extend-arc-with-constit entry name
                                           (make-arc-from-rule x 
                                                              (entry-start entry) bndgs)
                                           nil))))
            grammar)))

;; CHART-EXTEND tries to extend arcs in the chart with the new constituent

(defun chart-extend (entry name)
     (mapcar #'(lambda (x) (extend-arc entry name x)) 
             (get-arcs (entry-start entry))))


