/
make-regexp.el
233 lines (206 loc) · 10.5 KB
/
make-regexp.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
;;; make-regexp.el --- generate efficient regexps to match strings.
;; Copyright (C) 1994-2020 Free Software Foundation, Inc.
;; Author: Simon Marshall <simon@gnu.ai.mit.edu>
;; Keywords: lisp, matching
;; Version: 1.02
;; This file is part of GNU Emacs.
;;; License:
;;
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see
;; <http://www.gnu.org/licenses/>
;;; Commentary:
;; Purpose:
;;
;; To make efficient regexps from lists of strings.
;; For example:
;;
;; (let ((strings '("cond" "if" "while" "let\\*?" "prog1" "prog2" "progn"
;; "catch" "throw" "save-restriction" "save-excursion"
;; "save-window-excursion" "save-match-data"
;; "unwind-protect" "condition-case" "track-mouse")))
;; (concat "(" (make-regexp strings t)))
;;
;; => "(\\(c\\(atch\\|ond\\(\\|ition-case\\)\\)\\|if\\|let\\*?\\|prog[12n]\\|save-\\(excursion\\|match-data\\|restriction\\|window-excursion\\)\\|t\\(hrow\\|rack-mouse\\)\\|unwind-protect\\|while\\)"
;;
;; To search for the above regexp takes about 70% of the time as for the simple
;; (concat "(\\(" (mapconcat 'identity strings "\\|") "\\)") regexp.
;;
;; Obviously, the more the similarity between strings, the faster the regexp:
;;
;; (make-regexp '("abort" "abs" "accept" "access" "array" "begin" "body" "case"
;; "constant" "declare" "delay" "delta" "digits" "else" "elsif"
;; "entry" "exception" "exit" "function" "generic" "goto" "if"
;; "others" "limited" "loop" "mod" "new" "null" "out" "subtype"
;; "package" "pragma" "private" "procedure" "raise" "range"
;; "record" "rem" "renames" "return" "reverse" "select"
;; "separate" "task" "terminate" "then" "type" "when" "while"
;; "with" "xor"))
;;
;; => "a\\(b\\(ort\\|s\\)\\|cce\\(pt\\|ss\\)\\|rray\\)\\|b\\(egin\\|ody\\)\\|c\\(ase\\|onstant\\)\\|d\\(e\\(clare\\|l\\(ay\\|ta\\)\\)\\|igits\\)\\|e\\(ls\\(e\\|if\\)\\|ntry\\|x\\(ception\\|it\\)\\)\\|function\\|g\\(eneric\\|oto\\)\\|if\\|l\\(imited\\|oop\\)\\|mod\\|n\\(ew\\|ull\\)\\|o\\(thers\\|ut\\)\\|p\\(ackage\\|r\\(agma\\|ivate\\|ocedure\\)\\)\\|r\\(a\\(ise\\|nge\\)\\|e\\(cord\\|m\\|names\\|turn\\|verse\\)\\)\\|s\\(e\\(lect\\|parate\\)\\|ubtype\\)\\|t\\(ask\\|erminate\\|hen\\|ype\\)\\|w\\(h\\(en\\|ile\\)\\|ith\\)\\|xor"
;;
;; To search for the above regexp takes less than 60% of the time of the simple
;; mapconcat equivalent.
;;
;; But even small regexps may be worth it:
;;
;; (make-regexp '("and" "at" "do" "end" "for" "in" "is" "not" "of" "or" "use"))
;; => "a\\(nd\\|t\\)\\|do\\|end\\|for\\|i[ns]\\|not\\|o[fr]\\|use"
;;
;; as this is 10% faster than the mapconcat equivalent.
;; Installation:
;;
;; (autoload 'make-regexp "make-regexp"
;; "Return a regexp to match a string item in STRINGS.")
;;
;; (autoload 'make-regexps "make-regexp"
;; "Return a regexp to REGEXPS.")
;;
;; Since these functions were written to produce efficient regexps, not regexps
;; efficiently, it is probably not a good idea to in-line too many calls in
;; your code, unless you use the following neat trick with `eval-when-compile':
;;
;; (defvar definition-regexp
;; (let ((regexp (eval-when-compile
;; (make-regexp '("defun" "defsubst" "defmacro" "defalias"
;; "defvar" "defconst" "defadvice") t))))
;; (concat "^(" regexp)))
;;
;; The `byte-compile' code will be as if you had defined the variable thus:
;;
;; (defvar definition-regexp
;; "^(\\(def\\(a\\(dvice\\|lias\\)\\|const\\|macro\\|subst\\|un\\|var\\)\\)")
;; Feedback:
;;
;; Originally written for font-lock, from an idea from Stig's hl319.
;; Please don't tell me that it doesn't produce optimal regexps; I know that
;; already. But (ideas or) code to improve things (are) is welcome. Please
;; test your code and tell me the speed up in searching an appropriate buffer.
;;
;; Please send me bug reports, bug fixes, and extensions, etc.
;; Simon Marshall <simon@gnu.ai.mit.edu>
;; History:
;;
;; 1.00--1.01:
;; - Made `make-regexp' take `lax' to force top-level parentheses.
;; - Fixed `make-regexps' for MATCH bug and new `font-lock-keywords'.
;; - Added `unfontify' to user timing functions.
;; 1.01--1.02:
;; - Made `make-regexp' `let' a big `max-lisp-eval-depth'.
;; The basic idea is to find the shortest common non-"" prefix each time, and
;; squirrel it out. If there is no such prefix, we divide the list into two so
;; that (at least) one half will have at least a one-character common prefix.
;; In addition, we (a) delay the addition of () parenthesis as long as possible
;; (until we're sure we need them), and (b) try to squirrel out one-character
;; sequences (so we can use [] rather than ()).
;;; Code:
(defun make-regexp (strings &optional paren lax)
"Return a regexp to match a string item in STRINGS.
If optional PAREN non-nil, output regexp parentheses around returned regexp.
If optional LAX non-nil, don't output parentheses if it doesn't require them.
Merges keywords to avoid backtracking in Emacs' regexp matcher."
(let* ((max-lisp-eval-depth (* 1024 1024))
(strings (let ((l strings)) ; Paranoia---make strings unique!
(while l (setq l (setcdr l (delete (car l) (cdr l)))))
(sort strings 'string-lessp)))
(open-paren (if paren "\\(" "")) (close-paren (if paren "\\)" ""))
(open-lax (if lax "" open-paren)) (close-lax (if lax "" close-paren))
(completion-ignore-case nil))
(cond
;; If there's only one string, just return it.
((= (length strings) 1)
(concat open-lax (car strings) close-lax))
;; If there's an empty string, pull it out.
((string= (car strings) "")
(if (and (= (length strings) 2) (= (length (nth 1 strings)) 1))
(concat open-lax (nth 1 strings) "?" close-lax)
(concat open-paren "\\|" (make-regexp (cdr strings)) close-paren)))
;; If there are only one-character strings, make a [] list instead.
((= (length strings) (apply '+ (mapcar 'length strings)))
(concat open-lax "[" (mapconcat 'identity strings "") "]" close-lax))
(t
;; We have a list of strings. Is there a common prefix?
(let ((prefix (try-completion "" (mapcar 'list strings))))
(if (> (length prefix) 0)
;; Common prefix! Squirrel it out and recurse with the suffixes.
(let* ((len (length prefix))
(sufs (mapcar (lambda (str) (substring str len)) strings)))
(concat open-paren prefix (make-regexp sufs t t) close-paren))
;; No common prefix. Is there a one-character sequence?
(let ((letters (let ((completion-regexp-list '("^.$")))
(all-completions "" (mapcar 'list strings)))))
(if (> (length letters) 1)
;; Do the one-character sequences, then recurse on the rest.
(let ((rest (let ((completion-regexp-list '("^..+$")))
(all-completions "" (mapcar 'list strings)))))
(concat open-paren
(make-regexp letters) "\\|" (make-regexp rest)
close-paren))
;; No one-character sequence, so divide the list into two by
;; dividing into those that start with a particular letter, and
;; those that do not.
(let* ((char (substring (car strings) 0 1))
(half1 (all-completions char (mapcar 'list strings)))
(half2 (nthcdr (length half1) strings)))
(concat open-paren
(make-regexp half1) "\\|" (make-regexp half2)
close-paren))))))))))
;; This stuff is realy for font-lock...
;; Ahhh, the wonders of lisp...
(defun regexp-span (regexp &optional start)
"Return the span or depth of REGEXP.
This means the number of \"\\\\(...\\\\)\" pairs in REGEXP, optionally from START."
(let ((match (string-match (regexp-quote "\\(") regexp (or start 0))))
(if (not match) 0 (1+ (regexp-span regexp (match-end 0))))))
;; The basic idea is to concat the regexps together, keeping count of the span
;; of the regexps so that we can get the correct match for hilighting.
(defun make-regexps (&rest regexps)
"Return a regexp to match REGEXPS
Each item of REGEXPS should be of the form:
STRING ; A STRING to be used literally.
(STRING MATCH FACE DATA) ; Match STRING at depth MATCH with FACE
; and highlight according to DATA.
(STRINGS FACE DATA) ; STRINGS is a list of strings FACE is
; to highlight according to DATA.
Returns a list of the form:
(REGEXP (MATCH FACE DATA) ...)
For example:
(make-regexps \"^(\"
'((\"defun\" \"defalias\" \"defsubst\" \"defadvice\") keyword)
\"[ \t]*\"
'(\"\\\\([a-zA-Z-]+\\\\)?\" 1 function-name nil t))
=>
(\"^(\\\\(def\\\\(a\\\\(dvice\\\\|lias\\\\)\\\\|subst\\\\|un\\\\)\\\\)[ ]*\\\\([a-zA-Z-]+\\\\)?\"
(1 keyword) (4 function-name nil t))
Uses `make-regexp' to make efficient regexps."
(let ((regexp "") (data ()))
(while regexps
(cond ((stringp (car regexps))
(setq regexp (concat regexp (car regexps))))
((stringp (nth 0 (car regexps)))
(setq data (cons (cons (+ (regexp-span regexp)
(nth 1 (car regexps)))
(nthcdr 2 (car regexps)))
data)
regexp (concat regexp (nth 0 (car regexps)))))
(t
(setq data (cons (cons (1+ (regexp-span regexp))
(cdr (car regexps)))
data)
regexp (concat regexp (make-regexp (nth 0 (car regexps))
t)))))
(setq regexps (cdr regexps)))
(cons regexp (nreverse data))))
;; timing functions removed due to name collisions with Gnus
(provide 'make-regexp)
;;; make-regexp.el ends here