;; -*- Mode: Lisp -*-
;; (#P"/Users/gilbert/lisp/clex.36/src/clex.lisp" 43043)
;; (#P"/Users/gilbert/lisp/clex/src/clex.lisp" 43043)

(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)))
        ((and (re-and-p x) (or (re-setq-free-p x) (re-setq-free-p y))) (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)))
        #+NEW
        ((re-or-p x) (re-or (re-and (lhs x) y) (re-and (rhs x) y)))
        #+NEW
        ((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.36/src/clex.lisp" 45738)
;; (#P"/Users/gilbert/lisp/clex/src/clex.lisp" 45804)

(in-package :clex2)

(defun re-or (x y)
  (cond ((eq x +null+) y)
        ((eq y +null+) x)
        ((re-or-p y) (re-or (re-or x (lhs y)) (rhs y)))
        ((eq x y) x)
        ((let ((y* (re-stripped y)))
           (do ((q x (lhs q)))
               ((not (re-or-p q)) (eq (re-stripped q) y*))
             (when (eq (re-stripped (rhs q)) y*) (return t))))
         x)
        #+OLD
        ((and (typep x 're-set) (typep y 're-set)) (re-set (isum-union (re-isum x) (re-isum y))))
        (t (re-cons-or x y))))

;; (#P"/Users/gilbert/lisp/clex.36/src/clex.lisp" 48439)
;; (#P"/Users/gilbert/lisp/clex/src/clex.lisp" 48519)

(in-package :clex2)

(defun re-intersection (x y)
  (cond ((eq x +null+) +null+)
        ((eq y +null+) +null+)
        ((eq x +not-null+) y)
        ((eq y +not-null+) x)
        ((eq x y) x)
        ((and (or (eq x +epsilon+) (re-setq-p x)) (or (eq y +epsilon+) (re-setq-p y))) (re-and x y))
        ((and (re-and-p y) (re-setq-p (lhs y))) (re-and (lhs y) (re-intersection x (rhs y))))
        ((and (re-and-p x) (re-setq-p (lhs x))) (re-and (lhs x) (re-intersection (rhs x) y)))
        ((let ((y* (re-stripped y)))
           (do ((q x (lhs q)))
               ((not (re-intersection-p q)) (eq (re-stripped q) y*))
             (when (eq (re-stripped (rhs q)) y*) (return t))))
         x)
        ((typep y 're-intersection) (re-intersection (re-intersection x (lhs y)) (rhs y)))
        ((let* ((y* (re-stripped y)) (not-y* (re-not y*)))
           (do ((q x (lhs q)))
               ((not (typep q 're-intersection))
                (when (eq (re-stripped q) not-y*) (return-from re-intersection +null+))
                (eq (progn 're-stripped q) y*)
                nil)
             (when (eq (re-stripped (rhs q)) not-y*) (return-from re-intersection +null+))
             '(when (eq (progn 're-stripped (rhs q)) y*) (return t))))
         (warn "cancel: ~S ~S" x y)
         x)
        #+OLD
        ((and (typep x 're-set) (typep y 're-set)) (re-set (isum-intersection (re-isum x) (re-isum y))))
        (t (re-cons-intersection x y))))

;; (#P"/Users/gilbert/lisp/clex.36/src/clex-test.lisp" 13486)
;; (#P"/Users/gilbert/lisp/clex/src/clex-test.lisp" 13481)

(in-package :clex2)

(defun test-deriv (input sre &key (anchored-p t))
  (let ((re (con-init sre)) (vs (sre-variables sre)) (last-good +null+))
    (loop for start from 0 to (if anchored-p 0 (length input))
          for res = (match-deriv re input start #+NEW :anchored-p #+NEW anchored-p)
          while (eq res +null+)
          finally (setq last-good res))
          (cond ((eq +null+ last-good) :nomatch)
                (t
                 (labels ((frob (v)
                            (let ((q (assoc v (re-subst last-good))))
                              (cond ((null q) nil) ((eql (third q) 'p) (second q)) (t nil)))))
                   (loop for v in vs collect (list (frob (intern-$n.s v)) (frob (intern-$n.e v)))))))))

;; (#P"/Users/gilbert/lisp/clex.36/src/clex-test.lisp" 14657)
;; (#P"/Users/gilbert/lisp/clex/src/clex-test.lisp" 14675)

(in-package :clex2)

(defun match-deriv (re input start #+NEW &key #+NEW anchored-p)
  (let ((end (length input)))
    (let ((last-good +null+))
      (labels ((check-null (re p)
                 (when *trace-deriv* (print re))
                 (let ((nu
                        (let ((*new-vars-collector* (list nil)) (*k* (lambda nil p)))
                          (elide-epitext (con-nullable re)))))
                   (unless (eq nu +null+) (setq last-good nu)))))
        (loop for p from start to
              end
              for c = (if (= p end) +end-of-file-sentinel+ (char input p))
              do (check-null re p)
                 (when *trace-deriv* (format t "~%---- ~S ----" c))
                 (let ((re* (let* ((*new-vars-collector* (list nil)) (*k* (lambda nil p))) (con-deriv c re *k*))))
                   (setq re re*)))
              (check-null re (length input))
              last-good))))