bug#28759: 26.0.60; Bovine apparently generates Elisp code with oldstyle backquotes

classic Classic list List threaded Threaded
2 messages Options
Reply | Threaded
Open this post in threaded view
|

bug#28759: 26.0.60; Bovine apparently generates Elisp code with oldstyle backquotes

Philipp Stephani

See https://lists.gnu.org/archive/html/emacs-devel/2017-10/msg00313.html

The backtrace I got was

$ (cd admin/grammars && EMACSLOADPATH= "../../src/emacs" -batch --no-site-file --no-site-lisp -eval '(setq debug-on-error t)' -l semantic/bovine/grammar  -f bovine-batch-make-parser -o "../../lisp/cedet/semantic/bovine/make-by.el" make.by)
../../lisp/emacs-lisp/eieio.el: ‘eieio-object-name-string’ is an obsolete generic function (as of 25.1); use ‘eieio-named’ instead.
../../lisp/emacs-lisp/eieio.el: ‘object-print’ is an obsolete generic function (as of 26.1); use ‘cl-print-object’ instead.
../../lisp/emacs-lisp/eieio-base.el: ‘eieio-object-name-string’ is an obsolete generic function (as of 25.1); use ‘eieio-named’ instead.
Debugger entered--Lisp error: (error "Loading ‘nil’: old-style backquotes detected!")
  read("( ,@$2 )")
  (let ((sexp (read textform))) (insert "\n") (cond ((eq (car sexp) 'EXPAND) (insert ",(lambda (vals start end)") (bovine-grammar-expand-form (apply (cdr (assq 'EXPAND bovine--grammar-macros)) (cdr sexp)) quotemode t)) ((and (listp (car sexp)) (eq (car (car sexp)) 'EVAL))) (t (insert ",(semantic-lambda") (bovine-grammar-expand-form sexp quotemode))) (insert ")\n"))
  (if (string= "" textform) nil (let ((sexp (read textform))) (insert "\n") (cond ((eq (car sexp) 'EXPAND) (insert ",(lambda (vals start end)") (bovine-grammar-expand-form (apply (cdr (assq 'EXPAND bovine--grammar-macros)) (cdr sexp)) quotemode t)) ((and (listp (car sexp)) (eq (car (car sexp)) 'EVAL))) (t (insert ",(semantic-lambda") (bovine-grammar-expand-form sexp quotemode))) (insert ")\n")))
  bovine-grammar-expand-action("( ,@$2 )" backquote)
  (if actn (bovine-grammar-expand-action actn quotemode))
  (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)) (insert "\n(") (if (null items) (insert ";;EMPTY" (if actn "" "\n")) (while items (setq item (car items) items (cdr items)) (if (consp item) (message "Mid-rule action %S ignored" item) (or (char-equal (char-before) 40) (insert "\n")) (cond ((member item '("bovine-toplevel" "bovine-inner-scope")) (error "`%s' is a reserved internal name" item)) ((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)))) (t (insert (semantic-grammar-item-text item))))))) (if prec (message "%%prec %S ignored" prec)) (if actn (bovine-grammar-expand-action actn quotemode)) (insert ")"))
  (while nterms (setq nterm (car nterms) rules (semantic-tag-components-semantic-grammar-mode nterm) nterm (semantic-tag-name nterm) nterms (cdr nterms)) (if (member nterm '("bovine-toplevel" "bovine-inner-scope")) (progn (error "`%s' is a reserved internal name" nterm))) (insert "\n(" nterm) (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)) (insert "\n(") (if (null items) (insert ";;EMPTY" (if actn "" "\n")) (while items (setq item (car items) items (cdr items)) (if (consp item) (message "Mid-rule action %S ignored" item) (or (char-equal (char-before) 40) (insert "\n")) (cond ((member item '("bovine-toplevel" "bovine-inner-scope")) (error "`%s' is a reserved internal name" item)) ((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)))) (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"))
  (progn (erase-buffer) (insert "`(") (insert "\n(bovine-toplevel \n(" start ")\n) ;; end bovine-toplevel\n") (if scopestart (progn (insert "\n(bovine-inner-scope \n(" scopestart ")\n) ;; end bovine-inner-scope\n"))) (while nterms (setq nterm (car nterms) rules (semantic-tag-components-semantic-grammar-mode nterm) nterm (semantic-tag-name nterm) nterms (cdr nterms)) (if (member nterm '("bovine-toplevel" "bovine-inner-scope")) (progn (error "`%s' is a reserved internal name" nterm))) (insert "\n(" nterm) (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)) (insert "\n(") (if (null items) (insert ";;EMPTY" (if actn "" "\n")) (while items (setq item (car items) items (cdr items)) (if (consp item) (message "Mid-rule action %S ignored" item) (or (char-equal (char-before) 40) (insert "\n")) (cond ((member item '("bovine-toplevel" "bovine-inner-scope")) (error "`%s' is a reserved internal name" item)) ((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)))) (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))
  (unwind-protect (progn (erase-buffer) (insert "`(") (insert "\n(bovine-toplevel \n(" start ")\n) ;; end bovine-toplevel\n") (if scopestart (progn (insert "\n(bovine-inner-scope \n(" scopestart ")\n) ;; end bovine-inner-scope\n"))) (while nterms (setq nterm (car nterms) rules (semantic-tag-components-semantic-grammar-mode nterm) nterm (semantic-tag-name nterm) nterms (cdr nterms)) (if (member nterm '("bovine-toplevel" "bovine-inner-scope")) (progn (error "`%s' is a reserved internal name" nterm))) (insert "\n(" nterm) (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)) (insert "\n(") (if (null items) (insert ";;EMPTY" (if actn "" "\n")) (while items (setq item (car items) items (cdr items)) (if (consp item) (message "Mid-rule action %S ignored" item) (or (char-equal (char-before) 40) (insert "\n")) (cond ((member item '("bovine-toplevel" "bovine-inner-scope")) (error "`%s' is a reserved internal name" item)) ((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)))) (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)) (and (buffer-name temp-buffer) (kill-buffer temp-buffer)))
  (save-current-buffer (set-buffer temp-buffer) (unwind-protect (progn (erase-buffer) (insert "`(") (insert "\n(bovine-toplevel \n(" start ")\n) ;; end bovine-toplevel\n") (if scopestart (progn (insert "\n(bovine-inner-scope \n(" scopestart ")\n) ;; end bovine-inner-scope\n"))) (while nterms (setq nterm (car nterms) rules (semantic-tag-components-semantic-grammar-mode nterm) nterm (semantic-tag-name nterm) nterms (cdr nterms)) (if (member nterm '("bovine-toplevel" "bovine-inner-scope")) (progn (error "`%s' is a reserved internal name" nterm))) (insert "\n(" nterm) (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)) (insert "\n(") (if (null items) (insert ";;EMPTY" (if actn "" "\n")) (while items (setq item (car items) items (cdr items)) (if (consp item) (message "Mid-rule action %S ignored" item) (or (char-equal (char-before) 40) (insert "\n")) (cond ((member item '("bovine-toplevel" "bovine-inner-scope")) (error "`%s' is a reserved internal name" item)) ((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)))) (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)) (and (buffer-name temp-buffer) (kill-buffer temp-buffer))))
  (let ((temp-buffer (generate-new-buffer " *temp*"))) (save-current-buffer (set-buffer temp-buffer) (unwind-protect (progn (erase-buffer) (insert "`(") (insert "\n(bovine-toplevel \n(" start ")\n) ;; end bovine-toplevel\n") (if scopestart (progn (insert "\n(bovine-inner-scope \n(" scopestart ")\n) ;; end bovine-inner-scope\n"))) (while nterms (setq nterm (car nterms) rules (semantic-tag-components-semantic-grammar-mode nterm) nterm (semantic-tag-name nterm) nterms (cdr nterms)) (if (member nterm '("bovine-toplevel" "bovine-inner-scope")) (progn (error "`%s' is a reserved internal name" nterm))) (insert "\n(" nterm) (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)) (insert "\n(") (if (null items) (insert ";;EMPTY" (if actn "" "\n")) (while items (setq item (car items) items (cdr items)) (if (consp item) (message "Mid-rule action %S ignored" item) (or (char-equal (char-before) 40) (insert "\n")) (cond ((member item '("bovine-toplevel" "bovine-inner-scope")) (error "`%s' is a reserved internal name" item)) ((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)))) (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)) (and (buffer-name temp-buffer) (kill-buffer temp-buffer)))))
  (let* ((start (semantic-grammar-start)) (scopestart (semantic-grammar-scopestart)) (quotemode (semantic-grammar-quotemode)) (tags (let ((tags (semantic-something-to-tag-table (current-buffer))) (result nil)) (while tags (and (eq 'token (semantic-tag-class (car tags))) (setq result (cons (car tags) result))) (setq tags (cdr tags))) (nreverse result))) (nterms (let ((tags (semantic-something-to-tag-table (current-buffer))) (result nil)) (while tags (and (eq 'nonterminal (semantic-tag-class (car tags))) (setq result (cons (car tags) result))) (setq tags (cdr tags))) (nreverse result))) (bovine--grammar-macros (semantic-grammar-macros)) nterm rules items item actn prec tag type regex) (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))) (if (semantic-find-first-tag-by-name start nterms) nil (error "start symbol `%s' has no rule" start))) (t (setq start (semantic-tag-name (car nterms))))) (if scopestart (progn (setq scopestart (symbol-name scopestart)) (if (semantic-find-first-tag-by-name scopestart nterms) nil (error "scopestart symbol `%s' has no rule" scopestart)))) (let ((temp-buffer (generate-new-buffer " *temp*"))) (save-current-buffer (set-buffer temp-buffer) (unwind-protect (progn (erase-buffer) (insert "`(") (insert "\n(bovine-toplevel \n(" start ")\n) ;; end bovine-toplevel\n") (if scopestart (progn (insert "\n(bovine-inner-scope \n(" scopestart ")\n) ;; end bovine-inner-scope\n"))) (while nterms (setq nterm (car nterms) rules (semantic-tag-components-semantic-grammar-mode nterm) nterm (semantic-tag-name nterm) nterms (cdr nterms)) (if (member nterm '("bovine-toplevel" "bovine-inner-scope")) (progn (error "`%s' is a reserved internal name" nterm))) (insert "\n(" nterm) (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)) (insert "\n(") (if (null items) (insert ";;EMPTY" (if actn "" "\n")) (while items (setq item (car items) items (cdr items)) (if (consp item) (message "Mid-rule action %S ignored" item) (or (char-equal (char-before) 40) (insert "\n")) (cond ((member item '("bovine-toplevel" "bovine-inner-scope")) (error "`%s' is a reserved internal name" item)) ((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)))) (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)) (and (buffer-name temp-buffer) (kill-buffer temp-buffer))))))
  bovine-grammar-parsetable-builder()
  semantic-grammar-parsetable-builder()
  semantic-grammar-parser-data()
  semantic-grammar-create-package(nil t)
  (save-current-buffer (set-buffer (find-file-noselect infile)) (if outdir (setq default-directory outdir)) (semantic-grammar-create-package nil t))
  (let ((packagename (save-current-buffer (set-buffer (find-file-noselect infile)) (if outdir (setq default-directory outdir)) (semantic-grammar-create-package nil t))) lang filename copyright-end) (if (and packagename (string-match "^.*/\\(.*\\)-by\\.el\\'" packagename)) (progn (setq lang (match-string 1 packagename)) (setq filename (expand-file-name (concat lang "-by.el") outdir)) (let ((temp-file filename) (temp-buffer (get-buffer-create (generate-new-buffer-name " *temp file*")))) (unwind-protect (prog1 (save-current-buffer (set-buffer temp-buffer) (insert-file-contents filename) (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.\n\n;; GNU Emacs is free software: you can redistribute it and/or modify\n;; it under the terms of the GNU General Public License as published by\n;; the Free Software Foundation, either version 3 of the License, or\n;; (at your option) any later version.\n\n;; GNU Emacs is distributed in the hope that it will be useful,\n;; but WITHOUT ANY WARRANTY; without even the implied warranty of\n;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the\n;; GNU General Public License for more details.\n\n;; You should have received a copy of the GNU General Public License\n;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.\n\n;;; Commentary:\n;;\n;; This file was generated from admin/grammars/" lang ".by.\n\n;;; Code:\n") (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-current-buffer (set-buffer temp-buffer) (write-region nil nil temp-file nil 0))) (and (buffer-name temp-buffer) (kill-buffer temp-buffer)))))))
  bovine--make-parser-1("make.by" "../../lisp/cedet/semantic/bovine/")
  (let ((debug-on-error t)) (bovine--make-parser-1 infile outdir))
  bovine-batch-make-parser()
  command-line-1(("-eval" "(setq debug-on-error t)" "-l" "semantic/bovine/grammar" "-f" "bovine-batch-make-parser" "-o" "../../lisp/cedet/semantic/bovine/make-by.el" "make.by"))
  command-line()
  normal-top-level()

So something generates the Lisp code ( ,@$2 ), which is wrong.  Probably
this should generate ( \,@$2 ) instead.


In GNU Emacs 26.0.60 (build 3, x86_64-pc-linux-gnu, GTK+ Version 3.22.16)
 of 2017-10-09 built on localhost
Repository revision: 5b81f65ad0050a4bbd79c9aed3648fba4f19af27
Windowing system distributor 'The X.Org Foundation', version 11.0.11903000
System Description: Debian GNU/Linux rodete (upgraded from: Ubuntu 14.04 LTS)

Recent messages:
For information about GNU Emacs and the GNU system, type C-h C-a.

Configured using:
 'configure --enable-gcc-warnings=warn-only
 --enable-gtk-deprecation-warnings --without-pop --with-mailutils
 --enable-checking --enable-check-lisp-object-type --with-modules
 'CFLAGS=-O0 -ggdb3''

Configured features:
XPM JPEG TIFF GIF PNG SOUND DBUS GSETTINGS NOTIFY GNUTLS FREETYPE XFT
ZLIB TOOLKIT_SCROLL_BARS GTK3 X11 MODULES

Important settings:
  value of $LANG: en_US.UTF-8
  locale-coding-system: utf-8-unix

Major mode: Lisp Interaction

Minor modes in effect:
  tooltip-mode: t
  global-eldoc-mode: t
  eldoc-mode: t
  electric-indent-mode: t
  mouse-wheel-mode: t
  tool-bar-mode: t
  menu-bar-mode: t
  file-name-shadow-mode: t
  global-font-lock-mode: t
  font-lock-mode: t
  blink-cursor-mode: t
  auto-composition-mode: t
  auto-encryption-mode: t
  auto-compression-mode: t
  line-number-mode: t
  transient-mark-mode: t

Load-path shadows:
None found.

Features:
(shadow sort mail-extr emacsbug message rmc puny seq byte-opt gv
bytecomp byte-compile cconv cl-loaddefs cl-lib dired dired-loaddefs
format-spec rfc822 mml easymenu mml-sec password-cache epa derived epg
epg-config gnus-util rmail rmail-loaddefs mm-decode mm-bodies mm-encode
mail-parse rfc2231 mailabbrev gmm-utils mailheader sendmail rfc2047
rfc2045 ietf-drums mm-util mail-prsvr mail-utils elec-pair time-date
mule-util tooltip eldoc electric uniquify ediff-hook vc-hooks
lisp-float-type mwheel term/x-win x-win term/common-win x-dnd tool-bar
dnd fontset image regexp-opt fringe tabulated-list replace newcomment
text-mode elisp-mode lisp-mode prog-mode register page menu-bar
rfn-eshadow isearch timer select scroll-bar mouse jit-lock font-lock
syntax facemenu font-core term/tty-colors frame cl-generic cham georgian
utf-8-lang misc-lang vietnamese tibetan thai tai-viet lao korean
japanese eucjp-ms cp51932 hebrew greek romanian slovak czech european
ethiopic indian cyrillic chinese composite charscript charprop
case-table epa-hook jka-cmpr-hook help simple abbrev obarray minibuffer
cl-preloaded nadvice loaddefs button faces cus-face macroexp files
text-properties overlay sha1 md5 base64 format env code-pages mule
custom widget hashtable-print-readable backquote dbusbind inotify
dynamic-setting system-font-setting font-render-setting move-toolbar gtk
x-toolkit x multi-tty make-network-process emacs)

Memory information:
((conses 16 95077 6455)
 (symbols 48 20376 1)
 (miscs 40 41 120)
 (strings 32 28244 1299)
 (string-bytes 1 740395)
 (vectors 16 14053)
 (vector-slots 8 494105 8303)
 (floats 8 49 68)
 (intervals 56 224 0)
 (buffers 992 12))

--
Google Germany GmbH
Erika-Mann-Straße 33
80636 München

Registergericht und -nummer: Hamburg, HRB 86891
Sitz der Gesellschaft: Hamburg
Geschäftsführer: Paul Manicle, Halimah DeLaine Prado

If you received this communication by mistake, please don’t forward it to
anyone else (it may contain confidential or privileged information), please
erase all copies of it, including all attachments, and please let the sender
know it went to the wrong person.  Thanks.



Reply | Threaded
Open this post in threaded view
|

bug#28759: 26.0.60; Bovine apparently generates Elisp code with oldstyle backquotes

Philipp Stephani


Philipp <[hidden email]> schrieb am Mo., 9. Okt. 2017 um 16:20 Uhr:

See https://lists.gnu.org/archive/html/emacs-devel/2017-10/msg00313.html

The backtrace I got was

$ (cd admin/grammars && EMACSLOADPATH= "../../src/emacs" -batch --no-site-file --no-site-lisp -eval '(setq debug-on-error t)' -l semantic/bovine/grammar  -f bovine-batch-make-parser -o "../../lisp/cedet/semantic/bovine/make-by.el" make.by)
../../lisp/emacs-lisp/eieio.el: ‘eieio-object-name-string’ is an obsolete generic function (as of 25.1); use ‘eieio-named’ instead.
../../lisp/emacs-lisp/eieio.el: ‘object-print’ is an obsolete generic function (as of 26.1); use ‘cl-print-object’ instead.
../../lisp/emacs-lisp/eieio-base.el: ‘eieio-object-name-string’ is an obsolete generic function (as of 25.1); use ‘eieio-named’ instead.
Debugger entered--Lisp error: (error "Loading ‘nil’: old-style backquotes detected!")
  read("( ,@$2 )")

I looked a bit around, and found that these strings are copied verbatim from the *.by files.
Looking at the comments of lread.c, this seems to be a limitation of the reader: "Because it's more difficult to peek 2 chars ahead, a new-style ,@ can still not be used outside of a `, unless it's in the middle of a list."
Not sure what to do with this, though. Changing the reader would introduce a breaking change for no good reason, since we're trying to get rid of old-style backquotes. So I think this should rather be fixed in Bovine, either by escaping the offending commas, or by removing the space between ( and ,.