1 ;;; ebnf-iso.el --- parser for ISO EBNF
3 ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007
4 ;; Free Software Foundation, Inc.
6 ;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br>
7 ;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br>
8 ;; Keywords: wp, ebnf, PostScript
11 ;; This file is part of GNU Emacs.
13 ;; GNU Emacs is free software; you can redistribute it and/or modify
14 ;; it under the terms of the GNU General Public License as published by
15 ;; the Free Software Foundation; either version 2, or (at your option)
18 ;; GNU Emacs is distributed in the hope that it will be useful,
19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 ;; GNU General Public License for more details.
23 ;; You should have received a copy of the GNU General Public License
24 ;; along with GNU Emacs; see the file COPYING. If not, write to the
25 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
26 ;; Boston, MA 02110-1301, USA.
30 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
33 ;; This is part of ebnf2ps package.
35 ;; This package defines a parser for ISO EBNF.
37 ;; See ebnf2ps.el for documentation.
44 ;; `http://www.cl.cam.ac.uk/~mgk25/iso-ebnf.html'
45 ;; ("International Standard of the ISO EBNF Notation").
48 ;; ISO EBNF = syntax rule, {syntax rule};
50 ;; syntax rule = meta identifier, '=', definition list, ';';
52 ;; definition list = single definition, {'|', single definition};
54 ;; single definition = term, {',', term};
56 ;; term = factor, ['-', exception];
58 ;; exception = factor (* without <meta identifier> *);
60 ;; factor = [integer, '*'], primary;
62 ;; primary = optional sequence | repeated sequence | special sequence
63 ;; | grouped sequence | meta identifier | terminal string
68 ;; optional sequence = '[', definition list, ']';
70 ;; repeated sequence = '{', definition list, '}';
72 ;; grouped sequence = '(', definition list, ')';
74 ;; terminal string = "'", character - "'", {character - "'"}, "'"
75 ;; | '"', character - '"', {character - '"'}, '"';
77 ;; special sequence = '?', {character - '?'}, '?';
79 ;; meta identifier = letter, { letter | decimal digit | ' ' };
81 ;; integer = decimal digit, {decimal digit};
83 ;; comment = '(*', {comment symbol}, '*)';
85 ;; comment symbol = comment (* <== NESTED COMMENT *)
86 ;; | terminal string | special sequence | character;
88 ;; letter = ? A-Z a-z ?;
90 ;; decimal digit = ? 0-9 ?;
92 ;; character = letter | decimal digit
93 ;; | ',' | '=' | '|' | '/' | '!' | '*' | '(' | ')' | '[' | ']' | '{'
94 ;; | '}' | "'" | '"' | '?' | '-' | ';' | '.' | ' ' | ':' | '+' | '_'
95 ;; | '%' | '@' | '&' | '#' | '$' | '<' | '>' | '\' | '^' | '`' | '~';
98 ;; There is also the following alternative representation:
100 ;; STANDARD ALTERNATIVE
109 ;; Differences Between ISO EBNF And ebnf2ps ISO EBNF
110 ;; -------------------------------------------------
112 ;; ISO EBNF accepts the characters given by <character> production above,
113 ;; HORIZONTAL TAB (^I), VERTICAL TAB (^K), NEWLINE (^J or ^M) and FORM FEED
114 ;; (^L), any other characters are invalid. But ebnf2ps accepts also the
115 ;; european 8-bit accentuated characters (from \240 to \377) and underscore
119 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
127 (defvar ebnf-iso-lex nil
128 "Value returned by `ebnf-iso-lex' function.")
131 (defvar ebnf-no-meta-identifier nil
132 "Used by `ebnf-iso-term' and `ebnf-iso-lex' functions.")
135 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
136 ;; Syntactic analyzer
139 ;;; ISO EBNF = syntax rule, {syntax rule};
141 (defun ebnf-iso-parser (start)
143 (let ((total (+ (- ebnf-limit start) 1))
146 syntax-list token rule)
148 (setq token (ebnf-iso-lex))
149 (and (eq token 'end-of-input)
150 (error "Invalid ISO EBNF file format"))
151 (while (not (eq token 'end-of-input))
154 (/ (* (- (point) bias) 100.0) total))
155 (setq token (ebnf-iso-syntax-rule token)
158 (or (ebnf-add-empty-rule-list rule)
159 (setq syntax-list (cons rule syntax-list))))
164 ;;; syntax rule = meta identifier, '=', definition list, ';';
166 (defun ebnf-iso-syntax-rule (token)
167 (let ((header ebnf-iso-lex)
170 (setq ebnf-action nil)
171 (or (eq token 'non-terminal)
172 (error "Invalid meta identifier syntax rule"))
173 (or (eq (ebnf-iso-lex) 'equal)
174 (error "Invalid syntax rule: missing `='"))
175 (setq body (ebnf-iso-definition-list))
176 (or (eq (car body) 'period)
177 (error "Invalid syntax rule: missing `;' or `.'"))
178 (setq body (cdr body))
179 (ebnf-eps-add-production header)
181 (ebnf-make-production header body action))))
184 ;;; definition list = single definition, {'|', single definition};
186 (defun ebnf-iso-definition-list ()
188 (while (eq (car (setq sequence (ebnf-iso-single-definition)))
190 (setq sequence (cdr sequence)
191 body (cons sequence body)))
192 (ebnf-token-alternative body sequence)))
195 ;;; single definition = term, {',', term};
197 (defun ebnf-iso-single-definition ()
198 (let (token seq term)
199 (while (and (setq term (ebnf-iso-term (ebnf-iso-lex))
202 (eq token 'catenate))
203 (setq seq (cons term seq)))
205 (ebnf-token-sequence (if term
210 ;;; term = factor, ['-', exception];
212 ;;; exception = factor (* without <meta identifier> *);
214 (defun ebnf-iso-term (token)
215 (let ((factor (ebnf-iso-factor token)))
216 (if (not (eq (car factor) 'except))
219 ;; factor - exception
220 (let ((ebnf-no-meta-identifier t))
221 (ebnf-token-except (cdr factor) (ebnf-iso-factor (ebnf-iso-lex)))))))
224 ;;; factor = [integer, '*'], primary;
226 (defun ebnf-iso-factor (token)
227 (if (eq token 'integer)
228 (let ((times ebnf-iso-lex))
229 (or (eq (ebnf-iso-lex) 'repeat)
230 (error "Missing `*'"))
231 (ebnf-token-repeat times (ebnf-iso-primary (ebnf-iso-lex))))
232 (ebnf-iso-primary token)))
235 ;;; primary = optional sequence | repeated sequence | special sequence
236 ;;; | grouped sequence | meta identifier | terminal string
241 ;;; optional sequence = '[', definition list, ']';
243 ;;; repeated sequence = '{', definition list, '}';
245 ;;; grouped sequence = '(', definition list, ')';
247 ;;; terminal string = "'", character - "'", {character - "'"}, "'"
248 ;;; | '"', character - '"', {character - '"'}, '"';
250 ;;; special sequence = '?', {character - '?'}, '?';
252 ;;; meta identifier = letter, {letter | decimal digit};
254 (defun ebnf-iso-primary (token)
258 ((eq token 'terminal)
259 (ebnf-make-terminal ebnf-iso-lex))
261 ((eq token 'non-terminal)
262 (ebnf-make-non-terminal ebnf-iso-lex))
265 (ebnf-make-special ebnf-iso-lex))
267 ((eq token 'begin-group)
268 (let ((body (ebnf-iso-definition-list)))
269 (or (eq (car body) 'end-group)
270 (error "Missing `)'"))
273 ((eq token 'begin-optional)
274 (let ((body (ebnf-iso-definition-list)))
275 (or (eq (car body) 'end-optional)
276 (error "Missing `]' or `/)'"))
277 (ebnf-token-optional (cdr body))))
279 ((eq token 'begin-zero-or-more)
280 (let* ((body (ebnf-iso-definition-list))
282 (or (eq (car body) 'end-zero-or-more)
283 (error "Missing `}' or `:)'"))
284 (ebnf-make-zero-or-more repeat)))
295 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
299 (defconst ebnf-iso-token-table
300 ;; control character & 8-bit character are set to `error'
301 (let ((table (make-vector 256 'error))
303 ;; printable character
304 (while (< char ?\060)
305 (aset table char 'character)
306 (setq char (1+ char)))
308 (while (< char ?\072)
309 (aset table char 'integer)
310 (setq char (1+ char)))
311 (while (< char ?\101)
312 (aset table char 'character)
313 (setq char (1+ char)))
314 ;; upper case letters:
315 (while (< char ?\133)
316 (aset table char 'non-terminal)
317 (setq char (1+ char)))
318 (while (< char ?\141)
319 (aset table char 'character)
320 (setq char (1+ char)))
321 ;; lower case letters:
322 (while (< char ?\173)
323 (aset table char 'non-terminal)
324 (setq char (1+ char)))
325 (while (< char ?\177)
326 (aset table char 'character)
327 (setq char (1+ char)))
328 ;; European 8-bit accentuated characters:
330 (while (< char ?\400)
331 (aset table char 'non-terminal)
332 (setq char (1+ char)))
333 ;; Override space characters:
334 (aset table ?\013 'space) ; [VT] vertical tab
335 (aset table ?\n 'space) ; [NL] linefeed
336 (aset table ?\r 'space) ; [CR] carriage return
337 (aset table ?\t 'space) ; [HT] horizontal tab
338 (aset table ?\ 'space) ; [SP] space
339 ;; Override form feed character:
340 (aset table ?\f 'form-feed) ; [FF] form feed
341 ;; Override other lexical characters:
342 (aset table ?_ 'non-terminal)
343 (aset table ?\" 'double-terminal)
344 (aset table ?\' 'single-terminal)
345 (aset table ?\? 'special)
346 (aset table ?* 'repeat)
347 (aset table ?, 'catenate)
348 (aset table ?- 'except)
349 (aset table ?= 'equal)
350 (aset table ?\) 'end-group)
352 "Vector used to map characters to a lexical token.")
355 (defun ebnf-iso-initialize ()
356 "Initialize ISO EBNF token table."
357 (if ebnf-iso-alternative-p
358 ;; Override alternative lexical characters:
360 (aset ebnf-iso-token-table ?\( 'left-parenthesis)
361 (aset ebnf-iso-token-table ?\[ 'character)
362 (aset ebnf-iso-token-table ?\] 'character)
363 (aset ebnf-iso-token-table ?\{ 'character)
364 (aset ebnf-iso-token-table ?\} 'character)
365 (aset ebnf-iso-token-table ?| 'character)
366 (aset ebnf-iso-token-table ?\; 'character)
367 (aset ebnf-iso-token-table ?/ 'slash)
368 (aset ebnf-iso-token-table ?! 'alternative)
369 (aset ebnf-iso-token-table ?: 'colon)
370 (aset ebnf-iso-token-table ?. 'period))
371 ;; Override standard lexical characters:
372 (aset ebnf-iso-token-table ?\( 'begin-parenthesis)
373 (aset ebnf-iso-token-table ?\[ 'begin-optional)
374 (aset ebnf-iso-token-table ?\] 'end-optional)
375 (aset ebnf-iso-token-table ?\{ 'begin-zero-or-more)
376 (aset ebnf-iso-token-table ?\} 'end-zero-or-more)
377 (aset ebnf-iso-token-table ?| 'alternative)
378 (aset ebnf-iso-token-table ?\; 'period)
379 (aset ebnf-iso-token-table ?/ 'character)
380 (aset ebnf-iso-token-table ?! 'character)
381 (aset ebnf-iso-token-table ?: 'character)
382 (aset ebnf-iso-token-table ?. 'character)))
385 ;; replace the range "\240-\377" (see `ebnf-range-regexp').
386 (defconst ebnf-iso-non-terminal-chars
387 (ebnf-range-regexp " 0-9A-Za-z_" ?\240 ?\377))
390 (defun ebnf-iso-lex ()
391 "Lexical analyzer for ISO EBNF.
393 Return a lexical token.
395 See documentation for variable `ebnf-iso-lex'."
396 (if (>= (point) ebnf-limit)
399 ;; skip spaces and comments
400 (while (if (> (following-char) 255)
404 (setq token (aref ebnf-iso-token-table (following-char)))
407 (skip-chars-forward " \013\n\r\t" ebnf-limit)
408 (< (point) ebnf-limit))
409 ((or (eq token 'begin-parenthesis)
410 (eq token 'left-parenthesis))
412 (if (/= (following-char) ?*)
416 (ebnf-iso-skip-comment)
418 ((eq token 'form-feed)
420 (setq ebnf-action 'form-feed))
425 ((>= (point) ebnf-limit)
429 (error "Invalid character"))
432 (setq ebnf-iso-lex (ebnf-buffer-substring "0-9"))
434 ;; special: ?special?
436 (setq ebnf-iso-lex (concat (and ebnf-special-show-delimiter "?")
437 (ebnf-string " ->@-~" ?\? "special")
438 (and ebnf-special-show-delimiter "?")))
440 ;; terminal: "string"
441 ((eq token 'double-terminal)
442 (setq ebnf-iso-lex (ebnf-string " !#-~" ?\" "terminal"))
444 ;; terminal: 'string'
445 ((eq token 'single-terminal)
446 (setq ebnf-iso-lex (ebnf-string " -&(-~" ?\' "terminal"))
449 ((eq token 'non-terminal)
453 (ebnf-buffer-substring ebnf-iso-non-terminal-chars))))
454 (and ebnf-no-meta-identifier
455 (error "Exception sequence should not contain a meta identifier"))
457 ;; begin optional, begin list or begin group
458 ((eq token 'left-parenthesis)
460 (cond ((= (following-char) ?/)
463 ((= (following-char) ?:)
469 ;; end optional or alternative
472 (if (/= (following-char) ?\))
479 (if (/= (following-char) ?\))
484 ((eq token 'begin-parenthesis)
493 ;; replace the range "\177-\237" (see `ebnf-range-regexp').
494 (defconst ebnf-iso-comment-chars
495 (ebnf-range-regexp "^*(\000-\010\016-\037" ?\177 ?\237))
498 (defun ebnf-iso-skip-comment ()
502 ((and ebnf-eps-executing (= (following-char) ?\[))
503 (ebnf-eps-add-context (ebnf-iso-eps-filename)))
505 ((and ebnf-eps-executing (= (following-char) ?\]))
506 (ebnf-eps-remove-context (ebnf-iso-eps-filename)))
508 ((and ebnf-eps-executing (= (following-char) ?H))
509 (ebnf-eps-header-comment (ebnf-iso-eps-filename)))
511 ((and ebnf-eps-executing (= (following-char) ?F))
512 (ebnf-eps-footer-comment (ebnf-iso-eps-filename)))
513 ;; any other action in comment
515 (setq ebnf-action (aref ebnf-comment-table (following-char))))
519 (skip-chars-forward ebnf-iso-comment-chars ebnf-limit)
520 (cond ((>= (point) ebnf-limit)
521 (error "Missing end of comment: `*)'"))
522 ((= (following-char) ?*)
523 (skip-chars-forward "*" ebnf-limit)
524 (when (= (following-char) ?\))
527 (setq pair (1- pair))))
528 ((= (following-char) ?\()
529 (skip-chars-forward "(" ebnf-limit)
530 (when (= (following-char) ?*)
531 ;; beginning of comment
533 (setq pair (1+ pair))))
535 (error "Invalid character"))
539 (defun ebnf-iso-eps-filename ()
541 (buffer-substring-no-properties
543 (let ((chars (concat ebnf-iso-comment-chars "\n"))
546 (skip-chars-forward chars ebnf-limit)
548 (cond ((>= (point) ebnf-limit)
550 ((= (following-char) ?*)
551 (skip-chars-forward "*" ebnf-limit)
552 (if (/= (following-char) ?\))
556 ((= (following-char) ?\()
558 (if (/= (following-char) ?*)
568 (defun ebnf-iso-normalize (str)
569 (if (not ebnf-iso-normalize-p)
571 (let ((len (length str))
574 ;; count exceeding spaces
576 (if (/= (aref str stri) ?\ )
577 (setq stri (1+ stri))
578 (setq stri (1+ stri))
579 (while (and (< stri len) (= (aref str stri) ?\ ))
581 spaces (1+ spaces)))))
583 ;; no exceeding space
585 ;; at least one exceeding space
586 (let ((new (make-string (- len spaces) ?\ ))
588 ;; eliminate exceeding spaces
591 (if (/= (aref str stri) ?\ )
593 (aset new newi (aref str stri))
596 (aset new newi (aref str stri))
599 (while (and (> spaces 0) (= (aref str stri) ?\ ))
601 spaces (1- spaces)))))
602 ;; remaining is normalized
604 (aset new newi (aref str stri))
610 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
616 ;;; arch-tag: 03315eef-8f64-404a-bf9d-256d42442ee3
617 ;;; ebnf-iso.el ends here