* lisp/cedet/semantic/wisent/comp.el: lexical-binding.
(wisent-defcontext): Make sure the vars are also dynbound in the files
that `require` us.
(wisent-state-actions, wisent-automaton-lisp-form): Use `obarray-make`.
(wisent--compile-grammar): Rename from `wisent-compile-grammar`.
(wisent-compile-grammar): Redefine as an obsolete function.
(wisent-automaton-lisp-form): Avoid variable `state`.
* lisp/cedet/semantic/grammar.el: Use lexical-binding.
(semantic-grammar-require-form): New var.
(semantic-grammar-header): Use it to provide new element `require-form`.
(semantic-grammar-header-template): Use it.
* lisp/cedet/semantic/wisent.el (wisent-compiled-grammar): New macro.
* lisp/cedet/semantic/wisent/grammar.el (wisent-grammar-parsetable-builder):
Use it in the generated code instead of the `wisent-compile-grammar` function.
(wisent-grammar-mode): Set `semantic-grammar-require-form` so
the generated ELisp files require `semantic/wisent` rather than
`semantic/bovine`.
* lisp/cedet/semantic/wisent/wisent.el: Use lexical-binding.
* lisp/cedet/semantic/wisent/java-tags.el: Use lexical-binding.
* lisp/cedet/semantic/wisent/python.el: Use lexical-binding.
* lisp/cedet/semantic/wisent/javascript.el: Use lexical-binding.
(semantic-ctxt-current-symbol): Remove unused var `symlist`.
* admin/grammars/python.wy (wisent-python-EXPANDING-block):
Declare dynbound var.
* lisp/cedet/semantic/grammar-wy.el: Regenerate.
;;
declaration:
decl
- (eval $1)
+ (eval $1 t)
;
decl:
put_name_list:
BRACE_BLOCK
- (mapcar 'semantic-tag-name (EXPANDFULL $1 put_names))
+ (mapcar #'semantic-tag-name (EXPANDFULL $1 put_names))
;
put_names:
put_value_list:
BRACE_BLOCK
- (mapcar 'semantic-tag-code-detail (EXPANDFULL $1 put_values))
+ (mapcar #'semantic-tag-code-detail (EXPANDFULL $1 put_values))
;
put_values:
use_name_list:
BRACE_BLOCK
- (mapcar 'semantic-tag-name (EXPANDFULL $1 use_names))
+ (mapcar #'semantic-tag-name (EXPANDFULL $1 use_names))
;
use_names:
rules:
lifo_rules
- (apply 'nconc (nreverse $1))
+ (apply #'nconc (nreverse $1))
;
lifo_rules:
(tag))
(declare-function semantic-parse-region "semantic"
(start end &optional nonterminal depth returnonerror))
+(defvar wisent-python-EXPANDING-block)
}
%languagemode python-mode
paren_class_list
: PAREN_BLOCK
(let ((wisent-python-EXPANDING-block t))
- (mapcar 'semantic-tag-name (EXPANDFULL $1 paren_classes)))
+ (mapcar #'semantic-tag-name (EXPANDFULL $1 paren_classes)))
;
;; parameters: '(' [varargslist] ')'
;;; Code:
(require 'semantic/lex)
-(eval-when-compile (require 'semantic/bovine))
+(require 'semantic/wisent)
\f
;;; Prologue
;;
"Table of lexical tokens.")
(defconst semantic-grammar-wy--parse-table
- (progn
- (eval-when-compile
- (require 'semantic/wisent/comp))
- (wisent-compile-grammar
- '((DEFAULT-PREC NO-DEFAULT-PREC KEYWORD LANGUAGEMODE LEFT NONASSOC PACKAGE EXPECTEDCONFLICTS PROVIDE PREC PUT QUOTEMODE RIGHT SCOPESTART START TOKEN TYPE USE-MACROS STRING SYMBOL PERCENT_PERCENT CHARACTER PREFIXED_LIST SEXP PROLOGUE EPILOGUE PAREN_BLOCK BRACE_BLOCK LPAREN RPAREN LBRACE RBRACE COLON SEMI OR LT GT)
- nil
- (grammar
- ((prologue))
- ((epilogue))
- ((declaration))
- ((nonterminal))
- ((PERCENT_PERCENT)))
- (prologue
- ((PROLOGUE)
+ (wisent-compiled-grammar
+ ((DEFAULT-PREC NO-DEFAULT-PREC KEYWORD LANGUAGEMODE LEFT NONASSOC PACKAGE EXPECTEDCONFLICTS PROVIDE PREC PUT QUOTEMODE RIGHT SCOPESTART START TOKEN TYPE USE-MACROS STRING SYMBOL PERCENT_PERCENT CHARACTER PREFIXED_LIST SEXP PROLOGUE EPILOGUE PAREN_BLOCK BRACE_BLOCK LPAREN RPAREN LBRACE RBRACE COLON SEMI OR LT GT)
+ nil
+ (grammar
+ ((prologue))
+ ((epilogue))
+ ((declaration))
+ ((nonterminal))
+ ((PERCENT_PERCENT)))
+ (prologue
+ ((PROLOGUE)
+ (wisent-raw-tag
+ (semantic-tag-new-code "prologue" nil))))
+ (epilogue
+ ((EPILOGUE)
+ (wisent-raw-tag
+ (semantic-tag-new-code "epilogue" nil))))
+ (declaration
+ ((decl)
+ (eval $1 t)))
+ (decl
+ ((default_prec_decl))
+ ((no_default_prec_decl))
+ ((languagemode_decl))
+ ((package_decl))
+ ((expectedconflicts_decl))
+ ((provide_decl))
+ ((precedence_decl))
+ ((put_decl))
+ ((quotemode_decl))
+ ((scopestart_decl))
+ ((start_decl))
+ ((keyword_decl))
+ ((token_decl))
+ ((type_decl))
+ ((use_macros_decl)))
+ (default_prec_decl
+ ((DEFAULT-PREC)
+ `(wisent-raw-tag
+ (semantic-tag "default-prec" 'assoc :value
+ '("t")))))
+ (no_default_prec_decl
+ ((NO-DEFAULT-PREC)
+ `(wisent-raw-tag
+ (semantic-tag "default-prec" 'assoc :value
+ '("nil")))))
+ (languagemode_decl
+ ((LANGUAGEMODE symbols)
+ `(wisent-raw-tag
+ (semantic-tag ',(car $2)
+ 'languagemode :rest ',(cdr $2)))))
+ (package_decl
+ ((PACKAGE SYMBOL)
+ `(wisent-raw-tag
+ (semantic-tag-new-package ',$2 nil))))
+ (expectedconflicts_decl
+ ((EXPECTEDCONFLICTS symbols)
+ `(wisent-raw-tag
+ (semantic-tag ',(car $2)
+ 'expectedconflicts :rest ',(cdr $2)))))
+ (provide_decl
+ ((PROVIDE SYMBOL)
+ `(wisent-raw-tag
+ (semantic-tag ',$2 'provide))))
+ (precedence_decl
+ ((associativity token_type_opt items)
+ `(wisent-raw-tag
+ (semantic-tag ',$1 'assoc :type ',$2 :value ',$3))))
+ (associativity
+ ((LEFT)
+ (progn "left"))
+ ((RIGHT)
+ (progn "right"))
+ ((NONASSOC)
+ (progn "nonassoc")))
+ (put_decl
+ ((PUT put_name put_value)
+ `(wisent-raw-tag
+ (semantic-tag ',$2 'put :value ',(list $3))))
+ ((PUT put_name put_value_list)
+ `(wisent-raw-tag
+ (semantic-tag ',$2 'put :value ',$3)))
+ ((PUT put_name_list put_value)
+ `(wisent-raw-tag
+ (semantic-tag ',(car $2)
+ 'put :rest ',(cdr $2)
+ :value ',(list $3))))
+ ((PUT put_name_list put_value_list)
+ `(wisent-raw-tag
+ (semantic-tag ',(car $2)
+ 'put :rest ',(cdr $2)
+ :value ',$3))))
+ (put_name_list
+ ((BRACE_BLOCK)
+ (mapcar #'semantic-tag-name
+ (semantic-parse-region
+ (car $region1)
+ (cdr $region1)
+ 'put_names 1))))
+ (put_names
+ ((LBRACE)
+ nil)
+ ((RBRACE)
+ nil)
+ ((put_name)
+ (wisent-raw-tag
+ (semantic-tag $1 'put-name))))
+ (put_name
+ ((SYMBOL))
+ ((token_type)))
+ (put_value_list
+ ((BRACE_BLOCK)
+ (mapcar #'semantic-tag-code-detail
+ (semantic-parse-region
+ (car $region1)
+ (cdr $region1)
+ 'put_values 1))))
+ (put_values
+ ((LBRACE)
+ nil)
+ ((RBRACE)
+ nil)
+ ((put_value)
+ (wisent-raw-tag
+ (semantic-tag-new-code "put-value" $1))))
+ (put_value
+ ((SYMBOL any_value)
+ (cons $1 $2)))
+ (scopestart_decl
+ ((SCOPESTART SYMBOL)
+ `(wisent-raw-tag
+ (semantic-tag ',$2 'scopestart))))
+ (quotemode_decl
+ ((QUOTEMODE SYMBOL)
+ `(wisent-raw-tag
+ (semantic-tag ',$2 'quotemode))))
+ (start_decl
+ ((START symbols)
+ `(wisent-raw-tag
+ (semantic-tag ',(car $2)
+ 'start :rest ',(cdr $2)))))
+ (keyword_decl
+ ((KEYWORD SYMBOL string_value)
+ `(wisent-raw-tag
+ (semantic-tag ',$2 'keyword :value ',$3))))
+ (token_decl
+ ((TOKEN token_type_opt SYMBOL string_value)
+ `(wisent-raw-tag
+ (semantic-tag ',$3 ',(if $2 'token 'keyword)
+ :type ',$2 :value ',$4)))
+ ((TOKEN token_type_opt symbols)
+ `(wisent-raw-tag
+ (semantic-tag ',(car $3)
+ 'token :type ',$2 :rest ',(cdr $3)))))
+ (token_type_opt
+ (nil)
+ ((token_type)))
+ (token_type
+ ((LT SYMBOL GT)
+ (progn $2)))
+ (type_decl
+ ((TYPE token_type plist_opt)
+ `(wisent-raw-tag
+ (semantic-tag ',$2 'type :value ',$3))))
+ (plist_opt
+ (nil)
+ ((plist)))
+ (plist
+ ((plist put_value)
+ (append
+ (list $2)
+ $1))
+ ((put_value)
+ (list $1)))
+ (use_name_list
+ ((BRACE_BLOCK)
+ (mapcar #'semantic-tag-name
+ (semantic-parse-region
+ (car $region1)
+ (cdr $region1)
+ 'use_names 1))))
+ (use_names
+ ((LBRACE)
+ nil)
+ ((RBRACE)
+ nil)
+ ((SYMBOL)
+ (wisent-raw-tag
+ (semantic-tag $1 'use-name))))
+ (use_macros_decl
+ ((USE-MACROS SYMBOL use_name_list)
+ `(wisent-raw-tag
+ (semantic-tag "macro" 'macro :type ',$2 :value ',$3))))
+ (string_value
+ ((STRING)
+ (read $1)))
+ (any_value
+ ((SYMBOL))
+ ((STRING))
+ ((PAREN_BLOCK))
+ ((PREFIXED_LIST))
+ ((SEXP)))
+ (symbols
+ ((lifo_symbols)
+ (nreverse $1)))
+ (lifo_symbols
+ ((lifo_symbols SYMBOL)
+ (cons $2 $1))
+ ((SYMBOL)
+ (list $1)))
+ (nonterminal
+ ((SYMBOL
+ (setq semantic-grammar-wy--nterm $1 semantic-grammar-wy--rindx 0)
+ COLON rules SEMI)
+ (wisent-raw-tag
+ (semantic-tag $1 'nonterminal :children $4))))
+ (rules
+ ((lifo_rules)
+ (apply #'nconc
+ (nreverse $1))))
+ (lifo_rules
+ ((lifo_rules OR rule)
+ (cons $3 $1))
+ ((rule)
+ (list $1)))
+ (rule
+ ((rhs)
+ (let*
+ ((nterm semantic-grammar-wy--nterm)
+ (rindx semantic-grammar-wy--rindx)
+ (rhs $1)
+ comps prec action elt)
+ (setq semantic-grammar-wy--rindx
+ (1+ semantic-grammar-wy--rindx))
+ (while rhs
+ (setq elt
+ (car rhs)
+ rhs
+ (cdr rhs))
+ (cond
+ ((vectorp elt)
+ (if prec
+ (error "Duplicate %%prec in `%s:%d' rule" nterm rindx))
+ (setq prec
+ (aref elt 0)))
+ ((consp elt)
+ (if
+ (or action comps)
+ (setq comps
+ (cons elt comps)
+ semantic-grammar-wy--rindx
+ (1+ semantic-grammar-wy--rindx))
+ (setq action
+ (car elt))))
+ (t
+ (setq comps
+ (cons elt comps)))))
+ (wisent-cook-tag
(wisent-raw-tag
- (semantic-tag-new-code "prologue" nil))))
- (epilogue
- ((EPILOGUE)
- (wisent-raw-tag
- (semantic-tag-new-code "epilogue" nil))))
- (declaration
- ((decl)
- (eval $1)))
- (decl
- ((default_prec_decl))
- ((no_default_prec_decl))
- ((languagemode_decl))
- ((package_decl))
- ((expectedconflicts_decl))
- ((provide_decl))
- ((precedence_decl))
- ((put_decl))
- ((quotemode_decl))
- ((scopestart_decl))
- ((start_decl))
- ((keyword_decl))
- ((token_decl))
- ((type_decl))
- ((use_macros_decl)))
- (default_prec_decl
- ((DEFAULT-PREC)
- `(wisent-raw-tag
- (semantic-tag "default-prec" 'assoc :value
- '("t")))))
- (no_default_prec_decl
- ((NO-DEFAULT-PREC)
- `(wisent-raw-tag
- (semantic-tag "default-prec" 'assoc :value
- '("nil")))))
- (languagemode_decl
- ((LANGUAGEMODE symbols)
- `(wisent-raw-tag
- (semantic-tag ',(car $2)
- 'languagemode :rest ',(cdr $2)))))
- (package_decl
- ((PACKAGE SYMBOL)
- `(wisent-raw-tag
- (semantic-tag-new-package ',$2 nil))))
- (expectedconflicts_decl
- ((EXPECTEDCONFLICTS symbols)
- `(wisent-raw-tag
- (semantic-tag ',(car $2)
- 'expectedconflicts :rest ',(cdr $2)))))
- (provide_decl
- ((PROVIDE SYMBOL)
- `(wisent-raw-tag
- (semantic-tag ',$2 'provide))))
- (precedence_decl
- ((associativity token_type_opt items)
- `(wisent-raw-tag
- (semantic-tag ',$1 'assoc :type ',$2 :value ',$3))))
- (associativity
- ((LEFT)
- (progn "left"))
- ((RIGHT)
- (progn "right"))
- ((NONASSOC)
- (progn "nonassoc")))
- (put_decl
- ((PUT put_name put_value)
- `(wisent-raw-tag
- (semantic-tag ',$2 'put :value ',(list $3))))
- ((PUT put_name put_value_list)
- `(wisent-raw-tag
- (semantic-tag ',$2 'put :value ',$3)))
- ((PUT put_name_list put_value)
- `(wisent-raw-tag
- (semantic-tag ',(car $2)
- 'put :rest ',(cdr $2)
- :value ',(list $3))))
- ((PUT put_name_list put_value_list)
- `(wisent-raw-tag
- (semantic-tag ',(car $2)
- 'put :rest ',(cdr $2)
- :value ',$3))))
- (put_name_list
- ((BRACE_BLOCK)
- (mapcar 'semantic-tag-name
- (semantic-parse-region
- (car $region1)
- (cdr $region1)
- 'put_names 1))))
- (put_names
- ((LBRACE)
- nil)
- ((RBRACE)
- nil)
- ((put_name)
- (wisent-raw-tag
- (semantic-tag $1 'put-name))))
- (put_name
- ((SYMBOL))
- ((token_type)))
- (put_value_list
- ((BRACE_BLOCK)
- (mapcar 'semantic-tag-code-detail
- (semantic-parse-region
- (car $region1)
- (cdr $region1)
- 'put_values 1))))
- (put_values
- ((LBRACE)
- nil)
- ((RBRACE)
- nil)
- ((put_value)
- (wisent-raw-tag
- (semantic-tag-new-code "put-value" $1))))
- (put_value
- ((SYMBOL any_value)
- (cons $1 $2)))
- (scopestart_decl
- ((SCOPESTART SYMBOL)
- `(wisent-raw-tag
- (semantic-tag ',$2 'scopestart))))
- (quotemode_decl
- ((QUOTEMODE SYMBOL)
- `(wisent-raw-tag
- (semantic-tag ',$2 'quotemode))))
- (start_decl
- ((START symbols)
- `(wisent-raw-tag
- (semantic-tag ',(car $2)
- 'start :rest ',(cdr $2)))))
- (keyword_decl
- ((KEYWORD SYMBOL string_value)
- `(wisent-raw-tag
- (semantic-tag ',$2 'keyword :value ',$3))))
- (token_decl
- ((TOKEN token_type_opt SYMBOL string_value)
- `(wisent-raw-tag
- (semantic-tag ',$3 ',(if $2 'token 'keyword)
- :type ',$2 :value ',$4)))
- ((TOKEN token_type_opt symbols)
- `(wisent-raw-tag
- (semantic-tag ',(car $3)
- 'token :type ',$2 :rest ',(cdr $3)))))
- (token_type_opt
- (nil)
- ((token_type)))
- (token_type
- ((LT SYMBOL GT)
- (progn $2)))
- (type_decl
- ((TYPE token_type plist_opt)
- `(wisent-raw-tag
- (semantic-tag ',$2 'type :value ',$3))))
- (plist_opt
- (nil)
- ((plist)))
- (plist
- ((plist put_value)
- (append
- (list $2)
- $1))
- ((put_value)
- (list $1)))
- (use_name_list
- ((BRACE_BLOCK)
- (mapcar 'semantic-tag-name
- (semantic-parse-region
- (car $region1)
- (cdr $region1)
- 'use_names 1))))
- (use_names
- ((LBRACE)
- nil)
- ((RBRACE)
- nil)
- ((SYMBOL)
- (wisent-raw-tag
- (semantic-tag $1 'use-name))))
- (use_macros_decl
- ((USE-MACROS SYMBOL use_name_list)
- `(wisent-raw-tag
- (semantic-tag "macro" 'macro :type ',$2 :value ',$3))))
- (string_value
- ((STRING)
- (read $1)))
- (any_value
- ((SYMBOL))
- ((STRING))
- ((PAREN_BLOCK))
- ((PREFIXED_LIST))
- ((SEXP)))
- (symbols
- ((lifo_symbols)
- (nreverse $1)))
- (lifo_symbols
- ((lifo_symbols SYMBOL)
- (cons $2 $1))
- ((SYMBOL)
- (list $1)))
- (nonterminal
- ((SYMBOL
- (setq semantic-grammar-wy--nterm $1 semantic-grammar-wy--rindx 0)
- COLON rules SEMI)
- (wisent-raw-tag
- (semantic-tag $1 'nonterminal :children $4))))
- (rules
- ((lifo_rules)
- (apply 'nconc
- (nreverse $1))))
- (lifo_rules
- ((lifo_rules OR rule)
- (cons $3 $1))
- ((rule)
- (list $1)))
- (rule
- ((rhs)
- (let*
- ((nterm semantic-grammar-wy--nterm)
- (rindx semantic-grammar-wy--rindx)
- (rhs $1)
- comps prec action elt)
- (setq semantic-grammar-wy--rindx
- (1+ semantic-grammar-wy--rindx))
- (while rhs
- (setq elt
- (car rhs)
- rhs
- (cdr rhs))
- (cond
- ((vectorp elt)
- (if prec
- (error "Duplicate %%prec in `%s:%d' rule" nterm rindx))
- (setq prec
- (aref elt 0)))
- ((consp elt)
- (if
- (or action comps)
- (setq comps
- (cons elt comps)
- semantic-grammar-wy--rindx
- (1+ semantic-grammar-wy--rindx))
- (setq action
- (car elt))))
- (t
- (setq comps
- (cons elt comps)))))
- (wisent-cook-tag
- (wisent-raw-tag
- (semantic-tag
- (format "%s:%d" nterm rindx)
- 'rule :type
- (if comps "group" "empty")
- :value comps :prec prec :expr action))))))
- (rhs
- (nil)
- ((rhs item)
- (cons $2 $1))
- ((rhs action)
- (cons
- (list $2)
- $1))
- ((rhs PREC item)
- (cons
- (vector $3)
- $1)))
- (action
- ((PAREN_BLOCK))
- ((PREFIXED_LIST))
- ((BRACE_BLOCK)
- (format "(progn\n%s)"
- (let
- ((s $1))
- (if
- (string-match "^{[\r\n ]*" s)
- (setq s
- (substring s
- (match-end 0))))
- (if
- (string-match "[\r\n ]*}$" s)
- (setq s
- (substring s 0
- (match-beginning 0))))
- s))))
- (items
- ((lifo_items)
- (nreverse $1)))
- (lifo_items
- ((lifo_items item)
- (cons $2 $1))
- ((item)
- (list $1)))
- (item
- ((SYMBOL))
- ((CHARACTER))))
- '(grammar prologue epilogue declaration nonterminal rule put_names put_values use_names)))
+ (semantic-tag
+ (format "%s:%d" nterm rindx)
+ 'rule :type
+ (if comps "group" "empty")
+ :value comps :prec prec :expr action))))))
+ (rhs
+ (nil)
+ ((rhs item)
+ (cons $2 $1))
+ ((rhs action)
+ (cons
+ (list $2)
+ $1))
+ ((rhs PREC item)
+ (cons
+ (vector $3)
+ $1)))
+ (action
+ ((PAREN_BLOCK))
+ ((PREFIXED_LIST))
+ ((BRACE_BLOCK)
+ (format "(progn\n%s)"
+ (let
+ ((s $1))
+ (if
+ (string-match "^{[\r\n ]*" s)
+ (setq s
+ (substring s
+ (match-end 0))))
+ (if
+ (string-match "[\r\n ]*}$" s)
+ (setq s
+ (substring s 0
+ (match-beginning 0))))
+ s))))
+ (items
+ ((lifo_items)
+ (nreverse $1)))
+ (lifo_items
+ ((lifo_items item)
+ (cons $2 $1))
+ ((item)
+ (list $1)))
+ (item
+ ((SYMBOL))
+ ((CHARACTER))))
+ (grammar prologue epilogue declaration nonterminal rule put_names put_values use_names))
"Parser table.")
(defun semantic-grammar-wy--install-parser ()
semantic-lex-types-obarray semantic-grammar-wy--token-table)
;; Collect unmatched syntax lexical tokens
(add-hook 'wisent-discarding-token-functions
- 'wisent-collect-unmatched-syntax nil t))
+ #'wisent-collect-unmatched-syntax nil t))
\f
;;; Analyzers
-;;; semantic/grammar.el --- Major mode framework for Semantic grammars
+;;; semantic/grammar.el --- Major mode framework for Semantic grammars -*- lexical-binding: t; -*-
;; Copyright (C) 2002-2005, 2007-2021 Free Software Foundation, Inc.
That is tag names plus names defined in tag attribute `:rest'."
(let* ((tags (semantic-find-tags-by-class
class (current-buffer))))
- (apply 'append
+ (apply #'append
(mapcar
#'(lambda (tag)
(mapcar
- 'intern
+ #'intern
(cons (semantic-tag-name tag)
(semantic-tag-get-attribute tag :rest))))
tags))))
(setq put (car puts)
puts (cdr puts)
keys (mapcar
- 'intern
+ #'intern
(cons (semantic-tag-name put)
(semantic-tag-get-attribute put :rest))))
(while keys
(goto-char start)
(indent-sexp))))
+(defvar semantic-grammar-require-form
+ '(eval-when-compile (require 'semantic/bovine))
+ "The form to use to load the parser engine.")
+
(defconst semantic-grammar-header-template
'("\
;;; " file " --- Generated parser support file
;;; Code:
(require 'semantic/lex)
-(eval-when-compile (require 'semantic/bovine))
+" require-form "
")
"Generated header template.
The symbols in the template are local variables in
semantic--grammar-output-buffer))
(gram . ,(semantic-grammar-buffer-file))
(date . ,(format-time-string "%Y-%m-%d %T%z"))
+ (require-form . ,(format "%S" semantic-grammar-require-form))
(vcid . ,(concat "$" "Id" "$")) ;; Avoid expansion
;; Try to get the copyright from the input grammar, or
;; generate a new one if not found.
(let ((semantic-lex-types-obarray
(semantic-lex-make-type-table tokens props))
semantic-grammar--lex-block-specs)
- (mapatoms 'semantic-grammar-insert-defanalyzer
+ (mapatoms #'semantic-grammar-insert-defanalyzer
semantic-lex-types-obarray))))
\f
;;; Generation of the grammar support file.
(semantic--grammar-package (semantic-grammar-package))
(semantic--grammar-provide (semantic-grammar-first-tag-name 'provide))
(output (concat (or semantic--grammar-provide
- semantic--grammar-package) ".el"))
+ semantic--grammar-package)
+ ".el"))
(semantic--grammar-input-buffer (current-buffer))
(semantic--grammar-output-buffer
(find-file-noselect
(defvar semantic-grammar-mode-map
(let ((km (make-sparse-keymap)))
- (define-key km "|" 'semantic-grammar-electric-punctuation)
- (define-key km ";" 'semantic-grammar-electric-punctuation)
- (define-key km "%" 'semantic-grammar-electric-punctuation)
- (define-key km "(" 'semantic-grammar-electric-punctuation)
- (define-key km ")" 'semantic-grammar-electric-punctuation)
- (define-key km ":" 'semantic-grammar-electric-punctuation)
-
- (define-key km "\t" 'semantic-grammar-indent)
- (define-key km "\M-\t" 'semantic-grammar-complete)
- (define-key km "\C-c\C-c" 'semantic-grammar-create-package)
- (define-key km "\C-cm" 'semantic-grammar-find-macro-expander)
- (define-key km "\C-cik" 'semantic-grammar-insert-keyword)
-;; (define-key km "\C-cc" 'semantic-grammar-generate-and-load)
-;; (define-key km "\C-cr" 'semantic-grammar-generate-one-rule)
+ (define-key km "|" #'semantic-grammar-electric-punctuation)
+ (define-key km ";" #'semantic-grammar-electric-punctuation)
+ (define-key km "%" #'semantic-grammar-electric-punctuation)
+ (define-key km "(" #'semantic-grammar-electric-punctuation)
+ (define-key km ")" #'semantic-grammar-electric-punctuation)
+ (define-key km ":" #'semantic-grammar-electric-punctuation)
+
+ (define-key km "\t" #'semantic-grammar-indent)
+ (define-key km "\M-\t" #'semantic-grammar-complete)
+ (define-key km "\C-c\C-c" #'semantic-grammar-create-package)
+ (define-key km "\C-cm" #'semantic-grammar-find-macro-expander)
+ (define-key km "\C-cik" #'semantic-grammar-insert-keyword)
+;; (define-key km "\C-cc" #'semantic-grammar-generate-and-load)
+;; (define-key km "\C-cr" #'semantic-grammar-generate-one-rule)
km)
"Keymap used in `semantic-grammar-mode'.")
;; Setup Semantic to parse grammar
(semantic-grammar-wy--install-parser)
(setq semantic-lex-comment-regex ";;"
- semantic-lex-analyzer 'semantic-grammar-lexer
+ semantic-lex-analyzer #'semantic-grammar-lexer
semantic-type-relation-separator-character '(":")
semantic-symbol->name-assoc-list
'(
;; Before each change, clear the cached regexp used to highlight
;; macros local in this grammar.
(add-hook 'before-change-functions
- 'semantic--grammar-clear-macros-regexp-2 nil t)
+ #'semantic--grammar-clear-macros-regexp-2 nil t)
;; Handle safe re-parse of grammar rules.
(add-hook 'semantic-edits-new-change-functions
- 'semantic-grammar-edits-new-change-hook-fcn
+ #'semantic-grammar-edits-new-change-hook-fcn
nil t))
\f
;;;;
(names (semantic-tag-get-attribute tag :rest))
(type (semantic-tag-type tag)))
(if names
- (setq name (mapconcat 'identity (cons name names) " ")))
+ (setq name (mapconcat #'identity (cons name names) " ")))
(setq desc (concat
(if type
(format " <%s>" type)
(format " <%s>" type)
"")
(if val
- (concat " " (mapconcat 'identity val " "))
+ (concat " " (mapconcat #'identity val " "))
"")))))
(t
(setq desc (semantic-format-tag-abbreviate tag parent color))))
context-return)))
(define-mode-local-override semantic-analyze-possible-completions
- semantic-grammar-mode (context &rest flags)
+ semantic-grammar-mode (context &rest _flags)
"Return a list of possible completions based on CONTEXT."
(require 'semantic/analyze/complete)
(if (semantic-grammar-in-lisp-p)
(error-message-string error-to-filter))
(message "wisent-parse-max-stack-size \
might need to be increased"))
- (apply 'signal error-to-filter))))))
+ (apply #'signal error-to-filter))))))
;; Manage returned lookahead token
(if wisent-lookahead
(if (eq (caar la-elt) wisent-lookahead)
(if (consp cache) cache '(nil))
)))
+(defmacro wisent-compiled-grammar (grammar &optional start-list)
+ "Return a compiled form of the LALR(1) Wisent GRAMMAR.
+See `wisent--compile-grammar' for a description of the arguments
+and return value."
+ ;; Ensure that the grammar compiler is available.
+ (require 'semantic/wisent/comp)
+ (declare-function wisent-automaton-lisp-form "semantic/wisent/comp" (x))
+ (declare-function wisent--compile-grammar "semantic/wisent/comp" (grm st))
+ (wisent-automaton-lisp-form
+ (wisent--compile-grammar grammar start-list)))
+
(defun wisent-parse-region (start end &optional goal depth returnonerror)
"Parse the area between START and END using the Wisent LALR parser.
Return the list of semantic tags found.
-;;; semantic/wisent/comp.el --- GNU Bison for Emacs - Grammar compiler
+;;; semantic/wisent/comp.el --- GNU Bison for Emacs - Grammar compiler -*- lexical-binding: t; -*-
;; Copyright (C) 1984, 1986, 1989, 1992, 1995, 2000-2007, 2009-2021 Free
;; Software Foundation, Inc.
(declarations (mapcar #'(lambda (v) (list 'defvar v)) vars)))
`(progn
,@declarations
- (eval-when-compile
+ (eval-and-compile
(defvar ,context ',vars)))))
(defmacro wisent-with-context (name &rest body)
;;;; Environment dependencies
;;;; ------------------------
+;; FIXME: Use bignums or bool-vectors?
+
(defconst wisent-BITS-PER-WORD (logcount most-positive-fixnum))
(defsubst wisent-WORDSIZE (n)
"Figure out the actions for every state.
Return the action table."
;; Store the semantic action obarray in (unused) RCODE[0].
- (aset rcode 0 (make-vector 13 0))
+ (aset rcode 0 (obarray-make 13))
(let (i j action-table actrow action)
(setq action-table (make-vector nstates nil)
actrow (make-vector ntokens nil)
;;;; Compile input grammar
;;;; ---------------------
-(defun wisent-compile-grammar (grammar &optional start-list)
+(defun wisent--compile-grammar (grammar start-list)
"Compile the LALR(1) GRAMMAR.
GRAMMAR is a list (TOKENS ASSOCS . NONTERMS) where:
(wisent-parser-automaton)))))
\f
;;;; --------------------------
-;;;; Byte compile input grammar
+;;;; Obsolete byte compile support
;;;; --------------------------
(require 'bytecomp)
"Byte compile the `wisent-compile-grammar' FORM.
Automatically called by the Emacs Lisp byte compiler as a
`byte-compile' handler."
- ;; Eval the `wisent-compile-grammar' form to obtain an LALR
- ;; automaton internal data structure. Then, because the internal
- ;; data structure contains an obarray, convert it to a lisp form so
- ;; it can be byte-compiled.
(byte-compile-form
- ;; FIXME: we macroexpand here since `byte-compile-form' expects
- ;; macroexpanded code, but that's just a workaround: for lexical-binding
- ;; the lisp form should have to pass through closure-conversion and
- ;; `wisent-byte-compile-grammar' is called much too late for that.
- ;; Why isn't this `wisent-automaton-lisp-form' performed at
- ;; macroexpansion time? --Stef
(macroexpand-all
(wisent-automaton-lisp-form (eval form)))))
-;; FIXME: We shouldn't use a `byte-compile' handler. Maybe using a hash-table
-;; instead of an obarray would work around the problem that obarrays
-;; aren't printable. Then (put 'wisent-compile-grammar 'side-effect-free t).
-(put 'wisent-compile-grammar 'byte-compile 'wisent-byte-compile-grammar)
+(defun wisent-compile-grammar (grammar &optional start-list)
+ ;; This is kept for compatibility with FOO-wy.el files generated
+ ;; with older Emacsen.
+ (declare (obsolete wisent-compiled-grammar "Mar 2021"))
+ (wisent--compile-grammar grammar start-list))
+
+(put 'wisent-compile-grammar 'byte-compile #'wisent-byte-compile-grammar)
+
+;;;; --------------------------
+;;;; Byte compile input grammar
+;;;; --------------------------
+;; `wisent--compile-grammar' generates the actual parse table
+;; we need at run-time, but in order to be able to compile the code it
+;; contains, we need to "reify" it back into a piece of ELisp code
+;; which (re)builds it.
+;; This is needed for 2 reasons:
+;; - The parse tables include an obarray and these don't survive the print+read
+;; steps involved in generating a `.elc' file and reading it back in.
+;; - Within the parse table vectors/obarrays we have ELisp functions which
+;; we want to byte-compile, but if we were to just `quote' the table
+;; we'd get them with the same non-compiled functions.
(defun wisent-automaton-lisp-form (automaton)
"Return a Lisp form that produces AUTOMATON.
See also `wisent-compile-grammar' for more details on AUTOMATON."
(let ((obn (make-symbol "ob")) ; Generated obarray name
(obv (aref automaton 3)) ; Semantic actions obarray
)
- `(let ((,obn (make-vector 13 0)))
+ `(let ((,obn (obarray-make 13)))
;; Generate code to initialize the semantic actions obarray,
;; in local variable OBN.
,@(let (obcode)
;; obarray.
(vector
,@(mapcar
- #'(lambda (state) ;; for each state
+ ;; Use name `st' rather than `state' since `state' is
+ ;; defined as dynbound in `semantic-actions' context above :-( !
+ #'(lambda (st) ;; for each state
`(list
,@(mapcar
#'(lambda (tr) ;; for each transition
`(cons ,(if (symbolp k) `(quote ,k) k)
(intern-soft ,(symbol-name a) ,obn))
`(quote ,tr))))
- state)))
+ st)))
(aref automaton 0)))
;; The code of the goto table is unchanged.
,(aref automaton 1)
(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))))
+ `(wisent-compiled-grammar
+ ,(wisent-grammar-grammar)
+ ,(semantic-grammar-start)))
(defun wisent-grammar-setupcode-builder ()
"Return the parser setup code."
semantic-lex-types-obarray %s)\n\
;; Collect unmatched syntax lexical tokens\n\
(add-hook 'wisent-discarding-token-functions\n\
- 'wisent-collect-unmatched-syntax nil t)"
+ #'wisent-collect-unmatched-syntax nil t)"
(semantic-grammar-parsetable)
(buffer-name)
(semantic-grammar-keywordtable)
(define-derived-mode wisent-grammar-mode semantic-grammar-mode "WY"
"Major mode for editing Wisent grammars."
(semantic-grammar-setup-menu wisent-grammar-menu)
+ (setq-local semantic-grammar-require-form '(require 'semantic/wisent))
(semantic-install-function-overrides
'((semantic-grammar-parsetable-builder . wisent-grammar-parsetable-builder)
(semantic-grammar-setupcode-builder . wisent-grammar-setupcode-builder))))
-;;; semantic/wisent/java-tags.el --- Java LALR parser for Emacs
+;;; semantic/wisent/java-tags.el --- Java LALR parser for Emacs -*- lexical-binding: t; -*-
;; Copyright (C) 2001-2006, 2009-2021 Free Software Foundation, Inc.
(define-mode-local-override semantic-analyze-unsplit-name java-mode (namelist)
"Assemble the list of names NAMELIST into a namespace name."
- (mapconcat 'identity namelist "."))
+ (mapconcat #'identity namelist "."))
-;;; semantic/wisent/javascript.el --- javascript parser support
+;;; semantic/wisent/javascript.el --- javascript parser support -*- lexical-binding: t; -*-
;; Copyright (C) 2005, 2009-2021 Free Software Foundation, Inc.
;; Does javascript have identifiable local variables?
nil)
-(define-mode-local-override semantic-tag-protection js-mode (tag &optional parent)
+(define-mode-local-override semantic-tag-protection js-mode (_tag &optional _parent)
"Return protection information about TAG with optional PARENT.
This function returns on of the following symbols:
nil - No special protection. Language dependent.
is to return a symbol based on type modifiers."
nil)
-(define-mode-local-override semantic-analyze-scope-calculate-access js-mode (type scope)
+(define-mode-local-override semantic-analyze-scope-calculate-access js-mode (_type _scope)
"Calculate the access class for TYPE as defined by the current SCOPE.
Access is related to the :parents in SCOPE. If type is a member of SCOPE
then access would be `private'. If TYPE is inherited by a member of SCOPE,
(save-excursion
(if point (goto-char point))
(let* ((case-fold-search semantic-case-fold)
- symlist tmp end)
+ tmp end) ;; symlist
(with-syntax-table semantic-lex-syntax-table
(save-excursion
(when (looking-at "\\w\\|\\s_")
(unless (re-search-backward "\\s-" (point-at-bol) t)
(beginning-of-line))
(setq tmp (buffer-substring-no-properties (point) end))
+ ;; (setq symlist
(if (string-match "\\(.+\\)\\." tmp)
- (setq symlist (list (match-string 1 tmp)
- (substring tmp (1+ (match-end 1)) (length tmp))))
- (setq symlist (list tmp))))))))
+ (list (match-string 1 tmp)
+ (substring tmp (1+ (match-end 1)) (length tmp)))
+ (list tmp)))))));; )
;;; Setup Function
;;
-;;; wisent-python.el --- Semantic support for Python
+;;; wisent-python.el --- Semantic support for Python -*- lexical-binding: t; -*-
;; Copyright (C) 2002, 2004, 2006-2021 Free Software Foundation, Inc.
(define-mode-local-override semantic-tag-include-filename python-mode (tag)
"Return a suitable path for (some) Python imports."
(let ((name (semantic-tag-name tag)))
- (concat (mapconcat 'identity (split-string name "\\.") "/") ".py")))
+ (concat (mapconcat #'identity (split-string name "\\.") "/") ".py")))
;; Override ctxt-current-function/assignment defaults, since they do
;; not work properly with Python code, even leading to endless loops
;; (see bug #xxxxx).
-(define-mode-local-override semantic-ctxt-current-function python-mode (&optional point)
+(define-mode-local-override semantic-ctxt-current-function python-mode (&optional _point)
"Return the current function call the cursor is in at POINT.
The function returned is the one accepting the arguments that
the cursor is currently in. It will not return function symbol if the
cursor is on the text representing that function."
nil)
-(define-mode-local-override semantic-ctxt-current-assignment python-mode (&optional point)
+(define-mode-local-override semantic-ctxt-current-assignment python-mode (&optional _point)
"Return the current assignment near the cursor at POINT.
Return a list as per `semantic-ctxt-current-symbol'.
Return nil if there is nothing relevant."
-;;; semantic/wisent/wisent.el --- GNU Bison for Emacs - Runtime
+;;; semantic/wisent/wisent.el --- GNU Bison for Emacs - Runtime -*- lexical-binding: t; -*-
;;; Copyright (C) 2002-2007, 2009-2021 Free Software Foundation, Inc.
"Print a one-line message if `wisent-parse-verbose-flag' is set.
Pass STRING and ARGS arguments to `message'."
(and wisent-parse-verbose-flag
- (apply 'message string args)))
+ (apply #'message string args)))
\f
;;;; --------------------
;;;; The LR parser engine
(defcustom wisent-parse-max-stack-size 500
"The parser stack size."
- :type 'integer
- :group 'wisent)
+ :type 'integer)
(defcustom wisent-parse-max-recover 3
"Number of tokens to shift before turning off error status."
- :type 'integer
- :group 'wisent)
+ :type 'integer)
(defvar wisent-discarding-token-functions nil
"List of functions to be called when discarding a lexical token.
(wisent-error
(format "Syntax error, unexpected %s, expecting %s"
(wisent-token-to-string wisent-input)
- (mapconcat 'wisent-item-to-string
+ (mapconcat #'wisent-item-to-string
(delq wisent-error-term
- (mapcar 'car (cdr choices)))
+ (mapcar #'car (cdr choices)))
", "))))
;; Increment the error counter
(setq wisent-nerrs (1+ wisent-nerrs))
projects / emacs.git / commitdiff