Mercurial > emacs
annotate lisp/progmodes/ebnf-otz.el @ 110428:6060b86fc551
Merge changes made in Gnus trunk.
nnimap.el (nnimap-finish-retrieve-group-infos): Return data in the nntp buffer so the agent can save it.
nnimap.el (nnimap-open-shell-stream): Bind `process-connection-type' to nil, so that CRLF doesn't get translated to \n; (nnimap-open-connection): Don't make 'shell commands only send \n.
nnimap.el (nnimap-request-group): Don't make `M-g' bug out on group with no marks.
gnus-agent.el (gnus-agent-load-alist): Nix out the alist if the file doesn't exist.
nnimap.el (nnimap-finish-retrieve-group-infos): Protect against groups that have no articles.
nnimap.el (nnimap-request-article): Check that we really got an article when we requested one.
gnus-html.el (gnus-html-schedule-image-fetching): Ignore all errors from url-retrieve, for instance about invalid URLs.
gnus-agent.el: Change default of gnus-agent-auto-agentize-methods to nil.
author | Katsumi Yamaoka <yamaoka@jpl.org> |
---|---|
date | Sun, 19 Sep 2010 10:45:51 +0000 |
parents | 280c8ae2476d |
children | 417b1e4d63cd |
rev | line source |
---|---|
49669
158253007cd0
(ebnf-optimize, ebnf-optimize1): Fix typo.
Juanma Barranquero <lekktu@gmail.com>
parents:
39344
diff
changeset
|
1 ;;; ebnf-otz.el --- syntactic chart OpTimiZer |
27451 | 2 |
106815 | 3 ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 |
75347 | 4 ;; Free Software Foundation, Inc. |
27451 | 5 |
54140
766aaa5bded5
ABNF parser. Fix bug on productions like test = {"test"}* | ("tt" ["test"]). Reported by Markus Dreyer.
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
52401
diff
changeset
|
6 ;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br> |
766aaa5bded5
ABNF parser. Fix bug on productions like test = {"test"}* | ("tt" ["test"]). Reported by Markus Dreyer.
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
52401
diff
changeset
|
7 ;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br> |
39344 | 8 ;; Keywords: wp, ebnf, PostScript |
9 ;; Version: 1.0 | |
110015
280c8ae2476d
Add "Package:" file headers to denote built-in packages.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
10 ;; Package: ebnf2ps |
27451 | 11 |
27539 | 12 ;; This file is part of GNU Emacs. |
27451 | 13 |
94673
52b7a8c22af5
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
14 ;; GNU Emacs is free software: you can redistribute it and/or modify |
27451 | 15 ;; it under the terms of the GNU General Public License as published by |
94673
52b7a8c22af5
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
16 ;; the Free Software Foundation, either version 3 of the License, or |
52b7a8c22af5
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
17 ;; (at your option) any later version. |
27451 | 18 |
27539 | 19 ;; GNU Emacs is distributed in the hope that it will be useful, |
27451 | 20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
22 ;; GNU General Public License for more details. | |
23 | |
24 ;; You should have received a copy of the GNU General Public License | |
94673
52b7a8c22af5
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
25 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
27451 | 26 |
27 ;;; Commentary: | |
28 | |
29 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
30 ;; | |
31 ;; | |
32 ;; This is part of ebnf2ps package. | |
33 ;; | |
34 ;; This package defines an optimizer for ebnf2ps. | |
35 ;; | |
36 ;; See ebnf2ps.el for documentation. | |
37 ;; | |
38 ;; | |
54208 | 39 ;; Optimizations |
40 ;; ------------- | |
41 ;; | |
42 ;; | |
43 ;; *To be implemented*: | |
44 ;; left recursion: | |
45 ;; A = B | A C B | A C D. ==> A = B {C (B | D)}*. | |
46 ;; | |
47 ;; right recursion: | |
48 ;; A = B | C A. ==> A = {C}* B. | |
49 ;; A = B | D | C A | E A. ==> A = { C | E }* ( B | D ). | |
50 ;; | |
51 ;; optional: | |
52 ;; A = B | C B. ==> A = [C] B. | |
53 ;; A = B | B C. ==> A = B [C]. | |
54 ;; A = D | B D | B C D. ==> A = [B [C]] D. | |
55 ;; | |
56 ;; | |
57 ;; *Already implemented*: | |
58 ;; left recursion: | |
59 ;; A = B | A C. ==> A = B {C}*. | |
60 ;; A = B | A B. ==> A = {B}+. | |
61 ;; A = | A B. ==> A = {B}*. | |
62 ;; A = B | A C B. ==> A = {B || C}+. | |
63 ;; A = B | D | A C | A E. ==> A = ( B | D ) { C | E }*. | |
64 ;; | |
65 ;; optional: | |
66 ;; A = B | . ==> A = [B]. | |
67 ;; A = | B . ==> A = [B]. | |
68 ;; | |
58339 | 69 ;; factorization: |
54208 | 70 ;; A = B C | B D. ==> A = B (C | D). |
71 ;; A = C B | D B. ==> A = (C | D) B. | |
72 ;; A = B C E | B D E. ==> A = B (C | D) E. | |
73 ;; | |
74 ;; none: | |
75 ;; A = B | C | . ==> A = B | C | . | |
76 ;; A = B | C A D. ==> A = B | C A D. | |
77 ;; | |
78 ;; | |
27451 | 79 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
80 | |
38436
b174db545cfd
Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents:
34806
diff
changeset
|
81 ;;; Code: |
27451 | 82 |
83 | |
84 (require 'ebnf2ps) | |
85 | |
86 | |
87 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
88 | |
89 | |
90 (defvar ebnf-empty-rule-list nil | |
91 "List of empty rule name.") | |
92 | |
93 | |
94 (defun ebnf-add-empty-rule-list (rule) | |
95 "Add empty RULE in `ebnf-empty-rule-list'." | |
96 (and ebnf-ignore-empty-rule | |
97 (eq (ebnf-node-kind (ebnf-node-production rule)) | |
98 'ebnf-generate-empty) | |
99 (setq ebnf-empty-rule-list (cons (ebnf-node-name rule) | |
100 ebnf-empty-rule-list)))) | |
101 | |
102 | |
103 (defun ebnf-otz-initialize () | |
104 "Initialize optimizer." | |
105 (setq ebnf-empty-rule-list nil)) | |
106 | |
107 | |
108 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
109 ;; Eliminate empty rules | |
110 | |
111 | |
112 (defun ebnf-eliminate-empty-rules (syntax-list) | |
113 "Eliminate empty rules." | |
114 (while ebnf-empty-rule-list | |
115 (let ((ebnf-total (length syntax-list)) | |
116 (ebnf-nprod 0) | |
117 (prod-list syntax-list) | |
118 new-list before) | |
119 (while prod-list | |
120 (ebnf-message-info "Eliminating empty rules") | |
121 (let ((rule (car prod-list))) | |
122 ;; if any non-terminal pertains to ebnf-empty-rule-list | |
123 ;; then eliminate non-terminal from rule | |
124 (if (ebnf-eliminate-empty rule) | |
125 (setq before prod-list) | |
126 ;; eliminate empty rule from syntax-list | |
127 (setq new-list (cons (ebnf-node-name rule) new-list)) | |
128 (if before | |
129 (setcdr before (cdr prod-list)) | |
130 (setq syntax-list (cdr syntax-list))))) | |
131 (setq prod-list (cdr prod-list))) | |
132 (setq ebnf-empty-rule-list new-list))) | |
133 syntax-list) | |
134 | |
135 | |
136 ;; [production width-func entry height width name production action] | |
137 ;; [sequence width-func entry height width list] | |
138 ;; [alternative width-func entry height width list] | |
139 ;; [non-terminal width-func entry height width name default] | |
140 ;; [empty width-func entry height width] | |
141 ;; [terminal width-func entry height width name default] | |
142 ;; [special width-func entry height width name default] | |
143 | |
144 (defun ebnf-eliminate-empty (rule) | |
145 (let ((kind (ebnf-node-kind rule))) | |
146 (cond | |
147 ;; non-terminal | |
148 ((eq kind 'ebnf-generate-non-terminal) | |
149 (if (member (ebnf-node-name rule) ebnf-empty-rule-list) | |
150 nil | |
151 rule)) | |
152 ;; sequence | |
153 ((eq kind 'ebnf-generate-sequence) | |
154 (let ((seq (ebnf-node-list rule)) | |
155 (header (ebnf-node-list rule)) | |
156 before elt) | |
157 (while seq | |
158 (setq elt (car seq)) | |
159 (if (ebnf-eliminate-empty elt) | |
160 (setq before seq) | |
161 (if before | |
162 (setcdr before (cdr seq)) | |
163 (setq header (cdr header)))) | |
164 (setq seq (cdr seq))) | |
165 (when header | |
166 (ebnf-node-list rule header) | |
167 rule))) | |
168 ;; alternative | |
169 ((eq kind 'ebnf-generate-alternative) | |
170 (let ((seq (ebnf-node-list rule)) | |
171 (header (ebnf-node-list rule)) | |
172 before elt) | |
173 (while seq | |
174 (setq elt (car seq)) | |
175 (if (ebnf-eliminate-empty elt) | |
176 (setq before seq) | |
177 (if before | |
178 (setcdr before (cdr seq)) | |
179 (setq header (cdr header)))) | |
180 (setq seq (cdr seq))) | |
181 (when header | |
182 (if (= (length header) 1) | |
183 (car header) | |
184 (ebnf-node-list rule header) | |
185 rule)))) | |
186 ;; production | |
187 ((eq kind 'ebnf-generate-production) | |
188 (let ((prod (ebnf-eliminate-empty (ebnf-node-production rule)))) | |
189 (when prod | |
190 (ebnf-node-production rule prod) | |
191 rule))) | |
192 ;; terminal, special and empty | |
193 (t | |
194 rule) | |
195 ))) | |
196 | |
197 | |
198 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
199 ;; Optimizations | |
200 | |
201 | |
202 ;; *To be implemented*: | |
203 ;; left recursion: | |
204 ;; A = B | A C B | A C D. ==> A = B {C (B | D)}*. | |
205 | |
206 ;; right recursion: | |
207 ;; A = B | C A. ==> A = {C}* B. | |
208 ;; A = B | D | C A | E A. ==> A = { C | E }* ( B | D ). | |
209 | |
210 ;; optional: | |
211 ;; A = B | C B. ==> A = [C] B. | |
212 ;; A = B | B C. ==> A = B [C]. | |
213 ;; A = D | B D | B C D. ==> A = [B [C]] D. | |
214 | |
215 | |
216 ;; *Already implemented*: | |
217 ;; left recursion: | |
218 ;; A = B | A C. ==> A = B {C}*. | |
219 ;; A = B | A B. ==> A = {B}+. | |
220 ;; A = | A B. ==> A = {B}*. | |
221 ;; A = B | A C B. ==> A = {B || C}+. | |
222 ;; A = B | D | A C | A E. ==> A = ( B | D ) { C | E }*. | |
223 | |
224 ;; optional: | |
225 ;; A = B | . ==> A = [B]. | |
226 ;; A = | B . ==> A = [B]. | |
227 | |
58339 | 228 ;; factorization: |
27451 | 229 ;; A = B C | B D. ==> A = B (C | D). |
230 ;; A = C B | D B. ==> A = (C | D) B. | |
231 ;; A = B C E | B D E. ==> A = B (C | D) E. | |
232 | |
233 ;; none: | |
234 ;; A = B | C | . ==> A = B | C | . | |
235 ;; A = B | C A D. ==> A = B | C A D. | |
236 | |
237 (defun ebnf-optimize (syntax-list) | |
49669
158253007cd0
(ebnf-optimize, ebnf-optimize1): Fix typo.
Juanma Barranquero <lekktu@gmail.com>
parents:
39344
diff
changeset
|
238 "Syntactic chart optimizer." |
27451 | 239 (if (not ebnf-optimize) |
240 syntax-list | |
241 (let ((ebnf-total (length syntax-list)) | |
242 (ebnf-nprod 0) | |
243 new) | |
244 (while syntax-list | |
245 (setq new (cons (ebnf-optimize1 (car syntax-list)) new) | |
246 syntax-list (cdr syntax-list))) | |
247 (nreverse new)))) | |
248 | |
249 | |
250 ;; left recursion: | |
251 ;; 1. A = B | A C. ==> A = B {C}*. | |
252 ;; 2. A = B | A B. ==> A = {B}+. | |
253 ;; 3. A = | A B. ==> A = {B}*. | |
254 ;; 4. A = B | A C B. ==> A = {B || C}+. | |
255 ;; 5. A = B | D | A C | A E. ==> A = ( B | D ) { C | E }*. | |
256 | |
257 ;; optional: | |
258 ;; 6. A = B | . ==> A = [B]. | |
259 ;; 7. A = | B . ==> A = [B]. | |
260 | |
58339 | 261 ;; factorization: |
27451 | 262 ;; 8. A = B C | B D. ==> A = B (C | D). |
263 ;; 9. A = C B | D B. ==> A = (C | D) B. | |
264 ;; 10. A = B C E | B D E. ==> A = B (C | D) E. | |
265 | |
266 (defun ebnf-optimize1 (prod) | |
49669
158253007cd0
(ebnf-optimize, ebnf-optimize1): Fix typo.
Juanma Barranquero <lekktu@gmail.com>
parents:
39344
diff
changeset
|
267 (ebnf-message-info "Optimizing syntactic chart") |
27451 | 268 (let ((production (ebnf-node-production prod))) |
269 (and (eq (ebnf-node-kind production) 'ebnf-generate-alternative) | |
270 (let* ((hlist (ebnf-split-header-prefix | |
271 (ebnf-node-list production) | |
272 (ebnf-node-name prod))) | |
273 (nlist (car hlist)) | |
274 (zlist (cdr hlist)) | |
275 (elist (ebnf-split-header-suffix nlist zlist))) | |
276 (ebnf-node-production | |
277 prod | |
278 (cond | |
279 ;; cases 2., 4. | |
280 (elist | |
281 (and (eq elist t) | |
282 (setq elist nil)) | |
283 (setq elist (or (ebnf-prefix-suffix elist) | |
284 elist)) | |
285 (let* ((nl (ebnf-extract-empty nlist)) | |
286 (el (or (ebnf-prefix-suffix (cdr nl)) | |
287 (ebnf-create-alternative (cdr nl))))) | |
288 (if (car nl) | |
289 (ebnf-make-zero-or-more el elist) | |
290 (ebnf-make-one-or-more el elist)))) | |
291 ;; cases 1., 3., 5. | |
292 (zlist | |
293 (let* ((xlist (cdr (ebnf-extract-empty zlist))) | |
294 (znode (ebnf-make-zero-or-more | |
295 (or (ebnf-prefix-suffix xlist) | |
296 (ebnf-create-alternative xlist)))) | |
297 (nnode (ebnf-map-list-to-optional nlist))) | |
298 (and nnode | |
299 (setq nlist (list nnode))) | |
300 (if (or (null nlist) | |
301 (and (= (length nlist) 1) | |
302 (eq (ebnf-node-kind (car nlist)) | |
303 'ebnf-generate-empty))) | |
304 znode | |
305 (ebnf-make-sequence | |
306 (list (or (ebnf-prefix-suffix nlist) | |
307 (ebnf-create-alternative nlist)) | |
308 znode))))) | |
309 ;; cases 6., 7. | |
310 ((ebnf-map-node-to-optional production) | |
311 ) | |
312 ;; cases 8., 9., 10. | |
313 ((ebnf-prefix-suffix nlist) | |
314 ) | |
315 ;; none | |
316 (t | |
317 production) | |
318 )))) | |
319 prod)) | |
320 | |
321 | |
322 (defun ebnf-split-header-prefix (node-list header) | |
323 (let* ((hlist (ebnf-split-header-prefix1 node-list header)) | |
324 (nlist (car hlist)) | |
325 zlist empty-p) | |
326 (while (setq hlist (cdr hlist)) | |
327 (let ((elt (car hlist))) | |
328 (if (eq (ebnf-node-kind elt) 'ebnf-generate-sequence) | |
329 (setq zlist (cons | |
330 (let ((seq (cdr (ebnf-node-list elt)))) | |
331 (if (= (length seq) 1) | |
332 (car seq) | |
333 (ebnf-node-list elt seq) | |
334 elt)) | |
335 zlist)) | |
336 (setq empty-p t)))) | |
337 (and empty-p | |
338 (setq zlist (cons (ebnf-make-empty) | |
339 zlist))) | |
340 (cons nlist (nreverse zlist)))) | |
341 | |
342 | |
343 (defun ebnf-split-header-prefix1 (node-list header) | |
344 (let (hlist nlist) | |
345 (while node-list | |
346 (if (ebnf-node-equal-header (car node-list) header) | |
347 (setq hlist (cons (car node-list) hlist)) | |
348 (setq nlist (cons (car node-list) nlist))) | |
349 (setq node-list (cdr node-list))) | |
350 (cons (nreverse nlist) (nreverse hlist)))) | |
351 | |
352 | |
353 (defun ebnf-node-equal-header (node header) | |
354 (let ((kind (ebnf-node-kind node))) | |
355 (cond | |
356 ((eq kind 'ebnf-generate-sequence) | |
357 (ebnf-node-equal-header (car (ebnf-node-list node)) header)) | |
358 ((eq kind 'ebnf-generate-non-terminal) | |
359 (string= (ebnf-node-name node) header)) | |
360 (t | |
361 nil) | |
362 ))) | |
363 | |
364 | |
365 (defun ebnf-map-node-to-optional (node) | |
366 (and (eq (ebnf-node-kind node) 'ebnf-generate-alternative) | |
367 (ebnf-map-list-to-optional (ebnf-node-list node)))) | |
368 | |
369 | |
370 (defun ebnf-map-list-to-optional (nlist) | |
371 (and (= (length nlist) 2) | |
372 (let ((first (nth 0 nlist)) | |
373 (second (nth 1 nlist))) | |
374 (cond | |
375 ;; empty second | |
376 ((eq (ebnf-node-kind first) 'ebnf-generate-empty) | |
377 (ebnf-make-optional second)) | |
378 ;; first empty | |
379 ((eq (ebnf-node-kind second) 'ebnf-generate-empty) | |
380 (ebnf-make-optional first)) | |
381 ;; first second | |
382 (t | |
383 nil) | |
384 )))) | |
385 | |
386 | |
387 (defun ebnf-extract-empty (elist) | |
388 (let ((now elist) | |
389 before empty-p) | |
390 (while now | |
391 (if (not (eq (ebnf-node-kind (car now)) 'ebnf-generate-empty)) | |
392 (setq before now) | |
393 (setq empty-p t) | |
394 (if before | |
395 (setcdr before (cdr now)) | |
396 (setq elist (cdr elist)))) | |
397 (setq now (cdr now))) | |
398 (cons empty-p elist))) | |
399 | |
400 | |
401 (defun ebnf-split-header-suffix (nlist zlist) | |
402 (let (new empty-p) | |
403 (and (cond | |
404 ((= (length nlist) 1) | |
405 (let ((ok t) | |
406 (elt (car nlist))) | |
407 (while (and ok zlist) | |
408 (setq ok (ebnf-split-header-suffix1 elt (car zlist)) | |
409 zlist (cdr zlist)) | |
410 (if (eq ok t) | |
411 (setq empty-p t) | |
412 (setq new (cons ok new)))) | |
413 ok)) | |
414 ((= (length nlist) (length zlist)) | |
415 (let ((ok t)) | |
416 (while (and ok zlist) | |
417 (setq ok (ebnf-split-header-suffix1 (car nlist) (car zlist)) | |
418 nlist (cdr nlist) | |
419 zlist (cdr zlist)) | |
420 (if (eq ok t) | |
421 (setq empty-p t) | |
422 (setq new (cons ok new)))) | |
423 ok)) | |
424 (t | |
425 nil) | |
426 ) | |
427 (let* ((lis (ebnf-unique-list new)) | |
428 (len (length lis))) | |
429 (cond | |
430 ((zerop len) | |
431 t) | |
432 ((= len 1) | |
433 (setq lis (car lis)) | |
434 (if empty-p | |
435 (ebnf-make-optional lis) | |
436 lis)) | |
437 (t | |
438 (and empty-p | |
439 (setq lis (cons (ebnf-make-empty) lis))) | |
440 (ebnf-create-alternative (nreverse lis))) | |
441 ))))) | |
442 | |
443 | |
444 (defun ebnf-split-header-suffix1 (ne ze) | |
445 (cond | |
446 ((eq (ebnf-node-kind ne) 'ebnf-generate-sequence) | |
447 (and (eq (ebnf-node-kind ze) 'ebnf-generate-sequence) | |
448 (let ((nl (ebnf-node-list ne)) | |
449 (zl (ebnf-node-list ze)) | |
450 len z) | |
451 (and (>= (length zl) (length nl)) | |
452 (let ((ok t)) | |
453 (setq len (- (length zl) (length nl)) | |
454 z (nthcdr len zl)) | |
455 (while (and ok z) | |
456 (setq ok (ebnf-node-equal (car z) (car nl)) | |
457 z (cdr z) | |
458 nl (cdr nl))) | |
459 ok) | |
460 (if (zerop len) | |
461 t | |
462 (setcdr (nthcdr (1- len) zl) nil) | |
463 ze))))) | |
464 ((eq (ebnf-node-kind ze) 'ebnf-generate-sequence) | |
465 (let* ((zl (ebnf-node-list ze)) | |
466 (len (length zl))) | |
467 (and (ebnf-node-equal ne (car (nthcdr (1- len) zl))) | |
468 (cond | |
469 ((= len 1) | |
470 t) | |
471 ((= len 2) | |
472 (car zl)) | |
473 (t | |
474 (setcdr (nthcdr (- len 2) zl) nil) | |
475 ze) | |
476 )))) | |
477 (t | |
478 (ebnf-node-equal ne ze)) | |
479 )) | |
480 | |
481 | |
482 (defun ebnf-prefix-suffix (lis) | |
483 (and lis (listp lis) | |
484 (let* ((prefix (ebnf-split-prefix lis)) | |
485 (suffix (ebnf-split-suffix (cdr prefix))) | |
486 (middle (cdr suffix))) | |
487 (setq prefix (car prefix) | |
488 suffix (car suffix)) | |
489 (and (or prefix suffix) | |
490 (ebnf-make-sequence | |
491 (nconc prefix | |
492 (and middle | |
493 (list (or (ebnf-map-list-to-optional middle) | |
494 (ebnf-create-alternative middle)))) | |
495 suffix)))))) | |
496 | |
497 | |
498 (defun ebnf-split-prefix (lis) | |
499 (let* ((len (length lis)) | |
500 (tail lis) | |
501 (head (if (eq (ebnf-node-kind (car lis)) 'ebnf-generate-sequence) | |
502 (ebnf-node-list (car lis)) | |
503 (list (car lis)))) | |
504 (ipre (1+ len))) | |
505 ;; determine prefix length | |
506 (while (and (> ipre 0) (setq tail (cdr tail))) | |
507 (let ((cur head) | |
508 (this (if (eq (ebnf-node-kind (car tail)) 'ebnf-generate-sequence) | |
509 (ebnf-node-list (car tail)) | |
510 (list (car tail)))) | |
511 (i 0)) | |
512 (while (and cur this | |
513 (ebnf-node-equal (car cur) (car this))) | |
514 (setq cur (cdr cur) | |
515 this (cdr this) | |
516 i (1+ i))) | |
517 (setq ipre (min ipre i)))) | |
518 (if (or (zerop ipre) (> ipre len)) | |
519 ;; no prefix at all | |
520 (cons nil lis) | |
521 (let* ((tail (nthcdr ipre head)) | |
522 ;; get prefix | |
523 (prefix (progn | |
524 (and tail | |
525 (setcdr (nthcdr (1- ipre) head) nil)) | |
526 head)) | |
527 empty-p before) | |
528 ;; adjust first element | |
529 (if (or (not (eq (ebnf-node-kind (car lis)) 'ebnf-generate-sequence)) | |
530 (null tail)) | |
531 (setq lis (cdr lis) | |
532 tail lis | |
533 empty-p t) | |
534 (if (= (length tail) 1) | |
535 (setcar lis (car tail)) | |
536 (ebnf-node-list (car lis) tail)) | |
537 (setq tail (cdr lis))) | |
538 ;; eliminate prefix from lis based on ipre | |
539 (while tail | |
540 (let ((elt (car tail)) | |
541 rest) | |
542 (if (and (eq (ebnf-node-kind elt) 'ebnf-generate-sequence) | |
543 (setq rest (nthcdr ipre (ebnf-node-list elt)))) | |
544 (progn | |
545 (if (= (length rest) 1) | |
546 (setcar tail (car rest)) | |
547 (ebnf-node-list elt rest)) | |
548 (setq before tail)) | |
549 (setq empty-p t) | |
550 (if before | |
551 (setcdr before (cdr tail)) | |
552 (setq lis (cdr lis)))) | |
553 (setq tail (cdr tail)))) | |
554 (cons prefix (ebnf-unique-list | |
555 (if empty-p | |
556 (nconc lis (list (ebnf-make-empty))) | |
557 lis))))))) | |
558 | |
559 | |
560 (defun ebnf-split-suffix (lis) | |
561 (let* ((len (length lis)) | |
562 (tail lis) | |
563 (head (nreverse | |
564 (if (eq (ebnf-node-kind (car lis)) 'ebnf-generate-sequence) | |
565 (ebnf-node-list (car lis)) | |
566 (list (car lis))))) | |
567 (isuf (1+ len))) | |
568 ;; determine suffix length | |
569 (while (and (> isuf 0) (setq tail (cdr tail))) | |
570 (let* ((cur head) | |
571 (tlis (nreverse | |
572 (if (eq (ebnf-node-kind (car tail)) 'ebnf-generate-sequence) | |
573 (ebnf-node-list (car tail)) | |
574 (list (car tail))))) | |
575 (this tlis) | |
576 (i 0)) | |
577 (while (and cur this | |
578 (ebnf-node-equal (car cur) (car this))) | |
579 (setq cur (cdr cur) | |
580 this (cdr this) | |
581 i (1+ i))) | |
582 (nreverse tlis) | |
583 (setq isuf (min isuf i)))) | |
584 (setq head (nreverse head)) | |
585 (if (or (zerop isuf) (> isuf len)) | |
586 ;; no suffix at all | |
587 (cons nil lis) | |
588 (let* ((n (- (length head) isuf)) | |
589 ;; get suffix | |
590 (suffix (nthcdr n head)) | |
591 (tail (and (> n 0) | |
592 (progn | |
593 (setcdr (nthcdr (1- n) head) nil) | |
594 head))) | |
595 before empty-p) | |
596 ;; adjust first element | |
597 (if (or (not (eq (ebnf-node-kind (car lis)) 'ebnf-generate-sequence)) | |
598 (null tail)) | |
599 (setq lis (cdr lis) | |
600 tail lis | |
601 empty-p t) | |
602 (if (= (length tail) 1) | |
603 (setcar lis (car tail)) | |
604 (ebnf-node-list (car lis) tail)) | |
605 (setq tail (cdr lis))) | |
606 ;; eliminate suffix from lis based on isuf | |
607 (while tail | |
608 (let ((elt (car tail)) | |
609 rest) | |
610 (if (and (eq (ebnf-node-kind elt) 'ebnf-generate-sequence) | |
611 (setq rest (ebnf-node-list elt) | |
612 n (- (length rest) isuf)) | |
613 (> n 0)) | |
614 (progn | |
615 (if (= n 1) | |
616 (setcar tail (car rest)) | |
617 (setcdr (nthcdr (1- n) rest) nil) | |
618 (ebnf-node-list elt rest)) | |
619 (setq before tail)) | |
620 (setq empty-p t) | |
621 (if before | |
622 (setcdr before (cdr tail)) | |
623 (setq lis (cdr lis)))) | |
624 (setq tail (cdr tail)))) | |
625 (cons suffix (ebnf-unique-list | |
626 (if empty-p | |
627 (nconc lis (list (ebnf-make-empty))) | |
628 lis))))))) | |
629 | |
630 | |
631 (defun ebnf-unique-list (nlist) | |
632 (let ((current nlist) | |
633 before) | |
634 (while current | |
635 (let ((tail (cdr current)) | |
636 (head (car current)) | |
637 remove-p) | |
638 (while tail | |
639 (if (not (ebnf-node-equal head (car tail))) | |
640 (setq tail (cdr tail)) | |
641 (setq remove-p t | |
642 tail nil) | |
643 (if before | |
644 (setcdr before (cdr current)) | |
645 (setq nlist (cdr nlist))))) | |
646 (or remove-p | |
647 (setq before current)) | |
648 (setq current (cdr current)))) | |
649 nlist)) | |
650 | |
651 | |
652 (defun ebnf-node-equal (A B) | |
653 (let ((kindA (ebnf-node-kind A)) | |
654 (kindB (ebnf-node-kind B))) | |
655 (and (eq kindA kindB) | |
656 (cond | |
657 ;; empty | |
658 ((eq kindA 'ebnf-generate-empty) | |
659 t) | |
660 ;; non-terminal, terminal, special | |
661 ((memq kindA '(ebnf-generate-non-terminal | |
662 ebnf-generate-terminal | |
663 ebnf-generate-special)) | |
664 (string= (ebnf-node-name A) (ebnf-node-name B))) | |
665 ;; alternative, sequence | |
666 ((memq kindA '(ebnf-generate-alternative ; any order | |
667 ebnf-generate-sequence)) ; order is important | |
668 (let ((listA (ebnf-node-list A)) | |
669 (listB (ebnf-node-list B))) | |
670 (and (= (length listA) (length listB)) | |
671 (let ((ok t)) | |
672 (while (and ok listA) | |
673 (setq ok (ebnf-node-equal (car listA) (car listB)) | |
674 listA (cdr listA) | |
675 listB (cdr listB))) | |
676 ok)))) | |
677 ;; production | |
678 ((eq kindA 'ebnf-generate-production) | |
679 (and (string= (ebnf-node-name A) (ebnf-node-name B)) | |
680 (ebnf-node-equal (ebnf-node-production A) | |
681 (ebnf-node-production B)))) | |
682 ;; otherwise | |
683 (t | |
684 nil) | |
685 )))) | |
686 | |
687 | |
688 (defun ebnf-create-alternative (alt) | |
689 (if (> (length alt) 1) | |
690 (ebnf-make-alternative alt) | |
691 (car alt))) | |
692 | |
693 | |
694 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
695 | |
696 | |
697 (provide 'ebnf-otz) | |
698 | |
699 | |
93975
1e3a407766b9
Fix up comment convention on the arch-tag lines.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
79717
diff
changeset
|
700 ;; arch-tag: 7ef2249d-9e8b-4bc1-999f-95d784690636 |
27451 | 701 ;;; ebnf-otz.el ends here |