Gnus -- Minor tweak define #'time-to-seconds
[packages] / xemacs-packages / semantic / semantic-grammar.wy
1 ;;; semantic-grammar.wy -- LALR grammar of Semantic input grammars
2 ;;
3 ;; Copyright (C) 2002, 2003, 2004 David Ponce
4 ;;
5 ;; Author: David Ponce <david@dponce.com>
6 ;; Maintainer: David Ponce <david@dponce.com>
7 ;; Created: 26 Aug 2002
8 ;; Keywords: syntax
9 ;; X-RCS: $Id: semantic-grammar.wy,v 1.1 2007-11-26 15:10:38 michaels Exp $
10 ;;
11 ;; This file is not part of GNU Emacs.
12 ;;
13 ;; This program is free software; you can redistribute it and/or
14 ;; modify it under the terms of the GNU General Public License as
15 ;; published by the Free Software Foundation; either version 2, or (at
16 ;; your option) any later version.
17 ;;
18 ;; This software 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 GNU
21 ;; 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 %{
29   ;; Current parsed nonterminal name.
30   (defvar semantic-grammar-wy--nterm nil)
31   ;; Index of rule in a nonterminal clause.
32   (defvar semantic-grammar-wy--rindx nil)
33   }
34
35 ;;%package semantic-grammar-wy
36
37 %languagemode wy-mode
38
39 ;; Main
40 %start grammar
41 ;; Reparse
42 %start prologue epilogue declaration nonterminal rule
43 ;; EXPANDFULL
44 %start put_names put_values use_names
45
46 ;; Keywords
47 %type    <keyword>
48 %keyword DEFAULT-PREC    "%default-prec"
49 %keyword NO-DEFAULT-PREC "%no-default-prec"
50 %keyword KEYWORD         "%keyword"
51 %keyword LANGUAGEMODE    "%languagemode"
52 %keyword LEFT            "%left"
53 %keyword NONASSOC        "%nonassoc"
54 %keyword PACKAGE         "%package"
55 %keyword PREC            "%prec"
56 %keyword PUT             "%put"
57 %keyword QUOTEMODE       "%quotemode"
58 %keyword RIGHT           "%right"
59 %keyword SCOPESTART      "%scopestart"
60 %keyword START           "%start"
61 %keyword TOKEN           "%token"
62 %keyword TYPE            "%type"
63 %keyword USE-MACROS      "%use-macros"
64
65 ;; Literals
66 %type  <string>
67 %token <string>      STRING
68
69 %type  <symbol>      syntax ":?\\(\\sw\\|\\s_\\)+"
70 %token <symbol>      SYMBOL
71 %token <symbol>      PERCENT_PERCENT "\\`%%\\'"
72
73 %type  <char>        syntax semantic-grammar-lex-c-char-re
74 %token <char>        CHARACTER
75
76 %type  <qlist>       matchdatatype sexp syntax "\\s'\\s-*("
77 %token <qlist>       PREFIXED_LIST
78
79 %type  <sexp>        matchdatatype sexp syntax "\\="
80 %token <sexp>        SEXP
81
82 ;; Don't generate these analyzers which needs special handling code.
83 %token <code>        PROLOGUE "%{...%}"
84 %token <code>        EPILOGUE "%%...EOF"
85
86 ;; Blocks & Parenthesis
87 %type  <block>
88 %token <block>       PAREN_BLOCK "(LPAREN RPAREN)"
89 %token <block>       BRACE_BLOCK "(LBRACE RBRACE)"
90 %token <open-paren>  LPAREN      "("
91 %token <close-paren> RPAREN      ")"
92 %token <open-paren>  LBRACE      "{"
93 %token <close-paren> RBRACE      "}"
94
95 ;; Punctuations
96 %type  <punctuation>
97 %token <punctuation> COLON       ":"
98 %token <punctuation> SEMI        ";"
99 %token <punctuation> OR          "|"
100 %token <punctuation> LT          "<"
101 %token <punctuation> GT          ">"
102
103 %%
104
105 grammar:
106     prologue
107   | epilogue
108   | declaration
109   | nonterminal
110   | PERCENT_PERCENT
111   ;
112
113 ;;; Prologue/Epilogue
114 ;;
115 prologue:
116     PROLOGUE
117     (CODE-TAG "prologue" nil)
118   ;
119
120 epilogue:
121     EPILOGUE
122     (CODE-TAG "epilogue" nil)
123   ;
124
125 ;;; Declarations
126 ;;
127 declaration:
128     decl
129     (eval $1)
130   ;
131
132 decl:
133     default_prec_decl
134   | no_default_prec_decl
135   | languagemode_decl
136   | package_decl
137   | precedence_decl
138   | put_decl
139   | quotemode_decl
140   | scopestart_decl
141   | start_decl
142   | keyword_decl
143   | token_decl
144   | type_decl
145   | use_macros_decl
146   ;
147
148 default_prec_decl:
149     DEFAULT-PREC
150     `(TAG "default-prec" 'assoc :value '("t"))
151   ;
152
153 no_default_prec_decl:
154     NO-DEFAULT-PREC
155     `(TAG "default-prec" 'assoc :value '("nil"))
156   ;
157
158 languagemode_decl:
159     LANGUAGEMODE symbols
160     `(TAG ',(car $2) 'languagemode :rest ',(cdr $2))
161   ;
162
163 package_decl:
164     PACKAGE SYMBOL
165     `(PACKAGE-TAG ',$2 nil)
166   ;
167
168 precedence_decl:
169     associativity token_type_opt items
170     `(TAG ',$1 'assoc :type ',$2 :value ',$3)
171   ;
172
173 associativity:
174     LEFT
175     (progn "left")
176   | RIGHT
177     (progn "right")
178   | NONASSOC
179     (progn "nonassoc")
180   ;
181
182 put_decl:
183     PUT put_name put_value
184     `(TAG ',$2 'put :value ',(list $3))
185   | PUT put_name put_value_list
186     `(TAG ',$2 'put :value ',$3)
187   | PUT put_name_list put_value
188     `(TAG ',(car $2) 'put :rest ',(cdr $2) :value ',(list $3))
189   | PUT put_name_list put_value_list
190     `(TAG ',(car $2) 'put :rest ',(cdr $2) :value ',$3)
191   ;
192
193 put_name_list:
194     BRACE_BLOCK
195     (mapcar 'semantic-tag-name (EXPANDFULL $1 put_names))
196   ;
197
198 put_names:
199     LBRACE
200     ()
201   | RBRACE
202     ()
203   | put_name
204  ;; Must return a list of Semantic tags to EXPANDFULL!
205     (TAG $1 'put-name)
206   ;
207
208 put_name:
209     SYMBOL
210   | token_type
211   ;
212
213 put_value_list:
214     BRACE_BLOCK
215     (mapcar 'semantic-tag-code-detail (EXPANDFULL $1 put_values))
216   ;
217
218 put_values:
219     LBRACE
220     ()
221   | RBRACE
222     ()
223   | put_value
224  ;; Must return a list of Semantic tags to EXPANDFULL!
225     (CODE-TAG "put-value" $1)
226   ;
227
228 put_value:
229     SYMBOL any_value
230     (cons $1 $2)
231   ;
232
233 scopestart_decl:
234     SCOPESTART SYMBOL
235     `(TAG ',$2 'scopestart)
236   ;
237
238 quotemode_decl:
239     QUOTEMODE SYMBOL
240     `(TAG ',$2 'quotemode)
241   ;
242
243 start_decl:
244     START symbols
245     `(TAG ',(car $2) 'start :rest ',(cdr $2))
246   ;
247
248 keyword_decl:
249     KEYWORD SYMBOL string_value
250     `(TAG ',$2 'keyword :value ',$3)
251   ;
252
253 token_decl:
254     TOKEN token_type_opt SYMBOL string_value
255     `(TAG ',$3 ',(if $2 'token 'keyword) :type ',$2 :value ',$4)
256   | TOKEN token_type_opt symbols
257     `(TAG ',(car $3) 'token :type ',$2 :rest ',(cdr $3))
258   ;
259
260 token_type_opt:
261  ;; EMPTY
262   | token_type
263   ;
264
265 token_type:
266     LT SYMBOL GT
267     (progn $2)
268   ;
269
270 type_decl:
271     TYPE token_type plist_opt
272     `(TAG ',$2 'type :value ',$3)
273   ;
274
275 plist_opt:
276  ;;EMPTY
277   | plist
278   ;
279
280 plist:
281     plist put_value
282     (append (list $2) $1)
283   | put_value
284     (list $1)
285   ;
286
287 use_name_list:
288     BRACE_BLOCK
289     (mapcar 'semantic-tag-name (EXPANDFULL $1 use_names))
290   ;
291
292 use_names:
293     LBRACE
294     ()
295   | RBRACE
296     ()
297   | SYMBOL
298  ;; Must return a list of Semantic tags to EXPANDFULL!
299     (TAG $1 'use-name)
300   ;
301
302 use_macros_decl:
303     USE-MACROS SYMBOL use_name_list
304     `(TAG "macro" 'macro :type ',$2 :value ',$3)
305   ;
306
307 string_value:
308     STRING
309     (read $1)
310   ;
311
312 ;; Return a Lisp readable form
313 any_value:
314     SYMBOL
315   | STRING
316   | PAREN_BLOCK
317   | PREFIXED_LIST
318   | SEXP
319   ;
320
321 symbols:
322     lifo_symbols
323     (nreverse $1)
324   ;
325
326 lifo_symbols:
327     lifo_symbols SYMBOL
328     (cons $2 $1)
329   | SYMBOL
330     (list $1)
331   ;
332
333 ;;; Grammar rules
334 ;;
335 nonterminal:
336     SYMBOL
337     (setq semantic-grammar-wy--nterm $1
338           semantic-grammar-wy--rindx 0)
339     COLON rules SEMI
340     (TAG $1 'nonterminal :children $4)
341   ;
342
343 rules:
344     lifo_rules
345     (apply 'nconc (nreverse $1))
346   ;
347
348 lifo_rules:
349     lifo_rules OR rule
350     (cons $3 $1)
351   | rule
352     (list $1)
353   ;
354
355 rule:
356     rhs
357     (let* ((nterm semantic-grammar-wy--nterm)
358            (rindx semantic-grammar-wy--rindx)
359            (rhs   $1)
360            comps prec action elt)
361       (setq semantic-grammar-wy--rindx (1+ semantic-grammar-wy--rindx))
362       (while rhs
363         (setq elt (car rhs)
364               rhs (cdr rhs))
365         (cond
366          ;; precedence level
367          ((vectorp elt)
368           (if prec
369               (error "duplicate %%prec in `%s:%d' rule" nterm rindx))
370           (setq prec (aref elt 0)))
371          ;; action
372          ((consp elt)
373           ;; don't forget that rhs items are in reverse order, so
374           ;; the end-of-rule semantic action is the first item.
375           (if (or action comps)
376               ;; a mid-rule action
377               (setq comps (cons elt comps)
378                     ;; keep rule and action index synchronized
379                     semantic-grammar-wy--rindx
380                     (1+ semantic-grammar-wy--rindx))
381             ;; the end-of-rule action
382             (setq action (car elt))))
383          ;; item
384          (t
385           (setq comps (cons elt comps)))))
386       (EXPANDTAG
387        (TAG (format "%s:%d" nterm rindx) 'rule
388             :type (if comps "group" "empty")
389             :value comps :prec prec :expr action)))
390   ;
391
392 rhs:
393  ;; EMPTY
394   | rhs item
395     (cons $2 $1)
396   | rhs action
397     (cons (list $2) $1)
398   | rhs PREC item
399     (cons (vector $3) $1)
400   ;
401
402 action:
403     PAREN_BLOCK
404   | PREFIXED_LIST
405   | BRACE_BLOCK
406     (format "(progn\n%s)"
407             (let ((s $1))
408               (if (string-match "^{[\r\n\t ]*" s)
409                   (setq s (substring s (match-end 0))))
410               (if (string-match "[\r\n\t ]*}$" s)
411                   (setq s (substring s 0 (match-beginning 0))))
412               s))
413   ;
414
415 items:
416     lifo_items
417     (nreverse $1)
418   ;
419
420 lifo_items:
421     lifo_items item
422     (cons $2 $1)
423   | item
424     (list $1)
425   ;
426
427 item:
428     SYMBOL
429   | CHARACTER
430   ;
431
432 %%
433
434 (define-lex semantic-grammar-lexer
435   "Lexical analyzer that handles Semantic grammar buffers.
436 It ignores whitespaces, newlines and comments."
437   semantic-lex-ignore-newline
438   semantic-lex-ignore-whitespace
439   ;; Must detect prologue/epilogue before other symbols/keywords!
440   semantic-grammar-lex-prologue
441   semantic-grammar-lex-epilogue
442   semantic-grammar-wy--<keyword>-keyword-analyzer
443   semantic-grammar-wy--<symbol>-regexp-analyzer
444   semantic-grammar-wy--<char>-regexp-analyzer
445   semantic-grammar-wy--<string>-sexp-analyzer
446   ;; Must detect comments after strings because `comment-start-skip'
447   ;; regexp match semicolons inside strings!
448   semantic-lex-ignore-comments
449   ;; Must detect prefixed list before punctuation because prefix chars
450   ;; are also punctuations!
451   semantic-grammar-wy--<qlist>-sexp-analyzer
452   ;; Must detect punctuations after comments because the semicolon can
453   ;; be a punctuation or a comment start!
454   semantic-grammar-wy--<punctuation>-string-analyzer
455   semantic-grammar-wy--<block>-block-analyzer
456   semantic-grammar-wy--<sexp>-sexp-analyzer
457   )
458
459 ;;; semantic-grammar.wy ends here
460