collect (transform-term term))))))

(if (listp new-rhs) new-rhs (list new-rhs)))) ;; make sure it's always a list

+(defun transform-for-nil (grammar)

+ "Transform the grammar as needed to remove all occurrences of nil"

+ (labels ((term-expansions (term)

+ "Return a list of term expansions (including :nil)"

+ (let ((rule (assoc term grammar)))

+ (expand-term (term-list position expansion)

+ (loop for index from 0 below (length term-list)

+ collect (elt term-list index)))

+ (loop for term in term-list

+ else append (list term)))

+ (nilable-p (term grammar)

+ "A term is nilable if we have already identified it as such, or if

+ one of it's RHS is (:nil); we remember that a rule is nilable,

+ to simplify future checks"

+ (if (member term nilable)

+ t ;; already known to be nilable

+ (let ((rule (assoc term grammar)))

+ (when rule ;; terminals are not nilable

+ (destructuring-bind (rule-name &rest rhss) rule

+ (declare (ignorable rule-name))

+ (when (member `(:nil) rhss :test #'equal)

+ ;; (format *standard-output* "New nilable term: ~s~%" term)

+ ;; setting this, too, in case this changes

+ ;; how we handle RHSs we have already seen--so

+ ;; will have to go 'round again

+ (compute-nilable-terms (grammar)

+ (loop for rule in grammar

+ do (nilable-p (car rule) grammar)))

+ (substitute-and-split-rhss (grammar)

+ (destructuring-bind (rule-name &rest rhss) rule

+ do (loop for position from 0 below (length rhs)

+ for term = (elt rhs position)

+ if (nilable-p term grammar)

+ do (loop for expansion in (term-expansions term)

+ for expanded-rhs = (flatten (expand-term rhs position expansion))

+ ;; (format *standard-output* "Expanded ~s:~s to ~s~%" rule-name rhs expanded-rhs)

+ (push expanded-rhs new-rhss))))

+ unless expanded do (push rhs new-rhss))

+ (loop for rhs in (reverse new-rhss)

+ unless (member rhs unique-rhs :test #'equal)

+ collect rhs into unique-rhs

+ finally (return unique-rhs))))))))

+ (collapse-nils (grammar)

+ (or (loop for term in rhs

+ unless (equal :nil term)

+ (remove-unused-rules (grammar)

+ "After all of the :nil substitutions have been made, it is reasonable that some rules

+ may no longer be used anywhere; let's just drop them, to simplify table development"

+ (loop for rule in grammar

+ if (loop for any-rule in grammar

+ do (loop for any-rhs in (cdr any-rule)

+ if (member (car rule) any-rhs :test #'equal)

+ (loop ;; for i from 1 to 10

+ do (setf transforming nil)

+ (setf new-grammar (substitute-and-split-rhss new-grammar))

+ (setf new-grammar (collapse-nils new-grammar))

+ (compute-nilable-terms new-grammar))

+ (setf new-grammar (remove-unused-rules new-grammar))

(defun transform-extended-grammar-to-fundamental (grammar)

- (let ((*new-rules* nil))

- (append (for-each-rhs grammar

- (transform-rhs (if (listp rhs) rhs (list rhs)))))

+ (let ((*new-rules* nil))

+ (append (for-each-rhs grammar

+ (transform-rhs (if (listp rhs) rhs (list rhs)))))

;; ---------------------------------------------------------------------------------------------------------------------

;; LALR(1) grammar construction