procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

* lisp/cedet/semantic/wisent: Use lexical-binding

Browse source 
* 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.
This commit is contained in:
Stefan Monnier 2021-03-07 01:58:16 -05:00
parent 856a0a913a
commit 468bb5ab7f
11 changed files with 416 additions and 393 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
admin/grammars/grammar.wy
View file

@ -128,7 +128,7 @@ epilogue:
;;
declaration:
decl
(eval $1)
(eval $1 t)
;
decl:
@ -206,7 +206,7 @@ put_decl:
put_name_list:
BRACE_BLOCK
(mapcar 'semantic-tag-name (EXPANDFULL $1 put_names))
(mapcar #'semantic-tag-name (EXPANDFULL $1 put_names))
;
put_names:
@ -226,7 +226,7 @@ put_name:
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:
@ -300,7 +300,7 @@ plist:
use_name_list:
BRACE_BLOCK
(mapcar 'semantic-tag-name (EXPANDFULL $1 use_names))
(mapcar #'semantic-tag-name (EXPANDFULL $1 use_names))
;
use_names:
@ -356,7 +356,7 @@ nonterminal:
rules:
lifo_rules
(apply 'nconc (nreverse $1))
(apply #'nconc (nreverse $1))
;
lifo_rules:

3
admin/grammars/python.wy
View file

@ -97,6 +97,7 @@
(tag))
(declare-function semantic-parse-region "semantic"
(start end &optional nonterminal depth returnonerror))
(defvar wisent-python-EXPANDING-block)
}
%languagemode python-mode
@ -871,7 +872,7 @@ paren_class_list_opt
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] ')'

617
lisp/cedet/semantic/grammar-wy.el
View file

@ -24,7 +24,7 @@
;;; Code:
(require 'semantic/lex)
(eval-when-compile (require 'semantic/bovine))
(require 'semantic/wisent)
;;; Prologue
;;
@ -112,315 +112,312 @@
"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 "^{[ \n ]*" s)
(setq s
(substring s
(match-end 0))))
(if
(string-match "[ \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 "^{[ \n ]*" s)
(setq s
(substring s
(match-end 0))))
(if
(string-match "[ \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 ()
@ -434,7 +431,7 @@
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))
;;; Analyzers

58
lisp/cedet/semantic/grammar.el
View file

@ -1,4 +1,4 @@
;;; 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.
@ -191,11 +191,11 @@ Warn if other tags of class CLASS exist."
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))))
@ -312,7 +312,7 @@ the keyword and TOKEN is the terminal symbol identifying the keyword."
(setq put (car puts)
puts (cdr puts)
keys (mapcar
'intern
#'intern
(cons (semantic-tag-name put)
(semantic-tag-get-attribute put :rest))))
(while keys
@ -565,6 +565,10 @@ Typically a DEFINE expression should look like this:
(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
@ -602,7 +606,7 @@ Typically a DEFINE expression should look like this:
;;; Code:
(require 'semantic/lex)
(eval-when-compile (require 'semantic/bovine))
" require-form "
")
"Generated header template.
The symbols in the template are local variables in
@ -651,6 +655,7 @@ The symbols in the list 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.
@ -818,7 +823,7 @@ Block definitions are read from the current table of lexical types."
(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))))
;;; Generation of the grammar support file.
@ -846,7 +851,8 @@ Lisp code."
(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
@ -1197,20 +1203,20 @@ END is the limit of the search."
(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 "|" #'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 "\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'.")
@ -1322,7 +1328,7 @@ the change bounds to encompass the whole nonterminal tag."
;; 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
'(
@ -1343,10 +1349,10 @@ the change bounds to encompass the whole nonterminal tag."
;; 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))
;;;;
@ -1876,7 +1882,7 @@ Optional argument COLOR determines if color is added to the text."
(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)
@ -1893,7 +1899,7 @@ Optional argument COLOR determines if color is added to the text."
(format " <%s>" type)
"")
(if val
(concat " " (mapconcat 'identity val " "))
(concat " " (mapconcat #'identity val " "))
"")))))
(t
(setq desc (semantic-format-tag-abbreviate tag parent color))))
@ -1944,7 +1950,7 @@ Optional argument COLOR determines if color is added to the text."
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)

13
lisp/cedet/semantic/wisent.el
View file

@ -224,7 +224,7 @@ the standard function `semantic-parse-stream'."
(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)
@ -252,6 +252,17 @@ might need to be increased"))
(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.

55
lisp/cedet/semantic/wisent/comp.el
View file

@ -1,4 +1,4 @@
;;; 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.
@ -71,7 +71,7 @@
(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)
@ -101,6 +101,8 @@ If optional LEFT is non-nil insert spaces on left."
;;;; Environment dependencies
;;;; ------------------------
;; FIXME: Use bignums or bool-vectors?
(defconst wisent-BITS-PER-WORD (logcount most-positive-fixnum))
(defsubst wisent-WORDSIZE (n)
@ -2774,7 +2776,7 @@ that likes a token gets to handle it."
"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)
@ -3388,7 +3390,7 @@ NONTERMS is the list of non terminal definitions (see function
;;;; 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:
@ -3440,7 +3442,7 @@ where:
(wisent-parser-automaton)))))
;;;; --------------------------
;;;; Byte compile input grammar
;;;; Obsolete byte compile support
;;;; --------------------------
(require 'bytecomp)
@ -3449,25 +3451,32 @@ where:
"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."
@ -3477,7 +3486,7 @@ 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)
@ -3496,7 +3505,9 @@ See also `wisent-compile-grammar' for more details on AUTOMATON."
;; 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
@ -3507,7 +3518,7 @@ See also `wisent-compile-grammar' for more details on AUTOMATON."
`(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)

12
lisp/cedet/semantic/wisent/grammar.el
View file

@ -286,12 +286,9 @@ Return the expanded expression."
(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."
@ -305,7 +302,7 @@ Return the expanded expression."
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)
@ -325,6 +322,7 @@ 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)
(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))))

4
lisp/cedet/semantic/wisent/java-tags.el
View file

@ -1,4 +1,4 @@
;;; 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.
@ -92,7 +92,7 @@ This function override `get-local-variables'."
(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 "."))

15
lisp/cedet/semantic/wisent/javascript.el
View file

@ -1,4 +1,4 @@
;;; 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.
@ -70,7 +70,7 @@ This function overrides `get-local-variables'."
;; 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.
@ -85,7 +85,7 @@ The default behavior (if not overridden with `tag-protection'
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,
@ -101,7 +101,7 @@ This is currently needed for the mozrepl omniscient database."
(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_")
@ -110,10 +110,11 @@ This is currently needed for the mozrepl omniscient database."
(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
;;

8
lisp/cedet/semantic/wisent/python.el
View file

@ -1,4 +1,4 @@
;;; 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.
@ -464,19 +464,19 @@ To be implemented for Python! For now just return nil."
(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."

14
lisp/cedet/semantic/wisent/wisent.el
View file

@ -1,4 +1,4 @@
;;; 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.
@ -139,7 +139,7 @@ POSITIONS are available."
"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)))
;;;; --------------------
;;;; The LR parser engine
@ -147,13 +147,11 @@ Pass STRING and ARGS arguments to `message'."
(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.
@ -397,9 +395,9 @@ automaton has only one entry point."
(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))