(defun parse-re (string &optional (start 0) end)
  (setq end (or end (length string)))
  (let ((p start) ch (group 0) (cur-and nil) (cur-or nil) (stack nil))
    (labels ((getch ()
               (if (< p end) (char string (1- (incf p))) :eof))
             (push-char (ch)
               (push ch cur-and))
             (iter (op)
               (unless cur-and (error "Invalid preceding regular expression."))
               (setf (car cur-and) `(,@op ,(car cur-and))))
             (get-and ()
               (if (= 1 (length cur-and)) (car cur-and) `(and ,@(reverse cur-and))))
             (close-group (n)
               (let ((q `(= ,n ,(let ((q (reverse (cons (get-and) cur-or))))
                                     (if (cdr q) `(or ,@q) (car q))))))
                 (setf cur-or (pop stack) cur-and (pop stack))
                 (car (push q cur-and)))))
      (do () ((eq :eof (setq ch (getch))))
        (case ch
          (#\| (push (get-and) cur-or)
               (setf cur-and nil))
          (#\* (iter '(*)))
          (#\+ (iter '(+)))
          (#\? (iter '(?)))
          (#\( (push cur-and stack) (push cur-or stack)
               (setq cur-and nil cur-or nil))
          (#\) (if stack
                   (close-group (incf group))
                   (push-char ch)))     ;sic!
          (#\^ (push :bol cur-and))
          (#\$ (push :eol cur-and))
          (#\. (push :dot cur-and))
          (#\{ (let* ((p1 (or (position #\} string :start p :end end)
                              (error "Closing \"}\" missing.")))
                      (p2 (and p1 (position #\, string :start p :end p1)))
                      (m (parse-integer string :start p :end (or p2 p1)))
                      (n (cond ((null p2) m)
                               ((= (1+ p2) p1) '*)
                               (t (parse-integer string :start (1+ p2) :end p1)))))
                 (iter `(** ,m ,n))
                 (setq p (1+ p1))))
          (#\[ (let ((neg (and (< p end) (char= (char string p) #\^) (incf p) t))
                     (bag (list (getch))))
                 (do () ((eql #\] (setq ch (getch))))
                   (case ch
                     (:eof (error "Unmatched \"[\"."))
                     (#\- (let ((ch2 (getch)))
                            (cond ((eql ch2 #\])
                                   (decf p) (push ch bag))
                                  ((not (characterp (car bag)))
                                   (error "Misplaced \"-\" in bracket group."))
                                  ((char> (car bag) ch2)
                                   (error "Invalid range end."))
                                  (t (setf (car bag) `(<= ,(car bag) ,ch2))))))
                     (t (push ch bag))))
                 (setq bag `(or ,@(reverse bag)))
                 (push (if neg `(- :dot ,bag) bag) cur-and) ))
          (#\\ (case (setq ch (getch))
                 (:eof (error "Trailing backslash"))
                 ((#\^ #\. #\[ #\$ #\( #\) #\| #\* #\+ #\? #\{ #\\)
                  (push-char ch))
                 (#\< (push :beginning-of-word cur-and))
                 (#\> (push :end-of-word cur-and))
                 (#\b (push :word-boundary cur-and))
                 (#\s (push :space cur-and))
                 (t (error "Bad escape sequence \"\\~A\"." ch))))
          (t   (push-char ch))))
      (values (close-group 0)
              (1+ group)))))