;; (#P"/Users/gilbert/lisp/clex/src/clex.lisp" 84658)
;; (#P"/Users/gilbert/lisp/clex.broken-49/src/clex.lisp" 84658)

(in-package :clex2)

(defstruct dfa (states #() :type simple-vector))

;; (#P"/Users/gilbert/lisp/clex/src/pcre.lisp" 2369)
;; (#P"/Users/gilbert/lisp/clex.broken-49/src/clex.lisp" 127245)

(in-package :clex2)

(defun re-prepend-setqs (re)
  #+OLD
  re
  #+NEW
  (let ((vs (mapcar #'car (re-all-variables re))))
    (let ((x re))
      (loop for v in vs
            do (when (not (member v '(cat last-lineno last-nl b))) (setf x (re-and (re-setq (list v nil `',-1)) x))))
            x)))

;; (#P"/Users/gilbert/lisp/clex/src/pcre.lisp" 22354)
;; (#P"/Users/gilbert/lisp/clex.broken-49/src/pcre.lisp" 5719)

(in-package :clex2)

#+OLD
(defun re-deriv-2 (a re) (error "obsolete"))
#+NEW
(defun re-deriv-2 (a re) (declare (ignore a re)) (error "obsolete"))

;; (#P"/Users/gilbert/lisp/clex/src/pcre.lisp" 27520)
;; (#P"/Users/gilbert/lisp/clex.broken-49/src/pcre.lisp" 6877)

(in-package :clex2)

(defun re-deriv-cont (cont input p2 re* env2)
  #+OLD
  (cond ((slot-value cont 'emppty) (when (= p2 0) (with-slots (link) cont (re-deriv-cont link input p2 re* env2))))
        ((= p2 1) (unless *want-empty* (funcall *yield* (re-and env2 (cont-term cont)))))
        (t
         (if (functionp cont)
             (funcall cont p2 env2)
             (with-slots (yield re guardp link p)
                         cont
                         (cond (yield (funcall yield p2 re* env2))
                               (guardp
                                (cond (nil
                                       (let ((*iter-count* (1+ (cont-iter-count cont))))
                                         (re-deriv-4 re input p2 env2 link)))
                                      (t
                                       (cond (nil
                                              (re-nullable-p (lhs re))
                                              (print `(nullable ,(re-nullable (lhs re))))
                                              (re-deriv-cont link input p2 (re-and (re-nullable (lhs re)) re*) env2))
                                             (t (re-deriv-cont link input p2 re* env2)))))
                                '(print (list (re-stripped (cont-term cont)) input (> p2 p)))
                                '(funcall guardp)
                                '(if (> p2 p)
                                     (re-deriv-4 re input p2 env2 link)
                                     (re-deriv-cont link input p2 re* env2))
                                '(re-deriv-cont link input p2 re* env2))
                               (t (re-deriv-4 re input p2 env2 link)))))))
  #+NEW
  (cond ((= p2 1) (funcall *yield* (re-and env2 (cont-term cont))))
        (t
         (with-slots (yield re guardp link)
                     cont
                     (cond (guardp (re-deriv-cont link input p2 re* env2)) (t (re-deriv-4 re input p2 env2 link)))))))

;; (#P"/Users/gilbert/lisp/clex/src/pcre.lisp" 29184)
;; (#P"/Users/gilbert/lisp/clex.broken-49/src/pcre.lisp" 7223)

(in-package :clex2)

(defun re-deriv-4 (re input p env cont)
  #+OLD
  (cond ((null input) (break) '(print `(d = ,cont env = ,env)) (re-deriv-cont cont input p re env))
        (t
         (etypecase re
           (re-set (when (isum-member input (re-isum re)) (re-deriv-cont cont input (+ p 1) '??? env)))
           (re-or (re-deriv-4 (lhs re) input p env cont) (re-deriv-4 (rhs re) input p env cont))
           (re-setq (re-deriv-cont cont input p re (re-and env (re-nullable re))))
           (re-epsilon (re-deriv-cont cont input p re env))
           (re-null)
           (re-and (re-deriv-4 (lhs re)
                               input
                               p
                               env
                               (make-instance 'cont :term (re-and (rhs re) (cont-term cont)) :re (rhs re) :link cont)))
           (re-intersection
             (assert (eq (lhs re) +epsilon+))
             (let ((*want-empty* t))
               (re-deriv-4 (rhs re) input p env (make-instance 'cont :re '---void--- :emppty t :link cont))))
           (re-* (let* ((iter-count *iter-count*) (*iter-count* 0) (n (re-nullable (lhs re))))
                   (if (eq +null+ n) (setq n +epsilon+))
                   (block guard
                     (re-deriv-4 (lhs re)
                                 input
                                 p
                                 env
                                 (make-instance
                                   'cont
                                   :re
                                   re
                                   :iter-count
                                   iter-count
                                   :guardp
                                   (lambda nil
                                     (warn "Throwing guard for ~S" (re-sre (re-stripped re)))
                                     (return-from guard nil))
                                   :p
                                   p
                                   :term
                                   (re-and re (cont-term cont))
                                   :link
                                   cont)))
                   (if nil (re-deriv-cont cont input p re env) (re-deriv-cont cont input p re (re-and env n))))))))
  #+NEW
  (etypecase re
    (re-set (when (isum-member input (re-isum re)) (re-deriv-cont cont input (+ p 1) '??? env)))
    (re-or (re-deriv-4 (lhs re) input p env cont) (re-deriv-4 (rhs re) input p env cont))
    (re-setq (re-deriv-cont cont input p re (re-and env (re-nullable re))))
    (re-epsilon (re-deriv-cont cont input p re env))
    (re-and (re-deriv-4 (lhs re)
                        input
                        p
                        env
                        (make-instance 'cont :term (re-and (rhs re) (cont-term cont)) :re (rhs re) :link cont)))
    (re-intersection
      (assert (eq (lhs re) +epsilon+))
      (re-deriv-4 (rhs re) input p env (make-instance 'cont :re '---void--- :emppty t :link cont)))
    (re-* (re-deriv-4 (lhs re)
                      input
                      p
                      env
                      (make-instance 'cont :re re :guardp t :term (re-and re (cont-term cont)) :link cont))
          (re-deriv-cont cont input p re env))
    (re-null)))

;; (#P"/Users/gilbert/lisp/clex/src/clex.lisp" 42665)
;; (#P"/Users/gilbert/lisp/clex.broken-49/src/pcre.lisp" 10777)

(in-package :clex2)

(defun re-and-2 (x y)
  (cond ((eq x +epsilon+) y)
        ((eq y +epsilon+) x)
        ((eq x +null+) +null+)
        ((eq y +null+) +null+)
        ((and (eq x +not-null+) (eq y +not-null+)) +not-null+)
        ((and (re-setq-p x) (re-or-p y)) (re-or (re-and x (lhs y)) (re-and x (rhs y))))
        ((and (re-or-p x) (re-setq-p y)) (re-or (re-and (lhs x) y) (re-and (rhs x) y)))
        (#+OLD
         (and (re-and-p x) (or (re-setq-free-p x) (re-setq-free-p y)))
         #+NEW
         (re-and-p x)
         (re-and (lhs x) (re-and (rhs x) y)))
        ((and (re-setq-p x) (re-setq-p y)) (re-merge-setqs y x))
        ((and (re-and-p x) (re-setq-p (lhs x))) (re-and (lhs x) (re-and (rhs x) y)))
        ((and (re-setq-p x) (re-and-p y) (re-setq-p (lhs y))) (re-and (re-merge-setqs (lhs y) x) (rhs y)))
        ((re-or-p x) (re-or (re-and (lhs x) y) (re-and (rhs x) y)))
        ((re-and-p x) (re-and (lhs x) (re-and (rhs x) y)))
        ((and (re-and-p x) (re-setq-p (rhs x))) (re-and (lhs x) (re-and (rhs x) y)))
        (t (re-cons-and x y))))

;; (#P"/Users/gilbert/lisp/clex/src/bfi2.lisp" 19126)
;; (#P"/Users/gilbert/lisp/clex.broken-49/src/bfi2.lisp" 19437)

(in-package :clex2)

(defun sol-equal (xs ys)
  #+OLD
  (cond ((null xs) t)
        ((null ys) t)
        ((and (or (null (caar xs)) (null (caar ys)) (eql (caar xs) (caar ys)))
              (or (null (cadar xs)) (null (cadar ys)) (eql (cadar xs) (cadar ys))))
         (sol-equal (cdr xs) (cdr ys))))
  #+NEW
  (equal xs ys))