* lisp/files.el (auto-mode-alist): Add .by and .wy (Semantic grammars).
* cedet/semantic/bovine/grammar.el:
* cedet/semantic/wisent/grammar.el: Move from admin/grammars. Add
autoloads for bovine-grammar-mode and wisent-grammar-mode.
+2012-10-01 David Engster <deng@randomsample.de>
+
+ * grammars/bovine-grammar.el:
+ * grammars/wisent-grammar.el: Move to lisp directory.
+
2012-10-01 David Engster <deng@randomsample.de>
* grammars/bovine-grammar.el (bovine--grammar-newstyle-unquote):
+++ /dev/null
-;;; bovine-grammar.el --- Bovine's input grammar mode
-;;
-;; Copyright (C) 2002-2012 Free Software Foundation, Inc.
-;;
-;; Author: David Ponce <david@dponce.com>
-;; Maintainer: David Ponce <david@dponce.com>
-;; Created: 26 Aug 2002
-;; Keywords: syntax
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-;;
-;; Major mode for editing Bovine's input grammar (.by) files.
-
-;;; History:
-
-;;; Code:
-(require 'semantic)
-(require 'semantic/grammar)
-(require 'semantic/find)
-(require 'semantic/lex)
-(require 'semantic/wisent)
-(require 'semantic/bovine)
-
-(defun bovine-grammar-EXPAND (bounds nonterm)
- "Expand call to EXPAND grammar macro.
-Return the form to parse from within a nonterminal between BOUNDS.
-NONTERM is the nonterminal symbol to start with."
- `(semantic-bovinate-from-nonterminal
- (car ,bounds) (cdr ,bounds) ',nonterm))
-
-(defun bovine-grammar-EXPANDFULL (bounds nonterm)
- "Expand call to EXPANDFULL grammar macro.
-Return the form to recursively parse the area between BOUNDS.
-NONTERM is the nonterminal symbol to start with."
- `(semantic-parse-region
- (car ,bounds) (cdr ,bounds) ',nonterm 1))
-
-(defun bovine-grammar-TAG (name class &rest attributes)
- "Expand call to TAG grammar macro.
-Return the form to create a generic semantic tag.
-See the function `semantic-tag' for the meaning of arguments NAME,
-CLASS and ATTRIBUTES."
- `(semantic-tag ,name ,class ,@attributes))
-
-(defun bovine-grammar-VARIABLE-TAG (name type default-value &rest attributes)
- "Expand call to VARIABLE-TAG grammar macro.
-Return the form to create a semantic tag of class variable.
-See the function `semantic-tag-new-variable' for the meaning of
-arguments NAME, TYPE, DEFAULT-VALUE and ATTRIBUTES."
- `(semantic-tag-new-variable ,name ,type ,default-value ,@attributes))
-
-(defun bovine-grammar-FUNCTION-TAG (name type arg-list &rest attributes)
- "Expand call to FUNCTION-TAG grammar macro.
-Return the form to create a semantic tag of class function.
-See the function `semantic-tag-new-function' for the meaning of
-arguments NAME, TYPE, ARG-LIST and ATTRIBUTES."
- `(semantic-tag-new-function ,name ,type ,arg-list ,@attributes))
-
-(defun bovine-grammar-TYPE-TAG (name type members parents &rest attributes)
- "Expand call to TYPE-TAG grammar macro.
-Return the form to create a semantic tag of class type.
-See the function `semantic-tag-new-type' for the meaning of arguments
-NAME, TYPE, MEMBERS, PARENTS and ATTRIBUTES."
- `(semantic-tag-new-type ,name ,type ,members ,parents ,@attributes))
-
-(defun bovine-grammar-INCLUDE-TAG (name system-flag &rest attributes)
- "Expand call to INCLUDE-TAG grammar macro.
-Return the form to create a semantic tag of class include.
-See the function `semantic-tag-new-include' for the meaning of
-arguments NAME, SYSTEM-FLAG and ATTRIBUTES."
- `(semantic-tag-new-include ,name ,system-flag ,@attributes))
-
-(defun bovine-grammar-PACKAGE-TAG (name detail &rest attributes)
- "Expand call to PACKAGE-TAG grammar macro.
-Return the form to create a semantic tag of class package.
-See the function `semantic-tag-new-package' for the meaning of
-arguments NAME, DETAIL and ATTRIBUTES."
- `(semantic-tag-new-package ,name ,detail ,@attributes))
-
-(defun bovine-grammar-CODE-TAG (name detail &rest attributes)
- "Expand call to CODE-TAG grammar macro.
-Return the form to create a semantic tag of class code.
-See the function `semantic-tag-new-code' for the meaning of arguments
-NAME, DETAIL and ATTRIBUTES."
- `(semantic-tag-new-code ,name ,detail ,@attributes))
-
-(defun bovine-grammar-ALIAS-TAG (name aliasclass definition &rest attributes)
- "Expand call to ALIAS-TAG grammar macro.
-Return the form to create a semantic tag of class alias.
-See the function `semantic-tag-new-alias' for the meaning of arguments
-NAME, ALIASCLASS, DEFINITION and ATTRIBUTES."
- `(semantic-tag-new-alias ,name ,aliasclass ,definition ,@attributes))
-
-;; Cache of macro definitions currently in use.
-(defvar bovine--grammar-macros nil)
-
-(defun bovine-grammar-expand-form (form quotemode &optional inplace)
- "Expand FORM into a new one suitable to the bovine parser.
-FORM is a list in which we are substituting.
-Argument QUOTEMODE is non-nil if we are in backquote mode.
-When non-nil, optional argument INPLACE indicates that FORM is being
-expanded from elsewhere."
- (when (eq (car form) 'quote)
- (setq form (cdr form))
- (cond
- ((and (= (length form) 1) (listp (car form)))
- (insert "\n(append")
- (bovine-grammar-expand-form (car form) quotemode nil)
- (insert ")")
- (setq form nil inplace nil)
- )
- ((and (= (length form) 1) (symbolp (car form)))
- (insert "\n'" (symbol-name (car form)))
- (setq form nil inplace nil)
- )
- (t
- (insert "\n(list")
- (setq inplace t)
- )))
- (let ((macro (assq (car form) bovine--grammar-macros))
- inlist first n q x)
- (if macro
- (bovine-grammar-expand-form
- (apply (cdr macro) (cdr form))
- quotemode t)
- (if inplace (insert "\n("))
- (while form
- (setq first (car form)
- form (cdr form))
- ;; Hack for dealing with new reading of unquotes outside of
- ;; backquote (introduced in rev. 102591 in emacs-bzr).
- (when (and (>= emacs-major-version 24)
- (listp first)
- (or (equal (car first) '\,)
- (equal (car first) '\,@)))
- (if (listp (cadr first))
- (setq form (append (cdr first) form)
- first (car first))
- (setq first (intern (concat (symbol-name (car first))
- (symbol-name (cadr first)))))))
- (cond
- ((eq first nil)
- (when (and (not inlist) (not inplace))
- (insert "\n(list")
- (setq inlist t))
- (insert " nil")
- )
- ((listp first)
- ;;(let ((fn (and (symbolp (caar form)) (fboundp (caar form)))))
- (when (and (not inlist) (not inplace))
- (insert "\n(list")
- (setq inlist t))
- ;;(if (and inplace (not fn) (not (eq (caar form) 'EXPAND)))
- ;; (insert " (append"))
- (bovine-grammar-expand-form
- first quotemode t) ;;(and fn (not (eq fn 'quote))))
- ;;(if (and inplace (not fn) (not (eq (caar form) 'EXPAND)))
- ;; (insert ")"))
- ;;)
- )
- ((symbolp first)
- (setq n (symbol-name first) ;the name
- q quotemode ;implied quote flag
- x nil) ;expand flag
- (if (eq (aref n 0) ?,)
- (if quotemode
- ;; backquote mode needs the @
- (if (eq (aref n 1) ?@)
- (setq n (substring n 2)
- q nil
- x t)
- ;; non backquote mode behaves normally.
- (setq n (substring n 1)
- q nil))
- (setq n (substring n 1)
- x t)))
- (if (string= n "")
- (progn
- ;; We expand only the next item in place (a list?)
- ;; A regular inline-list...
- (bovine-grammar-expand-form (car form) quotemode t)
- (setq form (cdr form)))
- (if (and (eq (aref n 0) ?$)
- ;; Don't expand $ tokens in implied quote mode.
- ;; This acts like quoting in other symbols.
- (not q))
- (progn
- (cond
- ((and (not x) (not inlist) (not inplace))
- (insert "\n(list"))
- ((and x inlist (not inplace))
- (insert ")")
- (setq inlist nil)))
- (insert "\n(nth " (int-to-string
- (1- (string-to-number
- (substring n 1))))
- " vals)")
- (and (not x) (not inplace)
- (setq inlist t)))
-
- (when (and (not inlist) (not inplace))
- (insert "\n(list")
- (setq inlist t))
- (or (char-equal (char-before) ?\()
- (insert " "))
- (insert (if (or inplace (eq first t))
- "" "'")
- n))) ;; " "
- )
- (t
- (when (and (not inlist) (not inplace))
- (insert "\n(list")
- (setq inlist t))
- (insert (format "\n%S" first))
- )
- ))
- (if inlist (insert ")"))
- (if inplace (insert ")")))
- ))
-
-(defun bovine-grammar-expand-action (textform quotemode)
- "Expand semantic action string TEXTFORM into Lisp code.
-QUOTEMODE is the mode in which quoted symbols are slurred."
- (if (string= "" textform)
- nil
- (let ((sexp (read textform)))
- ;; We converted the lambda string into a list. Now write it
- ;; out as the bovine lambda expression, and do macro-like
- ;; conversion upon it.
- (insert "\n")
- (cond
- ((eq (car sexp) 'EXPAND)
- (insert ",(lambda (vals start end)")
- ;; The EXPAND macro definition is mandatory
- (bovine-grammar-expand-form
- (apply (cdr (assq 'EXPAND bovine--grammar-macros)) (cdr sexp))
- quotemode t)
- )
- ((and (listp (car sexp)) (eq (caar sexp) 'EVAL))
- ;; The user wants to evaluate the following args.
- ;; Use a simpler expander
- )
- (t
- (insert ",(semantic-lambda")
- (bovine-grammar-expand-form sexp quotemode)
- ))
- (insert ")\n")))
-)
-
-(defun bovine-grammar-parsetable-builder ()
- "Return the parser table expression as a string value.
-The format of a bovine parser table is:
-
- ( ( NONTERMINAL-SYMBOL1 MATCH-LIST1 )
- ( NONTERMINAL-SYMBOL2 MATCH-LIST2 )
- ...
- ( NONTERMINAL-SYMBOLn MATCH-LISTn )
-
-Where each NONTERMINAL-SYMBOL is an artificial symbol which can appear
-in any child state. As a starting place, one of the NONTERMINAL-SYMBOLS
-must be `bovine-toplevel'.
-
-A MATCH-LIST is a list of possible matches of the form:
-
- ( STATE-LIST1
- STATE-LIST2
- ...
- STATE-LISTN )
-
-where STATE-LIST is of the form:
- ( TYPE1 [ \"VALUE1\" ] TYPE2 [ \"VALUE2\" ] ... LAMBDA )
-
-where TYPE is one of the returned types of the token stream.
-VALUE is a value, or range of values to match against. For
-example, a SYMBOL might need to match \"foo\". Some TYPES will not
-have matching criteria.
-
-LAMBDA is a lambda expression which is evalled with the text of the
-type when it is found. It is passed the list of all buffer text
-elements found since the last lambda expression. It should return a
-semantic element (see below.)
-
-For consistency between languages, try to use common return values
-from your parser. Please reference the chapter \"Writing Parsers\" in
-the \"Language Support Developer's Guide -\" in the semantic texinfo
-manual."
- (let* ((start (semantic-grammar-start))
- (scopestart (semantic-grammar-scopestart))
- (quotemode (semantic-grammar-quotemode))
- (tags (semantic-find-tags-by-class
- 'token (current-buffer)))
- (nterms (semantic-find-tags-by-class
- 'nonterminal (current-buffer)))
- ;; Setup the cache of macro definitions.
- (bovine--grammar-macros (semantic-grammar-macros))
- nterm rules items item actn prec tag type regex)
-
- ;; Check some trivial things
- (cond
- ((null nterms)
- (error "Bad input grammar"))
- (start
- (if (cdr start)
- (message "Extra start symbols %S ignored" (cdr start)))
- (setq start (symbol-name (car start)))
- (unless (semantic-find-first-tag-by-name start nterms)
- (error "start symbol `%s' has no rule" start)))
- (t
- ;; Default to the first grammar rule.
- (setq start (semantic-tag-name (car nterms)))))
- (when scopestart
- (setq scopestart (symbol-name scopestart))
- (unless (semantic-find-first-tag-by-name scopestart nterms)
- (error "scopestart symbol `%s' has no rule" scopestart)))
-
- ;; Generate the grammar Lisp form.
- (with-temp-buffer
- (erase-buffer)
- (insert "`(")
- ;; Insert the start/scopestart rules
- (insert "\n(bovine-toplevel \n("
- start
- ")\n) ;; end bovine-toplevel\n")
- (when scopestart
- (insert "\n(bovine-inner-scope \n("
- scopestart
- ")\n) ;; end bovine-inner-scope\n"))
- ;; Process each nonterminal
- (while nterms
- (setq nterm (car nterms)
- ;; We can't use the override form because the current buffer
- ;; is not the originator of the tag.
- rules (semantic-tag-components-semantic-grammar-mode nterm)
- nterm (semantic-tag-name nterm)
- nterms (cdr nterms))
- (when (member nterm '("bovine-toplevel" "bovine-inner-scope"))
- (error "`%s' is a reserved internal name" nterm))
- (insert "\n(" nterm)
- ;; Process each rule
- (while rules
- (setq items (semantic-tag-get-attribute (car rules) :value)
- prec (semantic-tag-get-attribute (car rules) :prec)
- actn (semantic-tag-get-attribute (car rules) :expr)
- rules (cdr rules))
- ;; Process each item
- (insert "\n(")
- (if (null items)
- ;; EMPTY rule
- (insert ";;EMPTY" (if actn "" "\n"))
- ;; Expand items
- (while items
- (setq item (car items)
- items (cdr items))
- (if (consp item) ;; mid-rule action
- (message "Mid-rule action %S ignored" item)
- (or (char-equal (char-before) ?\()
- (insert "\n"))
- (cond
- ((member item '("bovine-toplevel" "bovine-inner-scope"))
- (error "`%s' is a reserved internal name" item))
- ;; Replace ITEM by its %token definition.
- ;; If a '%token TYPE ITEM [REGEX]' definition exists
- ;; in the grammar, ITEM is replaced by TYPE [REGEX].
- ((setq tag (semantic-find-first-tag-by-name
- item tags)
- type (semantic-tag-get-attribute tag :type))
- (insert type)
- (if (setq regex (semantic-tag-get-attribute tag :value))
- (insert (format "\n%S" regex))))
- ;; Don't change ITEM
- (t
- (insert (semantic-grammar-item-text item)))
- ))))
- (if prec
- (message "%%prec %S ignored" prec))
- (if actn
- (bovine-grammar-expand-action actn quotemode))
- (insert ")"))
- (insert "\n) ;; end " nterm "\n"))
- (insert ")\n")
- (buffer-string))))
-
-(defun bovine-grammar-setupcode-builder ()
- "Return the text of the setup code."
- (format
- "(setq semantic--parse-table %s\n\
- semantic-debug-parser-source %S\n\
- semantic-debug-parser-class 'semantic-bovine-debug-parser
- semantic-flex-keywords-obarray %s\n\
- %s)"
- (semantic-grammar-parsetable)
- (buffer-name)
- (semantic-grammar-keywordtable)
- (let ((mode (semantic-grammar-languagemode)))
- ;; Is there more than one major mode?
- (if (and (listp mode) (> (length mode) 1))
- (format "semantic-equivalent-major-modes '%S\n" mode)
- ""))))
-
-(defvar bovine-grammar-menu
- '("BY Grammar"
- )
- "BY mode specific grammar menu.
-Menu items are appended to the common grammar menu.")
-
-(define-derived-mode bovine-grammar-mode semantic-grammar-mode "BY"
- "Major mode for editing Bovine grammars."
- (semantic-grammar-setup-menu bovine-grammar-menu)
- (semantic-install-function-overrides
- '((grammar-parsetable-builder . bovine-grammar-parsetable-builder)
- (grammar-setupcode-builder . bovine-grammar-setupcode-builder)
- )))
-
-(add-to-list 'auto-mode-alist '("\\.by\\'" . bovine-grammar-mode))
-
-(defvar-mode-local bovine-grammar-mode semantic-grammar-macros
- '(
- (ASSOC . semantic-grammar-ASSOC)
- (EXPAND . bovine-grammar-EXPAND)
- (EXPANDFULL . bovine-grammar-EXPANDFULL)
- (TAG . bovine-grammar-TAG)
- (VARIABLE-TAG . bovine-grammar-VARIABLE-TAG)
- (FUNCTION-TAG . bovine-grammar-FUNCTION-TAG)
- (TYPE-TAG . bovine-grammar-TYPE-TAG)
- (INCLUDE-TAG . bovine-grammar-INCLUDE-TAG)
- (PACKAGE-TAG . bovine-grammar-PACKAGE-TAG)
- (CODE-TAG . bovine-grammar-CODE-TAG)
- (ALIAS-TAG . bovine-grammar-ALIAS-TAG)
- )
- "Semantic grammar macros used in bovine grammars.")
-
-(provide 'semantic/bovine/grammar)
-
-(defun bovine-make-parsers ()
- "Generate Emacs' built-in Bovine-based parser files."
- (interactive)
- (semantic-mode 1)
- ;; Loop through each .by file in current directory, and run
- ;; `semantic-grammar-batch-build-one-package' to build the grammar.
- (dolist (f (directory-files default-directory nil "\\.by\\'"))
- (let ((packagename
- (condition-case err
- (with-current-buffer (find-file-noselect f)
- (semantic-grammar-create-package))
- (error (message "%s" (error-message-string err)) nil)))
- lang filename)
- (when (and packagename
- (string-match "^.*/\\(.*\\)-by\\.el\\'" packagename))
- (setq lang (match-string 1 packagename))
- (setq filename (concat lang "-by.el"))
- (with-temp-buffer
- (insert-file-contents filename)
- (setq buffer-file-name (expand-file-name filename))
- ;; Fix copyright header:
- (goto-char (point-min))
- (re-search-forward "^;; Author:")
- (setq copyright-end (match-beginning 0))
- (re-search-forward "^;;; Code:\n")
- (delete-region copyright-end (match-end 0))
- (goto-char copyright-end)
- (insert ";; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-;;
-;; This file was generated from admin/grammars/"
- lang ".by.
-
-;;; Code:
-")
- (goto-char (point-min))
- (delete-region (point-min) (line-end-position))
- (insert ";;; " packagename
- " --- Generated parser support file")
- (delete-trailing-whitespace)
- (re-search-forward ";;; \\(.*\\) ends here")
- (replace-match packagename nil nil nil 1)
- (save-buffer))))))
-
-;;; bovine-grammar.el ends here
+++ /dev/null
-;;; wisent-grammar.el --- Wisent's input grammar mode
-
-;; Copyright (C) 2002-2012 Free Software Foundation, Inc.
-;;
-;; Author: David Ponce <david@dponce.com>
-;; Maintainer: David Ponce <david@dponce.com>
-;; Created: 26 Aug 2002
-;; Keywords: syntax
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-;;
-;; Major mode for editing Wisent's input grammar (.wy) files.
-
-;;; Code:
-(require 'semantic)
-(require 'semantic/grammar)
-(require 'semantic/find)
-(require 'semantic/lex)
-(require 'semantic/wisent)
-(require 'semantic/bovine)
-
-(defsubst wisent-grammar-region-placeholder (symb)
- "Given a $N placeholder symbol in SYMB, return a $regionN symbol.
-Return nil if $N is not a valid placeholder symbol."
- (let ((n (symbol-name symb)))
- (if (string-match "^[$]\\([1-9][0-9]*\\)$" n)
- (intern (concat "$region" (match-string 1 n))))))
-
-(defun wisent-grammar-EXPAND (symb nonterm)
- "Expand call to EXPAND grammar macro.
-Return the form to parse from within a nonterminal.
-SYMB is a $I placeholder symbol that gives the bounds of the area to
-parse.
-NONTERM is the nonterminal symbol to start with."
- (unless (member nonterm (semantic-grammar-start))
- (error "EXPANDFULL macro called with %s, but not used with %%start"
- nonterm))
- (let (($ri (wisent-grammar-region-placeholder symb)))
- (if $ri
- `(semantic-bovinate-from-nonterminal
- (car ,$ri) (cdr ,$ri) ',nonterm)
- (error "Invalid form (EXPAND %s %s)" symb nonterm))))
-
-(defun wisent-grammar-EXPANDFULL (symb nonterm)
- "Expand call to EXPANDFULL grammar macro.
-Return the form to recursively parse an area.
-SYMB is a $I placeholder symbol that gives the bounds of the area.
-NONTERM is the nonterminal symbol to start with."
- (unless (member nonterm (semantic-grammar-start))
- (error "EXPANDFULL macro called with %s, but not used with %%start"
- nonterm))
- (let (($ri (wisent-grammar-region-placeholder symb)))
- (if $ri
- `(semantic-parse-region
- (car ,$ri) (cdr ,$ri) ',nonterm 1)
- (error "Invalid form (EXPANDFULL %s %s)" symb nonterm))))
-
-(defun wisent-grammar-TAG (name class &rest attributes)
- "Expand call to TAG grammar macro.
-Return the form to create a generic semantic tag.
-See the function `semantic-tag' for the meaning of arguments NAME,
-CLASS and ATTRIBUTES."
- `(wisent-raw-tag
- (semantic-tag ,name ,class ,@attributes)))
-
-(defun wisent-grammar-VARIABLE-TAG (name type default-value &rest attributes)
- "Expand call to VARIABLE-TAG grammar macro.
-Return the form to create a semantic tag of class variable.
-See the function `semantic-tag-new-variable' for the meaning of
-arguments NAME, TYPE, DEFAULT-VALUE and ATTRIBUTES."
- `(wisent-raw-tag
- (semantic-tag-new-variable ,name ,type ,default-value ,@attributes)))
-
-(defun wisent-grammar-FUNCTION-TAG (name type arg-list &rest attributes)
- "Expand call to FUNCTION-TAG grammar macro.
-Return the form to create a semantic tag of class function.
-See the function `semantic-tag-new-function' for the meaning of
-arguments NAME, TYPE, ARG-LIST and ATTRIBUTES."
- `(wisent-raw-tag
- (semantic-tag-new-function ,name ,type ,arg-list ,@attributes)))
-
-(defun wisent-grammar-TYPE-TAG (name type members parents &rest attributes)
- "Expand call to TYPE-TAG grammar macro.
-Return the form to create a semantic tag of class type.
-See the function `semantic-tag-new-type' for the meaning of arguments
-NAME, TYPE, MEMBERS, PARENTS and ATTRIBUTES."
- `(wisent-raw-tag
- (semantic-tag-new-type ,name ,type ,members ,parents ,@attributes)))
-
-(defun wisent-grammar-INCLUDE-TAG (name system-flag &rest attributes)
- "Expand call to INCLUDE-TAG grammar macro.
-Return the form to create a semantic tag of class include.
-See the function `semantic-tag-new-include' for the meaning of
-arguments NAME, SYSTEM-FLAG and ATTRIBUTES."
- `(wisent-raw-tag
- (semantic-tag-new-include ,name ,system-flag ,@attributes)))
-
-(defun wisent-grammar-PACKAGE-TAG (name detail &rest attributes)
- "Expand call to PACKAGE-TAG grammar macro.
-Return the form to create a semantic tag of class package.
-See the function `semantic-tag-new-package' for the meaning of
-arguments NAME, DETAIL and ATTRIBUTES."
- `(wisent-raw-tag
- (semantic-tag-new-package ,name ,detail ,@attributes)))
-
-(defun wisent-grammar-CODE-TAG (name detail &rest attributes)
- "Expand call to CODE-TAG grammar macro.
-Return the form to create a semantic tag of class code.
-See the function `semantic-tag-new-code' for the meaning of arguments
-NAME, DETAIL and ATTRIBUTES."
- `(wisent-raw-tag
- (semantic-tag-new-code ,name ,detail ,@attributes)))
-
-(defun wisent-grammar-ALIAS-TAG (name aliasclass definition &rest attributes)
- "Expand call to ALIAS-TAG grammar macro.
-Return the form to create a semantic tag of class alias.
-See the function `semantic-tag-new-alias' for the meaning of arguments
-NAME, ALIASCLASS, DEFINITION and ATTRIBUTES."
- `(wisent-raw-tag
- (semantic-tag-new-alias ,name ,aliasclass ,definition ,@attributes)))
-
-(defun wisent-grammar-EXPANDTAG (raw-tag)
- "Expand call to EXPANDTAG grammar macro.
-Return the form to produce a list of cooked tags from raw form of
-Semantic tag RAW-TAG."
- `(wisent-cook-tag ,raw-tag))
-
-(defun wisent-grammar-AST-ADD (ast &rest nodes)
- "Expand call to AST-ADD grammar macro.
-Return the form to update the abstract syntax tree AST with NODES.
-See also the function `semantic-ast-add'."
- `(semantic-ast-add ,ast ,@nodes))
-
-(defun wisent-grammar-AST-PUT (ast &rest nodes)
- "Expand call to AST-PUT grammar macro.
-Return the form to update the abstract syntax tree AST with NODES.
-See also the function `semantic-ast-put'."
- `(semantic-ast-put ,ast ,@nodes))
-
-(defun wisent-grammar-AST-GET (ast node)
- "Expand call to AST-GET grammar macro.
-Return the form to get, from the abstract syntax tree AST, the value
-of NODE.
-See also the function `semantic-ast-get'."
- `(semantic-ast-get ,ast ,node))
-
-(defun wisent-grammar-AST-GET1 (ast node)
- "Expand call to AST-GET1 grammar macro.
-Return the form to get, from the abstract syntax tree AST, the first
-value of NODE.
-See also the function `semantic-ast-get1'."
- `(semantic-ast-get1 ,ast ,node))
-
-(defun wisent-grammar-AST-GET-STRING (ast node)
- "Expand call to AST-GET-STRING grammar macro.
-Return the form to get, from the abstract syntax tree AST, the value
-of NODE as a string.
-See also the function `semantic-ast-get-string'."
- `(semantic-ast-get-string ,ast ,node))
-
-(defun wisent-grammar-AST-MERGE (ast1 ast2)
- "Expand call to AST-MERGE grammar macro.
-Return the form to merge the abstract syntax trees AST1 and AST2.
-See also the function `semantic-ast-merge'."
- `(semantic-ast-merge ,ast1 ,ast2))
-
-(defun wisent-grammar-SKIP-BLOCK (&optional symb)
- "Expand call to SKIP-BLOCK grammar macro.
-Return the form to skip a parenthesized block.
-Optional argument SYMB is a $I placeholder symbol that gives the
-bounds of the block to skip. By default, skip the block at `$1'.
-See also the function `wisent-skip-block'."
- (let ($ri)
- (when symb
- (unless (setq $ri (wisent-grammar-region-placeholder symb))
- (error "Invalid form (SKIP-BLOCK %s)" symb)))
- `(wisent-skip-block ,$ri)))
-
-(defun wisent-grammar-SKIP-TOKEN ()
- "Expand call to SKIP-TOKEN grammar macro.
-Return the form to skip the lookahead token.
-See also the function `wisent-skip-token'."
- `(wisent-skip-token))
-
-(defun wisent-grammar-assocs ()
- "Return associativity and precedence level definitions."
- (mapcar
- #'(lambda (tag)
- (cons (intern (semantic-tag-name tag))
- (mapcar #'semantic-grammar-item-value
- (semantic-tag-get-attribute tag :value))))
- (semantic-find-tags-by-class 'assoc (current-buffer))))
-
-(defun wisent-grammar-terminals ()
- "Return the list of terminal symbols.
-Keep order of declaration in the WY file without duplicates."
- (let (terms)
- (mapc
- #'(lambda (tag)
- (mapcar #'(lambda (name)
- (add-to-list 'terms (intern name)))
- (cons (semantic-tag-name tag)
- (semantic-tag-get-attribute tag :rest))))
- (semantic--find-tags-by-function
- #'(lambda (tag)
- (memq (semantic-tag-class tag) '(token keyword)))
- (current-buffer)))
- (nreverse terms)))
-
-;; Cache of macro definitions currently in use.
-(defvar wisent--grammar-macros nil)
-
-(defun wisent-grammar-expand-macros (expr)
- "Expand expression EXPR into a form without grammar macros.
-Return the expanded expression."
- (if (or (atom expr) (semantic-grammar-quote-p (car expr)))
- expr ;; Just return atom or quoted expression.
- (let* ((expr (mapcar 'wisent-grammar-expand-macros expr))
- (macro (assq (car expr) wisent--grammar-macros)))
- (if macro ;; Expand Semantic built-in.
- (apply (cdr macro) (cdr expr))
- expr))))
-
-(defun wisent-grammar-nonterminals ()
- "Return the list form of nonterminal definitions."
- (let ((nttags (semantic-find-tags-by-class
- 'nonterminal (current-buffer)))
- ;; Setup the cache of macro definitions.
- (wisent--grammar-macros (semantic-grammar-macros))
- rltags nterms rules rule elems elem actn sexp prec)
- (while nttags
- (setq rltags (semantic-tag-components (car nttags))
- rules nil)
- (while rltags
- (setq elems (semantic-tag-get-attribute (car rltags) :value)
- prec (semantic-tag-get-attribute (car rltags) :prec)
- actn (semantic-tag-get-attribute (car rltags) :expr)
- rule nil)
- (when elems ;; not an EMPTY rule
- (while elems
- (setq elem (car elems)
- elems (cdr elems))
- (setq elem (if (consp elem) ;; mid-rule action
- (wisent-grammar-expand-macros (read (car elem)))
- (semantic-grammar-item-value elem)) ;; item
- rule (cons elem rule)))
- (setq rule (nreverse rule)))
- (if prec
- (setq prec (vector (semantic-grammar-item-value prec))))
- (if actn
- (setq sexp (wisent-grammar-expand-macros (read actn))))
- (setq rule (if actn
- (if prec
- (list rule prec sexp)
- (list rule sexp))
- (if prec
- (list rule prec)
- (list rule))))
- (setq rules (cons rule rules)
- rltags (cdr rltags)))
- (setq nterms (cons (cons (intern (semantic-tag-name (car nttags)))
- (nreverse rules))
- nterms)
- nttags (cdr nttags)))
- (nreverse nterms)))
-
-(defun wisent-grammar-grammar ()
- "Return Elisp form of the grammar."
- (let* ((terminals (wisent-grammar-terminals))
- (nonterminals (wisent-grammar-nonterminals))
- (assocs (wisent-grammar-assocs)))
- (cons terminals (cons assocs nonterminals))))
-
-(defun wisent-grammar-parsetable-builder ()
- "Return the value of the parser table."
- `(progn
- ;; Ensure that the grammar [byte-]compiler is available.
- (eval-when-compile (require 'semantic/wisent/comp))
- (wisent-compile-grammar
- ',(wisent-grammar-grammar)
- ',(semantic-grammar-start))))
-
-(defun wisent-grammar-setupcode-builder ()
- "Return the parser setup code."
- (format
- "(semantic-install-function-overrides\n\
- '((parse-stream . wisent-parse-stream)))\n\
- (setq semantic-parser-name \"LALR\"\n\
- semantic--parse-table %s\n\
- semantic-debug-parser-source %S\n\
- semantic-flex-keywords-obarray %s\n\
- semantic-lex-types-obarray %s)\n\
- ;; Collect unmatched syntax lexical tokens\n\
- (semantic-make-local-hook 'wisent-discarding-token-functions)\n\
- (add-hook 'wisent-discarding-token-functions\n\
- 'wisent-collect-unmatched-syntax nil t)"
- (semantic-grammar-parsetable)
- (buffer-name)
- (semantic-grammar-keywordtable)
- (semantic-grammar-tokentable)))
-
-(defvar wisent-grammar-menu
- '("WY Grammar"
- ["LALR Compiler Verbose" wisent-toggle-verbose-flag
- :style toggle :active (boundp 'wisent-verbose-flag)
- :selected (and (boundp 'wisent-verbose-flag)
- wisent-verbose-flag)]
- )
- "WY mode specific grammar menu.
-Menu items are appended to the common grammar menu.")
-
-(define-derived-mode wisent-grammar-mode semantic-grammar-mode "WY"
- "Major mode for editing Wisent grammars."
- (semantic-grammar-setup-menu wisent-grammar-menu)
- (semantic-install-function-overrides
- '((grammar-parsetable-builder . wisent-grammar-parsetable-builder)
- (grammar-setupcode-builder . wisent-grammar-setupcode-builder)
- )))
-
-(add-to-list 'auto-mode-alist '("\\.wy\\'" . wisent-grammar-mode))
-
-(defvar-mode-local wisent-grammar-mode semantic-grammar-macros
- '(
- (ASSOC . semantic-grammar-ASSOC)
- (EXPAND . wisent-grammar-EXPAND)
- (EXPANDFULL . wisent-grammar-EXPANDFULL)
- (TAG . wisent-grammar-TAG)
- (VARIABLE-TAG . wisent-grammar-VARIABLE-TAG)
- (FUNCTION-TAG . wisent-grammar-FUNCTION-TAG)
- (TYPE-TAG . wisent-grammar-TYPE-TAG)
- (INCLUDE-TAG . wisent-grammar-INCLUDE-TAG)
- (PACKAGE-TAG . wisent-grammar-PACKAGE-TAG)
- (EXPANDTAG . wisent-grammar-EXPANDTAG)
- (CODE-TAG . wisent-grammar-CODE-TAG)
- (ALIAS-TAG . wisent-grammar-ALIAS-TAG)
- (AST-ADD . wisent-grammar-AST-ADD)
- (AST-PUT . wisent-grammar-AST-PUT)
- (AST-GET . wisent-grammar-AST-GET)
- (AST-GET1 . wisent-grammar-AST-GET1)
- (AST-GET-STRING . wisent-grammar-AST-GET-STRING)
- (AST-MERGE . wisent-grammar-AST-MERGE)
- (SKIP-BLOCK . wisent-grammar-SKIP-BLOCK)
- (SKIP-TOKEN . wisent-grammar-SKIP-TOKEN)
- )
- "Semantic grammar macros used in wisent grammars.")
-
-(defvar wisent-make-parsers--emacs-license
- ";; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.")
-
-(defvar wisent-make-parsers--python-license
- ";; It is derived in part from the Python grammar, used under the
-;; following license:
-;;
-;; PYTHON SOFTWARE FOUNDATION LICENSE VERSION 2
-;; --------------------------------------------
-;; 1. This LICENSE AGREEMENT is between the Python Software Foundation
-;; (\"PSF\"), and the Individual or Organization (\"Licensee\") accessing
-;; and otherwise using this software (\"Python\") in source or binary
-;; form and its associated documentation.
-;;
-;; 2. Subject to the terms and conditions of this License Agreement,
-;; PSF hereby grants Licensee a nonexclusive, royalty-free, world-wide
-;; license to reproduce, analyze, test, perform and/or display
-;; publicly, prepare derivative works, distribute, and otherwise use
-;; Python alone or in any derivative version, provided, however, that
-;; PSF's License Agreement and PSF's notice of copyright, i.e.,
-;; \"Copyright (c) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
-;; 2009, 2010 Python Software Foundation; All Rights Reserved\" are
-;; retained in Python alone or in any derivative version prepared by
-;; Licensee.
-;;
-;; 3. In the event Licensee prepares a derivative work that is based
-;; on or incorporates Python or any part thereof, and wants to make
-;; the derivative work available to others as provided herein, then
-;; Licensee hereby agrees to include in any such work a brief summary
-;; of the changes made to Python.
-;;
-;; 4. PSF is making Python available to Licensee on an \"AS IS\"
-;; basis. PSF MAKES NO REPRESENTATIONS OR WARRANTIES, EXPRESS OR
-;; IMPLIED. BY WAY OF EXAMPLE, BUT NOT LIMITATION, PSF MAKES NO AND
-;; DISCLAIMS ANY REPRESENTATION OR WARRANTY OF MERCHANTABILITY OR FITNESS
-;; FOR ANY PARTICULAR PURPOSE OR THAT THE USE OF PYTHON WILL NOT
-;; INFRINGE ANY THIRD PARTY RIGHTS.
-;;
-;; 5. PSF SHALL NOT BE LIABLE TO LICENSEE OR ANY OTHER USERS OF PYTHON
-;; FOR ANY INCIDENTAL, SPECIAL, OR CONSEQUENTIAL DAMAGES OR LOSS AS A
-;; RESULT OF MODIFYING, DISTRIBUTING, OR OTHERWISE USING PYTHON, OR
-;; ANY DERIVATIVE THEREOF, EVEN IF ADVISED OF THE POSSIBILITY THEREOF.
-;;
-;; 6. This License Agreement will automatically terminate upon a
-;; material breach of its terms and conditions.
-;;
-;; 7. Nothing in this License Agreement shall be deemed to create any
-;; relationship of agency, partnership, or joint venture between PSF
-;; and Licensee. This License Agreement does not grant permission to
-;; use PSF trademarks or trade name in a trademark sense to endorse or
-;; promote products or services of Licensee, or any third party.
-;;
-;; 8. By copying, installing or otherwise using Python, Licensee
-;; agrees to be bound by the terms and conditions of this License
-;; Agreement.")
-
-(defvar wisent-make-parsers--ecmascript-license
- "\n;; It is derived from the grammar in the ECMAScript Language
-;; Specification published at
-;;
-;; http://www.ecma-international.org/publications/standards/Ecma-262.htm
-;;
-;; and redistributed under the following license:
-;;
-;; Redistribution and use in source and binary forms, with or without
-;; modification, are permitted provided that the following conditions
-;; are met:
-;;
-;; 1. Redistributions of source code must retain the above copyright
-;; notice, this list of conditions and the following disclaimer.
-;;
-;; 2. Redistributions in binary form must reproduce the above
-;; copyright notice, this list of conditions and the following
-;; disclaimer in the documentation and/or other materials provided
-;; with the distribution.
-;;
-;; 3. Neither the name of the authors nor Ecma International may be
-;; used to endorse or promote products derived from this software
-;; without specific prior written permission. THIS SOFTWARE IS
-;; PROVIDED BY THE ECMA INTERNATIONAL \"AS IS\" AND ANY EXPRESS OR
-;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-;; ARE DISCLAIMED. IN NO EVENT SHALL ECMA INTERNATIONAL BE LIABLE FOR
-;; ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT
-;; OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
-;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
-;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
-;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE
-;; USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
-;; DAMAGE.")
-
-(defvar wisent-make-parsers--parser-file-name
- `(("semantic/grammar-wy.el")
- ("srecode/srt-wy.el")
- ("semantic/wisent/js-wy.el"
- "Copyright (C) 1998-2011 Ecma International."
- ,wisent-make-parsers--ecmascript-license)
- ("semantic/wisent/javat-wy.el")
- ("semantic/wisent/python-wy.el"
- "Copyright (c) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
-\;; 2009, 2010 Python Software Foundation; All Rights Reserved"
- ,wisent-make-parsers--python-license)))
-
-(defun wisent-make-parsers ()
- "Generate Emacs' built-in Wisent-based parser files."
- (interactive)
- (semantic-mode 1)
- ;; Loop through each .wy file in current directory, and run
- ;; `semantic-grammar-batch-build-one-package' to build the grammar.
- (dolist (f (directory-files default-directory nil "\\.wy\\'"))
- (let ((packagename
- (condition-case err
- (with-current-buffer (find-file-noselect f)
- (semantic-grammar-create-package))
- (error (message "%s" (error-message-string err)) nil)))
- output-data)
- (when (setq output-data (assoc packagename wisent-make-parsers--parser-file-name))
- (let ((additional-copyright (nth 1 output-data))
- (additional-license (nth 2 output-data))
- (filename (progn (string-match ".*/\\(.*\\)" packagename) (match-string 1 packagename)))
- copyright-end)
- ;; Touch up the generated parsers for Emacs integration.
- (with-temp-buffer
- (insert-file-contents filename)
- ;; Fix copyright header:
- (goto-char (point-min))
- (when additional-copyright
- (re-search-forward "Copyright (C).*$")
- (insert "\n;; " additional-copyright))
- (re-search-forward "^;; Author:")
- (setq copyright-end (match-beginning 0))
- (re-search-forward "^;;; Code:\n")
- (delete-region copyright-end (match-end 0))
- (goto-char copyright-end)
- (insert wisent-make-parsers--emacs-license)
- (insert "\n\n;;; Commentary:
-;;
-;; This file was generated from admin/grammars/"
- f ".")
- (when additional-license
- (insert "\n" additional-license))
- (insert "\n\n;;; Code:\n")
- (goto-char (point-min))
- (delete-region (point-min) (line-end-position))
- (insert ";;; " packagename
- " --- Generated parser support file")
- (re-search-forward ";;; \\(.*\\) ends here")
- (replace-match packagename nil nil nil 1)
- (delete-trailing-whitespace)
- (write-region nil nil (expand-file-name filename))))))))
-
-;;; wisent-grammar.el ends here
+2012-10-06 Chong Yidong <cyd@gnu.org>
+
+ * files.el (auto-mode-alist): Add .by and .wy (Semantic grammars).
+
2012-10-06 Ikumi Keita <ikumi@ikumi.que.jp> (tiny change)
* international/characters.el: Fix simple mistake ((car chars) ->
+2012-10-06 Chong Yidong <cyd@gnu.org>
+
+ * semantic/bovine/grammar.el:
+ * semantic/wisent/grammar.el: Move from admin/grammars. Add
+ autoloads for bovine-grammar-mode and wisent-grammar-mode.
+
2012-10-02 Chong Yidong <cyd@gnu.org>
* srecode.el, ede.el: Restore Version header.
--- /dev/null
+;;; semantic/bovine/grammar.el --- Bovine's input grammar mode
+;;
+;; Copyright (C) 2002-2012 Free Software Foundation, Inc.
+;;
+;; Author: David Ponce <david@dponce.com>
+;; Maintainer: David Ponce <david@dponce.com>
+;; Created: 26 Aug 2002
+;; Keywords: syntax
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; Major mode for editing Bovine's input grammar (.by) files.
+
+;;; History:
+
+;;; Code:
+(require 'semantic)
+(require 'semantic/grammar)
+(require 'semantic/find)
+(require 'semantic/lex)
+(require 'semantic/wisent)
+(require 'semantic/bovine)
+
+(defun bovine-grammar-EXPAND (bounds nonterm)
+ "Expand call to EXPAND grammar macro.
+Return the form to parse from within a nonterminal between BOUNDS.
+NONTERM is the nonterminal symbol to start with."
+ `(semantic-bovinate-from-nonterminal
+ (car ,bounds) (cdr ,bounds) ',nonterm))
+
+(defun bovine-grammar-EXPANDFULL (bounds nonterm)
+ "Expand call to EXPANDFULL grammar macro.
+Return the form to recursively parse the area between BOUNDS.
+NONTERM is the nonterminal symbol to start with."
+ `(semantic-parse-region
+ (car ,bounds) (cdr ,bounds) ',nonterm 1))
+
+(defun bovine-grammar-TAG (name class &rest attributes)
+ "Expand call to TAG grammar macro.
+Return the form to create a generic semantic tag.
+See the function `semantic-tag' for the meaning of arguments NAME,
+CLASS and ATTRIBUTES."
+ `(semantic-tag ,name ,class ,@attributes))
+
+(defun bovine-grammar-VARIABLE-TAG (name type default-value &rest attributes)
+ "Expand call to VARIABLE-TAG grammar macro.
+Return the form to create a semantic tag of class variable.
+See the function `semantic-tag-new-variable' for the meaning of
+arguments NAME, TYPE, DEFAULT-VALUE and ATTRIBUTES."
+ `(semantic-tag-new-variable ,name ,type ,default-value ,@attributes))
+
+(defun bovine-grammar-FUNCTION-TAG (name type arg-list &rest attributes)
+ "Expand call to FUNCTION-TAG grammar macro.
+Return the form to create a semantic tag of class function.
+See the function `semantic-tag-new-function' for the meaning of
+arguments NAME, TYPE, ARG-LIST and ATTRIBUTES."
+ `(semantic-tag-new-function ,name ,type ,arg-list ,@attributes))
+
+(defun bovine-grammar-TYPE-TAG (name type members parents &rest attributes)
+ "Expand call to TYPE-TAG grammar macro.
+Return the form to create a semantic tag of class type.
+See the function `semantic-tag-new-type' for the meaning of arguments
+NAME, TYPE, MEMBERS, PARENTS and ATTRIBUTES."
+ `(semantic-tag-new-type ,name ,type ,members ,parents ,@attributes))
+
+(defun bovine-grammar-INCLUDE-TAG (name system-flag &rest attributes)
+ "Expand call to INCLUDE-TAG grammar macro.
+Return the form to create a semantic tag of class include.
+See the function `semantic-tag-new-include' for the meaning of
+arguments NAME, SYSTEM-FLAG and ATTRIBUTES."
+ `(semantic-tag-new-include ,name ,system-flag ,@attributes))
+
+(defun bovine-grammar-PACKAGE-TAG (name detail &rest attributes)
+ "Expand call to PACKAGE-TAG grammar macro.
+Return the form to create a semantic tag of class package.
+See the function `semantic-tag-new-package' for the meaning of
+arguments NAME, DETAIL and ATTRIBUTES."
+ `(semantic-tag-new-package ,name ,detail ,@attributes))
+
+(defun bovine-grammar-CODE-TAG (name detail &rest attributes)
+ "Expand call to CODE-TAG grammar macro.
+Return the form to create a semantic tag of class code.
+See the function `semantic-tag-new-code' for the meaning of arguments
+NAME, DETAIL and ATTRIBUTES."
+ `(semantic-tag-new-code ,name ,detail ,@attributes))
+
+(defun bovine-grammar-ALIAS-TAG (name aliasclass definition &rest attributes)
+ "Expand call to ALIAS-TAG grammar macro.
+Return the form to create a semantic tag of class alias.
+See the function `semantic-tag-new-alias' for the meaning of arguments
+NAME, ALIASCLASS, DEFINITION and ATTRIBUTES."
+ `(semantic-tag-new-alias ,name ,aliasclass ,definition ,@attributes))
+
+;; Cache of macro definitions currently in use.
+(defvar bovine--grammar-macros nil)
+
+(defun bovine-grammar-expand-form (form quotemode &optional inplace)
+ "Expand FORM into a new one suitable to the bovine parser.
+FORM is a list in which we are substituting.
+Argument QUOTEMODE is non-nil if we are in backquote mode.
+When non-nil, optional argument INPLACE indicates that FORM is being
+expanded from elsewhere."
+ (when (eq (car form) 'quote)
+ (setq form (cdr form))
+ (cond
+ ((and (= (length form) 1) (listp (car form)))
+ (insert "\n(append")
+ (bovine-grammar-expand-form (car form) quotemode nil)
+ (insert ")")
+ (setq form nil inplace nil)
+ )
+ ((and (= (length form) 1) (symbolp (car form)))
+ (insert "\n'" (symbol-name (car form)))
+ (setq form nil inplace nil)
+ )
+ (t
+ (insert "\n(list")
+ (setq inplace t)
+ )))
+ (let ((macro (assq (car form) bovine--grammar-macros))
+ inlist first n q x)
+ (if macro
+ (bovine-grammar-expand-form
+ (apply (cdr macro) (cdr form))
+ quotemode t)
+ (if inplace (insert "\n("))
+ (while form
+ (setq first (car form)
+ form (cdr form))
+ ;; Hack for dealing with new reading of unquotes outside of
+ ;; backquote (introduced in 2010-12-06T16:37:26Z!monnier@iro.umontreal.ca).
+ (when (and (>= emacs-major-version 24)
+ (listp first)
+ (or (equal (car first) '\,)
+ (equal (car first) '\,@)))
+ (if (listp (cadr first))
+ (setq form (append (cdr first) form)
+ first (car first))
+ (setq first (intern (concat (symbol-name (car first))
+ (symbol-name (cadr first)))))))
+ (cond
+ ((eq first nil)
+ (when (and (not inlist) (not inplace))
+ (insert "\n(list")
+ (setq inlist t))
+ (insert " nil")
+ )
+ ((listp first)
+ ;;(let ((fn (and (symbolp (caar form)) (fboundp (caar form)))))
+ (when (and (not inlist) (not inplace))
+ (insert "\n(list")
+ (setq inlist t))
+ ;;(if (and inplace (not fn) (not (eq (caar form) 'EXPAND)))
+ ;; (insert " (append"))
+ (bovine-grammar-expand-form
+ first quotemode t) ;;(and fn (not (eq fn 'quote))))
+ ;;(if (and inplace (not fn) (not (eq (caar form) 'EXPAND)))
+ ;; (insert ")"))
+ ;;)
+ )
+ ((symbolp first)
+ (setq n (symbol-name first) ;the name
+ q quotemode ;implied quote flag
+ x nil) ;expand flag
+ (if (eq (aref n 0) ?,)
+ (if quotemode
+ ;; backquote mode needs the @
+ (if (eq (aref n 1) ?@)
+ (setq n (substring n 2)
+ q nil
+ x t)
+ ;; non backquote mode behaves normally.
+ (setq n (substring n 1)
+ q nil))
+ (setq n (substring n 1)
+ x t)))
+ (if (string= n "")
+ (progn
+ ;; We expand only the next item in place (a list?)
+ ;; A regular inline-list...
+ (bovine-grammar-expand-form (car form) quotemode t)
+ (setq form (cdr form)))
+ (if (and (eq (aref n 0) ?$)
+ ;; Don't expand $ tokens in implied quote mode.
+ ;; This acts like quoting in other symbols.
+ (not q))
+ (progn
+ (cond
+ ((and (not x) (not inlist) (not inplace))
+ (insert "\n(list"))
+ ((and x inlist (not inplace))
+ (insert ")")
+ (setq inlist nil)))
+ (insert "\n(nth " (int-to-string
+ (1- (string-to-number
+ (substring n 1))))
+ " vals)")
+ (and (not x) (not inplace)
+ (setq inlist t)))
+
+ (when (and (not inlist) (not inplace))
+ (insert "\n(list")
+ (setq inlist t))
+ (or (char-equal (char-before) ?\()
+ (insert " "))
+ (insert (if (or inplace (eq first t))
+ "" "'")
+ n))) ;; " "
+ )
+ (t
+ (when (and (not inlist) (not inplace))
+ (insert "\n(list")
+ (setq inlist t))
+ (insert (format "\n%S" first))
+ )
+ ))
+ (if inlist (insert ")"))
+ (if inplace (insert ")")))
+ ))
+
+(defun bovine-grammar-expand-action (textform quotemode)
+ "Expand semantic action string TEXTFORM into Lisp code.
+QUOTEMODE is the mode in which quoted symbols are slurred."
+ (if (string= "" textform)
+ nil
+ (let ((sexp (read textform)))
+ ;; We converted the lambda string into a list. Now write it
+ ;; out as the bovine lambda expression, and do macro-like
+ ;; conversion upon it.
+ (insert "\n")
+ (cond
+ ((eq (car sexp) 'EXPAND)
+ (insert ",(lambda (vals start end)")
+ ;; The EXPAND macro definition is mandatory
+ (bovine-grammar-expand-form
+ (apply (cdr (assq 'EXPAND bovine--grammar-macros)) (cdr sexp))
+ quotemode t)
+ )
+ ((and (listp (car sexp)) (eq (caar sexp) 'EVAL))
+ ;; The user wants to evaluate the following args.
+ ;; Use a simpler expander
+ )
+ (t
+ (insert ",(semantic-lambda")
+ (bovine-grammar-expand-form sexp quotemode)
+ ))
+ (insert ")\n")))
+)
+
+(defun bovine-grammar-parsetable-builder ()
+ "Return the parser table expression as a string value.
+The format of a bovine parser table is:
+
+ ( ( NONTERMINAL-SYMBOL1 MATCH-LIST1 )
+ ( NONTERMINAL-SYMBOL2 MATCH-LIST2 )
+ ...
+ ( NONTERMINAL-SYMBOLn MATCH-LISTn )
+
+Where each NONTERMINAL-SYMBOL is an artificial symbol which can appear
+in any child state. As a starting place, one of the NONTERMINAL-SYMBOLS
+must be `bovine-toplevel'.
+
+A MATCH-LIST is a list of possible matches of the form:
+
+ ( STATE-LIST1
+ STATE-LIST2
+ ...
+ STATE-LISTN )
+
+where STATE-LIST is of the form:
+ ( TYPE1 [ \"VALUE1\" ] TYPE2 [ \"VALUE2\" ] ... LAMBDA )
+
+where TYPE is one of the returned types of the token stream.
+VALUE is a value, or range of values to match against. For
+example, a SYMBOL might need to match \"foo\". Some TYPES will not
+have matching criteria.
+
+LAMBDA is a lambda expression which is evalled with the text of the
+type when it is found. It is passed the list of all buffer text
+elements found since the last lambda expression. It should return a
+semantic element (see below.)
+
+For consistency between languages, try to use common return values
+from your parser. Please reference the chapter \"Writing Parsers\" in
+the \"Language Support Developer's Guide -\" in the semantic texinfo
+manual."
+ (let* ((start (semantic-grammar-start))
+ (scopestart (semantic-grammar-scopestart))
+ (quotemode (semantic-grammar-quotemode))
+ (tags (semantic-find-tags-by-class
+ 'token (current-buffer)))
+ (nterms (semantic-find-tags-by-class
+ 'nonterminal (current-buffer)))
+ ;; Setup the cache of macro definitions.
+ (bovine--grammar-macros (semantic-grammar-macros))
+ nterm rules items item actn prec tag type regex)
+
+ ;; Check some trivial things
+ (cond
+ ((null nterms)
+ (error "Bad input grammar"))
+ (start
+ (if (cdr start)
+ (message "Extra start symbols %S ignored" (cdr start)))
+ (setq start (symbol-name (car start)))
+ (unless (semantic-find-first-tag-by-name start nterms)
+ (error "start symbol `%s' has no rule" start)))
+ (t
+ ;; Default to the first grammar rule.
+ (setq start (semantic-tag-name (car nterms)))))
+ (when scopestart
+ (setq scopestart (symbol-name scopestart))
+ (unless (semantic-find-first-tag-by-name scopestart nterms)
+ (error "scopestart symbol `%s' has no rule" scopestart)))
+
+ ;; Generate the grammar Lisp form.
+ (with-temp-buffer
+ (erase-buffer)
+ (insert "`(")
+ ;; Insert the start/scopestart rules
+ (insert "\n(bovine-toplevel \n("
+ start
+ ")\n) ;; end bovine-toplevel\n")
+ (when scopestart
+ (insert "\n(bovine-inner-scope \n("
+ scopestart
+ ")\n) ;; end bovine-inner-scope\n"))
+ ;; Process each nonterminal
+ (while nterms
+ (setq nterm (car nterms)
+ ;; We can't use the override form because the current buffer
+ ;; is not the originator of the tag.
+ rules (semantic-tag-components-semantic-grammar-mode nterm)
+ nterm (semantic-tag-name nterm)
+ nterms (cdr nterms))
+ (when (member nterm '("bovine-toplevel" "bovine-inner-scope"))
+ (error "`%s' is a reserved internal name" nterm))
+ (insert "\n(" nterm)
+ ;; Process each rule
+ (while rules
+ (setq items (semantic-tag-get-attribute (car rules) :value)
+ prec (semantic-tag-get-attribute (car rules) :prec)
+ actn (semantic-tag-get-attribute (car rules) :expr)
+ rules (cdr rules))
+ ;; Process each item
+ (insert "\n(")
+ (if (null items)
+ ;; EMPTY rule
+ (insert ";;EMPTY" (if actn "" "\n"))
+ ;; Expand items
+ (while items
+ (setq item (car items)
+ items (cdr items))
+ (if (consp item) ;; mid-rule action
+ (message "Mid-rule action %S ignored" item)
+ (or (char-equal (char-before) ?\()
+ (insert "\n"))
+ (cond
+ ((member item '("bovine-toplevel" "bovine-inner-scope"))
+ (error "`%s' is a reserved internal name" item))
+ ;; Replace ITEM by its %token definition.
+ ;; If a '%token TYPE ITEM [REGEX]' definition exists
+ ;; in the grammar, ITEM is replaced by TYPE [REGEX].
+ ((setq tag (semantic-find-first-tag-by-name
+ item tags)
+ type (semantic-tag-get-attribute tag :type))
+ (insert type)
+ (if (setq regex (semantic-tag-get-attribute tag :value))
+ (insert (format "\n%S" regex))))
+ ;; Don't change ITEM
+ (t
+ (insert (semantic-grammar-item-text item)))
+ ))))
+ (if prec
+ (message "%%prec %S ignored" prec))
+ (if actn
+ (bovine-grammar-expand-action actn quotemode))
+ (insert ")"))
+ (insert "\n) ;; end " nterm "\n"))
+ (insert ")\n")
+ (buffer-string))))
+
+(defun bovine-grammar-setupcode-builder ()
+ "Return the text of the setup code."
+ (format
+ "(setq semantic--parse-table %s\n\
+ semantic-debug-parser-source %S\n\
+ semantic-debug-parser-class 'semantic-bovine-debug-parser
+ semantic-flex-keywords-obarray %s\n\
+ %s)"
+ (semantic-grammar-parsetable)
+ (buffer-name)
+ (semantic-grammar-keywordtable)
+ (let ((mode (semantic-grammar-languagemode)))
+ ;; Is there more than one major mode?
+ (if (and (listp mode) (> (length mode) 1))
+ (format "semantic-equivalent-major-modes '%S\n" mode)
+ ""))))
+
+(defvar bovine-grammar-menu
+ '("BY Grammar")
+ "BY mode specific grammar menu.
+Menu items are appended to the common grammar menu.")
+
+;;;###autoload
+(define-derived-mode bovine-grammar-mode semantic-grammar-mode "BY"
+ "Major mode for editing Bovine grammars."
+ (semantic-grammar-setup-menu bovine-grammar-menu)
+ (semantic-install-function-overrides
+ '((grammar-parsetable-builder . bovine-grammar-parsetable-builder)
+ (grammar-setupcode-builder . bovine-grammar-setupcode-builder))))
+
+(add-to-list 'auto-mode-alist '("\\.by\\'" . bovine-grammar-mode))
+
+(defvar-mode-local bovine-grammar-mode semantic-grammar-macros
+ '(
+ (ASSOC . semantic-grammar-ASSOC)
+ (EXPAND . bovine-grammar-EXPAND)
+ (EXPANDFULL . bovine-grammar-EXPANDFULL)
+ (TAG . bovine-grammar-TAG)
+ (VARIABLE-TAG . bovine-grammar-VARIABLE-TAG)
+ (FUNCTION-TAG . bovine-grammar-FUNCTION-TAG)
+ (TYPE-TAG . bovine-grammar-TYPE-TAG)
+ (INCLUDE-TAG . bovine-grammar-INCLUDE-TAG)
+ (PACKAGE-TAG . bovine-grammar-PACKAGE-TAG)
+ (CODE-TAG . bovine-grammar-CODE-TAG)
+ (ALIAS-TAG . bovine-grammar-ALIAS-TAG)
+ )
+ "Semantic grammar macros used in bovine grammars.")
+
+(defun bovine-make-parsers ()
+ "Generate Emacs' built-in Bovine-based parser files."
+ (interactive)
+ (semantic-mode 1)
+ ;; Loop through each .by file in current directory, and run
+ ;; `semantic-grammar-batch-build-one-package' to build the grammar.
+ (dolist (f (directory-files default-directory nil "\\.by\\'"))
+ (let ((packagename
+ (condition-case err
+ (with-current-buffer (find-file-noselect f)
+ (semantic-grammar-create-package))
+ (error (message "%s" (error-message-string err)) nil)))
+ lang filename)
+ (when (and packagename
+ (string-match "^.*/\\(.*\\)-by\\.el\\'" packagename))
+ (setq lang (match-string 1 packagename))
+ (setq filename (concat lang "-by.el"))
+ (with-temp-buffer
+ (insert-file-contents filename)
+ (setq buffer-file-name (expand-file-name filename))
+ ;; Fix copyright header:
+ (goto-char (point-min))
+ (re-search-forward "^;; Author:")
+ (setq copyright-end (match-beginning 0))
+ (re-search-forward "^;;; Code:\n")
+ (delete-region copyright-end (match-end 0))
+ (goto-char copyright-end)
+ (insert ";; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; This file was generated from admin/grammars/"
+ lang ".by.
+
+;;; Code:
+")
+ (goto-char (point-min))
+ (delete-region (point-min) (line-end-position))
+ (insert ";;; " packagename
+ " --- Generated parser support file")
+ (delete-trailing-whitespace)
+ (re-search-forward ";;; \\(.*\\) ends here")
+ (replace-match packagename nil nil nil 1)
+ (save-buffer))))))
+
+(provide 'semantic/bovine/grammar)
+
+;;; semantic/bovine/grammar.el ends here
--- /dev/null
+;;; semantic/wisent/grammar.el --- Wisent's input grammar mode
+
+;; Copyright (C) 2002-2012 Free Software Foundation, Inc.
+;;
+;; Author: David Ponce <david@dponce.com>
+;; Maintainer: David Ponce <david@dponce.com>
+;; Created: 26 Aug 2002
+;; Keywords: syntax
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; Major mode for editing Wisent's input grammar (.wy) files.
+
+;;; Code:
+(require 'semantic)
+(require 'semantic/grammar)
+(require 'semantic/find)
+(require 'semantic/lex)
+(require 'semantic/wisent)
+(require 'semantic/bovine)
+
+(defsubst wisent-grammar-region-placeholder (symb)
+ "Given a $N placeholder symbol in SYMB, return a $regionN symbol.
+Return nil if $N is not a valid placeholder symbol."
+ (let ((n (symbol-name symb)))
+ (if (string-match "^[$]\\([1-9][0-9]*\\)$" n)
+ (intern (concat "$region" (match-string 1 n))))))
+
+(defun wisent-grammar-EXPAND (symb nonterm)
+ "Expand call to EXPAND grammar macro.
+Return the form to parse from within a nonterminal.
+SYMB is a $I placeholder symbol that gives the bounds of the area to
+parse.
+NONTERM is the nonterminal symbol to start with."
+ (unless (member nonterm (semantic-grammar-start))
+ (error "EXPANDFULL macro called with %s, but not used with %%start"
+ nonterm))
+ (let (($ri (wisent-grammar-region-placeholder symb)))
+ (if $ri
+ `(semantic-bovinate-from-nonterminal
+ (car ,$ri) (cdr ,$ri) ',nonterm)
+ (error "Invalid form (EXPAND %s %s)" symb nonterm))))
+
+(defun wisent-grammar-EXPANDFULL (symb nonterm)
+ "Expand call to EXPANDFULL grammar macro.
+Return the form to recursively parse an area.
+SYMB is a $I placeholder symbol that gives the bounds of the area.
+NONTERM is the nonterminal symbol to start with."
+ (unless (member nonterm (semantic-grammar-start))
+ (error "EXPANDFULL macro called with %s, but not used with %%start"
+ nonterm))
+ (let (($ri (wisent-grammar-region-placeholder symb)))
+ (if $ri
+ `(semantic-parse-region
+ (car ,$ri) (cdr ,$ri) ',nonterm 1)
+ (error "Invalid form (EXPANDFULL %s %s)" symb nonterm))))
+
+(defun wisent-grammar-TAG (name class &rest attributes)
+ "Expand call to TAG grammar macro.
+Return the form to create a generic semantic tag.
+See the function `semantic-tag' for the meaning of arguments NAME,
+CLASS and ATTRIBUTES."
+ `(wisent-raw-tag
+ (semantic-tag ,name ,class ,@attributes)))
+
+(defun wisent-grammar-VARIABLE-TAG (name type default-value &rest attributes)
+ "Expand call to VARIABLE-TAG grammar macro.
+Return the form to create a semantic tag of class variable.
+See the function `semantic-tag-new-variable' for the meaning of
+arguments NAME, TYPE, DEFAULT-VALUE and ATTRIBUTES."
+ `(wisent-raw-tag
+ (semantic-tag-new-variable ,name ,type ,default-value ,@attributes)))
+
+(defun wisent-grammar-FUNCTION-TAG (name type arg-list &rest attributes)
+ "Expand call to FUNCTION-TAG grammar macro.
+Return the form to create a semantic tag of class function.
+See the function `semantic-tag-new-function' for the meaning of
+arguments NAME, TYPE, ARG-LIST and ATTRIBUTES."
+ `(wisent-raw-tag
+ (semantic-tag-new-function ,name ,type ,arg-list ,@attributes)))
+
+(defun wisent-grammar-TYPE-TAG (name type members parents &rest attributes)
+ "Expand call to TYPE-TAG grammar macro.
+Return the form to create a semantic tag of class type.
+See the function `semantic-tag-new-type' for the meaning of arguments
+NAME, TYPE, MEMBERS, PARENTS and ATTRIBUTES."
+ `(wisent-raw-tag
+ (semantic-tag-new-type ,name ,type ,members ,parents ,@attributes)))
+
+(defun wisent-grammar-INCLUDE-TAG (name system-flag &rest attributes)
+ "Expand call to INCLUDE-TAG grammar macro.
+Return the form to create a semantic tag of class include.
+See the function `semantic-tag-new-include' for the meaning of
+arguments NAME, SYSTEM-FLAG and ATTRIBUTES."
+ `(wisent-raw-tag
+ (semantic-tag-new-include ,name ,system-flag ,@attributes)))
+
+(defun wisent-grammar-PACKAGE-TAG (name detail &rest attributes)
+ "Expand call to PACKAGE-TAG grammar macro.
+Return the form to create a semantic tag of class package.
+See the function `semantic-tag-new-package' for the meaning of
+arguments NAME, DETAIL and ATTRIBUTES."
+ `(wisent-raw-tag
+ (semantic-tag-new-package ,name ,detail ,@attributes)))
+
+(defun wisent-grammar-CODE-TAG (name detail &rest attributes)
+ "Expand call to CODE-TAG grammar macro.
+Return the form to create a semantic tag of class code.
+See the function `semantic-tag-new-code' for the meaning of arguments
+NAME, DETAIL and ATTRIBUTES."
+ `(wisent-raw-tag
+ (semantic-tag-new-code ,name ,detail ,@attributes)))
+
+(defun wisent-grammar-ALIAS-TAG (name aliasclass definition &rest attributes)
+ "Expand call to ALIAS-TAG grammar macro.
+Return the form to create a semantic tag of class alias.
+See the function `semantic-tag-new-alias' for the meaning of arguments
+NAME, ALIASCLASS, DEFINITION and ATTRIBUTES."
+ `(wisent-raw-tag
+ (semantic-tag-new-alias ,name ,aliasclass ,definition ,@attributes)))
+
+(defun wisent-grammar-EXPANDTAG (raw-tag)
+ "Expand call to EXPANDTAG grammar macro.
+Return the form to produce a list of cooked tags from raw form of
+Semantic tag RAW-TAG."
+ `(wisent-cook-tag ,raw-tag))
+
+(defun wisent-grammar-AST-ADD (ast &rest nodes)
+ "Expand call to AST-ADD grammar macro.
+Return the form to update the abstract syntax tree AST with NODES.
+See also the function `semantic-ast-add'."
+ `(semantic-ast-add ,ast ,@nodes))
+
+(defun wisent-grammar-AST-PUT (ast &rest nodes)
+ "Expand call to AST-PUT grammar macro.
+Return the form to update the abstract syntax tree AST with NODES.
+See also the function `semantic-ast-put'."
+ `(semantic-ast-put ,ast ,@nodes))
+
+(defun wisent-grammar-AST-GET (ast node)
+ "Expand call to AST-GET grammar macro.
+Return the form to get, from the abstract syntax tree AST, the value
+of NODE.
+See also the function `semantic-ast-get'."
+ `(semantic-ast-get ,ast ,node))
+
+(defun wisent-grammar-AST-GET1 (ast node)
+ "Expand call to AST-GET1 grammar macro.
+Return the form to get, from the abstract syntax tree AST, the first
+value of NODE.
+See also the function `semantic-ast-get1'."
+ `(semantic-ast-get1 ,ast ,node))
+
+(defun wisent-grammar-AST-GET-STRING (ast node)
+ "Expand call to AST-GET-STRING grammar macro.
+Return the form to get, from the abstract syntax tree AST, the value
+of NODE as a string.
+See also the function `semantic-ast-get-string'."
+ `(semantic-ast-get-string ,ast ,node))
+
+(defun wisent-grammar-AST-MERGE (ast1 ast2)
+ "Expand call to AST-MERGE grammar macro.
+Return the form to merge the abstract syntax trees AST1 and AST2.
+See also the function `semantic-ast-merge'."
+ `(semantic-ast-merge ,ast1 ,ast2))
+
+(defun wisent-grammar-SKIP-BLOCK (&optional symb)
+ "Expand call to SKIP-BLOCK grammar macro.
+Return the form to skip a parenthesized block.
+Optional argument SYMB is a $I placeholder symbol that gives the
+bounds of the block to skip. By default, skip the block at `$1'.
+See also the function `wisent-skip-block'."
+ (let ($ri)
+ (when symb
+ (unless (setq $ri (wisent-grammar-region-placeholder symb))
+ (error "Invalid form (SKIP-BLOCK %s)" symb)))
+ `(wisent-skip-block ,$ri)))
+
+(defun wisent-grammar-SKIP-TOKEN ()
+ "Expand call to SKIP-TOKEN grammar macro.
+Return the form to skip the lookahead token.
+See also the function `wisent-skip-token'."
+ `(wisent-skip-token))
+
+(defun wisent-grammar-assocs ()
+ "Return associativity and precedence level definitions."
+ (mapcar
+ #'(lambda (tag)
+ (cons (intern (semantic-tag-name tag))
+ (mapcar #'semantic-grammar-item-value
+ (semantic-tag-get-attribute tag :value))))
+ (semantic-find-tags-by-class 'assoc (current-buffer))))
+
+(defun wisent-grammar-terminals ()
+ "Return the list of terminal symbols.
+Keep order of declaration in the WY file without duplicates."
+ (let (terms)
+ (mapc
+ #'(lambda (tag)
+ (mapcar #'(lambda (name)
+ (add-to-list 'terms (intern name)))
+ (cons (semantic-tag-name tag)
+ (semantic-tag-get-attribute tag :rest))))
+ (semantic--find-tags-by-function
+ #'(lambda (tag)
+ (memq (semantic-tag-class tag) '(token keyword)))
+ (current-buffer)))
+ (nreverse terms)))
+
+;; Cache of macro definitions currently in use.
+(defvar wisent--grammar-macros nil)
+
+(defun wisent-grammar-expand-macros (expr)
+ "Expand expression EXPR into a form without grammar macros.
+Return the expanded expression."
+ (if (or (atom expr) (semantic-grammar-quote-p (car expr)))
+ expr ;; Just return atom or quoted expression.
+ (let* ((expr (mapcar 'wisent-grammar-expand-macros expr))
+ (macro (assq (car expr) wisent--grammar-macros)))
+ (if macro ;; Expand Semantic built-in.
+ (apply (cdr macro) (cdr expr))
+ expr))))
+
+(defun wisent-grammar-nonterminals ()
+ "Return the list form of nonterminal definitions."
+ (let ((nttags (semantic-find-tags-by-class
+ 'nonterminal (current-buffer)))
+ ;; Setup the cache of macro definitions.
+ (wisent--grammar-macros (semantic-grammar-macros))
+ rltags nterms rules rule elems elem actn sexp prec)
+ (while nttags
+ (setq rltags (semantic-tag-components (car nttags))
+ rules nil)
+ (while rltags
+ (setq elems (semantic-tag-get-attribute (car rltags) :value)
+ prec (semantic-tag-get-attribute (car rltags) :prec)
+ actn (semantic-tag-get-attribute (car rltags) :expr)
+ rule nil)
+ (when elems ;; not an EMPTY rule
+ (while elems
+ (setq elem (car elems)
+ elems (cdr elems))
+ (setq elem (if (consp elem) ;; mid-rule action
+ (wisent-grammar-expand-macros (read (car elem)))
+ (semantic-grammar-item-value elem)) ;; item
+ rule (cons elem rule)))
+ (setq rule (nreverse rule)))
+ (if prec
+ (setq prec (vector (semantic-grammar-item-value prec))))
+ (if actn
+ (setq sexp (wisent-grammar-expand-macros (read actn))))
+ (setq rule (if actn
+ (if prec
+ (list rule prec sexp)
+ (list rule sexp))
+ (if prec
+ (list rule prec)
+ (list rule))))
+ (setq rules (cons rule rules)
+ rltags (cdr rltags)))
+ (setq nterms (cons (cons (intern (semantic-tag-name (car nttags)))
+ (nreverse rules))
+ nterms)
+ nttags (cdr nttags)))
+ (nreverse nterms)))
+
+(defun wisent-grammar-grammar ()
+ "Return Elisp form of the grammar."
+ (let* ((terminals (wisent-grammar-terminals))
+ (nonterminals (wisent-grammar-nonterminals))
+ (assocs (wisent-grammar-assocs)))
+ (cons terminals (cons assocs nonterminals))))
+
+(defun wisent-grammar-parsetable-builder ()
+ "Return the value of the parser table."
+ `(progn
+ ;; Ensure that the grammar [byte-]compiler is available.
+ (eval-when-compile (require 'semantic/wisent/comp))
+ (wisent-compile-grammar
+ ',(wisent-grammar-grammar)
+ ',(semantic-grammar-start))))
+
+(defun wisent-grammar-setupcode-builder ()
+ "Return the parser setup code."
+ (format
+ "(semantic-install-function-overrides\n\
+ '((parse-stream . wisent-parse-stream)))\n\
+ (setq semantic-parser-name \"LALR\"\n\
+ semantic--parse-table %s\n\
+ semantic-debug-parser-source %S\n\
+ semantic-flex-keywords-obarray %s\n\
+ semantic-lex-types-obarray %s)\n\
+ ;; Collect unmatched syntax lexical tokens\n\
+ (semantic-make-local-hook 'wisent-discarding-token-functions)\n\
+ (add-hook 'wisent-discarding-token-functions\n\
+ 'wisent-collect-unmatched-syntax nil t)"
+ (semantic-grammar-parsetable)
+ (buffer-name)
+ (semantic-grammar-keywordtable)
+ (semantic-grammar-tokentable)))
+
+(defvar wisent-grammar-menu
+ '("WY Grammar"
+ ["LALR Compiler Verbose" wisent-toggle-verbose-flag
+ :style toggle :active (boundp 'wisent-verbose-flag)
+ :selected (and (boundp 'wisent-verbose-flag)
+ wisent-verbose-flag)]
+ )
+ "WY mode specific grammar menu.
+Menu items are appended to the common grammar menu.")
+
+;;;###autoload
+(define-derived-mode wisent-grammar-mode semantic-grammar-mode "WY"
+ "Major mode for editing Wisent grammars."
+ (semantic-grammar-setup-menu wisent-grammar-menu)
+ (semantic-install-function-overrides
+ '((grammar-parsetable-builder . wisent-grammar-parsetable-builder)
+ (grammar-setupcode-builder . wisent-grammar-setupcode-builder))))
+
+(defvar-mode-local wisent-grammar-mode semantic-grammar-macros
+ '(
+ (ASSOC . semantic-grammar-ASSOC)
+ (EXPAND . wisent-grammar-EXPAND)
+ (EXPANDFULL . wisent-grammar-EXPANDFULL)
+ (TAG . wisent-grammar-TAG)
+ (VARIABLE-TAG . wisent-grammar-VARIABLE-TAG)
+ (FUNCTION-TAG . wisent-grammar-FUNCTION-TAG)
+ (TYPE-TAG . wisent-grammar-TYPE-TAG)
+ (INCLUDE-TAG . wisent-grammar-INCLUDE-TAG)
+ (PACKAGE-TAG . wisent-grammar-PACKAGE-TAG)
+ (EXPANDTAG . wisent-grammar-EXPANDTAG)
+ (CODE-TAG . wisent-grammar-CODE-TAG)
+ (ALIAS-TAG . wisent-grammar-ALIAS-TAG)
+ (AST-ADD . wisent-grammar-AST-ADD)
+ (AST-PUT . wisent-grammar-AST-PUT)
+ (AST-GET . wisent-grammar-AST-GET)
+ (AST-GET1 . wisent-grammar-AST-GET1)
+ (AST-GET-STRING . wisent-grammar-AST-GET-STRING)
+ (AST-MERGE . wisent-grammar-AST-MERGE)
+ (SKIP-BLOCK . wisent-grammar-SKIP-BLOCK)
+ (SKIP-TOKEN . wisent-grammar-SKIP-TOKEN)
+ )
+ "Semantic grammar macros used in wisent grammars.")
+
+(defvar wisent-make-parsers--emacs-license
+ ";; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.")
+
+(defvar wisent-make-parsers--python-license
+ ";; It is derived in part from the Python grammar, used under the
+;; following license:
+;;
+;; PYTHON SOFTWARE FOUNDATION LICENSE VERSION 2
+;; --------------------------------------------
+;; 1. This LICENSE AGREEMENT is between the Python Software Foundation
+;; (\"PSF\"), and the Individual or Organization (\"Licensee\") accessing
+;; and otherwise using this software (\"Python\") in source or binary
+;; form and its associated documentation.
+;;
+;; 2. Subject to the terms and conditions of this License Agreement,
+;; PSF hereby grants Licensee a nonexclusive, royalty-free, world-wide
+;; license to reproduce, analyze, test, perform and/or display
+;; publicly, prepare derivative works, distribute, and otherwise use
+;; Python alone or in any derivative version, provided, however, that
+;; PSF's License Agreement and PSF's notice of copyright, i.e.,
+;; \"Copyright (c) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
+;; 2009, 2010 Python Software Foundation; All Rights Reserved\" are
+;; retained in Python alone or in any derivative version prepared by
+;; Licensee.
+;;
+;; 3. In the event Licensee prepares a derivative work that is based
+;; on or incorporates Python or any part thereof, and wants to make
+;; the derivative work available to others as provided herein, then
+;; Licensee hereby agrees to include in any such work a brief summary
+;; of the changes made to Python.
+;;
+;; 4. PSF is making Python available to Licensee on an \"AS IS\"
+;; basis. PSF MAKES NO REPRESENTATIONS OR WARRANTIES, EXPRESS OR
+;; IMPLIED. BY WAY OF EXAMPLE, BUT NOT LIMITATION, PSF MAKES NO AND
+;; DISCLAIMS ANY REPRESENTATION OR WARRANTY OF MERCHANTABILITY OR FITNESS
+;; FOR ANY PARTICULAR PURPOSE OR THAT THE USE OF PYTHON WILL NOT
+;; INFRINGE ANY THIRD PARTY RIGHTS.
+;;
+;; 5. PSF SHALL NOT BE LIABLE TO LICENSEE OR ANY OTHER USERS OF PYTHON
+;; FOR ANY INCIDENTAL, SPECIAL, OR CONSEQUENTIAL DAMAGES OR LOSS AS A
+;; RESULT OF MODIFYING, DISTRIBUTING, OR OTHERWISE USING PYTHON, OR
+;; ANY DERIVATIVE THEREOF, EVEN IF ADVISED OF THE POSSIBILITY THEREOF.
+;;
+;; 6. This License Agreement will automatically terminate upon a
+;; material breach of its terms and conditions.
+;;
+;; 7. Nothing in this License Agreement shall be deemed to create any
+;; relationship of agency, partnership, or joint venture between PSF
+;; and Licensee. This License Agreement does not grant permission to
+;; use PSF trademarks or trade name in a trademark sense to endorse or
+;; promote products or services of Licensee, or any third party.
+;;
+;; 8. By copying, installing or otherwise using Python, Licensee
+;; agrees to be bound by the terms and conditions of this License
+;; Agreement.")
+
+(defvar wisent-make-parsers--ecmascript-license
+ "\n;; It is derived from the grammar in the ECMAScript Language
+;; Specification published at
+;;
+;; http://www.ecma-international.org/publications/standards/Ecma-262.htm
+;;
+;; and redistributed under the following license:
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions
+;; are met:
+;;
+;; 1. Redistributions of source code must retain the above copyright
+;; notice, this list of conditions and the following disclaimer.
+;;
+;; 2. Redistributions in binary form must reproduce the above
+;; copyright notice, this list of conditions and the following
+;; disclaimer in the documentation and/or other materials provided
+;; with the distribution.
+;;
+;; 3. Neither the name of the authors nor Ecma International may be
+;; used to endorse or promote products derived from this software
+;; without specific prior written permission. THIS SOFTWARE IS
+;; PROVIDED BY THE ECMA INTERNATIONAL \"AS IS\" AND ANY EXPRESS OR
+;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+;; ARE DISCLAIMED. IN NO EVENT SHALL ECMA INTERNATIONAL BE LIABLE FOR
+;; ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT
+;; OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
+;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE
+;; USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
+;; DAMAGE.")
+
+(defvar wisent-make-parsers--parser-file-name
+ `(("semantic/grammar-wy.el")
+ ("srecode/srt-wy.el")
+ ("semantic/wisent/js-wy.el"
+ "Copyright (C) 1998-2011 Ecma International."
+ ,wisent-make-parsers--ecmascript-license)
+ ("semantic/wisent/javat-wy.el")
+ ("semantic/wisent/python-wy.el"
+ "Copyright (c) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
+\;; 2009, 2010 Python Software Foundation; All Rights Reserved"
+ ,wisent-make-parsers--python-license)))
+
+(defun wisent-make-parsers ()
+ "Generate Emacs' built-in Wisent-based parser files."
+ (interactive)
+ (semantic-mode 1)
+ ;; Loop through each .wy file in current directory, and run
+ ;; `semantic-grammar-batch-build-one-package' to build the grammar.
+ (dolist (f (directory-files default-directory nil "\\.wy\\'"))
+ (let ((packagename
+ (condition-case err
+ (with-current-buffer (find-file-noselect f)
+ (semantic-grammar-create-package))
+ (error (message "%s" (error-message-string err)) nil)))
+ output-data)
+ (when (setq output-data (assoc packagename wisent-make-parsers--parser-file-name))
+ (let ((additional-copyright (nth 1 output-data))
+ (additional-license (nth 2 output-data))
+ (filename (progn (string-match ".*/\\(.*\\)" packagename) (match-string 1 packagename)))
+ copyright-end)
+ ;; Touch up the generated parsers for Emacs integration.
+ (with-temp-buffer
+ (insert-file-contents filename)
+ ;; Fix copyright header:
+ (goto-char (point-min))
+ (when additional-copyright
+ (re-search-forward "Copyright (C).*$")
+ (insert "\n;; " additional-copyright))
+ (re-search-forward "^;; Author:")
+ (setq copyright-end (match-beginning 0))
+ (re-search-forward "^;;; Code:\n")
+ (delete-region copyright-end (match-end 0))
+ (goto-char copyright-end)
+ (insert wisent-make-parsers--emacs-license)
+ (insert "\n\n;;; Commentary:
+;;
+;; This file was generated from admin/grammars/"
+ f ".")
+ (when additional-license
+ (insert "\n" additional-license))
+ (insert "\n\n;;; Code:\n")
+ (goto-char (point-min))
+ (delete-region (point-min) (line-end-position))
+ (insert ";;; " packagename
+ " --- Generated parser support file")
+ (re-search-forward ";;; \\(.*\\) ends here")
+ (replace-match packagename nil nil nil 1)
+ (delete-trailing-whitespace)
+ (write-region nil nil (expand-file-name filename))))))))
+
+(provide 'semantic/wisent/grammar)
+
+;;; semantic/wisent/grammar.el ends here
("\\.js\\'" . javascript-mode)
("\\.json\\'" . javascript-mode)
("\\.[ds]?vh?\\'" . verilog-mode)
+ ("\\.by\\'" . bovine-grammar-mode)
+ ("\\.wy\\'" . wisent-grammar-mode)
;; .emacs or .gnus or .viper following a directory delimiter in
;; Unix, MSDOG or VMS syntax.
("[]>:/\\]\\..*\\(emacs\\|gnus\\|viper\\)\\'" . emacs-lisp-mode)
projects / emacs.git / commitdiff