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