Commit | Line | Data |
---|---|---|
56329bc5 RS |
1 | ;;; regexp-opt.el --- generate efficient regexps to match strings. |
2 | ||
3 | ;; Copyright (C) 1994, 1995, 1996, 1997 Free Software Foundation, Inc. | |
4 | ||
5762abec | 5 | ;; Author: Simon Marshall <simon@gnu.org> |
56329bc5 | 6 | ;; Keywords: strings, regexps |
56329bc5 RS |
7 | |
8 | ;; This file is part of GNU Emacs. | |
9 | ||
10 | ;; GNU Emacs is free software; you can redistribute it and/or modify | |
11 | ;; it under the terms of the GNU General Public License as published by | |
12 | ;; the Free Software Foundation; either version 2, or (at your option) | |
13 | ;; any later version. | |
14 | ||
15 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
18 | ;; GNU General Public License for more details. | |
19 | ||
20 | ;; You should have received a copy of the GNU General Public License | |
21 | ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
22 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
23 | ;; Boston, MA 02111-1307, USA. | |
24 | ||
25 | ;;; Commentary: | |
26 | ||
27 | ;; The "opt" in "regexp-opt" stands for "optim\\(al\\|i\\(se\\|ze\\)\\)". | |
28 | ;; | |
25544ce1 SM |
29 | ;; This package generates a regexp from a given list of strings (which matches |
30 | ;; one of those strings) so that the regexp generated by: | |
56329bc5 | 31 | ;; |
25544ce1 SM |
32 | ;; (regexp-opt strings) |
33 | ;; | |
34 | ;; is equivalent to, but more efficient than, the regexp generated by: | |
35 | ;; | |
36 | ;; (mapconcat 'regexp-quote strings "\\|") | |
56329bc5 RS |
37 | ;; |
38 | ;; For example: | |
39 | ;; | |
40 | ;; (let ((strings '("cond" "if" "when" "unless" "while" | |
41 | ;; "let" "let*" "progn" "prog1" "prog2" | |
42 | ;; "save-restriction" "save-excursion" "save-window-excursion" | |
43 | ;; "save-current-buffer" "save-match-data" | |
44 | ;; "catch" "throw" "unwind-protect" "condition-case"))) | |
45 | ;; (concat "(" (regexp-opt strings t) "\\>")) | |
46 | ;; => "(\\(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\\)\\)\\>" | |
47 | ;; | |
25544ce1 SM |
48 | ;; Searching using the above example `regexp-opt' regexp takes approximately |
49 | ;; two-thirds of the time taken using the equivalent `mapconcat' regexp. | |
50 | ||
56329bc5 RS |
51 | ;; Since this package was written to produce efficient regexps, not regexps |
52 | ;; efficiently, it is probably not a good idea to in-line too many calls in | |
53 | ;; your code, unless you use the following trick with `eval-when-compile': | |
54 | ;; | |
55 | ;; (defvar definition-regexp | |
56 | ;; (eval-when-compile | |
57 | ;; (concat "^(" | |
58 | ;; (regexp-opt '("defun" "defsubst" "defmacro" "defalias" | |
59 | ;; "defvar" "defconst") t) | |
60 | ;; "\\>"))) | |
61 | ;; | |
62 | ;; The `byte-compile' code will be as if you had defined the variable thus: | |
63 | ;; | |
64 | ;; (defvar definition-regexp | |
65 | ;; "^(\\(def\\(alias\\|const\\|macro\\|subst\\|un\\|var\\)\\)\\>") | |
66 | ;; | |
25544ce1 SM |
67 | ;; Note that if you use this trick for all instances of `regexp-opt' and |
68 | ;; `regexp-opt-depth' in your code, regexp-opt.el would only have to be loaded | |
69 | ;; at compile time. But note also that using this trick means that should | |
70 | ;; regexp-opt.el be changed, perhaps to fix a bug or to add a feature to | |
71 | ;; improve the efficiency of `regexp-opt' regexps, you would have to recompile | |
72 | ;; your code for such changes to have effect in your code. | |
73 | ||
74 | ;; Originally written for font-lock.el, from an idea from Stig's hl319.el, with | |
75 | ;; thanks for ideas also to Michael Ernst, Bob Glickstein and Dan Nicolaescu. | |
56329bc5 RS |
76 | ;; Please don't tell me that it doesn't produce optimal regexps; I know that |
77 | ;; already. For example, the above explanation for the meaning of "opt" would | |
78 | ;; be more efficient as "optim\\(al\\|i[sz]e\\)", but this requires complex | |
79 | ;; forward looking. But (ideas or) code to improve things (are) is welcome. | |
80 | \f | |
81 | ;;; Code: | |
82 | ||
83 | ;;;###autoload | |
84 | (defun regexp-opt (strings &optional paren) | |
85 | "Return a regexp to match a string in STRINGS. | |
582305b0 RS |
86 | Each string should be unique in STRINGS and should not contain any regexps, |
87 | quoted or not. If optional PAREN is non-nil, ensure that the returned regexp | |
88 | is enclosed by at least one regexp grouping construct. | |
56329bc5 RS |
89 | The returned regexp is typically more efficient than the equivalent regexp: |
90 | ||
25544ce1 SM |
91 | (let ((open-paren (if PAREN \"\\\\(\" \"\")) (close-paren (if PAREN \"\\\\)\" \"\"))) |
92 | (concat open-paren (mapconcat 'regexp-quote STRINGS \"\\\\|\") close-paren)) | |
56329bc5 | 93 | |
25544ce1 SM |
94 | but typically contains more regexp grouping constructs. |
95 | Use `regexp-opt-depth' to count them." | |
56329bc5 RS |
96 | (save-match-data |
97 | ;; Recurse on the sorted list. | |
98 | (let ((max-lisp-eval-depth (* 1024 1024)) | |
99 | (completion-ignore-case nil)) | |
100 | (regexp-opt-group (sort (copy-sequence strings) 'string-lessp) paren)))) | |
101 | ||
102 | ;;;###autoload | |
103 | (defun regexp-opt-depth (regexp) | |
104 | "Return the depth of REGEXP. | |
105 | This means the number of regexp grouping constructs (parenthesised expressions) | |
106 | in REGEXP." | |
107 | (save-match-data | |
108 | ;; Hack to signal an error if REGEXP does not have balanced parentheses. | |
109 | (string-match regexp "") | |
110 | ;; Count the number of open parentheses in REGEXP. | |
111 | (let ((count 0) start) | |
112 | (while (string-match "\\\\(" regexp start) | |
113 | (setq count (1+ count) start (match-end 0))) | |
114 | count))) | |
115 | \f | |
116 | ;;; Workhorse functions. | |
117 | ||
118 | (eval-when-compile | |
119 | (require 'cl)) | |
120 | ||
121 | (unless (fboundp 'make-bool-vector) | |
122 | (defalias 'make-bool-vector 'make-vector)) | |
123 | ||
124 | (defun regexp-opt-group (strings &optional paren lax) | |
125 | ;; | |
126 | ;; Return a regexp to match a string in STRINGS. | |
127 | ;; If PAREN non-nil, output regexp parentheses around returned regexp. | |
128 | ;; If LAX non-nil, don't output parentheses if it doesn't require them. | |
129 | ;; Merges keywords to avoid backtracking in Emacs' regexp matcher. | |
130 | ;; | |
131 | ;; The basic idea is to find the shortest common prefix, remove it and | |
132 | ;; recurse. If there is no prefix, we divide the list into two so that (at | |
133 | ;; least) one half will have at least a one-character common prefix. | |
134 | ;; | |
135 | ;; Also we delay the addition of grouping parenthesis as long as possible | |
136 | ;; until we're sure we need them, and try to remove one-character sequences | |
137 | ;; so we can use character sets rather than grouping parenthesis. | |
138 | ;; | |
139 | (let* ((open-group (if paren "\\(" "")) | |
140 | (close-group (if paren "\\)" "")) | |
141 | (open-charset (if lax "" open-group)) | |
142 | (close-charset (if lax "" close-group))) | |
143 | (cond | |
e011fd6b KH |
144 | ;; Protect against user-stupidity... could call error here |
145 | ((null strings) | |
146 | nil) | |
56329bc5 RS |
147 | ;; If there is only one string, just return it. |
148 | ((= (length strings) 1) | |
149 | (if (= (length (car strings)) 1) | |
150 | (concat open-charset (regexp-quote (car strings)) close-charset) | |
151 | (concat open-group (regexp-quote (car strings)) close-group))) | |
152 | ;; | |
153 | ;; If there is an empty string, remove it and recurse on the rest. | |
154 | ((= (length (car strings)) 0) | |
155 | (concat open-charset | |
156 | (regexp-opt-group (cdr strings) t t) "?" | |
157 | close-charset)) | |
158 | ;; | |
159 | ;; If all are one-character strings, just return a character set. | |
160 | ((= (length strings) (apply '+ (mapcar 'length strings))) | |
161 | (concat open-charset | |
162 | (regexp-opt-charset strings) | |
163 | close-charset)) | |
164 | ;; | |
165 | ;; We have a list of different length strings. | |
166 | (t | |
167 | (let ((prefix (try-completion "" (mapcar 'list strings))) | |
168 | (letters (let ((completion-regexp-list '("^.$"))) | |
169 | (all-completions "" (mapcar 'list strings))))) | |
170 | (cond | |
171 | ;; | |
172 | ;; If there is a common prefix, remove it and recurse on the suffixes. | |
173 | ((> (length prefix) 0) | |
174 | (let* ((length (length prefix)) | |
175 | (suffixes (mapcar (lambda (s) (substring s length)) strings))) | |
176 | (concat open-group | |
177 | (regexp-quote prefix) (regexp-opt-group suffixes t t) | |
178 | close-group))) | |
179 | ;; | |
180 | ;; If there are several one-character strings, remove them and recurse | |
25544ce1 | 181 | ;; on the rest (first so the final regexp finds the longest match). |
56329bc5 RS |
182 | ((> (length letters) 1) |
183 | (let ((rest (let ((completion-regexp-list '("^..+$"))) | |
184 | (all-completions "" (mapcar 'list strings))))) | |
185 | (concat open-group | |
25544ce1 | 186 | (regexp-opt-group rest) "\\|" (regexp-opt-charset letters) |
56329bc5 RS |
187 | close-group))) |
188 | ;; | |
189 | ;; Otherwise, divide the list into those that start with a particular | |
190 | ;; letter and those that do not, and recurse on them. | |
191 | (t | |
192 | (let* ((char (substring (car strings) 0 1)) | |
193 | (half1 (all-completions char (mapcar 'list strings))) | |
194 | (half2 (nthcdr (length half1) strings))) | |
195 | (concat open-group | |
196 | (regexp-opt-group half1) "\\|" (regexp-opt-group half2) | |
197 | close-group))))))))) | |
198 | ||
199 | (defun regexp-opt-charset (chars) | |
200 | ;; | |
201 | ;; Return a regexp to match a character in CHARS. | |
202 | ;; | |
203 | ;; The basic idea is to find character ranges. Also we take care in the | |
204 | ;; position of character set meta characters in the character set regexp. | |
205 | ;; | |
206 | (let* ((charwidth 256) ; Yeah, right. | |
207 | (charmap (make-bool-vector charwidth nil)) | |
208 | (charset "") | |
209 | (bracket "") (dash "") (caret "")) | |
210 | ;; | |
211 | ;; Make a character map but extract character set meta characters. | |
25544ce1 SM |
212 | (dolist (char (mapcar 'string-to-char chars)) |
213 | (case char | |
214 | (?\] | |
215 | (setq bracket "]")) | |
216 | (?^ | |
217 | (setq caret "^")) | |
218 | (?- | |
219 | (setq dash "-")) | |
220 | (otherwise | |
221 | (aset charmap char t)))) | |
56329bc5 RS |
222 | ;; |
223 | ;; Make a character set from the map using ranges where applicable. | |
9b51ba9e SM |
224 | (dotimes (char charwidth) |
225 | (let ((start char)) | |
226 | (while (and (< char charwidth) (aref charmap char)) | |
227 | (incf char)) | |
228 | (cond ((> char (+ start 3)) | |
229 | (setq charset (format "%s%c-%c" charset start (1- char)))) | |
230 | ((> char start) | |
231 | (setq charset (format "%s%c" charset (setq char start))))))) | |
56329bc5 RS |
232 | ;; |
233 | ;; Make sure a caret is not first and a dash is first or last. | |
234 | (if (and (string-equal charset "") (string-equal bracket "")) | |
235 | (concat "[" dash caret "]") | |
236 | (concat "[" bracket charset caret dash "]")))) | |
237 | ||
238 | (provide 'regexp-opt) | |
239 | ||
240 | ;;; regexp-opt.el ends here |