"A production system for random violent sentences."

"Bsg is the grammar from which battle sentences are built. If
something can expand into something else, it is
written in parens.  If it is as expanded as it gets, it's just an atom."
(setq bsg                               ;battle-sentence grammar
   '((sentence = ((np) (pp)))
    (np = ((art) (adj*) (subj)))
    (pp = ((pred) (obj)))
    (art = a the some another)
    (adj* = () ((adj2) (adj*)))
    (adj2 = ((adv) (adj)) ((adj)))
    (adj = green fat smelly hairy cosmic evil foul bloody blind)
    (subj = ((noun)))
    (noun = griffin centaur centipede centurion sentry brigand)
    (pred = ((verb)) ((adv) (verb)) ((verb) (adv)))
    (adv = mightily cravenly heroically happily surreptitiously
       skillfully)
    (verb = smote struck pummeled eviscerated skinned beheaded
       snapped)
    (obj = ((art) (noun))) ))

(defun battle-sentence ()
      (grammar-expand '((sentence)) bsg))

(defun grammar-expand (sentence grammar)
     "Doesn't work."
     (if (not (null sentence))
;If the sentence *is* null, this returns nil, because there's no third
clause.
        (let* ((examinee (car sentence))
               (rest (cdr sentence)))
            (if (atom examinee)
               (cons examinee (grammar-expand rest grammar)) ;If the first
chunk is already fully expanded, then just cons it onto the expansion of
the rest of the sentence.
               (grammar-expand
                  (append
;If the first chunk still needs expansion, expand it, and *append* that
into the sentence.  
                     (get-one (car examinee) grammar)             ;If you
just consed it in, you'd get too many parnens. 
                     rest)
                  grammar)))))                                                   
"In the line above,, you need to take the car of examinee when you
get-one of it, because grammar-expand only thinks something needs
expansion if it's a list, while get-one requires atomic arguments."
      
(defun get-one (heading grammar)
     (let ((result (one-of (look-up heading grammar))))
         (if (listp result)
            result
;The results of get-one are later appended into the sentence being
expanded;  if they're not lists, it wouldn't work.
            (list result))))

(defun look-up (heading grammar)
     "Takes something like 'sentence, bsg', and returns something
like '((np) (pp))'.  That is, it tells you what the heading is composed 
of."
     (if (null grammar) nil
        (let ((examinee (car grammar))
               (left (cdr grammar)))
            (if (eq heading (car examinee))
               (cddr examinee)
               (look-up heading left)))))

(defun one-of (list)
    (nth (random (length list)) list))