annotate lisp/progmodes/ebnf-otz.el @ 64101:90caba02a18d

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