1 ;;; regexp-opt.el --- generate efficient regexps to match strings
3 ;; Copyright (C) 1994,95,96,97,98,99,2000 Free Software Foundation, Inc.
5 ;; Author: Simon Marshall <simon@gnu.org>
7 ;; Keywords: strings, regexps, extensions
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software; you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your option)
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24 ;; Boston, MA 02111-1307, USA.
28 ;; The "opt" in "regexp-opt" stands for "optim\\(al\\|i[sz]e\\)".
30 ;; This package generates a regexp from a given list of strings (which matches
31 ;; one of those strings) so that the regexp generated by:
33 ;; (regexp-opt strings)
35 ;; is equivalent to, but more efficient than, the regexp generated by:
37 ;; (mapconcat 'regexp-quote strings "\\|")
41 ;; (let ((strings '("cond" "if" "when" "unless" "while"
42 ;; "let" "let*" "progn" "prog1" "prog2"
43 ;; "save-restriction" "save-excursion" "save-window-excursion"
44 ;; "save-current-buffer" "save-match-data"
45 ;; "catch" "throw" "unwind-protect" "condition-case")))
46 ;; (concat "(" (regexp-opt strings t) "\\>"))
47 ;; => "(\\(c\\(atch\\|ond\\(ition-case\\)?\\)\\|if\\|let\\*?\\|prog[12n]\\|save-\\(current-buffer\\|excursion\\|match-data\\|restriction\\|window-excursion\\)\\|throw\\|un\\(less\\|wind-protect\\)\\|wh\\(en\\|ile\\)\\)\\>"
49 ;; Searching using the above example `regexp-opt' regexp takes approximately
50 ;; two-thirds of the time taken using the equivalent `mapconcat' regexp.
52 ;; Since this package was written to produce efficient regexps, not regexps
53 ;; efficiently, it is probably not a good idea to in-line too many calls in
54 ;; your code, unless you use the following trick with `eval-when-compile':
56 ;; (defvar definition-regexp
59 ;; (regexp-opt '("defun" "defsubst" "defmacro" "defalias"
60 ;; "defvar" "defconst") t)
63 ;; The `byte-compile' code will be as if you had defined the variable thus:
65 ;; (defvar definition-regexp
66 ;; "^(\\(def\\(alias\\|const\\|macro\\|subst\\|un\\|var\\)\\)\\>")
68 ;; Note that if you use this trick for all instances of `regexp-opt' and
69 ;; `regexp-opt-depth' in your code, regexp-opt.el would only have to be loaded
70 ;; at compile time. But note also that using this trick means that should
71 ;; regexp-opt.el be changed, perhaps to fix a bug or to add a feature to
72 ;; improve the efficiency of `regexp-opt' regexps, you would have to recompile
73 ;; your code for such changes to have effect in your code.
75 ;; Originally written for font-lock.el, from an idea from Stig's hl319.el, with
76 ;; thanks for ideas also to Michael Ernst, Bob Glickstein, Dan Nicolaescu and
78 ;; No doubt `regexp-opt' doesn't always produce optimal regexps, so code, ideas
79 ;; or any other information to improve things are welcome.
81 ;; One possible improvement would be to compile '("aa" "ab" "ba" "bb")
82 ;; into "[ab][ab]" rather than "a[ab]\\|b[ab]". I'm not sure it's worth
83 ;; it but if someone knows how to do it without going through too many
84 ;; contortions, I'm all ears.
89 (defun regexp-opt (strings &optional paren
)
90 "Return a regexp to match a string in STRINGS.
91 Each string should be unique in STRINGS and should not contain any regexps,
92 quoted or not. If optional PAREN is non-nil, ensure that the returned regexp
93 is enclosed by at least one regexp grouping construct.
94 The returned regexp is typically more efficient than the equivalent regexp:
96 (let ((open (if PAREN \"\\\\(\" \"\")) (close (if PAREN \"\\\\)\" \"\")))
97 (concat open (mapconcat 'regexp-quote STRINGS \"\\\\|\") close))
99 If PAREN is `words', then the resulting regexp is additionally surrounded
102 ;; Recurse on the sorted list.
103 (let* ((max-lisp-eval-depth (* 1024 1024))
104 (completion-ignore-case nil
)
105 (words (eq paren
'words
))
106 (open (cond ((stringp paren
) paren
) (paren "\\(")))
107 (sorted-strings (sort (copy-sequence strings
) 'string-lessp
))
108 (re (regexp-opt-group sorted-strings open
)))
109 (if words
(concat "\\<" re
"\\>") re
))))
112 (defun regexp-opt-depth (regexp)
113 "Return the depth of REGEXP.
114 This means the number of regexp grouping constructs (parenthesised expressions)
117 ;; Hack to signal an error if REGEXP does not have balanced parentheses.
118 (string-match regexp
"")
119 ;; Count the number of open parentheses in REGEXP.
120 (let ((count 0) start
)
121 (while (string-match "\\(\\`\\|[^\\]\\)\\\\\\(\\\\\\\\\\)*([^?]"
123 (setq count
(1+ count
) start
(match-end 0)))
126 ;;; Workhorse functions.
131 (defun regexp-opt-group (strings &optional paren lax
)
132 "Return a regexp to match a string in STRINGS.
133 If PAREN non-nil, output regexp parentheses around returned regexp.
134 If LAX non-nil, don't output parentheses if it doesn't require them.
135 Merges keywords to avoid backtracking in Emacs' regexp matcher.
137 The basic idea is to find the shortest common prefix or suffix, remove it
138 and recurse. If there is no prefix, we divide the list into two so that
139 \(at least) one half will have at least a one-character common prefix.
141 Also we delay the addition of grouping parenthesis as long as possible
142 until we're sure we need them, and try to remove one-character sequences
143 so we can use character sets rather than grouping parenthesis."
144 (let* ((open-group (cond ((stringp paren
) paren
) (paren "\\(?:") (t "")))
145 (close-group (if paren
"\\)" ""))
146 (open-charset (if lax
"" open-group
))
147 (close-charset (if lax
"" close-group
)))
150 ;; If there are no strings, just return the empty string.
151 ((= (length strings
) 0)
154 ;; If there is only one string, just return it.
155 ((= (length strings
) 1)
156 (if (= (length (car strings
)) 1)
157 (concat open-charset
(regexp-quote (car strings
)) close-charset
)
158 (concat open-group
(regexp-quote (car strings
)) close-group
)))
160 ;; If there is an empty string, remove it and recurse on the rest.
161 ((= (length (car strings
)) 0)
163 (regexp-opt-group (cdr strings
) t t
) "?"
166 ;; If there are several one-char strings, use charsets
167 ((and (= (length (car strings
)) 1)
168 (let ((strs (cdr strings
)))
169 (while (and strs
(/= (length (car strs
)) 1))
173 ;; Collect one-char strings
175 (if (= (length s
) 1) (push (string-to-char s
) letters
) (push s rest
)))
178 ;; several one-char strings: take them and recurse
179 ;; on the rest (first so as to match the longest).
181 (regexp-opt-group (nreverse rest
))
182 "\\|" (regexp-opt-charset letters
)
184 ;; all are one-char strings: just return a character set.
186 (regexp-opt-charset letters
)
189 ;; We have a list of different length strings.
191 (let ((prefix (try-completion "" (mapcar 'list strings
))))
192 (if (> (length prefix
) 0)
193 ;; common prefix: take it and recurse on the suffixes.
194 (let* ((n (length prefix
))
195 (suffixes (mapcar (lambda (s) (substring s n
)) strings
)))
197 (regexp-quote prefix
)
198 (regexp-opt-group suffixes t t
)
201 (let* ((sgnirts (mapcar (lambda (s)
202 (concat (nreverse (string-to-list s
))))
204 (xiffus (try-completion "" (mapcar 'list sgnirts
))))
205 (if (> (length xiffus
) 0)
206 ;; common suffix: take it and recurse on the prefixes.
207 (let* ((n (- (length xiffus
)))
209 ;; Sorting is necessary in cases such as ("ad" "d").
210 (sort (mapcar (lambda (s) (substring s
0 n
)) strings
)
213 (regexp-opt-group prefixes t t
)
215 (concat (nreverse (string-to-list xiffus
))))
218 ;; Otherwise, divide the list into those that start with a
219 ;; particular letter and those that do not, and recurse on them.
220 (let* ((char (char-to-string (string-to-char (car strings
))))
221 (half1 (all-completions char
(mapcar 'list strings
)))
222 (half2 (nthcdr (length half1
) strings
)))
224 (regexp-opt-group half1
)
225 "\\|" (regexp-opt-group half2
)
226 close-group
))))))))))
229 (defun regexp-opt-charset (chars)
231 ;; Return a regexp to match a character in CHARS.
233 ;; The basic idea is to find character ranges. Also we take care in the
234 ;; position of character set meta characters in the character set regexp.
236 (let* ((charmap (make-char-table 'case-table
))
239 (bracket "") (dash "") (caret ""))
241 ;; Make a character map but extract character set meta characters.
251 (aset charmap char t
))))
253 ;; Make a character set from the map using ranges where applicable.
257 (if (= (1- c
) end
) (setq end c
)
258 (if (> end
(+ start
2))
259 (setq charset
(format "%s%c-%c" charset start end
))
260 (while (>= end start
)
261 (setq charset
(format "%s%c" charset start
))
263 (setq start c end c
))))
266 (if (> end
(+ start
2))
267 (setq charset
(format "%s%c-%c" charset start end
))
268 (while (>= end start
)
269 (setq charset
(format "%s%c" charset start
))
272 ;; Make sure a caret is not first and a dash is first or last.
273 (if (and (string-equal charset
"") (string-equal bracket
""))
274 (concat "[" dash caret
"]")
275 (concat "[" bracket charset caret dash
"]"))))
277 (provide 'regexp-opt
)
279 ;;; regexp-opt.el ends here