anchor.diff:              :edges (mapcar #'reverse (fa-edges fa))
               :start (fa-accept fa)
               :accept (fa-start fa)))
  +
  +
  +(defun fa-prune (fa)
  +  "Remove unreachable and dead states from the FA."
  +  (let ((pred (fa-predecessor-array fa))
  +        (succ (fa-successor-array fa))
  +        (live-rev (make-array (length (fa-states fa)) :element-type 'bit))
  +        (live-fwd (make-array (length (fa-states fa)) :element-type 'bit))
  +        (state-map (make-array (length (fa-states fa)) :initial-element nil)))
  +    ;; mark forward live states
  +    (labels ((visit (i)
  +               (when (zerop (aref live-fwd i))
  +                 (setf (aref live-fwd i) 1)
  +                 (map nil (lambda (e) (visit (third e))) (aref succ i)))))
  +      (map nil #'visit (fa-start fa)))
  +    ;; mark reverse live states
  +    (labels ((visit (i)
  +               (when (zerop (aref live-rev i))
  +                 (setf (aref live-rev i) 1)
  +                 (map nil (lambda (e) (visit (car e))) (aref pred i)))))
  +      (map nil #'visit (fa-accept fa)))
  +    ;; find reorder mapping
  +    (loop
  +       for i from 0 ; original index
  +       with j = -1   ; new index
  +       for x across live-fwd
  +       for y across live-rev
  +       unless (or (zerop x) (zerop y))
  +       do (setf (aref state-map i)
  +                (incf j)))
  +    (fa-renumber fa :state-map state-map)))
  +
  +
  +(defun fa-renumber (fa &key state-map token-map)
  +  "Reorder states and tokens in the FA.
  +STATE-MAP: (aref state-map old-index) => (or new-index nil)
  +TOKEN-MAP: (aref token-map old-index) => (or new-index nil)"
  +  (labels ((new-state (i)
  +             (if state-map
  +                 (aref state-map i)
  +                 i))
  +           (new-token (i)
  +             (if token-map
  +                 (aref token-map i)
  +                 i)))
  +    (%make-fa :states  (cond ((null state-map) (fa-states fa))
  +                             (t (map 'vector #'identity
  +                                     (loop
  +                                        with i = 0
  +                                        for x across state-map
  +                                        when x
  +                                        collect i
  +                                        do (incf i)))))
  +              :tokens (if (null token-map)
  +                          (fa-tokens fa)
  +                          (let ((tokens (make-array (loop
  +                                                       for x across token-map
  +                                                       count x)
  +                                                    :initial-element nil)))
  +                            (loop with i = 0
  +                               for x across token-map
  +                               when x
  +                               do (setf (aref tokens (aref token-map i))
  +                                        (aref (fa-tokens fa) i)))
  +                            tokens))
  +              :start (sort (mapcan
  +                          (lambda (i) (when (new-state i)
  +                                   (list (new-state i))))
  +                          (fa-start fa))
  +                         #'<)
  +              :accept (sort (mapcan
  +                             (lambda (i) (when (new-state i)
  +                                      (list (new-state i))))
  +                             (fa-accept fa))
  +                            #'<)
  +              :edges (sort (mapcan
  +                            (lambda (e)
  +                              (when (and (new-state (first e))
  +                                         (new-token (second e))
  +                                         (new-state (third e)))
  +                                (list (list (new-state (first e))
  +                                            (new-token (second e))
  +                                            (new-state (third e))))))
  +                                (fa-edges fa))
  +                           #'symbol-list-compare))))
   
   
   ;;; Regex
  
positive.code: ;;;  -(states, tokens, edges, start, accept),
  ;;;    - edges: (list state-0 token state-1)
  
  (defstruct (fa (:constructor %make-fa))
    states
    tokens
  
negative.code:               :start (alexandria:ensure-list start)
                :accept (alexandria:ensure-list accept))))
  
  ;; fixme: multiple start states
  (defun make-fa-renumber (edges start accept)
    (let ((state-hash (make-hash-table :test #'equal))
          (token-hash (make-hash-table :test #'equal))
          (state-counter -1)
          (token-counter 0)
          nedges)
      (labels ((new-state (name)
                 (unless (gethash name state-hash)
                   (setf (gethash name state-hash)
                         (incf state-counter)))
                 (gethash name state-hash)))
        (setf (gethash :epsilon token-hash) 0)
        ;; start/accept states
        (map nil #'new-state (alexandria:ensure-list start))
        (map nil #'new-state (alexandria:ensure-list accept))
        ;; build hashes
        (dolist (e edges)
          (destructuring-bind (q0 z q1) e
            (unless (gethash z token-hash)
              (setf (gethash z token-hash) (incf token-counter)))
            (push (list (new-state q0) (gethash z token-hash) (new-state q1))
                  nedges)))
        ;; map hashes to build new edges and mapping arrays
        (let ((state-array (make-array (1+ state-counter)
                                       :initial-element nil))   ; i -> q
              (token-array (make-array (1+ token-counter)
                                       :initial-element nil)))  ;  i -> z
          (maphash (lambda (n d)
                     ;;(format t "~&[~A]: ~A~&" d n)
                     (setf (aref state-array d) n))
                   state-hash)
          (maphash (lambda (n d) (setf (aref token-array d) n))
                   token-hash)
          (%make-fa :states state-array
                    :tokens token-array
                    :edges nedges
                    :start (mapcar #'new-state (alexandria:ensure-list start))
                    :accept (mapcar #'new-state
                                    (alexandria:ensure-list accept)))))))
  
  
  (defun make-fa (edges start accept &key (renumber-symbols t) (dfa-sort nil))
    (let ((fa (if renumber-symbols
                  (make-fa-renumber edges start accept)
                  (make-fa-simple edges start accept))))
      (if dfa-sort
          (dfa-sort fa)
          fa)))
  
  
  (defun dfap (fa)
    "True if FA is deterministic"
    (let ((mover (fa-mover fa)))
      (when (> (length (fa-start fa)) 1)
        (return-from dfap (values nil -1 0)))
      (dotimes (i (length (fa-states fa)))
        ;; epsilon
        (when (funcall mover i 0)
          (return-from dfap (values nil i 0)))
        ;; others
        (loop for j from 1 below (length (fa-tokens fa))
           do (when (> (length (funcall mover i j)) 1)
                (return-from dfap (values nil i j)))))
      fa))
  
  
  (defun dfa-sort (fa &key preserve-states)
    "Sort all elements of the FA into canonical (ascending) order.
  