anchor.diff:          grammar)))
   
   
  +;; Hopcroft '79 p. 91
   (defun grammar-remove-unit (grammar)
  -  (let ((nonterms (grammar-nonterminals grammar))
  -        (unit-prod (make-finite-set :mutable t))
  -        (unit-body (make-hash-table :test #'equal))
  -        (modified))
  -    ;; find unit nonterminals
  -    (grammar-map nil
  -                 (lambda (head body)
  -                   (when (and (= 1 (length body))
  -                              (finite-set-inp (first body) nonterms))
  -                     (finite-set-nadd unit-prod (cons head body))
  -                     (push head (gethash (first body) unit-body ))))
  -                 grammar)
  -    ;; rewrite
  -    (setq grammar
  -          (rewrite-grammar
  -           (lambda (head body)
  -             ;;(format t "rewrite ~A => ~A~&" head body)
  -             (cond
  -               ((finite-set-inp (cons head body) unit-prod)
  -                (setq modified t)
  -                nil)
  -               ((and (finite-set-inp head unit-body))
  -                (cons (cons head body)
  -                      (loop for A in (gethash head unit-body)
  -                         for p = (cons A body)
  -                         unless (finite-set-inp p unit-prod)
  -                         collect p)))
  -               (t (list (cons head body)))))
  -           grammar :keep-repeated t))
  -    (if modified
  -        (grammar-remove-unit grammar)
  -        grammar)))
  +  "Remove unit productions from the grammar."
  +  ;; FIXME: sometimes reorders and loses the start symbol
  +  (let* ((terminals (grammar-terminals grammar))
  +         (nonterminals (grammar-nonterminals grammar))
  +         (chainable (grammar-chainable-parent-function  grammar terminals nonterminals)))
  +    (rewrite-grammar-list
  +     (lambda (production)
  +       (unless (grammar-chain-rule-p terminals nonterminals production)
  +         (let* ((b (car production))
  +                (alpha (cdr production))
  +                (a-list (funcall chainable b)))
  +           (cons production
  +                 (finite-set-map 'list (lambda (a) (cons a alpha)) a-list)))))
  +     grammar :recursive nil)))
  +
   
   (defun grammar-print (grammar &optional (output *standard-output*))
     (grammar-map nil (curry-list #'format output  "~&~A => ~{~A~^ ~}~%") grammar))
  
positive.code:                                    (terminals (grammar-terminals grammar))
                                     (nonterminals (grammar-nonterminals grammar)))
    "Compute nonterminals reachable for each nonterminal of the grammar using only chain rules.
  RESULT: (lambda nonterminal) => finite-set of chainable nonterminals"
    (grammar-nonterminal-fixpoint (lambda (head body head-set mapping-function)
                                    (declare (ignore head))
                                    (finite-set-add (finite-set-union head-set
  
negative.code:                                (funcall function lhs rhs)))
                      grammar))
  
  
  (defun grammar-fold-list (function initial-value grammar)
    "Reduces function across productions of the grammar.
  FUNCTION: (lambda (value production))
  GRAMMAR: the BNF grammar
  RESULT: function reduced across grammar"
    (reduce function grammar :initial-value initial-value))
  
  (defun grammar-fold (function initial-value grammar)
    "Reduces function across productions of the grammar.
  FUNCTION: (lambda (value lhs rhs))
  GRAMMAR: the BNF grammar
  RESULT: function reduced across grammar"
    (grammar-fold-list (lambda (value production)
                         (destructuring-bind (lhs &rest rhs) production
                           (funcall function value lhs rhs)))
            initial-value grammar ))
  
  
  (defun grammar-nonterminals (grammar)
  