1 ;;; wisent-grammar.el --- Wisent's input grammar mode
3 ;; Copyright (C) 2002-2011 Free Software Foundation, Inc.
5 ;; Author: David Ponce <david@dponce.com>
6 ;; Maintainer: David Ponce <david@dponce.com>
7 ;; Created: 26 Aug 2002
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software: you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation, either version 3 of the License, or
14 ;; (at your option) any later version.
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
26 ;; Major mode for editing Wisent's input grammar (.wy) files.
29 (require 'semantic
/grammar
)
30 (require 'semantic
/find
)
32 (defsubst wisent-grammar-region-placeholder
(symb)
33 "Given a $N placeholder symbol in SYMB, return a $regionN symbol.
34 Return nil if $N is not a valid placeholder symbol."
35 (let ((n (symbol-name symb
)))
36 (if (string-match "^[$]\\([1-9][0-9]*\\)$" n
)
37 (intern (concat "$region" (match-string 1 n
))))))
39 (defun wisent-grammar-EXPAND (symb nonterm
)
40 "Expand call to EXPAND grammar macro.
41 Return the form to parse from within a nonterminal.
42 SYMB is a $I placeholder symbol that gives the bounds of the area to
44 NONTERM is the nonterminal symbol to start with."
45 (unless (member nonterm
(semantic-grammar-start))
46 (error "EXPANDFULL macro called with %s, but not used with %%start"
48 (let (($ri
(wisent-grammar-region-placeholder symb
)))
50 `(semantic-bovinate-from-nonterminal
51 (car ,$ri
) (cdr ,$ri
) ',nonterm
)
52 (error "Invalid form (EXPAND %s %s)" symb nonterm
))))
54 (defun wisent-grammar-EXPANDFULL (symb nonterm
)
55 "Expand call to EXPANDFULL grammar macro.
56 Return the form to recursively parse an area.
57 SYMB is a $I placeholder symbol that gives the bounds of the area.
58 NONTERM is the nonterminal symbol to start with."
59 (unless (member nonterm
(semantic-grammar-start))
60 (error "EXPANDFULL macro called with %s, but not used with %%start"
62 (let (($ri
(wisent-grammar-region-placeholder symb
)))
64 `(semantic-parse-region
65 (car ,$ri
) (cdr ,$ri
) ',nonterm
1)
66 (error "Invalid form (EXPANDFULL %s %s)" symb nonterm
))))
68 (defun wisent-grammar-TAG (name class
&rest attributes
)
69 "Expand call to TAG grammar macro.
70 Return the form to create a generic semantic tag.
71 See the function `semantic-tag' for the meaning of arguments NAME,
72 CLASS and ATTRIBUTES."
74 (semantic-tag ,name
,class
,@attributes
)))
76 (defun wisent-grammar-VARIABLE-TAG (name type default-value
&rest attributes
)
77 "Expand call to VARIABLE-TAG grammar macro.
78 Return the form to create a semantic tag of class variable.
79 See the function `semantic-tag-new-variable' for the meaning of
80 arguments NAME, TYPE, DEFAULT-VALUE and ATTRIBUTES."
82 (semantic-tag-new-variable ,name
,type
,default-value
,@attributes
)))
84 (defun wisent-grammar-FUNCTION-TAG (name type arg-list
&rest attributes
)
85 "Expand call to FUNCTION-TAG grammar macro.
86 Return the form to create a semantic tag of class function.
87 See the function `semantic-tag-new-function' for the meaning of
88 arguments NAME, TYPE, ARG-LIST and ATTRIBUTES."
90 (semantic-tag-new-function ,name
,type
,arg-list
,@attributes
)))
92 (defun wisent-grammar-TYPE-TAG (name type members parents
&rest attributes
)
93 "Expand call to TYPE-TAG grammar macro.
94 Return the form to create a semantic tag of class type.
95 See the function `semantic-tag-new-type' for the meaning of arguments
96 NAME, TYPE, MEMBERS, PARENTS and ATTRIBUTES."
98 (semantic-tag-new-type ,name
,type
,members
,parents
,@attributes
)))
100 (defun wisent-grammar-INCLUDE-TAG (name system-flag
&rest attributes
)
101 "Expand call to INCLUDE-TAG grammar macro.
102 Return the form to create a semantic tag of class include.
103 See the function `semantic-tag-new-include' for the meaning of
104 arguments NAME, SYSTEM-FLAG and ATTRIBUTES."
106 (semantic-tag-new-include ,name
,system-flag
,@attributes
)))
108 (defun wisent-grammar-PACKAGE-TAG (name detail
&rest attributes
)
109 "Expand call to PACKAGE-TAG grammar macro.
110 Return the form to create a semantic tag of class package.
111 See the function `semantic-tag-new-package' for the meaning of
112 arguments NAME, DETAIL and ATTRIBUTES."
114 (semantic-tag-new-package ,name
,detail
,@attributes
)))
116 (defun wisent-grammar-CODE-TAG (name detail
&rest attributes
)
117 "Expand call to CODE-TAG grammar macro.
118 Return the form to create a semantic tag of class code.
119 See the function `semantic-tag-new-code' for the meaning of arguments
120 NAME, DETAIL and ATTRIBUTES."
122 (semantic-tag-new-code ,name
,detail
,@attributes
)))
124 (defun wisent-grammar-ALIAS-TAG (name aliasclass definition
&rest attributes
)
125 "Expand call to ALIAS-TAG grammar macro.
126 Return the form to create a semantic tag of class alias.
127 See the function `semantic-tag-new-alias' for the meaning of arguments
128 NAME, ALIASCLASS, DEFINITION and ATTRIBUTES."
130 (semantic-tag-new-alias ,name
,aliasclass
,definition
,@attributes
)))
132 (defun wisent-grammar-EXPANDTAG (raw-tag)
133 "Expand call to EXPANDTAG grammar macro.
134 Return the form to produce a list of cooked tags from raw form of
135 Semantic tag RAW-TAG."
136 `(wisent-cook-tag ,raw-tag
))
138 (defun wisent-grammar-AST-ADD (ast &rest nodes
)
139 "Expand call to AST-ADD grammar macro.
140 Return the form to update the abstract syntax tree AST with NODES.
141 See also the function `semantic-ast-add'."
142 `(semantic-ast-add ,ast
,@nodes
))
144 (defun wisent-grammar-AST-PUT (ast &rest nodes
)
145 "Expand call to AST-PUT grammar macro.
146 Return the form to update the abstract syntax tree AST with NODES.
147 See also the function `semantic-ast-put'."
148 `(semantic-ast-put ,ast
,@nodes
))
150 (defun wisent-grammar-AST-GET (ast node
)
151 "Expand call to AST-GET grammar macro.
152 Return the form to get, from the abstract syntax tree AST, the value
154 See also the function `semantic-ast-get'."
155 `(semantic-ast-get ,ast
,node
))
157 (defun wisent-grammar-AST-GET1 (ast node
)
158 "Expand call to AST-GET1 grammar macro.
159 Return the form to get, from the abstract syntax tree AST, the first
161 See also the function `semantic-ast-get1'."
162 `(semantic-ast-get1 ,ast
,node
))
164 (defun wisent-grammar-AST-GET-STRING (ast node
)
165 "Expand call to AST-GET-STRING grammar macro.
166 Return the form to get, from the abstract syntax tree AST, the value
168 See also the function `semantic-ast-get-string'."
169 `(semantic-ast-get-string ,ast
,node
))
171 (defun wisent-grammar-AST-MERGE (ast1 ast2
)
172 "Expand call to AST-MERGE grammar macro.
173 Return the form to merge the abstract syntax trees AST1 and AST2.
174 See also the function `semantic-ast-merge'."
175 `(semantic-ast-merge ,ast1
,ast2
))
177 (defun wisent-grammar-SKIP-BLOCK (&optional symb
)
178 "Expand call to SKIP-BLOCK grammar macro.
179 Return the form to skip a parenthesized block.
180 Optional argument SYMB is a $I placeholder symbol that gives the
181 bounds of the block to skip. By default, skip the block at `$1'.
182 See also the function `wisent-skip-block'."
185 (unless (setq $ri
(wisent-grammar-region-placeholder symb
))
186 (error "Invalid form (SKIP-BLOCK %s)" symb
)))
187 `(wisent-skip-block ,$ri
)))
189 (defun wisent-grammar-SKIP-TOKEN ()
190 "Expand call to SKIP-TOKEN grammar macro.
191 Return the form to skip the lookahead token.
192 See also the function `wisent-skip-token'."
193 `(wisent-skip-token))
195 (defun wisent-grammar-assocs ()
196 "Return associativity and precedence level definitions."
199 (cons (intern (semantic-tag-name tag
))
200 (mapcar #'semantic-grammar-item-value
201 (semantic-tag-get-attribute tag
:value
))))
202 (semantic-find-tags-by-class 'assoc
(current-buffer))))
204 (defun wisent-grammar-terminals ()
205 "Return the list of terminal symbols.
206 Keep order of declaration in the WY file without duplicates."
210 (mapcar #'(lambda (name)
211 (add-to-list 'terms
(intern name
)))
212 (cons (semantic-tag-name tag
)
213 (semantic-tag-get-attribute tag
:rest
))))
214 (semantic--find-tags-by-function
216 (memq (semantic-tag-class tag
) '(token keyword
)))
220 ;; Cache of macro definitions currently in use.
221 (defvar wisent--grammar-macros nil
)
223 (defun wisent-grammar-expand-macros (expr)
224 "Expand expression EXPR into a form without grammar macros.
225 Return the expanded expression."
226 (if (or (atom expr
) (semantic-grammar-quote-p (car expr
)))
227 expr
;; Just return atom or quoted expression.
228 (let* ((expr (mapcar 'wisent-grammar-expand-macros expr
))
229 (macro (assq (car expr
) wisent--grammar-macros
)))
230 (if macro
;; Expand Semantic built-in.
231 (apply (cdr macro
) (cdr expr
))
234 (defun wisent-grammar-nonterminals ()
235 "Return the list form of nonterminal definitions."
236 (let ((nttags (semantic-find-tags-by-class
237 'nonterminal
(current-buffer)))
238 ;; Setup the cache of macro definitions.
239 (wisent--grammar-macros (semantic-grammar-macros))
240 rltags nterms rules rule elems elem actn sexp prec
)
242 (setq rltags
(semantic-tag-components (car nttags
))
245 (setq elems
(semantic-tag-get-attribute (car rltags
) :value
)
246 prec
(semantic-tag-get-attribute (car rltags
) :prec
)
247 actn
(semantic-tag-get-attribute (car rltags
) :expr
)
249 (when elems
;; not an EMPTY rule
251 (setq elem
(car elems
)
253 (setq elem
(if (consp elem
) ;; mid-rule action
254 (wisent-grammar-expand-macros (read (car elem
)))
255 (semantic-grammar-item-value elem
)) ;; item
256 rule
(cons elem rule
)))
257 (setq rule
(nreverse rule
)))
259 (setq prec
(vector (semantic-grammar-item-value prec
))))
261 (setq sexp
(wisent-grammar-expand-macros (read actn
))))
264 (list rule prec sexp
)
269 (setq rules
(cons rule rules
)
270 rltags
(cdr rltags
)))
271 (setq nterms
(cons (cons (intern (semantic-tag-name (car nttags
)))
274 nttags
(cdr nttags
)))
277 (defun wisent-grammar-grammar ()
278 "Return Elisp form of the grammar."
279 (let* ((terminals (wisent-grammar-terminals))
280 (nonterminals (wisent-grammar-nonterminals))
281 (assocs (wisent-grammar-assocs)))
282 (cons terminals
(cons assocs nonterminals
))))
284 (defun wisent-grammar-parsetable-builder ()
285 "Return the value of the parser table."
287 ;; Ensure that the grammar [byte-]compiler is available.
288 (eval-when-compile (require 'semantic
/wisent
/comp
))
289 (wisent-compile-grammar
290 ',(wisent-grammar-grammar)
291 ',(semantic-grammar-start))))
293 (defun wisent-grammar-setupcode-builder ()
294 "Return the parser setup code."
296 "(semantic-install-function-overrides\n\
297 '((parse-stream . wisent-parse-stream)))\n\
298 (setq semantic-parser-name \"LALR\"\n\
299 semantic--parse-table %s\n\
300 semantic-debug-parser-source %S\n\
301 semantic-flex-keywords-obarray %s\n\
302 semantic-lex-types-obarray %s)\n\
303 ;; Collect unmatched syntax lexical tokens\n\
304 (semantic-make-local-hook 'wisent-discarding-token-functions)\n\
305 (add-hook 'wisent-discarding-token-functions\n\
306 'wisent-collect-unmatched-syntax nil t)"
307 (semantic-grammar-parsetable)
309 (semantic-grammar-keywordtable)
310 (semantic-grammar-tokentable)))
312 (defvar wisent-grammar-menu
314 ["LALR Compiler Verbose" wisent-toggle-verbose-flag
315 :style toggle
:active
(boundp 'wisent-verbose-flag
)
316 :selected
(and (boundp 'wisent-verbose-flag
)
317 wisent-verbose-flag
)]
319 "WY mode specific grammar menu.
320 Menu items are appended to the common grammar menu.")
322 (define-derived-mode wisent-grammar-mode semantic-grammar-mode
"WY"
323 "Major mode for editing Wisent grammars."
324 (semantic-grammar-setup-menu wisent-grammar-menu
)
325 (semantic-install-function-overrides
326 '((grammar-parsetable-builder . wisent-grammar-parsetable-builder
)
327 (grammar-setupcode-builder . wisent-grammar-setupcode-builder
)
330 (add-to-list 'auto-mode-alist
'("\\.wy$" . wisent-grammar-mode
))
332 (defvar-mode-local wisent-grammar-mode semantic-grammar-macros
334 (ASSOC . semantic-grammar-ASSOC
)
335 (EXPAND . wisent-grammar-EXPAND
)
336 (EXPANDFULL . wisent-grammar-EXPANDFULL
)
337 (TAG . wisent-grammar-TAG
)
338 (VARIABLE-TAG . wisent-grammar-VARIABLE-TAG
)
339 (FUNCTION-TAG . wisent-grammar-FUNCTION-TAG
)
340 (TYPE-TAG . wisent-grammar-TYPE-TAG
)
341 (INCLUDE-TAG . wisent-grammar-INCLUDE-TAG
)
342 (PACKAGE-TAG . wisent-grammar-PACKAGE-TAG
)
343 (EXPANDTAG . wisent-grammar-EXPANDTAG
)
344 (CODE-TAG . wisent-grammar-CODE-TAG
)
345 (ALIAS-TAG . wisent-grammar-ALIAS-TAG
)
346 (AST-ADD . wisent-grammar-AST-ADD
)
347 (AST-PUT . wisent-grammar-AST-PUT
)
348 (AST-GET . wisent-grammar-AST-GET
)
349 (AST-GET1 . wisent-grammar-AST-GET1
)
350 (AST-GET-STRING . wisent-grammar-AST-GET-STRING
)
351 (AST-MERGE . wisent-grammar-AST-MERGE
)
352 (SKIP-BLOCK . wisent-grammar-SKIP-BLOCK
)
353 (SKIP-TOKEN . wisent-grammar-SKIP-TOKEN
)
355 "Semantic grammar macros used in wisent grammars.")
357 ;;; wisent-grammar.el ends here