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