;;; Lists of terminals for grammar validation
(defvar *nouns* '(cats mice birds dogs frogs bugs))
(defvar *verbs* '(chase see love avoid follow hit consume eat))
(defvar *vpast* '(chased seen loved avoided followed hit consumed eaten))

;;; Create a list of tree-nodes from the given list of symbols
(defun sym-list (&rest tokens)
  (loop for token in tokens collecting
    (cons token nil)))

;;; Helper macro for building parse tree
;;; Sets the cdr of the current node to tree, then recurses on it
(defmacro set-node-recurse (tree)
  `(build-tree (setf (cdr node) ,tree) sentence))

;;; Pops a word from the sentence onto the parse tree
(defun pop-word (sentence node)
  (setf (cdr node) (first sentence))
  (rest sentence))

;;; Create a parse tree from a given sentence
;;; Returns the remainder of the sentence, and its parse tree
(defun build-tree (current-tree sentence)
  ;; If we're done, stop here rather than recursing indefinitely
  (if (or (null sentence) (equal sentence :END-TOKEN))
    (values nil current-tree)
    ;; Otherwise, loop through current parse tree, reading
    ;; sentence as appropriate, then return the new parse
    ;; state (sentence + tree)
    ;; Each node is of the form (:SYMBOL . subtree).
    (dolist (node current-tree (values sentence current-tree))
      (setf sentence
        (case (car node)
          ;; non-terminals - recurse
          (:S  (set-node-recurse     (sym-list :NP :VP)))
          (:NP (or (set-node-recurse (sym-list :N :RC))
                   (set-node-recurse (sym-list :N))))
          (:VP (set-node-recurse     (sym-list :V :NP)))
          (:RC (or (set-node-recurse (sym-list :THAT :NP :V))
                   (set-node-recurse (sym-list :THAT :ARE :NP :V-PAST :BY :NP))))
          ;; terminals - pop a word off the sentence
          (:N    (when (member (first sentence) *nouns*)
                   (pop-word sentence node)))
          (:V    (when (member (first sentence) *verbs*)
                   (pop-word sentence node)))
          (:THAT (when (eq (first sentence) 'that)
                   (pop-word sentence node)))
          (:ARE  (when (eq (first sentence) 'are)
                   (pop-word sentence node)))
          (:BY   (when (eq (first sentence) 'by)
                   (pop-word sentence node))))))))

;;; Convert a given verb to its past tense, or nil
(defun pasturize (verb)
  (do ((pres *verbs* (rest pres))
       (past *vpast* (rest past)))
      ((or (null pres) (eq (car pres) verb)) (car past))))

;;; Converts a tree from original form to Bob's new form
;;; Note that this assumes :RC nodes are in the first form,
;;; and converts them to the second.
(defun transform (tree)
  (if (listp tree)
    (dolist (node tree)
      (setf (cdr node)
        (if (eq (car node) :RC)
          (list
            (cons :THAT 'that)
            (cons :ARE 'are)
            (cons :V (pasturize (cdar (cdddr node))))
            (cons :BY 'by)
            (cons :NP (cdadr (transform (cdr node)))))
          (transform (cdr node))))))
  tree)

;;; Flatten a tree into a sentence
(defun tree-to-list (tree)
  (loop for node in tree appending
    (if (atom (cdr node))
      (list (cdr node))
      (tree-to-list (cdr node)))))

;;; Main function - takes a sentence, parses and transforms it.
(defun convert (sentence)
  ;; Build the parse tree
  (multiple-value-bind (sentence tree)
    (build-tree (sym-list :S) (append sentence :END-TOKEN))
    ;; Check that nothing is left but the END-TOKEN
    (if (eq sentence :END-TOKEN)
      (tree-to-list (transform tree))
      :erroneous)))