1 ;;; regexp-opt.el --- generate efficient regexps to match strings.
3 ;; Copyright (C) 1994, 95, 96, 97, 98, 1999 Free Software Foundation, Inc.
5 ;; Author: Simon Marshall <simon@gnu.org>
6 ;; Keywords: strings, regexps
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 ;; Note that this package will also find common suffix strings if this does not
53 ;; increase the number of grouping constructs. For example:
55 ;; (regexp-opt '("these" "those"))
60 ;; (regexp-opt '("barfly" "housefly"))
61 ;; => "barfly\\|housefly" rather than "\\(bar\\|house\\)fly"
63 ;; Since this package was written to produce efficient regexps, not regexps
64 ;; efficiently, it is probably not a good idea to in-line too many calls in
65 ;; your code, unless you use the following trick with `eval-when-compile':
67 ;; (defvar definition-regexp
70 ;; (regexp-opt '("defun" "defsubst" "defmacro" "defalias"
71 ;; "defvar" "defconst") t)
74 ;; The `byte-compile' code will be as if you had defined the variable thus:
76 ;; (defvar definition-regexp
77 ;; "^(\\(def\\(alias\\|const\\|macro\\|subst\\|un\\|var\\)\\)\\>")
79 ;; Note that if you use this trick for all instances of `regexp-opt' and
80 ;; `regexp-opt-depth' in your code, regexp-opt.el would only have to be loaded
81 ;; at compile time. But note also that using this trick means that should
82 ;; regexp-opt.el be changed, perhaps to fix a bug or to add a feature to
83 ;; improve the efficiency of `regexp-opt' regexps, you would have to recompile
84 ;; your code for such changes to have effect in your code.
86 ;; Originally written for font-lock.el, from an idea from Stig's hl319.el, with
87 ;; thanks for ideas also to Michael Ernst, Bob Glickstein, Dan Nicolaescu and
89 ;; No doubt `regexp-opt' doesn't always produce optimal regexps, so code, ideas
90 ;; or any other information to improve things are welcome.
95 (defun regexp-opt (strings &optional paren
)
96 "Return a regexp to match a string in STRINGS.
97 Each string should be unique in STRINGS and should not contain any regexps,
98 quoted or not. If optional PAREN is non-nil, ensure that the returned regexp
99 is enclosed by at least one regexp grouping construct.
100 The returned regexp is typically more efficient than the equivalent regexp:
102 (let ((open-paren (if PAREN \"\\\\(\" \"\")) (close-paren (if PAREN \"\\\\)\" \"\")))
103 (concat open-paren (mapconcat 'regexp-quote STRINGS \"\\\\|\") close-paren))
105 but typically contains more regexp grouping constructs.
106 Use `regexp-opt-depth' to count them."
108 ;; Recurse on the sorted list.
109 (let ((max-lisp-eval-depth (* 1024 1024))
110 (completion-ignore-case nil
))
111 (regexp-opt-group (sort (copy-sequence strings
) 'string-lessp
) paren
))))
114 (defun regexp-opt-depth (regexp)
115 "Return the depth of REGEXP.
116 This means the number of regexp grouping constructs (parenthesised expressions)
119 ;; Hack to signal an error if REGEXP does not have balanced parentheses.
120 (string-match regexp
"")
121 ;; Count the number of open parentheses in REGEXP.
122 (let ((count 0) start
)
123 (while (string-match "\\\\(" regexp start
)
124 (setq count
(1+ count
) start
(match-end 0)))
127 ;;; Workhorse functions.
132 (unless (fboundp 'make-bool-vector
)
133 (defalias 'make-bool-vector
'make-vector
))
135 (defun regexp-opt-group (strings &optional paren lax
)
137 ;; Return a regexp to match a string in STRINGS.
138 ;; If PAREN non-nil, output regexp parentheses around returned regexp.
139 ;; If LAX non-nil, don't output parentheses if it doesn't require them.
140 ;; Merges keywords to avoid backtracking in Emacs' regexp matcher.
142 ;; The basic idea is to find the shortest common prefix or suffix, remove it
143 ;; and recurse. If there is no prefix, we divide the list into two so that
144 ;; (at least) one half will have at least a one-character common prefix.
146 ;; Also we delay the addition of grouping parenthesis as long as possible
147 ;; until we're sure we need them, and try to remove one-character sequences
148 ;; so we can use character sets rather than grouping parenthesis.
150 (let* ((open-group (if paren
"\\(" ""))
151 (close-group (if paren
"\\)" ""))
152 (open-charset (if lax
"" open-group
))
153 (close-charset (if lax
"" close-group
))
154 (open-presuf open-charset
)
155 (close-presuf close-charset
))
158 ;; If there are no strings, just return the empty string.
159 ((= (length strings
) 0)
162 ;; If there is only one string, just return it.
163 ((= (length strings
) 1)
164 (if (= (length (car strings
)) 1)
165 (concat open-charset
(regexp-quote (car strings
)) close-charset
)
166 (concat open-group
(regexp-quote (car strings
)) close-group
)))
168 ;; If there is an empty string, remove it and recurse on the rest.
169 ((= (length (car strings
)) 0)
171 (regexp-opt-group (cdr strings
) t t
) "?"
174 ;; If all are one-character strings, just return a character set.
175 ((= (apply 'max
(mapcar 'length strings
)) 1)
177 (regexp-opt-charset strings
)
180 ;; We have a list of different length strings.
182 (let ((prefix (try-completion "" (mapcar 'list strings
)))
183 (suffix (regexp-opt-try-suffix strings
))
184 (letters (let ((completion-regexp-list '("^.$")))
185 (all-completions "" (mapcar 'list strings
)))))
188 ;; If there is a common prefix, remove it and recurse on the suffixes.
189 ((> (length prefix
) 0)
190 (let* ((end (length prefix
))
191 (suffixes (mapcar (lambda (s) (substring s end
)) strings
)))
193 (regexp-quote prefix
) (regexp-opt-group suffixes t t
)
196 ;; If there is a common suffix, remove it and recurse on the prefixes.
197 ((> (length suffix
) (if lax
199 (- (apply 'max
(mapcar 'length strings
)) 2)))
200 (let* ((end (- (length suffix
)))
201 (prefixes (sort (mapcar (lambda (s) (substring s
0 end
))
205 (regexp-opt-group prefixes t t
) (regexp-quote suffix
)
208 ;; If there are several one-character strings, remove them and recurse
209 ;; on the rest (first so the final regexp finds the longest match).
210 ((> (length letters
) 1)
211 (let ((rest (let ((completion-regexp-list '("^..+$")))
212 (all-completions "" (mapcar 'list strings
)))))
214 (regexp-opt-group rest
) "\\|" (regexp-opt-charset letters
)
217 ;; Otherwise, divide the list into those that start with a particular
218 ;; letter and those that do not, and recurse on them.
220 (let* ((char (substring (car strings
) 0 1))
221 (half1 (all-completions char
(mapcar 'list strings
)))
222 (half2 (nthcdr (length half1
) strings
)))
224 (regexp-opt-group half1
) "\\|" (regexp-opt-group half2
)
227 (defun regexp-opt-charset (chars)
229 ;; Return a regexp to match a character in CHARS.
231 ;; The basic idea is to find character ranges. Also we take care in the
232 ;; position of character set meta characters in the character set regexp.
234 (let* ((charwidth 256) ; Yeah, right.
235 (charmap (make-bool-vector charwidth nil
))
237 (bracket "") (dash "") (caret ""))
239 ;; Make a character map but extract character set meta characters.
240 (dolist (char (mapcar 'string-to-char chars
))
249 (aset charmap char t
))))
251 ;; Make a character set from the map using ranges where applicable.
252 (dotimes (char charwidth
)
254 (while (and (< char charwidth
) (aref charmap char
))
256 (cond ((> char
(+ start
3))
257 (setq charset
(format "%s%c-%c" charset start
(1- char
))))
259 (setq charset
(format "%s%c" charset
(setq char start
)))))))
261 ;; Make sure a caret is not first and a dash is first or last.
262 (if (and (string-equal charset
"") (string-equal bracket
""))
263 (concat "[" dash caret
"]")
264 (concat "[" bracket charset caret dash
"]"))))
266 (defun regexp-opt-try-suffix (strings)
268 ;; Return common suffix of each string in STRINGS. See `try-completion'.
270 (let* ((chars (mapcar (lambda (s) (mapcar 'identity s
)) strings
))
271 (srahc (mapcar 'reverse chars
))
272 (sgnirts (mapcar (lambda (c) (mapconcat 'char-to-string c
"")) srahc
))
273 (xiffus (try-completion "" (mapcar 'list sgnirts
))))
274 (mapconcat 'char-to-string
(reverse (mapcar 'identity xiffus
)) "")))
276 (provide 'regexp-opt
)
278 ;;; regexp-opt.el ends here