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 (max-specpdl-size (* 1024 1024))
105 (completion-ignore-case nil
)
106 (completion-regexp-list nil
)
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
))))
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
"\\)"))
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")
132 (defun regexp-opt-depth (regexp)
133 "Return the depth of REGEXP.
134 This means the number of regexp grouping constructs (parenthesised expressions)
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
)
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
)))
149 ;;; Workhorse functions.
154 (defun regexp-opt-group (strings &optional paren lax
)
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.
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.
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.
167 (let* ((open-group (cond ((stringp paren
) paren
) (paren "\\(?:") (t "")))
168 (close-group (if paren
"\\)" ""))
169 (open-charset (if lax
"" open-group
))
170 (close-charset (if lax
"" close-group
)))
173 ;; If there are no strings, just return the empty string.
174 ((= (length strings
) 0)
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
)))
183 ;; If there is an empty string, remove it and recurse on the rest.
184 ((= (length (car strings
)) 0)
186 (regexp-opt-group (cdr strings
) t t
) "?"
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))
196 ;; Collect one-char strings
198 (if (= (length s
) 1) (push (string-to-char s
) letters
) (push s rest
)))
201 ;; several one-char strings: take them and recurse
202 ;; on the rest (first so as to match the longest).
204 (regexp-opt-group (nreverse rest
))
205 "\\|" (regexp-opt-charset letters
)
207 ;; all are one-char strings: just return a character set.
209 (regexp-opt-charset letters
)
212 ;; We have a list of different length strings.
214 (let ((prefix (try-completion "" strings
)))
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
)))
220 (regexp-quote prefix
)
221 (regexp-opt-group suffixes t t
)
224 (let* ((sgnirts (mapcar (lambda (s)
225 (concat (nreverse (string-to-list s
))))
227 (xiffus (try-completion "" sgnirts
)))
228 (if (> (length xiffus
) 0)
229 ;; common suffix: take it and recurse on the prefixes.
230 (let* ((n (- (length xiffus
)))
232 ;; Sorting is necessary in cases such as ("ad" "d").
233 (sort (mapcar (lambda (s) (substring s
0 n
)) strings
)
236 (regexp-opt-group prefixes t t
)
238 (concat (nreverse (string-to-list xiffus
))))
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
))))
244 (half1 (all-completions char strings
))
245 (half2 (nthcdr (length half1
) strings
)))
247 (regexp-opt-group half1
)
248 "\\|" (regexp-opt-group half2
)
249 close-group
))))))))))
252 (defun regexp-opt-charset (chars)
254 ;; Return a regexp to match a character in CHARS.
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.
259 (let* ((charmap (make-char-table 'case-table
))
262 (bracket "") (dash "") (caret ""))
264 ;; Make a character map but extract character set meta characters.
274 (aset charmap char t
))))
276 ;; Make a character set from the map using ranges where applicable.
280 (if (= (1- c
) end
) (setq end c
)
281 (if (> end
(+ start
2))
282 (setq charset
(format "%s%c-%c" charset start end
))
283 (while (>= end start
)
284 (setq charset
(format "%s%c" charset start
))
286 (setq start c end c
))))
289 (if (> end
(+ start
2))
290 (setq charset
(format "%s%c-%c" charset start end
))
291 (while (>= end start
)
292 (setq charset
(format "%s%c" charset start
))
295 ;; Make sure a caret is not first and a dash is first or last.
296 (if (and (string-equal charset
"") (string-equal bracket
""))
297 (concat "[" dash caret
"]")
298 (concat "[" bracket charset caret dash
"]"))))
300 (provide 'regexp-opt
)
302 ;;; arch-tag: 6c5a66f4-29af-4fd6-8c3b-4b554d5b4370
303 ;;; regexp-opt.el ends here