(in-package "USER")

;; Die zentralen Datenstrukturen Chart und Agenda werden in 
;; globalen Variablen verwaltet.

;; Kanten werden in der Chart sowohl nach ihren Start- als
;; auch ihren Endpunkten gefuehrt, um der Fundamental Rule
;; ein schnelles Auffinden zu ermoeglichen. 

;; Die Agenda wird als einfacher Stack implementiert.

(defstruct chart by-start by-end)

(defvar *chart* nil)

(defvar *agenda* nil)

(defparameter *grammar*
    '((s np vp)
      (np det n)
      (np np pp)
      (vp v)
      (vp v np)
      (vp v pp)
      (pp p np)
      (n adj n)
      (n woman)(n man)(n ball)(n scope)
      (det the)(det a)
      (p with)
      (adj fat)
      (adj cute)
      (v saw)(v snored)))

(defun snoc (item list)
  (append list (list item)))

(defun rule-lhs (rule)
  (first rule))

(defun rule-rhs (rule)
  (rest rule))

(defun rules-starting-in (category)
  (loop for rule in *grammar*
      when (eq category (first (rule-rhs rule)))
      collect rule))

(defstruct (edge (:print-function edge-print))
  lhs analyzed unanalyzed start end)

(defun edge-print (edge stream level)
  (declare (ignore level))
  (format stream "~_<(~A, ~A) ~A -> ~{~A~^ ~} . ~{~A~^ ~}>"
          (edge-start edge)
          (edge-end edge)
          (edge-lhs edge)
          (edge-analyzed edge) 
          (edge-unanalyzed edge) ))
          
(defun passive-p (edge)
  (null (edge-unanalyzed edge)))

(defun active-edges-ending-at (chart position)
  (loop for edge in (aref (chart-by-end chart) position)
      unless (passive-p edge)
      collect edge))

(defun passive-edges-starting-at (chart position)
  (loop for edge in (aref (chart-by-start chart) position)
      when (passive-p edge)
      collect edge))

(defun find-edges (&key (lhs nil lhs-p)
                        (analyzed nil analyzed-p)
                        (unanalyzed nil unanalyzed-p)
                        (start 0 start-p)
                        (end 0 end-p))
  [...])
  
(defun parse (input)
  (let ((number-of-vertices (1+ (length input))))
    (setf *chart*
      (make-chart :by-start (make-array number-of-vertices)
                  :by-end (make-array number-of-vertices)))
    (setf *agenda* nil)
    (loop for word in input
        for position from 0
        do (loop for rule in (rules-starting-in word)
               do (new-edge :lhs (rule-lhs rule)
                            :analyzed (list word)
                            :unanalyzed (rest (rule-rhs rule))
                            :start position
                            :end (1+ position))))
    (parse-loop)))

(defun parse-loop ()
  (loop for edge = (pop *agenda*)
      when (not edge)
      return *chart*
             
      ;;; Dies ist die einzige Stelle, an der Kanten tatsaechlich
      ;;; in die Chart eingetragen werden!
      when (store-edge edge)
           
      ;;; Die anderen Funktionen kommunizieren mit
      ;;; der Chart lediglich ueber die Agenda.
      do (cond ((passive-p edge)
                (fundamental4passive edge)
                (postulate edge))
               (T 
                (fundamental4active edge)))))

(defun fundamental4active (active)
  ;; Finde alle passiven Kanten, die am
  ;; Endpunkt der aktiven Kante anfangen 
  ;; und der naechsten gesuchten Kategorie
  ;; entsprechen, baue entsprechende Kanten
  ;; und trage sie in die Agenda ein.
  (loop with lhs = (edge-lhs active)
      with analyzed = (edge-analyzed active)
      with unanalyzed = (edge-unanalyzed active)
      with start = (edge-start active)
      with end = (edge-end active)
      for passive in (passive-edges-starting-at *chart* end)
      when (eq (edge-lhs passive)
               (first unanalyzed))
      do (new-edge :lhs lhs
                   :analyzed (snoc (first unanalyzed) analyzed)
                   :unanalyzed (rest unanalyzed)
                   :start start :end (edge-end passive))))

(defun fundamental4passive (passive)
  ;; Finde alle aktiven Kanten, die am 
  ;; Startpunkt der passiven Kante enden 
  ;; und deren naechste gesuchte Kategorie der 
  ;; der passiven Kante entspricht, baue entsprechende
  ;; Kanten und trage sie in die Agenda ein.
  [...])

(defun postulate (passive)
  ;; Instanziiere Regeln, deren erstes Symbol
  ;; auf der rechten Seite der Kategorie
  ;; der passiven Kante entspricht und trage sie
  ;; in die Agenda ein.
  [...])

(defun new-edge (&key lhs analyzed unanalyzed start end)
  (push (make-edge :lhs lhs :analyzed analyzed :unanalyzed unanalyzed
                   :start start :end end)
        *agenda*))

(defun store-edge (edge)
  (unless (find-edges :lhs (edge-lhs edge)
                      :analyzed (edge-analyzed edge)
                      :unanalyzed (edge-unanalyzed edge)
                      :start (edge-start edge)
                      :end (edge-end edge))
    (push edge (aref (chart-by-start *chart*)
                     (edge-start edge)))
    (push edge (aref (chart-by-end *chart*)
                     (edge-end edge)))))