anchor.diff:                    ;; transitions
                     (pda-map-transtions nil
                                         (lambda (x y)
  -                                        (destructuring-bind ((q-0 z g-0) (q-1 g-1)) (list x y)
  -                                          (format s "~&  ~A -> ~A [fontsize=~D,label=\"~A,~A&rarr;~A\"];~%"
  +                                        (destructuring-bind ((q-0 z g-0) (q-1 &rest g-1)) (list x y)
  +                                          (format s "~&  ~A -> ~A [fontsize=~D,label=\"~A,~A&rarr;~{~A~}\"];~%"
                                                     (funcall state-numbers q-0)
                                                     (funcall state-numbers q-1)
                                                     font-size
  -                                                  (dot-gsymbol z) (dot-gsymbol g-0) (dot-gsymbol g-1))))
  +                                                  (dot-gsymbol z) (dot-gsymbol g-0)
  +                                                  (map 'list #'dot-gsymbol g-1))))
                                         pda)
                     (format s "~&}~%")))))
  +
  +;; Sipser p116
  +(defun grammar->pda-sipser (grammar &key (gensym (gensym "pda")))
  +  (let ((counter -1))
  +    (labels ((make-state (&optional (val (incf counter)))
  +               (cons gensym val)))
  +      (let* ((q-start (make-state :start))
  +             (q-accept (make-state :accept))
  +             (q-loop (make-state :loop))
  +             (edges (list (pda-edge q-start :epsilon :epsilon q-loop (grammar-start-nonterminal grammar) :$)
  +                          (pda-edge q-loop :epsilon :$ q-accept :epsilon))))
  +        ;; production edges
  +        (grammar-map nil
  +                     (lambda (head body)
  +                       (push (pda-edge-extended q-loop :epsilon head q-loop body)
  +                             edges))
  +                     grammar)
  +        ;; token edges
  +        (finite-set-map nil
  +                        (lambda (z)
  +                          (push (pda-edge q-loop z z q-loop :epsilon)
  +                                edges))
  +                        (grammar-terminals grammar))
  +        ;; construct
  +        (make-pda edges q-start (finite-set q-accept))))))
  
positive.code:         (input-alphabet (make-finite-set))
          (stack-alphabet (make-finite-set)))
      (loop
         for (x y) in edges
         for ((q-0 sigma gamma-0) (q-1 gamma-1)) in edges
         do
           (setf (gethash x hash) (finite-set-add (gethash x hash) y)
                 states (finite-set-union states (finite-set q-0 q-1))
                 input-alphabet (finite-set-add input-alphabet sigma)
                 stack-alphabet (finite-set-union stack-alphabet (finite-set gamma-0 gamma-1))))
      (assert (finite-set-inp start states))
      (assert (finite-set-subsetp accept states))
      (%make-pda :states states
  
negative.code:   accept)
  
  
  (defun pda-edge-extended (q-0 z g-0 q-1 g-1-list)
    "Make a PDA edge."
    (list (list q-0 z g-0)
          (cons q-1 g-1-list)))
  
  (defun pda-edge (q-0 z g-0 q-1 &rest g-1)
    "Make a PDA edge."
    (pda-edge-extended q-0 z g-0 q-1 g-1))
  
  (defun pda-map-transtions (result-type function pda)
    "Apply FUNCTION to all transitions of PDA.
  FUNCTION: (lambda ( (list q-0 z g-0) (list q-1 g-1))"
  