(in-package "USER")

(defparameter *grammar*
  '((S NP VP) 
    (NP Det N)
    (VP V) (VP V NP)
    (Det the) (Det a)
    (N woman) (N man) (N ball) (N scope)
    (V snored) (V saw)))

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

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

(defun rules-for-category (category)
  (loop for rule in *grammar*
      when (eq (rule-lhs rule) category)
      collect rule))

(defstruct parse
  analyzed
  unanalyzed)

(defun complete-parses (parses)
  (remove-if-not #'null parses :key #'parse-unanalyzed))

(defun make-tree (root daughters)
  (cons root daughters))

(defun tree-root (tree)
  (first tree))

(defun tree-daughters (tree)
  (rest tree))

(defun parse (input goal)
  ;; versuche, goal mit einem Praefix von input abzuleiten
  (if (eq (first input) goal)
      ;; goal laesst sich mit dem ersten Zeichen ableiten: erzeuge ein 
      ;; (Teil-)Resultat, das den Parsebaum in :analyzed und den Rest der
      ;; noch zu verarbeitenden Eingabe in :unanalyzed enthaelt
      (list (make-parse :analyzed (first input) :unanalyzed (rest input)))
    ;; expandiere goal durch alle Regeln, die goal auf der linken Seite haben
    ;; und versuche, die einzelnen Teilziele auf den entsprechenden rechten
    ;; Seiten nacheinander abzuleiten: das tut extend-parse
    (loop for rule in (rules-for-category goal)
        nconc (extend-parse (rule-lhs rule) nil (rule-rhs rule) input))))


(defun extend-parse (lhs analyzed unanalyzed input)
  ;; lhs:        das abzuleitende Ziel
  ;; analyzed:   die bereits abgeleiteten Teilziele
  ;; unanalyzed: die noch abzuleitenden Teilziele
  ;; input:      die Eingabe von dem Punkt an, von dem das Ziel abgeleitet
  ;;             werden soll
  (if (null unanalyzed)
      ;; Alle Teilziele wurden abgeleitet: Erzeuge ein (Teil-)Resultat,
      ;; das den lokalen Parsebaum in :analyzed enthaelt und in :unanalyzed
      ;; den noch zu verarbeitenden input
     (list (make-parse :analyzed (make-tree lhs analyzed) :unanalyzed input))
    ;; versuche, das erste Teilziel abzuleiten. Fuer alle Teilresultate, die
    ;; erzeugt werden, versuche, die weiteren Teilziele abzuleiten
    (loop for parse in (parse input (first unanalyzed))
        nconc (extend-parse 
               lhs
               (append analyzed (list (parse-analyzed parse)))
               (rest unanalyzed)
               (parse-unanalyzed parse)))))