annotate lisp/progmodes/ebnf-otz.el @ 110561:93141d34a175

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