Commit | Line | Data |
---|---|---|
55535639 | 1 | ;;; regexp-opt.el --- generate efficient regexps to match strings |
56329bc5 | 2 | |
c0056275 | 3 | ;; Copyright (C) 1994,95,96,97,98,99,2000 Free Software Foundation, Inc. |
56329bc5 | 4 | |
5762abec | 5 | ;; Author: Simon Marshall <simon@gnu.org> |
fcc31755 | 6 | ;; Maintainer: FSF |
370893a1 | 7 | ;; Keywords: strings, regexps, extensions |
56329bc5 RS |
8 | |
9 | ;; This file is part of GNU Emacs. | |
10 | ||
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) | |
14 | ;; any later version. | |
15 | ||
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. | |
20 | ||
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. | |
25 | ||
26 | ;;; Commentary: | |
27 | ||
b02b54a8 | 28 | ;; The "opt" in "regexp-opt" stands for "optim\\(al\\|i[sz]e\\)". |
56329bc5 | 29 | ;; |
25544ce1 SM |
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: | |
56329bc5 | 32 | ;; |
25544ce1 SM |
33 | ;; (regexp-opt strings) |
34 | ;; | |
35 | ;; is equivalent to, but more efficient than, the regexp generated by: | |
36 | ;; | |
37 | ;; (mapconcat 'regexp-quote strings "\\|") | |
56329bc5 RS |
38 | ;; |
39 | ;; For example: | |
40 | ;; | |
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\\)\\)\\>" | |
48 | ;; | |
25544ce1 SM |
49 | ;; Searching using the above example `regexp-opt' regexp takes approximately |
50 | ;; two-thirds of the time taken using the equivalent `mapconcat' regexp. | |
51 | ||
56329bc5 RS |
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': | |
55 | ;; | |
56 | ;; (defvar definition-regexp | |
57 | ;; (eval-when-compile | |
58 | ;; (concat "^(" | |
59 | ;; (regexp-opt '("defun" "defsubst" "defmacro" "defalias" | |
60 | ;; "defvar" "defconst") t) | |
61 | ;; "\\>"))) | |
62 | ;; | |
63 | ;; The `byte-compile' code will be as if you had defined the variable thus: | |
64 | ;; | |
65 | ;; (defvar definition-regexp | |
66 | ;; "^(\\(def\\(alias\\|const\\|macro\\|subst\\|un\\|var\\)\\)\\>") | |
67 | ;; | |
25544ce1 SM |
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. | |
74 | ||
75 | ;; Originally written for font-lock.el, from an idea from Stig's hl319.el, with | |
b02b54a8 GM |
76 | ;; thanks for ideas also to Michael Ernst, Bob Glickstein, Dan Nicolaescu and |
77 | ;; Stefan Monnier. | |
78 | ;; No doubt `regexp-opt' doesn't always produce optimal regexps, so code, ideas | |
79 | ;; or any other information to improve things are welcome. | |
c0056275 SM |
80 | ;; |
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. | |
56329bc5 | 85 | \f |
c0056275 | 86 | ;;; Code: |
56329bc5 RS |
87 | |
88 | ;;;###autoload | |
89 | (defun regexp-opt (strings &optional paren) | |
90 | "Return a regexp to match a string in STRINGS. | |
582305b0 RS |
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. | |
56329bc5 RS |
94 | The returned regexp is typically more efficient than the equivalent regexp: |
95 | ||
908bb42f SM |
96 | (let ((open (if PAREN \"\\\\(\" \"\")) (close (if PAREN \"\\\\)\" \"\"))) |
97 | (concat open (mapconcat 'regexp-quote STRINGS \"\\\\|\") close)) | |
98 | ||
99 | If PAREN is `words', then the resulting regexp is additionally surrounded | |
100 | by \\=\\< and \\>." | |
56329bc5 RS |
101 | (save-match-data |
102 | ;; Recurse on the sorted list. | |
908bb42f | 103 | (let* ((max-lisp-eval-depth (* 1024 1024)) |
f3bd3e5f | 104 | (max-specpdl-size (* 1024 1024)) |
908bb42f | 105 | (completion-ignore-case nil) |
08cf00d8 | 106 | (completion-regexp-list nil) |
908bb42f SM |
107 | (words (eq paren 'words)) |
108 | (open (cond ((stringp paren) paren) (paren "\\("))) | |
109 | (sorted-strings (sort (copy-sequence strings) 'string-lessp)) | |
110 | (re (regexp-opt-group sorted-strings open))) | |
111 | (if words (concat "\\<" re "\\>") re)))) | |
56329bc5 | 112 | |
59b2ee69 JB |
113 | (defconst regexp-opt-not-groupie*-re |
114 | (let* ((harmless-ch "[^\\\\[]") | |
115 | (esc-pair-not-lp "\\\\[^(]") | |
116 | (class-harmless-ch "[^][]") | |
117 | (class-lb-harmless "[^]:]") | |
118 | (class-lb-colon-maybe-charclass ":\\([a-z]+:]\\)?") | |
119 | (class-lb (concat "\\[\\(" class-lb-harmless | |
120 | "\\|" class-lb-colon-maybe-charclass "\\)")) | |
121 | (class | |
122 | (concat "\\[^?]?" | |
123 | "\\(" class-harmless-ch | |
124 | "\\|" class-lb "\\)*" | |
125 | "\\[?]")) ; special handling for bare [ at end of re | |
126 | (shy-lp "\\\\(\\?:")) | |
127 | (concat "\\(" harmless-ch "\\|" esc-pair-not-lp | |
128 | "\\|" class "\\|" shy-lp "\\)*")) | |
129 | "Matches any part of a regular expression EXCEPT for non-shy \"\\\\(\"s") | |
130 | ||
56329bc5 RS |
131 | ;;;###autoload |
132 | (defun regexp-opt-depth (regexp) | |
133 | "Return the depth of REGEXP. | |
134 | This means the number of regexp grouping constructs (parenthesised expressions) | |
135 | in REGEXP." | |
136 | (save-match-data | |
137 | ;; Hack to signal an error if REGEXP does not have balanced parentheses. | |
138 | (string-match regexp "") | |
139 | ;; Count the number of open parentheses in REGEXP. | |
140 | (let ((count 0) start) | |
59b2ee69 JB |
141 | (while |
142 | (progn | |
143 | (string-match regexp-opt-not-groupie*-re regexp start) | |
144 | (setq start ( + (match-end 0) 2)) ; +2 for "\\(" after match-end. | |
145 | (<= start (length regexp))) | |
146 | (setq count (1+ count))) | |
56329bc5 RS |
147 | count))) |
148 | \f | |
149 | ;;; Workhorse functions. | |
150 | ||
151 | (eval-when-compile | |
152 | (require 'cl)) | |
153 | ||
56329bc5 | 154 | (defun regexp-opt-group (strings &optional paren lax) |
94abe30b SM |
155 | ;; Return a regexp to match a string in the sorted list STRINGS. |
156 | ;; If PAREN non-nil, output regexp parentheses around returned regexp. | |
157 | ;; If LAX non-nil, don't output parentheses if it doesn't require them. | |
158 | ;; Merges keywords to avoid backtracking in Emacs' regexp matcher. | |
159 | ||
160 | ;; The basic idea is to find the shortest common prefix or suffix, remove it | |
161 | ;; and recurse. If there is no prefix, we divide the list into two so that | |
162 | ;; \(at least) one half will have at least a one-character common prefix. | |
163 | ||
164 | ;; Also we delay the addition of grouping parenthesis as long as possible | |
165 | ;; until we're sure we need them, and try to remove one-character sequences | |
166 | ;; so we can use character sets rather than grouping parenthesis. | |
c0056275 | 167 | (let* ((open-group (cond ((stringp paren) paren) (paren "\\(?:") (t ""))) |
56329bc5 RS |
168 | (close-group (if paren "\\)" "")) |
169 | (open-charset (if lax "" open-group)) | |
c0056275 | 170 | (close-charset (if lax "" close-group))) |
56329bc5 | 171 | (cond |
b02b54a8 GM |
172 | ;; |
173 | ;; If there are no strings, just return the empty string. | |
174 | ((= (length strings) 0) | |
175 | "") | |
176 | ;; | |
56329bc5 RS |
177 | ;; If there is only one string, just return it. |
178 | ((= (length strings) 1) | |
179 | (if (= (length (car strings)) 1) | |
180 | (concat open-charset (regexp-quote (car strings)) close-charset) | |
181 | (concat open-group (regexp-quote (car strings)) close-group))) | |
182 | ;; | |
183 | ;; If there is an empty string, remove it and recurse on the rest. | |
184 | ((= (length (car strings)) 0) | |
185 | (concat open-charset | |
186 | (regexp-opt-group (cdr strings) t t) "?" | |
187 | close-charset)) | |
188 | ;; | |
c0056275 SM |
189 | ;; If there are several one-char strings, use charsets |
190 | ((and (= (length (car strings)) 1) | |
191 | (let ((strs (cdr strings))) | |
192 | (while (and strs (/= (length (car strs)) 1)) | |
193 | (pop strs)) | |
194 | strs)) | |
195 | (let (letters rest) | |
196 | ;; Collect one-char strings | |
197 | (dolist (s strings) | |
5cda4b07 | 198 | (if (= (length s) 1) (push (string-to-char s) letters) (push s rest))) |
c0056275 SM |
199 | |
200 | (if rest | |
201 | ;; several one-char strings: take them and recurse | |
202 | ;; on the rest (first so as to match the longest). | |
203 | (concat open-group | |
204 | (regexp-opt-group (nreverse rest)) | |
205 | "\\|" (regexp-opt-charset letters) | |
206 | close-group) | |
207 | ;; all are one-char strings: just return a character set. | |
208 | (concat open-charset | |
209 | (regexp-opt-charset letters) | |
210 | close-charset)))) | |
56329bc5 RS |
211 | ;; |
212 | ;; We have a list of different length strings. | |
213 | (t | |
91fc05b1 | 214 | (let ((prefix (try-completion "" strings))) |
c0056275 SM |
215 | (if (> (length prefix) 0) |
216 | ;; common prefix: take it and recurse on the suffixes. | |
217 | (let* ((n (length prefix)) | |
218 | (suffixes (mapcar (lambda (s) (substring s n)) strings))) | |
bba6564c | 219 | (concat open-group |
c0056275 SM |
220 | (regexp-quote prefix) |
221 | (regexp-opt-group suffixes t t) | |
bba6564c | 222 | close-group)) |
c0056275 SM |
223 | |
224 | (let* ((sgnirts (mapcar (lambda (s) | |
225 | (concat (nreverse (string-to-list s)))) | |
226 | strings)) | |
91fc05b1 | 227 | (xiffus (try-completion "" sgnirts))) |
c0056275 SM |
228 | (if (> (length xiffus) 0) |
229 | ;; common suffix: take it and recurse on the prefixes. | |
230 | (let* ((n (- (length xiffus))) | |
7e1d6bdb SM |
231 | (prefixes |
232 | ;; Sorting is necessary in cases such as ("ad" "d"). | |
233 | (sort (mapcar (lambda (s) (substring s 0 n)) strings) | |
234 | 'string-lessp))) | |
bba6564c | 235 | (concat open-group |
c0056275 SM |
236 | (regexp-opt-group prefixes t t) |
237 | (regexp-quote | |
238 | (concat (nreverse (string-to-list xiffus)))) | |
bba6564c | 239 | close-group)) |
a1506d29 | 240 | |
c0056275 SM |
241 | ;; Otherwise, divide the list into those that start with a |
242 | ;; particular letter and those that do not, and recurse on them. | |
243 | (let* ((char (char-to-string (string-to-char (car strings)))) | |
91fc05b1 | 244 | (half1 (all-completions char strings)) |
94abe30b | 245 | (half2 (nthcdr (length half1) strings))) |
c0056275 SM |
246 | (concat open-group |
247 | (regexp-opt-group half1) | |
248 | "\\|" (regexp-opt-group half2) | |
249 | close-group)))))))))) | |
250 | ||
56329bc5 RS |
251 | |
252 | (defun regexp-opt-charset (chars) | |
253 | ;; | |
254 | ;; Return a regexp to match a character in CHARS. | |
255 | ;; | |
256 | ;; The basic idea is to find character ranges. Also we take care in the | |
257 | ;; position of character set meta characters in the character set regexp. | |
258 | ;; | |
5cda4b07 SM |
259 | (let* ((charmap (make-char-table 'case-table)) |
260 | (start -1) (end -2) | |
56329bc5 RS |
261 | (charset "") |
262 | (bracket "") (dash "") (caret "")) | |
263 | ;; | |
264 | ;; Make a character map but extract character set meta characters. | |
5cda4b07 | 265 | (dolist (char chars) |
25544ce1 SM |
266 | (case char |
267 | (?\] | |
268 | (setq bracket "]")) | |
269 | (?^ | |
270 | (setq caret "^")) | |
271 | (?- | |
272 | (setq dash "-")) | |
273 | (otherwise | |
274 | (aset charmap char t)))) | |
56329bc5 RS |
275 | ;; |
276 | ;; Make a character set from the map using ranges where applicable. | |
5cda4b07 SM |
277 | (map-char-table |
278 | (lambda (c v) | |
279 | (when v | |
6466bb34 KH |
280 | (if (consp c) |
281 | (if (= (1- (car c)) end) (setq end (cdr c)) | |
282 | (if (> end (+ start 2)) | |
283 | (setq charset (format "%s%c-%c" charset start end)) | |
284 | (while (>= end start) | |
285 | (setq charset (format "%s%c" charset start)) | |
286 | (incf start))) | |
287 | (setq start (car c) end (cdr c))) | |
288 | (if (= (1- c) end) (setq end c) | |
289 | (if (> end (+ start 2)) | |
5cda4b07 SM |
290 | (setq charset (format "%s%c-%c" charset start end)) |
291 | (while (>= end start) | |
292 | (setq charset (format "%s%c" charset start)) | |
293 | (incf start))) | |
6466bb34 | 294 | (setq start c end c))))) |
5cda4b07 SM |
295 | charmap) |
296 | (when (>= end start) | |
297 | (if (> end (+ start 2)) | |
298 | (setq charset (format "%s%c-%c" charset start end)) | |
299 | (while (>= end start) | |
300 | (setq charset (format "%s%c" charset start)) | |
301 | (incf start)))) | |
56329bc5 RS |
302 | ;; |
303 | ;; Make sure a caret is not first and a dash is first or last. | |
304 | (if (and (string-equal charset "") (string-equal bracket "")) | |
305 | (concat "[" dash caret "]") | |
306 | (concat "[" bracket charset caret dash "]")))) | |
307 | ||
308 | (provide 'regexp-opt) | |
309 | ||
6b61353c | 310 | ;;; arch-tag: 6c5a66f4-29af-4fd6-8c3b-4b554d5b4370 |
56329bc5 | 311 | ;;; regexp-opt.el ends here |