1;;; ebnf-yac.el --- parser for Yacc/Bison
2
3;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007
4;;   Free Software Foundation, Inc.
5
6;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br>
7;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br>
8;; Keywords: wp, ebnf, PostScript
9;; Version: 1.3
10
11;; This file is part of GNU Emacs.
12
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)
16;; any later version.
17
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.
22
23;; You should have received a copy of the GNU General Public License
24;; along with GNU Emacs; see the file COPYING.  If not, write to the
25;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
26;; Boston, MA 02110-1301, USA.
27
28;;; Commentary:
29
30;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
31;;
32;;
33;; This is part of ebnf2ps package.
34;;
35;; This package defines a parser for Yacc/Bison.
36;;
37;; See ebnf2ps.el for documentation.
38;;
39;;
40;; Yacc/Bison Syntax
41;; -----------------
42;;
43;; YACC = { YACC-Definitions }* "%%" { YACC-Rule }* [ "%%" [ YACC-Code ] ].
44;;
45;; YACC-Definitions = ( "%token" | "%left" | "%right" | "%nonassoc" )
46;;                    [ "<" Name ">" ] Name-List
47;;                  | "%prec" Name
48;;                  | "any other Yacc definition"
49;;                  .
50;;
51;; YACC-Code = "any C definition".
52;;
53;; YACC-Rule = Name ":" Alternative ";".
54;;
55;; Alternative = { Sequence || "|" }*.
56;;
57;; Sequence = { Factor }*.
58;;
59;; Factor = Name
60;;        | "'" "character" "'"
61;;        | "error"
62;;        | "{" "C like commands" "}"
63;;        .
64;;
65;; Name-List = { Name || "," }*.
66;;
67;; Name = "[A-Za-z][A-Za-z0-9_.]*".
68;;
69;; Comment = "/*" "any character, but the sequence \"*/\"" "*/"
70;;         | "//" "any character, but the newline \"\\n\"" "\\n".
71;;
72;;
73;; In other words, a valid Name begins with a letter (upper or lower case)
74;; followed by letters, decimal digits, underscore (_) or point (.).  For
75;; example: this_is_a_valid.name, Another_EXAMPLE, mIxEd.CaSe.
76;;
77;;
78;; Acknowledgements
79;; ----------------
80;;
81;; Thanks to Matthew K. Junker <junker@alum.mit.edu> for the suggestion to deal
82;; with %right, %left and %prec pragmas.  His suggestion was extended to deal
83;; with %nonassoc pragma too.
84;;
85;;
86;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
87
88;;; Code:
89
90
91(require 'ebnf-otz)
92
93
94(defvar ebnf-yac-lex nil
95  "Value returned by `ebnf-yac-lex' function.")
96
97
98(defvar ebnf-yac-token-list nil
99  "List of `%TOKEN' names.")
100
101
102(defvar ebnf-yac-skip-char nil
103  "Non-nil means skip printable characters with no grammatical meaning.")
104
105
106(defvar ebnf-yac-error nil
107  "Non-nil means \"error\" occurred.")
108
109
110;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
111;; Syntactic analyzer
112
113
114;;; YACC = { YACC-Definitions }* "%%" { YACC-Rule }* [ "%%" [ YACC-Code ] ].
115;;;
116;;; YACC-Code = "any C definition".
117
118(defun ebnf-yac-parser (start)
119  "yacc/Bison parser."
120  (let ((total (+ (- ebnf-limit start) 1))
121	(bias (1- start))
122	(origin (point))
123	syntax-list token rule)
124    (goto-char start)
125    (setq token (ebnf-yac-lex))
126    (and (eq token 'end-of-input)
127	 (error "Invalid Yacc/Bison file format"))
128    (or (eq (ebnf-yac-definitions token) 'yac-separator)
129	(error "Missing `%%%%'"))
130    (setq token (ebnf-yac-lex))
131    (while (not (memq token '(end-of-input yac-separator)))
132      (ebnf-message-float
133       "Parsing...%s%%"
134       (/ (* (- (point) bias) 100.0) total))
135      (setq token (ebnf-yac-rule token)
136	    rule  (cdr token)
137	    token (car token))
138      (or (ebnf-add-empty-rule-list rule)
139	  (setq syntax-list (cons rule syntax-list))))
140    (goto-char origin)
141    syntax-list))
142
143
144;;; YACC-Definitions = ( "%token" | "%left" | "%right" | "%nonassoc" )
145;;;                    [ "<" Name ">" ] Name-List
146;;;                  | "%prec" Name
147;;;                  | "any other Yacc definition"
148;;;                  .
149
150(defun ebnf-yac-definitions (token)
151  (let ((ebnf-yac-skip-char t))
152    (while (not (memq token '(yac-separator end-of-input)))
153      (setq token
154	    (cond
155	     ;; ( "%token" | "%left" | "%right" | "%nonassoc" )
156	     ;; [ "<" Name ">" ] Name-List
157	     ((eq token 'yac-token)
158	      (setq token (ebnf-yac-lex))
159	      (when (eq token 'open-angle)
160		(or (eq (ebnf-yac-lex) 'non-terminal)
161		    (error "Missing type name"))
162		(or (eq (ebnf-yac-lex) 'close-angle)
163		    (error "Missing `>'"))
164		(setq token (ebnf-yac-lex)))
165	      (setq token               (ebnf-yac-name-list token)
166		    ebnf-yac-token-list (nconc (cdr token)
167					       ebnf-yac-token-list))
168	      (car token))
169	     ;;  "%prec" Name
170	     ((eq token 'yac-prec)
171	      (or (eq (ebnf-yac-lex) 'non-terminal)
172		  (error "Missing prec name"))
173	      (ebnf-yac-lex))
174	     ;;  "any other Yacc definition"
175	     (t
176	      (ebnf-yac-lex))
177	     )))
178    token))
179
180
181;;; YACC-Rule = Name ":" Alternative ";".
182
183(defun ebnf-yac-rule (token)
184  (let ((header ebnf-yac-lex)
185	(action ebnf-action)
186	body)
187    (setq ebnf-action nil)
188    (or (eq token 'non-terminal)
189	(error "Invalid rule name"))
190    (or (eq (ebnf-yac-lex) 'colon)
191	(error "Invalid rule: missing `:'"))
192    (setq body (ebnf-yac-alternative))
193    (or (eq (car body) 'period)
194	(error "Invalid rule: missing `;'"))
195    (setq body (cdr body))
196    (ebnf-eps-add-production header)
197    (cons (ebnf-yac-lex)
198	  (ebnf-make-production header body action))))
199
200
201;;; Alternative = { Sequence || "|" }*.
202
203(defun ebnf-yac-alternative ()
204  (let (body sequence)
205    (while (eq (car (setq sequence (ebnf-yac-sequence)))
206	       'alternative)
207      (and (setq sequence (cdr sequence))
208	   (setq body     (cons sequence body))))
209    (ebnf-token-alternative body sequence)))
210
211
212;;; Sequence = { Factor }*.
213
214(defun ebnf-yac-sequence ()
215  (let (ebnf-yac-error token seq factor)
216    (while (setq token  (ebnf-yac-lex)
217		 factor (ebnf-yac-factor token))
218      (setq seq (cons factor seq)))
219    (cons token
220	  (if (and ebnf-yac-ignore-error-recovery ebnf-yac-error)
221	      ;; ignore error recovery
222	      nil
223	    (ebnf-token-sequence seq)))))
224
225
226;;; Factor = Name
227;;;        | "'" "character" "'"
228;;;        | "error"
229;;;        | "{" "C like commands" "}"
230;;;        .
231
232(defun ebnf-yac-factor (token)
233  (cond
234   ;; 'character'
235   ((eq token 'terminal)
236    (ebnf-make-terminal ebnf-yac-lex))
237   ;; Name
238   ((eq token 'non-terminal)
239    (ebnf-make-non-terminal ebnf-yac-lex))
240   ;; "error"
241   ((eq token 'yac-error)
242    (ebnf-make-special ebnf-yac-lex))
243   ;; not a factor
244   (t
245    nil)
246   ))
247
248
249;;; Name-List = { Name || "," }*.
250
251(defun ebnf-yac-name-list (token)
252  (let (names)
253    (when (eq token 'non-terminal)
254      (while (progn
255	       (setq names (cons ebnf-yac-lex names)
256		     token (ebnf-yac-lex))
257	       (eq token 'comma))
258	(or (eq (ebnf-yac-lex) 'non-terminal)
259	    (error "Missing token name"))))
260    (cons token names)))
261
262
263;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
264;; Lexical analyzer
265
266
267;;; Name = "[A-Za-z][A-Za-z0-9_.]*".
268;;;
269;;; Comment = "/*" "any character, but the sequence \"*/\"" "*/"
270;;;         | "//" "any character" "\\n".
271
272(defconst ebnf-yac-token-table
273  ;; control character & 8-bit character are set to `error'
274  (let ((table (make-vector 256 'error)))
275    ;; upper & lower case letters:
276    (mapcar
277     #'(lambda (char)
278	 (aset table char 'non-terminal))
279     "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz")
280    ;; printable characters:
281    (mapcar
282     #'(lambda (char)
283	 (aset table char 'character))
284     "!#$&()*+-.0123456789=?@[\\]^_`~")
285    ;; Override space characters:
286    (aset table ?\n 'space)		; [NL] linefeed
287    (aset table ?\r 'space)		; [CR] carriage return
288    (aset table ?\t 'space)		; [HT] horizontal tab
289    (aset table ?\  'space)		; [SP] space
290    ;; Override form feed character:
291    (aset table ?\f 'form-feed)		; [FF] form feed
292    ;; Override other lexical characters:
293    (aset table ?<  'open-angle)
294    (aset table ?>  'close-angle)
295    (aset table ?,  'comma)
296    (aset table ?%  'yac-pragma)
297    (aset table ?/  'slash)
298    (aset table ?\{ 'yac-code)
299    (aset table ?\" 'string)
300    (aset table ?\' 'terminal)
301    (aset table ?:  'colon)
302    (aset table ?|  'alternative)
303    (aset table ?\; 'period)
304    table)
305  "Vector used to map characters to a lexical token.")
306
307
308(defun ebnf-yac-initialize ()
309  "Initializations for Yacc/Bison parser."
310  (setq ebnf-yac-token-list nil))
311
312
313(defun ebnf-yac-lex ()
314  "Lexical analyzer for Yacc/Bison.
315
316Return a lexical token.
317
318See documentation for variable `ebnf-yac-lex'."
319  (if (>= (point) ebnf-limit)
320      'end-of-input
321    (let (token)
322      ;; skip spaces, code blocks and comments
323      (while (if (> (following-char) 255)
324		 (progn
325		   (setq token 'error)
326		   nil)
327	       (setq token (aref ebnf-yac-token-table (following-char)))
328	       (cond
329		((or (eq token 'space)
330		     (and ebnf-yac-skip-char
331			  (eq token 'character)))
332		 (ebnf-yac-skip-spaces))
333		((eq token 'yac-code)
334		 (ebnf-yac-skip-code))
335		((eq token 'slash)
336		 (ebnf-yac-handle-comment))
337		((eq token 'form-feed)
338		 (forward-char)
339		 (setq ebnf-action 'form-feed))
340		(t nil)
341		)))
342      (cond
343       ;; end of input
344       ((>= (point) ebnf-limit)
345	'end-of-input)
346       ;; error
347       ((eq token 'error)
348	(error "Invalid character"))
349       ;; "string"
350       ((eq token 'string)
351	(setq ebnf-yac-lex (ebnf-get-string))
352	'string)
353       ;; terminal: 'char'
354       ((eq token 'terminal)
355	(setq ebnf-yac-lex (ebnf-string " -&(-~" ?\' "terminal"))
356	'terminal)
357       ;; non-terminal, terminal or "error"
358       ((eq token 'non-terminal)
359	(setq ebnf-yac-lex (ebnf-buffer-substring "0-9A-Za-z_."))
360	(cond ((member ebnf-yac-lex ebnf-yac-token-list)
361	       'terminal)
362	      ((string= ebnf-yac-lex "error")
363	       (setq ebnf-yac-error t)
364	       'yac-error)
365	      (t
366	       'non-terminal)
367	      ))
368       ;; %% and Yacc pragmas (%TOKEN, %START, etc).
369       ((eq token 'yac-pragma)
370	(forward-char)
371	(cond
372	 ;; Yacc separator
373	 ((eq (following-char) ?%)
374	  (forward-char)
375	  'yac-separator)
376	 ;; %TOKEN, %RIGHT, %LEFT,  %PREC, %NONASSOC
377	 ((cdr (assoc (upcase (ebnf-buffer-substring "0-9A-Za-z_"))
378		      '(("TOKEN"    . yac-token)
379			("RIGHT"    . yac-token)
380			("LEFT"     . yac-token)
381			("NONASSOC" . yac-token)
382			("PREC"     . yac-prec)))))
383	 ;; other Yacc pragmas
384	 (t
385	  'yac-pragma)
386	 ))
387       ;; miscellaneous
388       (t
389	(forward-char)
390	token)
391       ))))
392
393
394(defun ebnf-yac-skip-spaces ()
395  (skip-chars-forward
396   (if ebnf-yac-skip-char
397       "\n\r\t !#$&()*+-.0123456789=?@[\\\\]^_`~"
398     "\n\r\t ")
399   ebnf-limit)
400  (< (point) ebnf-limit))
401
402
403;; replace the range "\177-\377" (see `ebnf-range-regexp').
404(defconst ebnf-yac-skip-chars
405  (ebnf-range-regexp "^{}/'\"\000-\010\013\016-\037" ?\177 ?\377))
406
407
408(defun ebnf-yac-skip-code ()
409  (forward-char)
410  (let ((pair 1))
411    (while (> pair 0)
412      (skip-chars-forward ebnf-yac-skip-chars ebnf-limit)
413      (cond
414       ((= (following-char) ?{)
415	(forward-char)
416	(setq pair (1+ pair)))
417       ((= (following-char) ?})
418	(forward-char)
419	(setq pair (1- pair)))
420       ((= (following-char) ?/)
421	(ebnf-yac-handle-comment))
422       ((= (following-char) ?\")
423	(ebnf-get-string))
424       ((= (following-char) ?\')
425	(ebnf-string " -&(-~" ?\' "character"))
426       (t
427	(error "Invalid character"))
428       )))
429  (ebnf-yac-skip-spaces))
430
431
432(defun ebnf-yac-handle-comment ()
433  (forward-char)
434  (cond
435   ;; begin comment
436   ((= (following-char) ?*)
437    (ebnf-yac-skip-comment)
438    (ebnf-yac-skip-spaces))
439   ;; line comment
440   ((= (following-char) ?/)
441    (end-of-line)
442    (ebnf-yac-skip-spaces))
443   ;; no comment
444   (t nil)
445   ))
446
447
448;; replace the range "\177-\237" (see `ebnf-range-regexp').
449(defconst ebnf-yac-comment-chars
450  (ebnf-range-regexp "^*\000-\010\013\016-\037" ?\177 ?\237))
451
452
453(defun ebnf-yac-skip-comment ()
454  (forward-char)
455  (cond
456   ;; open EPS file
457   ((and ebnf-eps-executing (= (following-char) ?\[))
458    (ebnf-eps-add-context (ebnf-yac-eps-filename)))
459   ;; close EPS file
460   ((and ebnf-eps-executing (= (following-char) ?\]))
461    (ebnf-eps-remove-context (ebnf-yac-eps-filename)))
462   ;; any other action in comment
463   (t
464    (setq ebnf-action (aref ebnf-comment-table (following-char))))
465   )
466  (let ((not-end t))
467    (while not-end
468      (skip-chars-forward ebnf-yac-comment-chars ebnf-limit)
469      (cond ((>= (point) ebnf-limit)
470	     (error "Missing end of comment: `*/'"))
471	    ((= (following-char) ?*)
472	     (skip-chars-forward "*" ebnf-limit)
473	     (when (= (following-char) ?/)
474	       ;; end of comment
475	       (forward-char)
476	       (setq not-end nil)))
477	    (t
478	     (error "Invalid character"))
479	    ))))
480
481
482(defun ebnf-yac-eps-filename ()
483  (forward-char)
484  (buffer-substring-no-properties
485   (point)
486   (let ((chars (concat ebnf-yac-comment-chars "\n"))
487	 found)
488     (while (not found)
489       (skip-chars-forward chars ebnf-limit)
490       (setq found
491	     (cond ((>= (point) ebnf-limit)
492		    (point))
493		   ((= (following-char) ?*)
494		    (skip-chars-forward "*" ebnf-limit)
495		    (if (/= (following-char) ?\/)
496			nil
497		      (backward-char)
498		      (point)))
499		   (t
500		    (point))
501		   )))
502     found)))
503
504
505;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
506
507
508(provide 'ebnf-yac)
509
510
511;;; arch-tag: 8a96989c-0b1d-42ba-a020-b2901f9a2a4d
512;;; ebnf-yac.el ends here
513