Function: rx--reduce-to-char-alt

rx--reduce-to-char-alt is a byte-compiled function defined in rx.el.gz.

Signature

(rx--reduce-to-char-alt FORM)

Documentation

Transform FORM into (INTERVALS . CLASSES) or nil if not possible.

Process or, intersection and not. FORM must be normalised (from rx--normalise-char-pattern).

Source Code

;; Defined in /usr/src/emacs/lisp/emacs-lisp/rx.el.gz
(defun rx--reduce-to-char-alt (form)
  "Transform FORM into (INTERVALS . CLASSES) or nil if not possible.
Process `or', `intersection' and `not'.
FORM must be normalised (from `rx--normalise-char-pattern')."
  (cond
   ((stringp form)
    (and (= (length form) 1)
         (let ((c (aref form 0)))
           (list (list (cons c c))))))
   ((consp form)
    (let ((head (car form)))
      (cond
       ;; FIXME: Transform `digit', `xdigit', `cntrl', `ascii', `nonascii'
       ;; to ranges? That would allow them to be negated and intersected.
       ((eq head 'rx--char-alt) (cdr form))
       ((eq head 'not)
        (unless (= (length form) 2)
          (error "rx `not' form takes exactly one argument"))
        (let ((arg (rx--reduce-to-char-alt (cadr form))))
          ;; Only interval sets without classes are closed under complement.
          (and arg (null (cdr arg))
               (list (rx--interval-set-complement (car arg))))))
       ((eq head 'or)
        (let ((args (cdr form)))
          (let ((acc '(nil)))  ; union identity
            (while (and args
                        (let ((char (rx--reduce-to-char-alt (car args))))
                          (setq acc (and char (rx--char-alt-union acc char)))))
              (setq args (cdr args)))
            acc)))
       ((eq head 'intersection)
        (list (rx--intersection-intervals (cdr form))))
       )))
   ((memq form '(nonl not-newline any))
    '(((0 . 9) (11 . #x3fffff))))
   ((memq form '(anychar anything))
    '(((0 . #x3fffff))))
   ;; FIXME: A better handling of `unmatchable' would be:
   ;;   * (seq ... unmatchable ...) -> unmatchable
   ;;   * any or-pattern branch that is `unmatchable' is deleted
   ;;   * (REPEAT unmatchable) -> "", if REPEAT accepts 0 repetitions
   ;;   * (REPEAT unmatchable) -> unmatchable, otherwise
   ;; if it's worth the trouble (probably not).
   ((eq form 'unmatchable)
    '(nil))
   ))