paip2-2.lisp

;;;; PAIP 2.2

(defparameter *simple-grammar*
  `((sentence -> (noun-phrase verb-phrase))
     (noun-phrase -> (Article Noun))
     (verb-phrase -> (Verb noun-phrase))
     (Article -> the a)
     (Noun -> man ball woman table)
     (Verb -> hit took saw liked)))

(defparameter *grammar* *simple-grammar*)

(defun mappend (fn the-list)
  (if (null the-list)
      nil
      (append (funcall fn (first the-list))
	      (mappend fn (rest the-list)))))

(defun random-elt (choices)
  (elt choices (random (length choices))))

(defun rule-lhs (rule)
  (first rule))
(defun rule-rhs (rule)
  (cddr rule))
(defun rewrites (category)
  (rule-rhs (assoc category *grammar*)))

(defun generate-org (phrase)
  "Generate a random sentence or phrase"
  (if (listp phrase)
      (mappend #'generate-org phrase)
      (let ((choices (rewrites phrase)))
	(if (null choices)
	    (list phrase)
	    (generate-org (random-elt choices))))))

(defun generate (phrase)
  (cond
    ((listp phrase)
     (mappend #'generate phrase))
    ((terminate-p phrase) `(,phrase))
    (T (generate (random-elt (rewrites phrase))))))

(defun terminate-p (phrase)
  (not (assoc phrase *grammar*)))