From: Chong Yidong Date: Sat, 6 Oct 2012 14:18:35 +0000 (+0800) Subject: Move bovine-grammar and wisent-grammar into lisp/ directory. X-Git-Tag: emacs-24.2.90~239^2~36 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=9414dd8d50cc49464c97a5cb81f38796ff1fbec1;p=emacs.git Move bovine-grammar and wisent-grammar into lisp/ directory. * 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. --- diff --git a/admin/ChangeLog b/admin/ChangeLog index 2da65523116..8fe82ca36cb 100644 --- a/admin/ChangeLog +++ b/admin/ChangeLog @@ -1,3 +1,8 @@ +2012-10-01 David Engster + + * grammars/bovine-grammar.el: + * grammars/wisent-grammar.el: Move to lisp directory. + 2012-10-01 David Engster * grammars/bovine-grammar.el (bovine--grammar-newstyle-unquote): diff --git a/admin/grammars/bovine-grammar.el b/admin/grammars/bovine-grammar.el deleted file mode 100644 index a7289f6bafe..00000000000 --- a/admin/grammars/bovine-grammar.el +++ /dev/null @@ -1,507 +0,0 @@ -;;; bovine-grammar.el --- Bovine's input grammar mode -;; -;; Copyright (C) 2002-2012 Free Software Foundation, Inc. -;; -;; Author: David Ponce -;; Maintainer: David Ponce -;; 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 . - -;;; 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 . - -;;; 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 diff --git a/admin/grammars/wisent-grammar.el b/admin/grammars/wisent-grammar.el deleted file mode 100644 index 25dba5be2d8..00000000000 --- a/admin/grammars/wisent-grammar.el +++ /dev/null @@ -1,526 +0,0 @@ -;;; wisent-grammar.el --- Wisent's input grammar mode - -;; Copyright (C) 2002-2012 Free Software Foundation, Inc. -;; -;; Author: David Ponce -;; Maintainer: David Ponce -;; 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 . - -;;; 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 .") - -(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 diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 87b54707e0a..5d93a386a21 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,7 @@ +2012-10-06 Chong Yidong + + * files.el (auto-mode-alist): Add .by and .wy (Semantic grammars). + 2012-10-06 Ikumi Keita (tiny change) * international/characters.el: Fix simple mistake ((car chars) -> diff --git a/lisp/cedet/ChangeLog b/lisp/cedet/ChangeLog index e066368d011..9e20b4fbb4e 100644 --- a/lisp/cedet/ChangeLog +++ b/lisp/cedet/ChangeLog @@ -1,3 +1,9 @@ +2012-10-06 Chong Yidong + + * 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 * srecode.el, ede.el: Restore Version header. diff --git a/lisp/cedet/semantic/bovine/grammar.el b/lisp/cedet/semantic/bovine/grammar.el new file mode 100644 index 00000000000..cc27c5b0646 --- /dev/null +++ b/lisp/cedet/semantic/bovine/grammar.el @@ -0,0 +1,506 @@ +;;; semantic/bovine/grammar.el --- Bovine's input grammar mode +;; +;; Copyright (C) 2002-2012 Free Software Foundation, Inc. +;; +;; Author: David Ponce +;; Maintainer: David Ponce +;; 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 . + +;;; 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 . + +;;; 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 diff --git a/lisp/cedet/semantic/wisent/grammar.el b/lisp/cedet/semantic/wisent/grammar.el new file mode 100644 index 00000000000..6fa52dc2adc --- /dev/null +++ b/lisp/cedet/semantic/wisent/grammar.el @@ -0,0 +1,526 @@ +;;; semantic/wisent/grammar.el --- Wisent's input grammar mode + +;; Copyright (C) 2002-2012 Free Software Foundation, Inc. +;; +;; Author: David Ponce +;; Maintainer: David Ponce +;; 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 . + +;;; 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 .") + +(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 diff --git a/lisp/files.el b/lisp/files.el index c3f9e1ef1a0..e030aff0ae2 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -2326,6 +2326,8 @@ ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|7Z\\)\\'" . archive-mode) ("\\.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)