[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/wisi 511d382b2b 1/2: Release version 4.2.0
|
From: |
Stephen Leake |
|
Subject: |
[elpa] externals/wisi 511d382b2b 1/2: Release version 4.2.0 |
|
Date: |
Wed, 11 Jan 2023 19:24:22 -0500 (EST) |
branch: externals/wisi
commit 511d382b2be240a601c7e5807532d8b09e37785c
Author: Stephen Leake <stephen_leake@stephe-leake.org>
Commit: Stephen Leake <stephen_leake@stephe-leake.org>
Release version 4.2.0
---
Alire.make | 10 +
ELPA.make | 34 +-
NEWS | 31 +-
README | 2 +-
alire_rules.make | 16 +
emacs_wisi_common_parse.adb | 3 +-
emacs_wisi_common_parse.ads | 3 +-
gen_emacs_wisi_lr_parse.adb | 12 +-
gen_emacs_wisi_lr_text_rep_parse.adb | 12 +-
gen_run_wisi_lr_parse.adb | 12 +-
gen_run_wisi_lr_text_rep_parse.adb | 12 +-
install.sh | 2 +-
prj-alire.el | 11 +
prj-wisi.el | 30 ++
run_wisi_common_parse.adb | 10 +-
run_wisi_common_parse.ads | 5 +-
standard_common.gpr | 7 +
wisi-fringe.el | 107 +-----
wisi-parse_context.adb | 3 +-
wisi-parse_context.ads | 2 +-
wisi-prj.el | 24 +-
wisi-process-parse.el | 40 ++-
wisi-run-indent-test.el | 57 ++-
wisi-skel.el | 8 +-
wisi.el | 101 ++++--
wisi.texi | 12 +-
wisitoken-bnf-generate.adb | 36 +-
wisitoken-bnf-output_ada.adb | 12 +-
wisitoken-bnf.adb | 1 +
wisitoken-bnf.ads | 13 +-
wisitoken-generate-lr-lr1_generate.adb | 629 +--------------------------------
wisitoken-generate-lr-lr1_generate.ads | 18 +-
wisitoken-lexer-re2c.ads | 2 +-
wisitoken-parse-lr-parser-parse.adb | 3 +-
wisitoken-parse-lr-parser.adb | 6 +
wisitoken-parse-lr-parser.ads | 12 +-
wisitoken-parse.ads | 1 +
wisitoken-parse_table-mode.el | 10 +-
wisitoken-user_guide.texinfo | 6 +-
wisitoken_grammar_actions.adb | 2 +-
wisitoken_grammar_actions.ads | 2 +-
wisitoken_grammar_main.adb | 2 +-
wisitoken_grammar_main.ads | 2 +-
wisitoken_grammar_re2c.c | 2 +-
wisitoken_grammar_re2c_c.ads | 2 +-
45 files changed, 411 insertions(+), 916 deletions(-)
diff --git a/Alire.make b/Alire.make
new file mode 100644
index 0000000000..74f5027966
--- /dev/null
+++ b/Alire.make
@@ -0,0 +1,10 @@
+# Build Ada parts of Emacs wisi with Alire; see build/Makefile for non-Alire
build
+
+STEPHES_ADA_LIBRARY_ALIRE_PREFIX ?= $(CURDIR)/../org.stephe_leake.sal
+
+include $(STEPHES_ADA_LIBRARY_ALIRE_PREFIX)/build/alire_rules.make
+
+# Local Variables:
+# eval: (unless dvc-doing-ediff-p (load-file "prj-wisi.el"))
+# End:
+# end of file
diff --git a/ELPA.make b/ELPA.make
index 27829eef96..566092f31a 100644
--- a/ELPA.make
+++ b/ELPA.make
@@ -1,31 +1,31 @@
-# For compiling in elpa
+# For compiling wisi code in elpa worktree
-.PHONY : all force
-
-all : byte-compile autoloads
+#export Standard_Common_Build := Debug
-ifeq ($(shell uname),Linux)
-EMACS_EXE ?= emacs
+.PHONY : all force
-else ifeq ($(shell uname),Darwin)
-EMACS_EXE ?= "/Applications/Emacs.app/Contents/MacOS/Emacs"
+all : build_ada byte-compile
-else
-# windows
-# specify uniscribe to workaround weird Windows harfbuzz bug
-EMACS_EXE ?= emacs -xrm Emacs.fontBackend:uniscribe
+build_ada : wisi.gpr force
+ gprbuild -p -j8 wisi.gpr
-endif
+wisi.gpr : wisi.gpr.gp
+ gnatprep -DELPA="yes" wisi.gpr.gp wisi.gpr
-BYTE_COMPILE := "(progn (setq byte-compile-error-on-warn
t)(batch-byte-compile))"
+BYTE_COMPILE := "(progn (setq package-load-list '((wisi) (ada-mode)
(gnat-compiler) all)) (package-initialize)(setq byte-compile-error-on-warn
t)(batch-byte-compile))"
byte-compile : byte-compile-clean
- $(EMACS_EXE) -Q -batch -L . --eval $(BYTE_COMPILE) *.el
+ emacs -Q -batch -L . --eval $(BYTE_COMPILE) *.el
byte-compile-clean :
rm -f *.elc
-autoloads : force
- $(EMACS_EXE) -Q -batch --eval "(progn (setq generated-autoload-file
(expand-file-name \"autoloads.el\"))(update-directory-autoloads \".\"))"
+clean : force
+ rm -rf wisi.gpr obj *parse_table*
+recursive-clean : force
+ gprclean -r -P wisi.gpr
+# Local Variables:
+# eval: (unless dvc-doing-ediff-p (load-file "prj-wisi.el"))
+# End:
# end of file
diff --git a/NEWS b/NEWS
index 478b6f91ef..058168d67c 100644
--- a/NEWS
+++ b/NEWS
@@ -1,11 +1,40 @@
GNU Emacs wisi NEWS -- history of user-visible changes.
-Copyright (C) 2014 - 2022 Free Software Foundation, Inc.
+Copyright (C) 2014 - 2023 Free Software Foundation, Inc.
Please send wisi bug reports to bug-gnu-emacs@gnu.org, with
'wisi' in the subject. If possible, use M-x report-emacs-bug.
+* wisi 4.2.0
+3 Jan 2023
+
+** New user variables wisi-disable-completion,
+ wisi-disable-diagnostics, wisi-disable-indent, wisi-disable-parser,
+ wisi-disable-statement to control various features. Normally set by
+ the major mode when it chooses which backends to use.
+
+** New wisi project file statement; @code{import_env_var} - copies the
+ value of an environment variable from @code{process-environment} to
+ the project environment variables.
+
+** Case exception files declared in a wisi project file are now
+ searched for on the project file search path.
+
+** No longer displays right fringe marks, that were supposed to show
+ the location of erros within a file; too hard to get right and
+ maintain, not very useful.
+
+** No longer sets global value of skeleton-end-hook.
+
+** Several small bug fixes
+
+** parser process protocol version 7
+
+ Add commands dump_prev_tree, save_prev_auto; useful for debugging
+ incremental parse issues. Controlled by new user variable
+ wisi-save-text-tree.
+
* wisi 4.1.1
8 Oct 2022
diff --git a/README b/README
index 633727e4b8..715c4da796 100644
--- a/README
+++ b/README
@@ -1,4 +1,4 @@
-Emacs wisi package 4.1.1
+Emacs wisi package 4.2.0
The wisi package provides utilities for using generalized
error-correcting LR parsers (in external processes) to do indentation,
diff --git a/alire_rules.make b/alire_rules.make
new file mode 100644
index 0000000000..e214496368
--- /dev/null
+++ b/alire_rules.make
@@ -0,0 +1,16 @@
+# gnu make rules for building with Alire.
+
+# alr must be started in the directory holding alire.toml
+alire-build : force
+ GPR_PROJECT_PATH= ; alr --no-tty --no-color $(ALIRE_ARGS) build
$(ALIRE_BUILD_ARGS)
+
+alire-env :
+ GPR_PROJECT_PATH= ; alr $(ALIRE_ARGS) printenv
+
+alire-clean :
+ alr clean
+ rm -rf alire build/obj/release build/obj/development
+
+.PHONY : force
+
+# end of file
diff --git a/emacs_wisi_common_parse.adb b/emacs_wisi_common_parse.adb
index 6c1c80a228..5fc3877ee7 100644
--- a/emacs_wisi_common_parse.adb
+++ b/emacs_wisi_common_parse.adb
@@ -249,6 +249,7 @@ package body Emacs_Wisi_Common_Parse is
Language_Protocol_Version : in String;
Params : in Process_Start_Params;
Factory : in WisiToken.Parse.Factory;
+ Free_Parser : in WisiToken.Parse.Free_Parser;
Trace : in WisiToken.Trace_Access)
is
use Ada.Text_IO;
@@ -349,7 +350,7 @@ package body Emacs_Wisi_Common_Parse is
Reset_Content_On_Free => False);
elsif Match ("kill-context") then
- Wisi.Parse_Context.Kill (File_Name => Wisi.Get_String
(Command_Line, Last));
+ Wisi.Parse_Context.Kill (File_Name => Wisi.Get_String
(Command_Line, Last), Free_Parser => Free_Parser);
elsif Match ("memory_report_reset") then
-- Args: <none>
diff --git a/emacs_wisi_common_parse.ads b/emacs_wisi_common_parse.ads
index e6852cf422..a5fb95840b 100644
--- a/emacs_wisi_common_parse.ads
+++ b/emacs_wisi_common_parse.ads
@@ -24,7 +24,7 @@ with WisiToken.Parse;
with Wisi.Parse_Context;
package Emacs_Wisi_Common_Parse is
- Protocol_Version : constant String := "6";
+ Protocol_Version : constant String := "7";
-- Protocol_Version defines the data sent between elisp and the
-- background process, except for the language-specific parameters,
-- which are defined by the Language_Protocol_Version parameter to
@@ -67,6 +67,7 @@ package Emacs_Wisi_Common_Parse is
Language_Protocol_Version : in String;
Params : in Process_Start_Params;
Factory : in WisiToken.Parse.Factory;
+ Free_Parser : in WisiToken.Parse.Free_Parser;
Trace : in WisiToken.Trace_Access);
----------
diff --git a/gen_emacs_wisi_lr_parse.adb b/gen_emacs_wisi_lr_parse.adb
index 72638d68bf..b4f59111a1 100644
--- a/gen_emacs_wisi_lr_parse.adb
+++ b/gen_emacs_wisi_lr_parse.adb
@@ -36,7 +36,17 @@ is
Language_Matching_Begin_Tokens => Language_Matching_Begin_Tokens,
Language_String_ID_Set => Language_String_ID_Set));
end Factory;
+
+ procedure Free_Parser (Object : in out WisiToken.Parse.Base_Parser_Access)
+ is
+ LR_Parser : WisiToken.Parse.LR.Parser.Parser_Access :=
WisiToken.Parse.LR.Parser.Parser_Access (Object);
+ begin
+ WisiToken.Parse.LR.Parser.Free (LR_Parser);
+ Object := null;
+ end Free_Parser;
+
begin
Process_Stream
- (Name, Language_Protocol_Version, Params, Factory'Unrestricted_Access,
Trace'Unchecked_Access);
+ (Name, Language_Protocol_Version, Params,
+ Factory'Unrestricted_Access, Free_Parser'Unrestricted_Access,
Trace'Unchecked_Access);
end Gen_Emacs_Wisi_LR_Parse;
diff --git a/gen_emacs_wisi_lr_text_rep_parse.adb
b/gen_emacs_wisi_lr_text_rep_parse.adb
index c3a73ca565..ac7c2117ea 100644
--- a/gen_emacs_wisi_lr_text_rep_parse.adb
+++ b/gen_emacs_wisi_lr_text_rep_parse.adb
@@ -41,7 +41,17 @@ is
Language_String_ID_Set => Language_String_ID_Set,
Text_Rep_File_Name => Text_Rep_File_Name_Full));
end Factory;
+
+ procedure Free_Parser (Object : in out WisiToken.Parse.Base_Parser_Access)
+ is
+ LR_Parser : WisiToken.Parse.LR.Parser.Parser_Access :=
WisiToken.Parse.LR.Parser.Parser_Access (Object);
+ begin
+ WisiToken.Parse.LR.Parser.Free (LR_Parser);
+ Object := null;
+ end Free_Parser;
+
begin
Process_Stream
- (Name, Language_Protocol_Version, Params, Factory'Unrestricted_Access,
Trace'Unchecked_Access);
+ (Name, Language_Protocol_Version, Params,
+ Factory'Unrestricted_Access, Free_Parser'Unrestricted_Access,
Trace'Unchecked_Access);
end Gen_Emacs_Wisi_LR_Text_Rep_Parse;
diff --git a/gen_run_wisi_lr_parse.adb b/gen_run_wisi_lr_parse.adb
index 31477aa0dd..c96ecc789d 100644
--- a/gen_run_wisi_lr_parse.adb
+++ b/gen_run_wisi_lr_parse.adb
@@ -34,6 +34,16 @@ is
Language_Matching_Begin_Tokens => Language_Matching_Begin_Tokens,
Language_String_ID_Set => Language_String_ID_Set));
end Factory;
+
+ procedure Free_Parser (Object : in out WisiToken.Parse.Base_Parser_Access)
+ is
+ LR_Parser : WisiToken.Parse.LR.Parser.Parser_Access :=
WisiToken.Parse.LR.Parser.Parser_Access (Object);
+ begin
+ WisiToken.Parse.LR.Parser.Free (LR_Parser);
+ Object := null;
+ end Free_Parser;
+
begin
- Run_Wisi_Common_Parse.Parse_File (Factory'Unrestricted_Access,
Trace'Unchecked_Access);
+ Run_Wisi_Common_Parse.Parse_File
+ (Factory'Unrestricted_Access, Free_Parser'Unrestricted_Access,
Trace'Unchecked_Access);
end Gen_Run_Wisi_LR_Parse;
diff --git a/gen_run_wisi_lr_text_rep_parse.adb
b/gen_run_wisi_lr_text_rep_parse.adb
index a426cdc144..4bc934f10e 100644
--- a/gen_run_wisi_lr_text_rep_parse.adb
+++ b/gen_run_wisi_lr_text_rep_parse.adb
@@ -40,6 +40,16 @@ is
Language_String_ID_Set => Language_String_ID_Set,
Text_Rep_File_Name => Text_Rep_File_Name_Full));
end Factory;
+
+ procedure Free_Parser (Object : in out WisiToken.Parse.Base_Parser_Access)
+ is
+ LR_Parser : WisiToken.Parse.LR.Parser.Parser_Access :=
WisiToken.Parse.LR.Parser.Parser_Access (Object);
+ begin
+ WisiToken.Parse.LR.Parser.Free (LR_Parser);
+ Object := null;
+ end Free_Parser;
+
begin
- Run_Wisi_Common_Parse.Parse_File (Factory'Unrestricted_Access,
Trace'Unchecked_Access);
+ Run_Wisi_Common_Parse.Parse_File
+ (Factory'Unrestricted_Access, Free_Parser'Unrestricted_Access,
Trace'Unchecked_Access);
end Gen_Run_Wisi_LR_Text_Rep_Parse;
diff --git a/install.sh b/install.sh
old mode 100644
new mode 100755
index 202d6a1e8b..886fc94eed
--- a/install.sh
+++ b/install.sh
@@ -6,7 +6,7 @@
# $1 : optional --prefix=<dir>
#
# If you don't have write permission in the GNAT installation
-# directory, you need to use --prefix=<dir>, or run with root privileges.
+# directory, you need to use --prefix=<dir>, or run with root priviledges.
WISI_DIR=`ls -d ../wisi-3.1.?`
diff --git a/prj-alire.el b/prj-alire.el
new file mode 100644
index 0000000000..773c435d3f
--- /dev/null
+++ b/prj-alire.el
@@ -0,0 +1,11 @@
+;; Set up building with Alire -*- no-byte-compile : t -*-
+
+(wisi-prj-select-cache
+ "prj-alire.el"
+ (create-alire-prj
+ :name "wisi stephe-3 Alire eglot"
+ :gpr-file gpr-file
+ :xref-label 'gpr_query)
+ "Makefile")
+
+;; end of file
diff --git a/prj-wisi.el b/prj-wisi.el
new file mode 100644
index 0000000000..f8e41afdbf
--- /dev/null
+++ b/prj-wisi.el
@@ -0,0 +1,30 @@
+;; Set up building with gprbuild in elpa -*- no-byte-compile : t -*-
+;;
+;; Copyright (C) 2021, 2022 Free Software Foundation, Inc.
+;;
+;; 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 <https://www.gnu.org/licenses/>.
+
+(wisi-prj-select-cache
+ "wisi.gpr"
+ (create-ada-prj
+ :name "wisi main"
+ :compile-env
+ (list
+ (concat "SAL=" (expand-file-name "../../org.stephe_leake.sal"))
+ (concat "WISITOKEN=" (expand-file-name "../../org.wisitoken"))
+ ))
+ "Makefile"
+ )
diff --git a/run_wisi_common_parse.adb b/run_wisi_common_parse.adb
index cd9609c98c..a3ece4cabf 100644
--- a/run_wisi_common_parse.adb
+++ b/run_wisi_common_parse.adb
@@ -404,6 +404,7 @@ package body Run_Wisi_Common_Parse is
procedure Process_Command
(Parse_Context : in out Wisi.Parse_Context.Parse_Context_Access;
Factory : in WisiToken.Parse.Factory;
+ Free_Parser : in WisiToken.Parse.Free_Parser;
Line : in String;
Trace : in WisiToken.Trace_Access)
is
@@ -466,7 +467,7 @@ package body Run_Wisi_Common_Parse is
if Source_File_Name = -Parse_Context.File_Name then
Parse_Context := null;
end if;
- Wisi.Parse_Context.Kill (Source_File_Name);
+ Wisi.Parse_Context.Kill (Source_File_Name, Free_Parser);
end;
when Language_Params =>
@@ -684,7 +685,10 @@ package body Run_Wisi_Common_Parse is
end case;
end Process_Command;
- procedure Parse_File (Factory : in WisiToken.Parse.Factory; Trace : in
WisiToken.Trace_Access)
+ procedure Parse_File
+ (Factory : in WisiToken.Parse.Factory;
+ Free_Parser : in WisiToken.Parse.Free_Parser;
+ Trace : in WisiToken.Trace_Access)
is
use Ada.Text_IO;
use WisiToken;
@@ -953,7 +957,7 @@ package body Run_Wisi_Common_Parse is
if Line (1 .. 2) = "--" then
null;
else
- Process_Command (Parse_Context, Factory, Line,
Trace);
+ Process_Command (Parse_Context, Factory,
Free_Parser, Line, Trace);
Trace.New_Line;
end if;
end if;
diff --git a/run_wisi_common_parse.ads b/run_wisi_common_parse.ads
index 67a5b8c3e1..d4f3cad148 100644
--- a/run_wisi_common_parse.ads
+++ b/run_wisi_common_parse.ads
@@ -22,7 +22,10 @@ with Wisi;
with WisiToken.Parse;
package Run_Wisi_Common_Parse is
- procedure Parse_File (Factory : in WisiToken.Parse.Factory; Trace : in
WisiToken.Trace_Access);
+ procedure Parse_File
+ (Factory : in WisiToken.Parse.Factory;
+ Free_Parser : in WisiToken.Parse.Free_Parser;
+ Trace : in WisiToken.Trace_Access);
-- Reads command line, processes command(s).
end Run_Wisi_Common_Parse;
diff --git a/standard_common.gpr b/standard_common.gpr
index 520c5f6e6e..6553e9559b 100644
--- a/standard_common.gpr
+++ b/standard_common.gpr
@@ -170,4 +170,11 @@ project Standard_Common is
end Linker;
-- In project files, no linker package is needed.
+
+ package Pretty_Printer is
+ -- Used by ada_language_server and gnatpp. Projects will need
+ -- to add "--dictionary=<case exceptions file>".
+ for Default_Switches ("Ada") use ("--source-line-breaks");
+ end Pretty_Printer;
+
end Standard_Common;
diff --git a/wisi-fringe.el b/wisi-fringe.el
index d928f38bda..875d4437e8 100644
--- a/wisi-fringe.el
+++ b/wisi-fringe.el
@@ -33,60 +33,18 @@
(require 'wisi-parse-common) ;For `wisi-debug'
-(defun wisi-fringe-create-bitmaps ()
- "Return an array of bitmap symbols containing the fringe bitmaps."
- ;; First create the ’!!’ bitmap.
- (define-fringe-bitmap 'wisi-fringe--double-exclaim-bmp
- (vector
- #b00000000
- #b01100110
- #b01100110
- #b01100110
- #b01100110
- #b01100110
- #b00000000
- #b01100110
- #b01010110
- #b00000000))
-
- ;; In condensing the entire buffer to the current window height, we
- ;; assume a 10 point font, which allows 6 distinct line positions
- ;; each one pixel high, with one blank pixel between.
-
- (let ((result (make-vector 64 nil))
- (i 1))
- (while (<= i (length result))
- (aset result (1- i)
- (define-fringe-bitmap (intern (format "wisi-fringe--line-%d-bmp" i))
- (vector
- (if (>= i 32) #b11111111 #b00000000)
- #b00000000
- (if (>= (% i 32) 16) #b11111111 #b00000000)
- #b00000000
- (if (>= (% i 16) 8) #b11111111 #b00000000)
- #b00000000
- (if (>= (% i 8) 4) #b11111111 #b00000000)
- #b00000000
- (if (>= (% i 4) 2) #b11111111 #b00000000)
- #b00000000
- (if (>= (% i 2) 1) #b11111111 #b00000000)
- )))
- (setq i (1+ i)))
- result))
-
-(defconst wisi-fringe-bitmaps (wisi-fringe-create-bitmaps)
- "Array of 64 bitmap symbols.")
-
-(defun wisi-fringe--put-right (line bitmap-index)
- (save-excursion
- (goto-char (point-min))
- (forward-line (1- line))
- (let* ((endpos (line-end-position))
- (ov (make-overlay endpos (1+ endpos)))
- (bmp (aref wisi-fringe-bitmaps bitmap-index)))
- (overlay-put ov 'after-string (propertize "-" 'display (list
'right-fringe bmp 'compilation-error)))
- (overlay-put ov 'wisi-fringe t)
- )))
+(define-fringe-bitmap 'wisi-fringe--double-exclaim-bmp
+ (vector
+ #b00000000
+ #b01100110
+ #b01100110
+ #b01100110
+ #b01100110
+ #b01100110
+ #b00000000
+ #b01100110
+ #b01010110
+ #b00000000))
(defun wisi-fringe--put-left (line)
(save-excursion
@@ -103,26 +61,6 @@
(overlay-put ov 'wisi-fringe t)
)))
-(defun wisi-fringe--scale (error-line buffer-lines window-line-first
window-lines)
- "Return a cons (LINE . BIN) for ERROR-LINE,
-where LINE is the line to display the error bar on, and BIN is a
-6-bit bit vector giving the relative position in that line.
-BUFFER-LINES is the count of lines in the buffer.
-WINDOW-LINE-FIRST is the first and last lines of the buffer
-visible in the window. WINDOW-LINES is the count of lines visible
-in the window."
- ;; If the end of buffer is inside the window, and this calculation
- ;; puts a mark after that, it will actually be put on the last real
- ;; line. That’s good enough for our purposes.
-
- ;; partial-lines / window-line = 6
- ;; buffer-lines / window-line = 1/scale
- ;; buffer-lines / partial-line = (window-line / partial-lines) *
(buffer-lines / window-line) = 1/6 * 1/scale
- (let* ((scale (/ window-lines (float buffer-lines)))
- (line (floor (* scale error-line)))
- (rem (- error-line (floor (/ line scale)))))
- (cons (+ window-line-first line) (ash 1 (min 5 (floor (* rem (* 6
scale))))))))
-
(defun wisi-fringe-clean ()
"Remove all wisi-fringe marks."
(remove-overlays (point-min) (point-max) 'wisi-fringe t))
@@ -131,17 +69,10 @@ in the window."
"Display markers in the fringe for each buffer position in POSITIONS.
The buffer containing POSITIONS must be current, and the window
displaying that buffer must be current."
- ;; We don't recompute fringe display on scroll, because the user
- ;; will probably have edited the code by then, triggering a new
- ;; parse. FIXME: use flymake.
(wisi-fringe-clean)
(when positions
- (let (scaled-posns
- (buffer-lines (line-number-at-pos (point-max) t))
- (window-lines (window-height))
- (window-pos-first (window-start))
- (window-pos-last (window-end))
- (window-line-first (line-number-at-pos (window-start) t)))
+ (let ((window-pos-first (window-start))
+ (window-pos-last (window-end)))
(when (< 1 wisi-debug)
(wisi-parse-log-message wisi-parser-shared
@@ -151,19 +82,11 @@ displaying that buffer must be current."
window-pos-last)))
(dolist (pos positions)
- (let* ((line (line-number-at-pos (max (point-min) (min (point-max)
pos)) t))
- (scaled-pos (wisi-fringe--scale line buffer-lines
window-line-first window-lines)))
+ (let* ((line (line-number-at-pos (max (point-min) (min (point-max)
pos)) t)))
(when (and (>= pos window-pos-first)
(<= pos window-pos-last))
(wisi-fringe--put-left line))
- (if (and scaled-posns
- (= (caar scaled-posns) (car scaled-pos)))
- (setcdr (car scaled-posns) (logior (cdar scaled-posns) (cdr
scaled-pos)))
- (push scaled-pos scaled-posns))
))
-
- (dolist (pos scaled-posns)
- (wisi-fringe--put-right (car pos) (1- (cdr pos))))
)))
(provide 'wisi-fringe)
diff --git a/wisi-parse_context.adb b/wisi-parse_context.adb
index 62654c0a0c..97c13bdce3 100644
--- a/wisi-parse_context.adb
+++ b/wisi-parse_context.adb
@@ -161,7 +161,7 @@ package body Wisi.Parse_Context is
end;
end Find;
- procedure Kill (File_Name : in String)
+ procedure Kill (File_Name : in String; Free_Parser : in
WisiToken.Parse.Free_Parser)
is begin
if File_Name'Length = 0 then
raise Wisi.Protocol_Error with "no file name given";
@@ -181,6 +181,7 @@ package body Wisi.Parse_Context is
begin
Map.Delete (File_Name);
Ada.Strings.Unbounded.Free (Context.Text_Buffer);
+ Free_Parser (Context.Parser);
Free (Context);
end;
end if;
diff --git a/wisi-parse_context.ads b/wisi-parse_context.ads
index 136a62a3e1..40f354ce6d 100644
--- a/wisi-parse_context.ads
+++ b/wisi-parse_context.ads
@@ -89,7 +89,7 @@ package Wisi.Parse_Context is
-- Raise Not_Found if no context found for File_Name.
-- If Have_Text, raise Not_Found if Text_Buffer is empty.
- procedure Kill (File_Name : in String);
+ procedure Kill (File_Name : in String; Free_Parser : in
WisiToken.Parse.Free_Parser);
procedure Clear;
-- Delete all contexts.
diff --git a/wisi-prj.el b/wisi-prj.el
index 75ed467e94..69ecc132a2 100644
--- a/wisi-prj.el
+++ b/wisi-prj.el
@@ -55,7 +55,7 @@
;;
;; New exceptions may be added interactively via
;; `wisi-case-create-exception'. If an exception is defined in
- ;; multiple files, the first occurrence is used.
+ ;; multiple files, the first occurence is used.
;;
;; The file format is one word per line, which gives the casing to be
;; used for that word in source code. If the line starts with
@@ -166,6 +166,11 @@ If NOT-FULL is non-nil, very slow refresh operations may
be skipped.")
;; modes don't have a language-specific compiler (eg java-wisi) or
;; xref process (eg gpr-mode).
+;;;###autoload
+(defun wisi-prj-make-compiler (label)
+ ;; We assume the constructor is autoloaded
+ (funcall (intern (format "create-%s-compiler" (symbol-name label)))))
+
(cl-defgeneric wisi-compiler-parse-one (compiler project name value)
"Set NAME, VALUE in COMPILER, if recognized by COMPILER.
PROJECT is an `wisi-prj' object; COMPILER is `wisi-prj-compiler'.")
@@ -196,6 +201,10 @@ SOURCE-BUFFER contains the source code referenced in the
error message.")
(cl-defgeneric wisi-compiler-root-dir (compiler)
"Return a meaningful root directory; nil if none.")
+(defun wisi-prj-make-xref (label)
+ ;; We assume the constructor is autoloaded
+ (funcall (intern (format "create-%s-xref" (symbol-name label)))))
+
(cl-defgeneric wisi-xref-parse-one (_xref _project _name _value)
"If recognized by XREF, set NAME, VALUE in XREF, return non-nil.
Else return nil."
@@ -534,7 +543,7 @@ With prefix, keep previous references in output buffer."
))
(defun wisi-show-local-references (&optional append)
- "Show all references of identifier at point occurring in current file.
+ "Show all references of identifier at point occuring in current file.
With prefix, keep previous references in output buffer."
(interactive "P")
(let* ((project (wisi-check-current-project (buffer-file-name)))
@@ -612,6 +621,9 @@ COLUMN - Emacs column of the start of the identifier")
(wisi-compiler-root-dir (wisi-prj-compiler project)))
(car (wisi-prj-source-path project))))
+(cl-defmethod project-name ((project wisi-prj))
+ (wisi-prj-name project))
+
(cl-defmethod project-files ((project wisi-prj) &optional dirs)
(let (result)
(dolist (dir (or dirs
@@ -998,7 +1010,7 @@ Return (cons full-exceptions partial-exceptions)."
))
(defun wisi--case-merge-exceptions (result new)
- "Merge NEW exceptions into RESULT.
+ "Merge NEW exeptions into RESULT.
An item in both lists has the RESULT value."
(dolist (item new)
(unless (assoc-string (car item) result t)
@@ -1429,7 +1441,11 @@ For `xref-backend-functions'."
(let ((prj (project-current)))
(when (and (wisi-prj-p prj)
(wisi-prj-xref prj))
- prj)))
+ (cond
+ ((eq (wisi-prj-xref prj) 'eglot)
+ 'eglot)
+ (t prj))
+ )))
;;;; project-find-functions alternatives
diff --git a/wisi-process-parse.el b/wisi-process-parse.el
index 4a209d987f..def4ce9c6e 100644
--- a/wisi-process-parse.el
+++ b/wisi-process-parse.el
@@ -1,6 +1,6 @@
;;; wisi-process-parse.el --- interface to external parse program -*-
lexical-binding: t; -*-
;;
-;; Copyright (C) 2014, 2017 - 2022 Free Software Foundation, Inc.
+;; Copyright (C) 2014, 2017 - 2023 Free Software Foundation, Inc.
;;
;; Author: Stephen Leake <stephen_leake@member.fsf.org>
;;
@@ -22,7 +22,7 @@
(require 'cl-lib)
(require 'wisi-parse-common)
-(defconst wisi-process-parse-protocol-version "6"
+(defconst wisi-process-parse-protocol-version "7"
"Defines data exchanged between this package and the background process.
Must match emacs_wisi_common_parse.ads Protocol_Version.")
@@ -153,10 +153,7 @@ Otherwise add PARSER to `wisi-process--alist', return it."
(with-current-buffer (car wisi-parse-full-active)
(read-only-mode -1)
(let ((region (cdr wisi-parse-full-active)))
- (when (and (>= (cdr region) (car region))
- (>= (cdr region) (point-min))
- (<= (car region) (point-max)))
- (font-lock-flush (car region) (cdr region))))
+ (font-lock-flush (max (point-min) (car region)) (min
(point-max) (cdr region))))
(set-process-filter process nil)
@@ -172,9 +169,9 @@ Otherwise add PARSER to `wisi-process--alist', return it."
)
(setq wisi-parse-full-active nil)
))))
- ))))
+ ))))
-(cl-defmethod wisi-parse-require-process (parser &key nowait)
+(cl-defmethod wisi-parse-require-process ((parser wisi-process--parser) &key
nowait)
(unless (process-live-p (wisi-process--parser-process parser))
(let ((process-connection-type nil) ;; use a pipe, not a pty; avoid
line-by-line reads
(process-name (format " *%s_wisi_parse*" (wisi-process--parser-label
parser))))
@@ -192,7 +189,9 @@ Otherwise add PARSER to `wisi-process--alist', return it."
(erase-buffer));; delete any previous messages, prompt
(when (or (not nowait) (>= wisi-debug 2))
- (message "starting parser %s ..." (wisi-process--parser-label parser)))
+ (message "starting wisi parser %s in buffer %s ..."
+ (wisi-process--parser-label parser)
+ (current-buffer)))
(wisi-parse-log-message parser "create process")
(setf (wisi-process--parser-version-checked parser) nil)
@@ -219,7 +218,7 @@ Otherwise add PARSER to `wisi-process--alist', return it."
(unless nowait
(wisi-process-parse--wait parser)
- (message "starting parser ... done"))
+ (message "starting wisi parser ... done"))
)))
(defun wisi-process-parse--wait (parser)
@@ -258,7 +257,7 @@ Otherwise add PARSER to `wisi-process--alist', return it."
(defun wisi-process-parse--add-cmd-length (cmd)
"Return CMD (a string) with length prefixed."
;; Characters in cmd length must match emacs_wisi_common_parse.adb
- ;; Get_Command_Length. If the actual length overflows the allotted
+ ;; Get_Command_Length. If the actual length overflows the alloted
;; space, we will get a protocol_error from the parser
;; eventually. Caller should prevent that and send an alternate
;; command.
@@ -324,6 +323,10 @@ complete. PARSE-END is end of desired parse region."
;; we don't log the buffer text; may be huge
(process-send-string process (buffer-substring-no-properties begin
send-end))
+ ;; We don't set wisi-process--parser-update-fringe; partial parse
+ ;; almost always has bogus errors at the start and end of the
+ ;; parse.
+ ;;
;; We don't wait for the send to complete here.
))
@@ -390,7 +393,7 @@ complete."
)))
(process (wisi-process--parser-process parser)))
- (setf (wisi-process--parser-update-fringe parser) t)
+ (setf (wisi-process--parser-update-fringe parser) (not
wisi-disable-diagnostics))
(with-current-buffer (wisi-process--parser-buffer parser)
(erase-buffer))
@@ -819,6 +822,7 @@ Source buffer is current."
(cl-defmethod wisi-parse-reset ((parser wisi-process--parser))
(setf (wisi-process--parser-busy parser) nil)
+ (setq wisi-parse-full-active nil)
(wisi-parse-require-process parser)
(wisi-process--kill-context parser)
(wisi-process-parse--wait parser))
@@ -838,6 +842,10 @@ Source buffer is current."
(cl-defun wisi-process-parse--prepare (parser parse-action &key nowait)
"Check for parser busy and startup, mark parser busy, require parser
process."
+ (unless (process-live-p (wisi-process--parser-process parser))
+ (wisi-parse-log-message parser "process died")
+ (error "parser process died"))
+
(when (wisi-process--parser-busy parser)
(when (< 1 wisi-debug)
(wisi-parse-log-message parser (format "parse--prepare %s in %s parser
busy" parse-action (current-buffer))))
@@ -1177,17 +1185,19 @@ Source buffer is current."
;; The parser process has not finished starting up, or has not yet
;; been started. If this is the very first Ada file in the current
;; project, and there is more text in the file than the process
- ;; send buffer holds, w-p-p--send-* hangs waiting for the process
+ ;; send buffer holds, w-p-p--send-* waits for the process
;; to start reading, which is after it loads the parse table,
;; which can take noticeable time for Ada.
- (message "starting parser %s ..." (wisi-process--parser-label parser)))
+ (message "waiting for wisi parser %s start in buffer %s ..."
+ (wisi-process--parser-label parser)
+ (current-buffer)))
(wisi-process-parse--prepare parser parse-action :nowait nowait)
(setf (wisi-parser-local-lexer-errors wisi-parser-local) nil)
(setf (wisi-parser-local-parse-errors wisi-parser-local) nil)
(cond
((and full nowait)
(set-process-filter (wisi-process--parser-process parser)
#'wisi-process-parse--filter)
- (setq wisi-parse-full-active (cons (current-buffer) (cons (point-max)
(point-min))))
+ (setq wisi-parse-full-active (cons (current-buffer) (cons (point-min)
(point-max))))
(read-only-mode 1)
(wisi-process-parse--send-incremental-parse parser full))
(t
diff --git a/wisi-run-indent-test.el b/wisi-run-indent-test.el
index b3a52bfcca..0f3090c4c0 100644
--- a/wisi-run-indent-test.el
+++ b/wisi-run-indent-test.el
@@ -36,6 +36,10 @@ text, after each edit in an incremental parse, and before
each partial parse.")
(defun test-in-comment-p ()
(nth 4 (syntax-ppss)))
+(defun wisi-wait-parser()
+ (while (wisi-process--parser-busy wisi-parser-shared)
+ (accept-process-output nil wisi-process-time-out)))
+
(defvar test-face-wait-fn nil
"Function to call after `font-lock-ensure' to wait for face to actually be
set.")
@@ -52,10 +56,12 @@ FACE may be a list."
(error "can't find '%s'" token)))
(when (not skip-recase-test) ;; should be t when wisi-disable-face is t
- (let ((token (match-string 0))
+ (let ((token (match-string-no-properties 0))
(test-pos (match-beginning 0)))
(when wisi-parser-shared
+ ;; it may be busy doing initial parse in another file opened by an
xref command.
+ (wisi-wait-parser)
(wisi-validate-cache (line-beginning-position) (line-end-position)
nil 'face))
(font-lock-ensure (line-beginning-position) (line-end-position))
@@ -93,9 +99,7 @@ FACE may be a list."
(when (text-property-not-all test-pos (+ test-pos (length token)) key
token-face)
(error "mixed faces, expecting %s for '%s'" face token))
- (unless (or (and (listp face)
- (memq token-face face))
- (eq token-face face))
+ (unless (equal token-face face)
(error "found face %s, expecting %s for '%s'" token-face face
token))
)))))
@@ -212,13 +216,24 @@ Each item is a list (ACTION PARSE-BEGIN PARSE-END
EDIT-BEGIN)")
(wisi-test-save-log-1 (get-buffer (nth 0 item)) (nth 1 item))))
))
+(defvar eglot-send-changes-idle-time)
+(declare-function jsonrpc--debug "jsonrpc.el")
+
(defun run-test-here ()
"Run an indentation and casing test on the current buffer."
(interactive)
- (condition-case-unless-debug err
+ (when wisi-incremental-parse-enable
+ ;; wait for the parser to finish the initial parse
+ (wisi-wait-parser))
+
+ (condition-case err
(progn
(setq indent-tabs-mode nil)
- (setq jit-lock-context-time 0.0);; for test-face
+
+ ;; for test-face
+ (setq jit-lock-context-time 0.0)
+ (setq-local font-lock-ensure-function 'jit-lock-fontify-now) ;; it's
not at all clear what's resetting this
+ (setq-local eglot-send-changes-idle-time 0.0) ;; FIXME: did not help
test-face
;; Test files use wisi-prj-select-cached to parse and select a project
file.
(setq project-find-functions (list #'wisi-prj-current-cached))
@@ -230,6 +245,7 @@ Each item is a list (ACTION PARSE-BEGIN PARSE-END
EDIT-BEGIN)")
(wisi-process-parse-save-text wisi-parser-shared save-edited-text t))
(let ((error-count 0)
+ (error-lines '())
(pass-count 0)
(test-buffer (current-buffer))
cmd-line
@@ -263,10 +279,13 @@ Each item is a list (ACTION PARSE-BEGIN PARSE-END
EDIT-BEGIN)")
((string= (match-string 1) "CMD")
(looking-at ".*$")
(setq cmd-line (line-number-at-pos)
- last-cmd (match-string 0))
+ last-cmd (match-string-no-properties 0)
+ force-fail nil)
(let ((msg (format "%s:%d: test %s" (buffer-file-name) cmd-line
last-cmd)))
(when wisi-parser-shared (wisi-parse-log-message
wisi-parser-shared msg))
(message "%s" msg)
+ (when (and (fboundp 'eglot-current-server)
(eglot-current-server))
+ (jsonrpc--debug (eglot-current-server) msg))
(save-excursion
(setq last-result
(condition-case-unless-debug err
@@ -278,12 +297,15 @@ Each item is a list (ACTION PARSE-BEGIN PARSE-END
EDIT-BEGIN)")
(message msg)))
((error wisi-parse-error)
(setq error-count (1+ error-count))
+ (push cmd-line error-lines)
(setq msg (concat msg " ... signaled"))
(setq force-fail t)
(when wisi-parser-shared (wisi-parse-log-message
wisi-parser-shared msg))
(message msg)
(setq msg (format "... %s: %s" (car err) (cdr err)))
(when wisi-parser-shared (wisi-parse-log-message
wisi-parser-shared msg))
+ (when (and (fboundp 'eglot-current-server)
(eglot-current-server))
+ (jsonrpc--debug (eglot-current-server) msg))
(message msg)
nil)))
))
@@ -307,6 +329,7 @@ Each item is a list (ACTION PARSE-BEGIN PARSE-END
EDIT-BEGIN)")
(message msg))
(setq error-count (1+ error-count))
+ (push (line-number-at-pos) error-lines)
(let ((msg (concat
(format "error: %s:%d:\n" (buffer-file-name)
(line-number-at-pos))
@@ -317,8 +340,7 @@ Each item is a list (ACTION PARSE-BEGIN PARSE-END
EDIT-BEGIN)")
last-result
expected-result)))))
(when wisi-parser-shared (wisi-parse-log-message
wisi-parser-shared msg))
- (message "%s" msg))
- (setq force-fail nil)))
+ (message "%s" msg))))
((string= (match-string 1) "RESULT_START")
(looking-at ".*$")
@@ -339,6 +361,7 @@ Each item is a list (ACTION PARSE-BEGIN PARSE-END
EDIT-BEGIN)")
((string= (match-string 1) "RESULT_FINISH")
(unless (equal (length expected-result) (length last-result))
(setq error-count (1+ error-count))
+ (push (line-number-at-pos) error-lines)
;; this is used for gpr-query tests, not parser tests,
;; so we don't write to the parser log.
(message
@@ -353,6 +376,7 @@ Each item is a list (ACTION PARSE-BEGIN PARSE-END
EDIT-BEGIN)")
(while (< i (length expected-result))
(unless (equal (nth i expected-result) (nth i last-result))
(setq error-count (1+ error-count))
+ (push (line-number-at-pos) error-lines)
(message
(concat
(format "error: %s:%d:\n" (buffer-file-name)
(line-number-at-pos))
@@ -383,6 +407,7 @@ Each item is a list (ACTION PARSE-BEGIN PARSE-END
EDIT-BEGIN)")
(t
(setq error-count (1+ error-count))
+ (push (line-number-at-pos) error-lines)
(error (concat "Unexpected EMACS test command " (match-string
1))))))
(let ((msg (format "%s:%d tests passed %d"
@@ -391,6 +416,7 @@ Each item is a list (ACTION PARSE-BEGIN PARSE-END
EDIT-BEGIN)")
(message msg))
(when (> error-count 0)
+ (message "errors on lines: %s" error-lines)
(error
"%s:%d: aborting due to previous errors (%d)"
(buffer-file-name) (line-number-at-pos (point)) error-count))
@@ -435,9 +461,9 @@ Each item is a list (ACTION PARSE-BEGIN PARSE-END
EDIT-BEGIN)")
(cl-case system-type
(gnu/linux
(list
- (cons 'font "DejaVu Sans Mono-8")
+ (cons 'font "DejaVu Sans Mono-11")
(cons 'width 120) ;; characters; fringe extra
- (cons 'height 94) ;; characters
+ (cons 'height 73) ;; characters
(cons 'left 0)
(cons 'top 0)))
(windows-nt
@@ -462,12 +488,14 @@ Each item is a list (ACTION PARSE-BEGIN PARSE-END
EDIT-BEGIN)")
(other-window -1))
(define-key global-map [M-C-up] 'wisi-prev-window)
(define-key global-map [M-C-down] 'other-window)
+(define-key global-map [f11] 'switch-to-buffer)
(defun run-test (file-name)
"Run an indentation and casing test on FILE-NAME."
(interactive "f")
(setq-default indent-tabs-mode nil) ;; no tab chars in files
+ (setq message-log-max most-positive-fixnum)
;; we'd like to run emacs from a makefile as:
;;
@@ -483,12 +511,7 @@ Each item is a list (ACTION PARSE-BEGIN PARSE-END
EDIT-BEGIN)")
;;
;; emacs -Q -l runtest.el --eval '(progn (run-test
"<filename>")(kill-emacs))'
;;
- ;; Then we have problems with font lock defaulting to jit-lock; that
- ;; screws up font-lock tests because the test runs before jit-lock
- ;; does. This forces default font-lock, which fontifies the whole
- ;; buffer when (font-lock-fontify-buffer) is called, which tests
- ;; that rely on font-lock do explicitly.
- (setq font-lock-support-mode nil)
+ ;; Then we must use (font-lock-ensure) to force immediate fontification.
(setq xref-prompt-for-identifier nil)
diff --git a/wisi-skel.el b/wisi-skel.el
index dacbc6c433..79e9a65a12 100644
--- a/wisi-skel.el
+++ b/wisi-skel.el
@@ -78,7 +78,8 @@ separated by `|', with trailing `...' if there are more keys."
)
(defun wisi-skel-enable-parse ()
- (setq wisi-inhibit-parse nil));
+ (setq wisi-inhibit-parse nil)
+ (remove-hook 'skeleton-end-hook #'wisi-skel-enable-parse t));
(defun wisi-skel-expand (&optional name)
"Expand the token or placeholder before point to a skeleton.
@@ -106,6 +107,8 @@ before that as the token."
(skel (assoc-string token wisi-skel-token-alist))
(handled nil))
+ (add-hook 'skeleton-end-hook #'wisi-skel-enable-parse 90 t)
+
(if skel
(progn
(when (listp (cdr skel))
@@ -193,8 +196,5 @@ before that as the token."
(interactive)
(skip-syntax-backward "^!"))
-;;;###autoload
-(add-hook 'skeleton-end-hook #'wisi-skel-enable-parse 90)
-
(provide 'wisi-skel)
;;; wisi-skel.el ends here
diff --git a/wisi.el b/wisi.el
index c67c353749..ff517456a6 100644
--- a/wisi.el
+++ b/wisi.el
@@ -1,13 +1,13 @@
;;; wisi.el --- Utilities for implementing an indentation/navigation engine
using a generalized LR parser -*- lexical-binding:t -*-
;;
-;; Copyright (C) 2012 - 2022 Free Software Foundation, Inc.
+;; Copyright (C) 2012 - 2023 Free Software Foundation, Inc.
;;
;; Author: Stephen Leake <stephen_leake@stephe-leake.org>
;; Maintainer: Stephen Leake <stephen_leake@stephe-leake.org>
;; Keywords: parser
;; indentation
;; navigation
-;; Version: 4.1.1
+;; Version: 4.2.0
;; package-requires: ((emacs "25.3") (seq "2.20"))
;; URL: https://stephe-leake.org/ada/wisitoken.html
;;
@@ -142,35 +142,51 @@ Increasing this will give better results when in the
middle of a
deeply nested statement, but worse in some situations."
:type 'integer
:safe #'integerp)
+(make-variable-buffer-local 'wisi-indent-context-lines)
-(defcustom wisi-disable-face nil
- "When non-nil, `wisi-setup' does not enable use of parser for font-lock.
-Useful when debugging parser or parser actions."
+(defcustom wisi-disable-completion nil
+ "When non-nil, `wisi-setup' does not enable use of wisi xref for completion.
+Useful when using wisi in parallel with eglot."
:type 'boolean
:safe #'booleanp)
+(make-variable-buffer-local 'wisi-disable-completion)
-(defcustom wisi-disable-completion nil
- "When non-nil, `wisi-setup' does not enable use of wisi xref for completion
+(defcustom wisi-disable-diagnostics nil
+ "When non-nil, `wisi-setup' does not enable reporting diagnostics.
Useful when using wisi in parallel with eglot."
:type 'boolean
:safe #'booleanp)
+(make-variable-buffer-local 'wisi-disable-diagnostics)
+
+(defcustom wisi-disable-face nil
+ "When non-nil, `wisi-setup' does not enable use of parser for font-lock."
+ :type 'boolean
+ :safe #'booleanp)
+(make-variable-buffer-local 'wisi-disable-face)
(defcustom wisi-disable-indent nil
- "When non-nil, `wisi-setup' does not enable use of parser for indent.
-Useful when using wisi in parallel with eglot."
+ "When non-nil, `wisi-setup' does not enable use of parser for indent."
:type 'boolean
:safe #'booleanp)
+(make-variable-buffer-local 'wisi-disable-indent)
(defcustom wisi-disable-parser nil
- "When non-nil, `wisi-setup' does not enable use of parser for any purpose.
-Useful when using wisi in parallel with eglot."
+ "When non-nil, `wisi-setup' does not enable use of parser for any purpose."
+ :type 'boolean
+ :safe #'booleanp)
+(make-variable-buffer-local 'wisi-disable-parser)
+
+(defcustom wisi-disable-statement nil
+ "When non-nil, the wisi parser should not be enabled for statement motion."
:type 'boolean
:safe #'booleanp)
+(make-variable-buffer-local 'wisi-disable-statement)
(defcustom wisi-parse-full-background t
"If non-nil, do initial full parse in background."
:type 'boolean
:safe #'booleanp)
+(make-variable-buffer-local 'wisi-parse-full-background)
(defconst wisi-error-buffer-name "*wisi syntax errors*"
"Name of buffer for displaying syntax errors.")
@@ -859,14 +875,13 @@ Run the parser first if needed."
(wisi-set-last-parse-region begin parse-end parse-action)
- (unless (eq parse-action 'face)
- (when (buffer-live-p wisi-error-buffer)
- (with-current-buffer wisi-error-buffer
- (setq buffer-read-only nil)
- (erase-buffer)
- (setq buffer-read-only t)
- (when (get-buffer-window wisi-error-buffer)
- (delete-window (get-buffer-window wisi-error-buffer))))))
+ (when (buffer-live-p wisi-error-buffer)
+ (with-current-buffer wisi-error-buffer
+ (setq buffer-read-only nil)
+ (erase-buffer)
+ (setq buffer-read-only t)
+ (when (get-buffer-window wisi-error-buffer)
+ (delete-window (get-buffer-window wisi-error-buffer)))))
(condition-case err
(save-excursion
@@ -898,10 +913,7 @@ Run the parser first if needed."
(wisi-parse-error
(cl-ecase parse-action
(face
- ;; Caches set by failed elisp parse are ok, but some parse
- ;; failures return 'nil' in parse-region.
- (when (cdr parsed-region)
- (wisi--delete-face-cache (cdr parsed-region))))
+ (wisi--delete-face-cache (car parsed-region)))
(navigate
;; don't trust parse result
@@ -956,7 +968,7 @@ Run the parser first if needed."
(defun wisi-validate-cache (begin end error-on-fail parse-action)
"Ensure cached data for PARSE-ACTION is valid in region BEGIN END"
- ;; Tolerate (point) +- size exceeding buffer limits.
+ ;; Tolerate (point) +- size exeeding buffer limits.
(setq begin (max begin (point-min)))
(setq end (min end (point-max)))
@@ -1044,8 +1056,8 @@ fails."
(wisi-validate-cache parse-begin parse-end error-on-fail parse-action)))
-(defun wisi-fontify-region (begin end)
- "For `jit-lock-functions'."
+(defun wisi-fontify-region (begin end &optional _contextual)
+ "For `jit-lock-register'."
(remove-text-properties begin end '(font-lock-face nil))
(if wisi-parse-full-active
@@ -1220,7 +1232,7 @@ Return start cache."
(defun wisi-goto-statement-start ()
"Move point to token at start of statement point is in or after.
-Return start cache."
+Return start cache (nil if point is before first statement)."
(interactive)
(wisi-validate-cache-current-statement t 'navigate)
(wisi-goto-start (or (wisi-get-cache (point))
@@ -1818,7 +1830,11 @@ with incremental parse after each key event."
"Set up a buffer for parsing files with wisi."
;; wisi-disable-* should be set in a find-file-hook such as
;; ada-eglot-setup, not in local variables.
- (when (and (not wisi-disable-parser) parser)
+ (when (and (not wisi-disable-parser)
+ parser
+ ;; indirect buffers handled below.
+ ;; We don't insist on (null wisi-parser-shared), so we can re-run
ada-mode
+ )
(setq wisi-parser-shared parser)
(setq wisi-parser-local (make-wisi-parser-local))
@@ -1850,7 +1866,14 @@ with incremental parse after each key event."
(add-hook 'kill-buffer-hook #'wisi-parse-kill-buf 90 t)
+ (when (not wisi-disable-completion)
+ (add-hook 'completion-at-point-functions #'wisi-completion-at-point -90
t))
+
+ ;; wisi-disable-diagnostics is handled in wisi-process-parse.el
+
(when (not wisi-disable-face)
+ ;; font-lock complains about not working in indirect buffers,
+ ;; but we need to set all the local variables for mmm-mode.
(jit-lock-register #'wisi-fontify-region))
(when (not wisi-disable-indent)
@@ -1858,8 +1881,8 @@ with incremental parse after each key event."
(setq-local indent-region-function #'wisi-indent-region)
(setq-local comment-indent-function #'wisi-comment-indent))
- (when (not wisi-disable-completion) ;; FIXME; check that (wisi-prj-xref
prj) is valid?
- (add-hook 'completion-at-point-functions #'wisi-completion-at-point -90
t))
+ ;; wisi-disable-statement just affects whether to start the
+ ;; parser.
(setq-local forward-sexp-function #'wisi-forward-sexp)
@@ -1867,11 +1890,19 @@ with incremental parse after each key event."
(when wisi-save-all-changes
(setf (wisi-parser-local-all-changes wisi-parser-local) nil))
- ;; We don't wait for this to complete here, so users can scroll
- ;; around while the initial parse runs. font-lock will not work
- ;; during that time (the parser is busy, the buffer is read-only).
- (when (< 0 wisi-debug) (message "start initial full parse in %s"
(current-buffer)))
- (wisi-parse-incremental wisi-parser-shared 'none :full t :nowait
wisi-parse-full-background)
+ (unless (buffer-base-buffer)
+ ;; If are in an indirect buffer (ie mmm-temp-buffer), We need
+ ;; to set all the local variables above, but _not_ start a
+ ;; parse; that would duplicate and conflict with the parse in
+ ;; the main buffer.
+
+ ;; We don't wait for this to complete here, so users can scroll
+ ;; around while the initial parse runs. font-lock will not work
+ ;; during that time (the parser is busy, the buffer is read-only).
+ (when (< 0 wisi-debug) (message "starting initial full parse; parser %s
buffer %s"
+ (wisi-process--parser-label parser)
+ (current-buffer)))
+ (wisi-parse-incremental wisi-parser-shared 'none :full t :nowait
wisi-parse-full-background))
(when wisi-save-text-tree
(wisi-parse-save-text-tree-auto wisi-parser-shared t))
diff --git a/wisi.texi b/wisi.texi
index 29c8e79ff1..9949c5b1e1 100644
--- a/wisi.texi
+++ b/wisi.texi
@@ -2,7 +2,7 @@
@settitle Wisi
@copying
-Copyright @copyright{} 1999 - 2022 Free Software Foundation, Inc.
+Copyright @copyright{} 1999 - 2023 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
@@ -25,7 +25,7 @@ developing GNU and promoting software freedom.''
@titlepage
@sp 10
-@title Wisi Version 4.1.1
+@title Wisi Version 4.2.0
@page
@vskip 0pt plus 1filll
@insertcopying
@@ -37,7 +37,7 @@ developing GNU and promoting software freedom.''
@node Top
@top Top
-Wisi Version 4.1.1
+Wisi Version 4.2.0
@end ifnottex
@menu
@@ -231,7 +231,7 @@ some other purpose. It is good style to indicate the
purpose in a
comment.
For example, ada-mode uses a 'misc' property on left parentheses that
-start a subprogram parameter list; this distinguishes them from other
+start a subprogram parameter list; this distinquishes them from other
left parentheses, and makes it possible to automatically call
@code{ada-format-paramlist} to format the
parameter list, instead of using the standard Emacs @code{align}.
@@ -338,7 +338,7 @@ Indent for comments are computed in the same way, except
that the
delta that applies to a comment that follows a token is given by the
indent action entry for the next token. If a token is the last in a
production, the comment indent is @code{nil}. These rules often give
-the wrong indent for a comment, so they can be overridden by specifying
+the wrong indent for a comment, so they can be overridden by specifing
a comment indent for a token using @code{[CODE-INDENT
COMMENT-INDENT]}; see below. Indent functions can also modify how
comments are indented.
@@ -517,7 +517,7 @@ expression_list : expression | expression_list ','
expression
statements : statement | statements statement
-statement : function_call ';' | assignment | if_statment
+statement : function_call ';' | assigment | if_statment
assign_value : ':=' expression
diff --git a/wisitoken-bnf-generate.adb b/wisitoken-bnf-generate.adb
index b401e8e523..9c45c28e41 100644
--- a/wisitoken-bnf-generate.adb
+++ b/wisitoken-bnf-generate.adb
@@ -3,7 +3,7 @@
-- Parser for Wisi grammar files, producing Ada source
-- files for a parser.
--
--- Copyright (C) 2012 - 2015, 2017 - 2022 Free Software Foundation, Inc.
+-- Copyright (C) 2012 - 2015, 2017 - 2023 Free Software Foundation, Inc.
--
-- The WisiToken package is free software; you can redistribute it
-- and/or modify it under terms of the GNU General Public License as
@@ -29,7 +29,6 @@ with Ada.Strings.Maps;
with Ada.Strings.Unbounded;
with Ada.Text_IO;
with GNAT.Traceback.Symbolic;
-with System.Multiprocessors;
with WisiToken.BNF.Generate_Utils;
with WisiToken.BNF.Output_Ada;
with WisiToken.BNF.Output_Ada_Common;
@@ -55,7 +54,7 @@ is
use Ada.Text_IO;
First : Boolean := True;
begin
- Put_Line (Standard_Error, "version 4.0"); -- matches release version in
Docs/wisitoken.html
+ Put_Line (Standard_Error, "version 4.1"); -- matches release version in
Docs/wisitoken.html
Put_Line (Standard_Error, "wisitoken-bnf-generate [options] {wisi
grammar file}");
Put_Line (Standard_Error, "Generate source code implementing a parser
for the grammar.");
New_Line (Standard_Error);
@@ -121,9 +120,6 @@ is
Put_Line (Standard_Error, " --ignore_conflicts; ignore excess/unknown
conflicts");
Put_Line (Standard_Error,
" --test_main; generate standalone main program for running
the generated parser, modify file names");
- Put_Line (Standard_Error,
- " --task_count n; number of tasks used to compute LR1 items;
0 means CPU count." &
- " Default 1.");
Put_Line (Standard_Error, "verbosity keys:");
Enable_Trace_Help;
end Put_Usage;
@@ -134,8 +130,6 @@ is
Output_BNF : Boolean := False;
Ignore_Conflicts : Boolean := False;
Test_Main : Boolean := False;
- Generate_Task_Count : System.Multiprocessors.CPU_Range := 1;
- Generate_Task_Count_Set : Boolean := False;
Command_Generate_Set : Generate_Set_Access; -- override grammar file
declarations
@@ -250,19 +244,6 @@ begin
Suffix := +Argument (Arg_Next);
Arg_Next := Arg_Next + 1;
- elsif Argument (Arg_Next) = "--task_count" then
- Arg_Next := @ + 1;
- Generate_Task_Count_Set := True;
- declare
- use System.Multiprocessors;
- begin
- Generate_Task_Count := CPU_Range'Value (Argument (Arg_Next));
- if Generate_Task_Count = 0 then
- Generate_Task_Count := Number_Of_CPUs;
- end if;
- end;
- Arg_Next := @ + 1;
-
elsif Argument (Arg_Next) = "--test_main" then
Arg_Next := Arg_Next + 1;
Test_Main := True;
@@ -522,10 +503,6 @@ begin
Parser => Tuple.Gen_Alg,
Phase => WisiToken_Grammar_Runtime.Other);
- if not Generate_Task_Count_Set then
- Generate_Task_Count := System.Multiprocessors.Number_Of_CPUs;
- end if;
-
declare
use all type WisiToken.Parse.LR.Parse_Table_Ptr;
use Ada.Real_Time;
@@ -548,9 +525,6 @@ begin
Parse_Table_File_Name : constant String :=
(if Tuple.Gen_Alg in LALR .. Packrat_Proc
then -Output_File_Name_Root & "_" & To_Lower
(Tuple.Gen_Alg'Image) &
- (if Tuple.Gen_Alg = LR1 and Test_Main
- then "_t" & Ada.Strings.Fixed.Trim
(Generate_Task_Count'Image, Ada.Strings.Both)
- else "") &
(if Input_Data.If_Lexer_Present
then "_" & Lexer_Image (Input_Data.User_Lexer).all
else "") &
@@ -651,7 +625,6 @@ begin
Include_Extra => Test_Main,
Ignore_Conflicts => Ignore_Conflicts,
Recursion_Strategy =>
Input_Data.Language_Params.Recursion_Strategy,
- Task_Count => Generate_Task_Count,
Use_Cached_Recursions => not
(Input_Data.If_Lexer_Present or Input_Data.If_Parser_Present),
Recursions => Cached_Recursions);
@@ -713,8 +686,7 @@ begin
if Tuple.Text_Rep then
WisiToken.Generate.LR.Put_Text_Rep
(Generate_Data.LR_Parse_Table.all,
- Text_Rep_File_Name
- (-Output_File_Name_Root, Tuple, Generate_Task_Count,
Input_Data.If_Lexer_Present, Test_Main));
+ Text_Rep_File_Name (-Output_File_Name_Root, Tuple,
Input_Data.If_Lexer_Present));
end if;
when others =>
@@ -729,7 +701,7 @@ begin
WisiToken.BNF.Output_Ada
(Input_Data, Grammar_Parser.Tree.Lexer.File_Name,
-Output_File_Name_Root, Generate_Data,
- Packrat_Data, Tuple, Test_Main, Multiple_Tuples,
Generate_Task_Count);
+ Packrat_Data, Tuple, Test_Main, Multiple_Tuples);
when Ada_Emacs_Lang =>
if Trace_Generate > Outline then
diff --git a/wisitoken-bnf-output_ada.adb b/wisitoken-bnf-output_ada.adb
index bf30759c27..6069c84291 100644
--- a/wisitoken-bnf-output_ada.adb
+++ b/wisitoken-bnf-output_ada.adb
@@ -23,7 +23,6 @@ pragma License (Modified_GPL);
with Ada.Strings.Fixed;
with Ada.Text_IO; use Ada.Text_IO;
with GNAT.Regexp;
-with System.Multiprocessors;
with WisiToken.BNF.Generate_Packrat;
with WisiToken.BNF.Generate_Utils;
with WisiToken.BNF.Output_Ada_Common; use WisiToken.BNF.Output_Ada_Common;
@@ -37,18 +36,14 @@ procedure WisiToken.BNF.Output_Ada
Packrat_Data : in WisiToken.Generate.Packrat.Data;
Tuple : in Generate_Tuple;
Test_Main : in Boolean;
- Multiple_Tuples : in Boolean;
- Generate_Task_Count : in System.Multiprocessors.CPU_Range)
+ Multiple_Tuples : in Boolean)
is
Common_Data : Output_Ada_Common.Common_Data :=
WisiToken.BNF.Output_Ada_Common.Initialize
(Input_Data, Tuple, Grammar_File_Name, Output_File_Name_Root,
Check_Interface => False);
Gen_Alg_Name : constant String :=
(if Test_Main or Multiple_Tuples
- then "_" & Generate_Algorithm_Image (Common_Data.Generate_Algorithm).all
&
- (if Common_Data.Generate_Algorithm = LR1
- then "_t" & Ada.Strings.Fixed.Trim (Generate_Task_Count'Image,
Ada.Strings.Both)
- else "")
+ then "_" & Generate_Algorithm_Image (Common_Data.Generate_Algorithm).all
else "");
function Symbol_Regexp (Item : in String) return String
@@ -436,8 +431,7 @@ is
if Common_Data.Text_Rep then
Put_Line
(" """ &
- Text_Rep_File_Name
- (Output_File_Name_Root, Tuple, Generate_Task_Count,
Input_Data.If_Lexer_Present, Test_Main) & """,");
+ Text_Rep_File_Name (Output_File_Name_Root, Tuple,
Input_Data.If_Lexer_Present) & """,");
end if;
if Input_Data.Language_Params.Error_Recover then
if Input_Data.Language_Params.Use_Language_Runtime then
diff --git a/wisitoken-bnf.adb b/wisitoken-bnf.adb
index c5157ebf59..ee98bf4dbf 100644
--- a/wisitoken-bnf.adb
+++ b/wisitoken-bnf.adb
@@ -21,6 +21,7 @@ pragma License (GPL);
with Ada.Command_Line;
with Ada.Directories;
with Ada.Environment_Variables;
+with Ada.Strings.Fixed;
with Ada.Text_IO;
package body WisiToken.BNF is
diff --git a/wisitoken-bnf.ads b/wisitoken-bnf.ads
index d5c9dc73a7..5275e2cc95 100644
--- a/wisitoken-bnf.ads
+++ b/wisitoken-bnf.ads
@@ -31,10 +31,8 @@ with Ada.Containers.Doubly_Linked_Lists;
with Ada.Containers.Indefinite_Doubly_Linked_Lists;
with Ada.Containers.Ordered_Maps;
with Ada.Containers.Vectors;
-with Ada.Strings.Fixed;
with Ada.Strings.Unbounded;
with Ada.Unchecked_Deallocation;
-with System.Multiprocessors;
with WisiToken.Parse.LR;
with WisiToken.Syntax_Trees;
package WisiToken.BNF is
@@ -129,17 +127,12 @@ package WisiToken.BNF is
Tuple : in Generate_Tuple);
function Text_Rep_File_Name
- (File_Name_Root : in String;
- Tuple : in Generate_Tuple;
- Generate_Task_Count : in System.Multiprocessors.CPU_Range;
- If_Lexer_Present : in Boolean;
- Test_Main : in Boolean)
+ (File_Name_Root : in String;
+ Tuple : in Generate_Tuple;
+ If_Lexer_Present : in Boolean)
return String
is (File_Name_Root & "_" &
Ada.Characters.Handling.To_Lower (Generate_Algorithm_Image
(Tuple.Gen_Alg).all) &
- (if Tuple.Gen_Alg = LR1 and Test_Main
- then "_t" & Ada.Strings.Fixed.Trim (Generate_Task_Count'Image,
Ada.Strings.Both)
- else "") &
(if If_Lexer_Present
then "_" & Lexer_Image (Tuple.Lexer).all
else "") &
diff --git a/wisitoken-generate-lr-lr1_generate.adb
b/wisitoken-generate-lr-lr1_generate.adb
index 016baa9284..2226fc2d25 100644
--- a/wisitoken-generate-lr-lr1_generate.adb
+++ b/wisitoken-generate-lr-lr1_generate.adb
@@ -22,9 +22,8 @@ pragma License (Modified_GPL);
with Ada.Calendar;
with Ada.Containers;
-with Ada.Exceptions;
with Ada.Text_IO;
-with System.Address_To_Access_Conversions;
+with WisiToken.Generate.LR1_Items;
package body WisiToken.Generate.LR.LR1_Generate is
function LR1_Goto_Transitions
@@ -68,7 +67,7 @@ package body WisiToken.Generate.LR.LR1_Generate is
return Closure (Goto_Set, Has_Empty_Production, First_Terminal_Sequence,
Grammar, Descriptor);
end LR1_Goto_Transitions;
- function LR1_Item_Sets_Single
+ function LR1_Item_Sets
(Has_Empty_Production : in Token_ID_Set;
First_Terminal_Sequence : in Token_Sequence_Arrays.Vector;
Grammar : in WisiToken.Productions.Prod_Arrays.Vector;
@@ -197,618 +196,7 @@ package body WisiToken.Generate.LR.LR1_Generate is
end if;
return C;
- end LR1_Item_Sets_Single;
-
- function LR1_Item_Sets_Parallel
- (Has_Empty_Production : in Token_ID_Set;
- First_Terminal_Sequence : in Token_Sequence_Arrays.Vector;
- Grammar : in WisiToken.Productions.Prod_Arrays.Vector;
- Descriptor : in WisiToken.Descriptor;
- Task_Count : in System.Multiprocessors.CPU_Range;
- Hash_Table_Size : in Positive :=
LR1_Items.Item_Set_Trees.Default_Rows)
- return LR1_Items.Item_Set_List
- is
- use LR1_Items;
- use all type Ada.Containers.Count_Type;
- use all type SAL.Base_Peek_Type;
- use all type System.Multiprocessors.CPU_Range;
-
- -- [dragon] algorithm 4.9 pg 231; figure 4.38 pg 232; procedure
- -- "items", with some optimizations.
-
- type Base_Worker_ID is range 0 .. Positive'Last;
- subtype Worker_ID is Base_Worker_ID range 1 .. Base_Worker_ID'Last;
-
- package Item_Set_Tree_Node_Arrays is new
SAL.Gen_Unbounded_Definite_Vectors
- (Positive, Item_Set_Tree_Node, (others => <>));
-
- package Worker_Array_State_Index_Arrays is new
SAL.Gen_Unbounded_Definite_Vectors
- (Worker_ID, State_Index_Arrays.Vector,
State_Index_Arrays.Empty_Vector);
-
- type Worker_Data is record
- -- All data produced by one worker from one state, except New_C,
- -- which doesn't need to be split by supervisor state.
- From_State : State_Index := State_Index'Last;
- New_States : State_Index_Arrays.Vector;
- Existing_Goto_Items : Goto_Item_Arrays.Vector;
- New_Goto_Items : Goto_Item_Arrays.Vector;
- end record;
-
- package State_Array_Worker_Data is new SAL.Gen_Unbounded_Definite_Vectors
- (State_Index, Worker_Data, (others => <>));
-
- protected Supervisor is
-
- procedure Initialize
- (Worker_Count : in LR1_Item_Sets_Parallel.Worker_ID;
- First_Item_Set : in out Item_Set);
-
- entry Get
- (Worker_ID : in LR1_Item_Sets_Parallel.Worker_ID;
- Sets_To_Check : out Item_Set_List;
- Keys_To_Store : out Item_Set_Tree_Node_Arrays.Vector)
- with Pre => Sets_To_Check.Is_Empty and Keys_To_Store.Is_Empty;
- -- Set Sets_To_Check to new states to check, _not_ indexed by state;
- -- they may be discontinuous. Available when there are states to
- -- check, or when all states have been checked and all workers are
- -- inactive; then Sets_To_Check is empty.
- --
- -- If Sets_To_Check is not empty, Keys_To_Store contains keys from
- -- other workers to store in worker's C_Tree; increment active worker
- -- count.
-
- procedure Update
- (Worker_ID : in LR1_Item_Sets_Parallel.Worker_ID;
- New_C : in out Item_Set_Arrays.Vector;
- Worker_Data : in out State_Array_Worker_Data.Vector);
- -- New_C: New states found by worker, indexed by worker new state
- -- number (1 origin); add to supervisor C. States are updated to
supervisor
- -- state numbers; worker should add those to worker's C_Tree.
- --
- -- Worker_Data : Indexed by supervisor state number I. Contains:
- --
- -- New_States: Worker new state numbers for states derived from C
(I);
- -- sets are in New_C.
- --
- -- Existing_Goto_Items: Gotos from C (I) to some state in
supervisor
- -- C (which worker found in C_Tree); add to supervisor C (I).
- --
- -- New_Goto_Items: From C (I) to some state in New_C (given by
- -- worker new state number). Add to supervisor C (I).
- --
- -- Decrement active worker count.
-
- procedure Fatal_Error
- (Exception_ID : in Ada.Exceptions.Exception_Id;
- Message : in String);
- -- Worker encountered an exception; record it for Done, decrement
- -- active worker count.
-
- entry Done
- (ID : out Ada.Exceptions.Exception_Id;
- Message : out Ada.Strings.Unbounded.Unbounded_String);
- -- Available when all states have been checked, and all workers
- -- inactive.
-
- function Get_C return Item_Set_List;
-
- private
- C : Item_Set_List; -- result
- C_Tree : Item_Set_Tree; -- for fast find
- States_To_Check : State_Index_Queues.Queue;
- -- [dragon] specifies 'until no more items can be added', but we use
- -- a queue to avoid checking unecessary states. Ada LR1 has over
- -- 100,000 states, so this is a significant gain (reduced time from
- -- 600 seconds to 40).
-
- Worker_Count : LR1_Item_Sets_Parallel.Worker_ID;
- Active_Workers : Natural := 0;
- Fatal : Boolean := False;
-
- New_States_For_Worker : Worker_Array_State_Index_Arrays.Vector;
- -- Indexed by worker ID
-
- Error_ID : Ada.Exceptions.Exception_Id :=
Ada.Exceptions.Null_Id;
- Error_Message : Ada.Strings.Unbounded.Unbounded_String;
-
- Min_States_Get : SAL.Peek_Type := 10;
-
- Net_Time : Duration := 0.0; -- Time spent in Get,
Update.
- Found_States : Integer := 0; -- States found in Update;
counts duplicate states found by workers
- Summary_Last_Output : State_Index := 0;
- end Supervisor;
-
- function Image (Node_Ref : Item_Set_Trees.Variable_Reference_Type)
return String
- is
- package Convert is new System.Address_To_Access_Conversions
(Item_Set_Tree_Node);
- begin
- return Convert.To_Address (Convert.Object_Pointer (Node_Ref))'Image &
":" &
- Node_Ref.Hash'Image & ":" & Node_Ref.State'Image;
- end Image;
-
- protected body Supervisor is
-
- procedure Initialize
- (Worker_Count : in LR1_Item_Sets_Parallel.Worker_ID;
- First_Item_Set : in out Item_Set)
- is
- First_State_Index : constant State_Index :=
First_Item_Set.Tree_Node.State;
- begin
- Supervisor.Worker_Count := Worker_Count;
-
- New_States_For_Worker.Set_First_Last (1, Worker_Count);
-
- C.Set_First_Last (First_State_Index, First_State_Index - 1);
- C_Tree.Set_Rows (Hash_Table_Size);
-
- First_Item_Set.Dot_IDs := Get_Dot_IDs (Grammar,
First_Item_Set.Set, Descriptor);
- Compute_Key_Hash (First_Item_Set, C_Tree.Rows, Grammar,
Descriptor, True);
-
- C.Append (First_Item_Set);
- C_Tree.Insert (First_Item_Set.Tree_Node, Duplicate => SAL.Error);
-
- States_To_Check.Put (First_State_Index);
- end Initialize;
-
- entry Get
- (Worker_ID : in LR1_Item_Sets_Parallel.Worker_ID;
- Sets_To_Check : out Item_Set_List;
- Keys_To_Store : out Item_Set_Tree_Node_Arrays.Vector)
- when Fatal or States_To_Check.Length > 0 or Active_Workers = 0
- is
- use all type Ada.Calendar.Time;
-
- Time_Start : constant Ada.Calendar.Time := Ada.Calendar.Clock;
- begin
- if States_To_Check.Length > 0 then
- for I in 1 ..
- (if States_To_Check.Length / SAL.Peek_Type (Worker_Count) <
Min_States_Get
- then States_To_Check.Length
- else States_To_Check.Length / SAL.Peek_Type (Worker_Count))
- loop
- Sets_To_Check.Append (C (States_To_Check.Get));
- end loop;
-
- if not New_States_For_Worker (Worker_ID).Is_Empty then
- Keys_To_Store.Set_Capacity
- (New_States_For_Worker (Worker_ID).First_Index,
New_States_For_Worker (Worker_ID).Last_Index);
- for State of New_States_For_Worker (Worker_ID) loop
- pragma Assert (C (State).Tree_Node.State = State);
- Keys_To_Store.Append (C (State).Tree_Node);
- end loop;
- New_States_For_Worker (Worker_ID).Clear;
- end if;
-
- if Trace_Generate_Table > Detail then
- Ada.Text_IO.Put
- ("(worker" & Worker_ID'Image & ") Checking" &
Sets_To_Check.Length'Image & " states");
- for Set of Sets_To_Check loop
- Ada.Text_IO.Put (Set.Tree_Node.State'Image);
- end loop;
- Ada.Text_IO.New_Line;
- if Trace_Generate_Table > Extra then
- for Set of Sets_To_Check loop
- Put (Grammar, Descriptor, Set, Show_Lookaheads =>
False, Kernel_Only => True);
- end loop;
- end if;
-
- Ada.Text_IO.Put
- ("(worker" & Worker_ID'Image & ") storing" &
Keys_To_Store.Length'Image & " states");
- for Node of Keys_To_Store loop
- Ada.Text_IO.Put (Node.State'Image);
- end loop;
- Ada.Text_IO.New_Line;
- end if;
-
- Active_Workers := @ + 1;
-
- Net_Time := @ + (Ada.Calendar.Clock - Time_Start);
- end if;
-
- if Trace_Time and C.Last_Index > Summary_Last_Output +
- (if C_Tree.Rows < 15_053 then 500 else 10_000) -- 500 for
ada_lite.wy, 10_000 for ada.wy
- then
- Ada.Text_IO.Put_Line
- ("(super) time:" & Net_Time'Image &
- " states:" & C.Last_Index'Image &
- " States_To_Check:" & States_To_Check.Length'Image &
- " Found_States:" & Found_States'Image);
- Summary_Last_Output := C.Last_Index;
- end if;
- end Get;
-
- procedure Update
- (Worker_ID : in LR1_Item_Sets_Parallel.Worker_ID;
- New_C : in out Item_Set_Arrays.Vector;
- Worker_Data : in out State_Array_Worker_Data.Vector)
- is
- use all type Ada.Calendar.Time;
- Time_Start : constant Ada.Calendar.Time := Ada.Calendar.Clock;
-
- State_Map : array (New_C.First_Index .. New_C.Last_Index) of
State_Index;
- -- Indexed by worker new state number, contains super state number
- begin
- if Trace_Generate_Table > Detail then
- Ada.Text_IO.Put ("(super) Update from worker" & Worker_ID'Image
& "; new states:");
- for Data of Worker_Data loop
- for Node of Data.New_Goto_Items loop
- Ada.Text_IO.Put
- (Data.From_State'Image & "." & Image (Node.Symbol,
Descriptor) & "." &
- Trimmed_Image (Node.State));
- end loop;
- Ada.Text_IO.Put (" | ");
- end loop;
- Ada.Text_IO.New_Line;
- end if;
-
- for Worker_Data of Update.Worker_Data loop
- for Worker_New_State of Worker_Data.New_States loop
- declare
- use Item_Set_Trees;
-
- Super_New_State : constant State_Index := C.Last_Index +
1;
-
- Found : Boolean;
- Found_Ref : constant
Item_Set_Trees.Variable_Reference_Type := C_Tree.Find_Or_Insert_Var
- (New_C (Worker_New_State).Tree_Node, Found);
- begin
- if Found then
- State_Map (Worker_New_State) := Found_Ref.State;
- Found_States := @ + 1;
- New_C (Worker_New_State).Tree_Node.State :=
Found_Ref.State;
-
- else
- Found_Ref.State := Super_New_State;
- New_C (Worker_New_State).Tree_Node.State :=
Super_New_State;
-
- States_To_Check.Put (Super_New_State);
-
- State_Map (Worker_New_State) := Super_New_State;
-
- C.Append (New_C (Worker_New_State));
- pragma Assert (C.Last_Index = Super_New_State);
-
- for ID in New_States_For_Worker.First_Index ..
New_States_For_Worker.Last_Index loop
- if ID /= Worker_ID then
- New_States_For_Worker (ID).Append
(Super_New_State);
- end if;
- end loop;
-
- if Trace_Generate_Table > Extra then
- Ada.Text_IO.Put_Line
- ("from state" & Worker_Data.From_State'Image &
"." & Trimmed_Image (Worker_New_State));
- Put (Grammar, Descriptor, New_C (Worker_New_State),
- Show_Lookaheads => False,
- Kernel_Only => True);
- end if;
- end if;
- end;
- end loop;
-
- -- Now we have State_Map, we can process the gotos.
- declare
- use Goto_Item_Lists;
- From_State : constant State_Index := Worker_Data.From_State;
- begin
- for Item of Worker_Data.Existing_Goto_Items loop
- if Trace_Generate_Table > Extra and then
- not Has_Element (C (From_State).Goto_List.Find
(Item.Symbol))
- then
- Ada.Text_IO.Put_Line
- (" state" & From_State'Image & " adding goto on "
&
- Image (Item.Symbol, Descriptor) & " to existing
state" & Item.State'Image);
- end if;
-
- C (From_State).Goto_List.Insert (Item, Duplicate =>
SAL.Ignore);
- end loop;
-
- for Item of Worker_Data.New_Goto_Items loop
- Item.State := State_Map (Item.State);
-
- if Trace_Generate_Table > Extra and then
- not Goto_Item_Lists.Has_Element
- (C (From_State).Goto_List.Find (Item.Symbol))
- then
- Ada.Text_IO.Put_Line
- (" state" & From_State'Image & " adding goto on "
&
- Image (Item.Symbol, Descriptor) & " to new state"
& Item.State'Image);
- end if;
-
- C (From_State).Goto_List.Insert (Item, Duplicate =>
SAL.Ignore);
- end loop;
- end;
- end loop;
-
- Active_Workers := @ - 1;
-
- Net_Time := @ + (Ada.Calendar.Clock - Time_Start);
- exception
- when E : others =>
-
- Active_Workers := @ - 1;
- Fatal := True;
- States_To_Check.Clear; -- force an early end.
- declare
- use Ada.Text_IO;
- use Ada.Exceptions;
- begin
- Error_ID := Exception_Identity (E);
- Error_Message := +Exception_Message (E);
- Put_Line
- (Standard_Error, "(super) Update exception: " &
Exception_Name (E) & ": " & Exception_Message (E));
- end;
- end Update;
-
- procedure Fatal_Error
- (Exception_ID : in Ada.Exceptions.Exception_Id;
- Message : in String)
- is begin
- Supervisor.Error_ID := Exception_ID;
- Supervisor.Error_Message := +Message;
-
- States_To_Check.Clear; -- force an early end.
- Fatal := True;
- Active_Workers := @ - 1;
- end Fatal_Error;
-
- entry Done
- (ID : out Ada.Exceptions.Exception_Id;
- Message : out Ada.Strings.Unbounded.Unbounded_String)
- when Fatal or (Active_Workers = 0 and States_To_Check.Is_Empty)
- is begin
- if Trace_Time then
- Ada.Text_IO.Put_Line
- ("(super) net time:" & Net_Time'Image &
- " states:" & C.Last_Index'Image &
- " States_To_Check:" & States_To_Check.Length'Image &
- " Found_States:" & Found_States'Image);
- end if;
-
- ID := Supervisor.Error_ID;
- Message := Supervisor.Error_Message;
- end Done;
-
- function Get_C return Item_Set_List
- is begin
- return C;
- end Get_C;
-
- end Supervisor;
-
- task type Worker_Task
- is
- entry Start (ID : in LR1_Item_Sets_Parallel.Worker_ID);
- -- Start states from Supervisor. Stop when Supervisor returns
- -- Invalid_State_Index;
- end Worker_Task;
-
- task body Worker_Task
- is
- use all type Ada.Calendar.Time;
-
- ID : LR1_Item_Sets_Parallel.Worker_ID;
-
- Time_Start : Ada.Calendar.Time;
- Net_Time : Duration := 0.0; -- Time spent outside Supervisor
- States_Checked : Integer := 0;
- States_Found : Integer := 0;
-
- C_Tree : Item_Set_Tree; -- Local copy for fast find
- C : Item_Set_Arrays.Vector; -- Local copy of subset of C to
search; from Supervisor
-
- Local_New_State : State_Index := 1;
-
- -- See Supervisor Get, Update for definitions of these.
- New_C : Item_Set_Arrays.Vector;
- New_C_Tree : Item_Set_Tree;
- Worker_Data : State_Array_Worker_Data.Vector;
-
- procedure Check_State (C_Index : in State_Index)
- is
- C_I : Item_Set renames C (C_Index);
- Worker_Data : LR1_Item_Sets_Parallel.Worker_Data renames
Worker_Task.Worker_Data (C_Index);
- begin
- States_Checked := @ + 1;
- Worker_Data.From_State := C_I.Tree_Node.State;
- Worker_Data.New_States.Clear;
- Worker_Data.Existing_Goto_Items.Clear;
- Worker_Data.New_Goto_Items.Clear;
-
- for Dot_ID_I in C_I.Dot_IDs.First_Index .. C_I.Dot_IDs.Last_Index
loop
- -- [dragon] has 'for each grammar symbol X', but
LR1_Goto_Transitions
- -- rejects Symbol that is not in Dot_IDs, so we iterate over
that.
-
- declare
- Symbol : Token_ID renames C_I.Dot_IDs (Dot_ID_I);
- New_Item_Set : Item_Set := LR1_Goto_Transitions
- (C_I, Symbol, Has_Empty_Production,
First_Terminal_Sequence, Grammar, Descriptor);
- begin
- Compute_Key_Hash (New_Item_Set, C_Tree.Rows, Grammar,
Descriptor, True);
- declare
- use Item_Set_Trees;
-
- -- First search in Worker.C_Tree
- Found_Cur : Cursor := C_Tree.Find
(New_Item_Set.Tree_Node);
-
- Found_State : constant Unknown_State_Index :=
- (if Has_Element (Found_Cur)
- then C_Tree.Constant_Ref (Found_Cur).State
- else Unknown_State);
- begin
- if Found_State = Unknown_State then
- Found_Cur := New_C_Tree.Find (New_Item_Set.Tree_Node);
-
- if Has_Element (Found_Cur) then
- -- Local_New_State was previously generated from
some other state we
- -- are checking.
- Worker_Data.New_Goto_Items.Append ((Symbol,
C_Tree.Constant_Ref (Found_Cur).State));
-
- else
- Worker_Data.New_Goto_Items.Append ((Symbol,
Local_New_State));
-
- New_Item_Set.Tree_Node.State := Local_New_State;
- New_Item_Set.Dot_IDs := Get_Dot_IDs (Grammar,
New_Item_Set.Set, Descriptor);
- New_C.Append (New_Item_Set);
- pragma Assert (New_C.Last_Index = Local_New_State);
- Worker_Data.New_States.Append (Local_New_State);
-
- New_C_Tree.Insert (New_Item_Set.Tree_Node,
Duplicate => SAL.Error);
-
- Local_New_State := Local_New_State + 1;
- end if;
- else
- States_Found := @ + 1;
- pragma Assert (C_I.Goto_List.Count = 0);
- Worker_Data.Existing_Goto_Items.Append ((Symbol,
Found_State));
- if Trace_Generate_Table > Extra then
- Ada.Text_IO.Put_Line
- ("(worker" & ID'Image & ") state" &
Worker_Data.From_State'Image & " adding goto on " &
- Image (Symbol, Descriptor) & " to existing
state" & Image
- (C_Tree.Variable_Ref (Found_Cur)));
- end if;
- end if;
- end;
- end;
- end loop;
- end Check_State;
- begin
- select
- accept Start (ID : in LR1_Item_Sets_Parallel.Worker_ID)
-
- do
- Worker_Task.ID := ID;
- end Start;
- or
- terminate;
- end select;
-
- C_Tree.Set_Rows (Hash_Table_Size);
- New_C_Tree.Set_Rows (Hash_Table_Size);
-
- loop
- declare
- Keys_To_Store : Item_Set_Tree_Node_Arrays.Vector;
- begin
- Supervisor.Get (ID, C, Keys_To_Store);
- exit when C.Length = 0;
-
- Time_Start := Ada.Calendar.Clock;
-
- for Set of C loop
- -- C are all new states to check, but they may
- -- have been in a previous Keys_To_Store.
- C_Tree.Insert (Set.Tree_Node, Duplicate => SAL.Ignore);
- end loop;
- for Node of Keys_To_Store loop
- -- States are added to Keys_To_Store when they are new in
- -- Supervisor.C_Tree, before they are given to any worker
to check;
- -- they may also be in C
- C_Tree.Insert (Node, Duplicate => SAL.Ignore);
- end loop;
- end;
-
- Local_New_State := 1;
- New_C.Set_First_Last (First => Local_New_State, Last =>
Local_New_State - 1);
- New_C_Tree.Clear; -- IMPROVEME: new_c_tree red_black should use
vector store, not allocate each node
-
- Worker_Data.Set_First_Last (C.First_Index, C.Last_Index);
-
- for I in C.First_Index .. C.Last_Index loop
- Check_State (I);
- end loop;
- C.Clear;
-
- Net_Time := @ + (Ada.Calendar.Clock - Time_Start);
- Supervisor.Update (ID, New_C, Worker_Data);
- Time_Start := Ada.Calendar.Clock;
-
- -- New_C.Tree_Node.State updated; insert into C_Tree.
- for Item of New_C loop
- C_Tree.Insert (Item.Tree_Node, Duplicate => SAL.Error);
- end loop;
- Net_Time := @ + (Ada.Calendar.Clock - Time_Start);
- end loop;
-
- if Trace_Time then
- declare
- Elements, Max_Row_Depth, Average_Row_Depth :
Ada.Containers.Count_Type;
- Rows, Empty_Rows : Integer;
- begin
- C_Tree.Sizes (Elements, Rows, Max_Row_Depth, Average_Row_Depth,
Empty_Rows);
-
- Ada.Text_IO.Put_Line
- ("(worker" & ID'Image & ") net time" & Net_Time'Image &
- " states checked:" & States_Checked'Image & " states
found:" & States_Found'Image &
- " hash table states:" & Elements'Image &
- " rows:" & Rows'Image &
- " max_row_depth:" & Max_Row_Depth'Image &
- " average_row_depth:" & Average_Row_Depth'Image &
- " empty_rows:" & Empty_Rows'Image);
- end;
- end if;
-
- if Trace_Generate_Table > Outline then
- Ada.Text_IO.Put_Line ("(worker" & ID'Image & ") terminate");
- end if;
- exception
- when E : others =>
- Supervisor.Fatal_Error (Ada.Exceptions.Exception_Identity (E),
Ada.Exceptions.Exception_Message (E));
- if Trace_Generate_Table > Outline then
- Ada.Text_IO.Put_Line ("(worker" & ID'Image & ") terminate on
exception");
- end if;
- end Worker_Task;
-
- Worker_Tasks : array
- (1 .. System.Multiprocessors.CPU_Range'Min
- (Task_Count,
- System.Multiprocessors.CPU_Range'Max (1,
System.Multiprocessors.Number_Of_CPUs)))
- of Worker_Task;
-
- First_State_Index : constant State_Index := 0;
-
- First_Item_Set : Item_Set := Closure
- ((Set => Item_Lists.To_List
- ((Prod => (Grammar.First_Index, 0),
- Dot => Grammar (Grammar.First_Index).RHSs
(0).Tokens.First_Index,
- Lookaheads => To_Lookahead (Descriptor.EOI_ID))),
- Tree_Node =>
- (State => First_State_Index,
- others => <>),
- others => <>),
- Has_Empty_Production, First_Terminal_Sequence, Grammar, Descriptor);
- begin
- Supervisor.Initialize (LR1_Item_Sets_Parallel.Worker_ID
(Worker_Tasks'Last), First_Item_Set);
-
- if Trace_Generate_Table > Outline then
- Ada.Text_IO.Put_Line (Worker_Tasks'Length'Image & " lr1_items worker
tasks");
- end if;
-
- for I in Worker_Tasks'Range loop
- Worker_Tasks (I).Start (LR1_Item_Sets_Parallel.Worker_ID (I));
- end loop;
-
- declare
- use Ada.Exceptions;
- ID : Exception_Id;
- Message : Ada.Strings.Unbounded.Unbounded_String;
- begin
- Supervisor.Done (ID, Message); -- Wait for all states to be checked
-
- if ID /= Null_Id then
- for I in Worker_Tasks'Range loop
- if not Worker_Tasks (I)'Terminated then
- abort Worker_Tasks (I);
- end if;
- end loop;
- Raise_Exception (ID, -Message);
- else
- if Trace_Generate_Table > Outline then
- Ada.Text_IO.Put_Line ("super reports done");
- end if;
- end if;
- end;
- return Supervisor.Get_C;
- end LR1_Item_Sets_Parallel;
+ end LR1_Item_Sets;
procedure Add_Actions
(Item_Sets : in LR1_Items.Item_Set_List;
@@ -846,13 +234,10 @@ package body WisiToken.Generate.LR.LR1_Generate is
Include_Extra : in Boolean := False;
Ignore_Conflicts : in Boolean := False;
Recursion_Strategy : in WisiToken.Recursion_Strategy := Full;
- Task_Count : in System.Multiprocessors.CPU_Range := 1;
Use_Cached_Recursions : in Boolean := False;
Recursions : in out WisiToken.Generate.Recursions)
return Parse_Table_Ptr
is
- use all type System.Multiprocessors.CPU_Range;
-
Time_Start : constant Ada.Calendar.Time := Ada.Calendar.Clock;
Add_Actions_Time : Ada.Calendar.Time;
Minimal_Actions_Time : Ada.Calendar.Time;
@@ -881,12 +266,8 @@ package body WisiToken.Generate.LR.LR1_Generate is
First_Terminal_Sequence : constant Token_Sequence_Arrays.Vector :=
WisiToken.Generate.To_Terminal_Sequence_Array (First_Nonterm_Set,
Descriptor);
- Item_Sets : constant LR1_Items.Item_Set_List :=
- (if Task_Count = 1
- then LR1_Item_Sets_Single
- (Has_Empty_Production, First_Terminal_Sequence, Grammar, Descriptor)
- else LR1_Item_Sets_Parallel
- (Has_Empty_Production, First_Terminal_Sequence, Grammar,
Descriptor, Task_Count));
+ Item_Sets : constant LR1_Items.Item_Set_List := LR1_Item_Sets
+ (Has_Empty_Production, First_Terminal_Sequence, Grammar,
Descriptor);
Unknown_Conflicts : Conflict_Lists.Tree;
Known_Conflicts_Edit : Conflict_Lists.Tree := Known_Conflicts;
diff --git a/wisitoken-generate-lr-lr1_generate.ads
b/wisitoken-generate-lr-lr1_generate.ads
index 32f618f941..42004e7f2a 100644
--- a/wisitoken-generate-lr-lr1_generate.ads
+++ b/wisitoken-generate-lr-lr1_generate.ads
@@ -25,8 +25,6 @@
pragma License (Modified_GPL);
-with System.Multiprocessors;
-with WisiToken.Generate.LR1_Items;
with WisiToken.Productions;
package WisiToken.Generate.LR.LR1_Generate is
@@ -42,7 +40,6 @@ package WisiToken.Generate.LR.LR1_Generate is
Include_Extra : in Boolean := False;
Ignore_Conflicts : in Boolean := False;
Recursion_Strategy : in WisiToken.Recursion_Strategy := Full;
- Task_Count : in System.Multiprocessors.CPU_Range := 1;
Use_Cached_Recursions : in Boolean := False;
Recursions : in out WisiToken.Generate.Recursions)
return Parse_Table_Ptr
@@ -63,14 +60,11 @@ package WisiToken.Generate.LR.LR1_Generate is
--
-- Unless Ignore_Unknown_Conflicts is True, raise Grammar_Error if there
-- are unknown conflicts.
- --
- -- Use Task_Count tasks in computing LR1 items. Default is 1 so unit
- -- tests return repeatable results.
----------
-- visible for unit test
- function LR1_Item_Sets_Single
+ function LR1_Item_Sets
(Has_Empty_Production : in Token_ID_Set;
First_Terminal_Sequence : in Token_Sequence_Arrays.Vector;
Grammar : in WisiToken.Productions.Prod_Arrays.Vector;
@@ -79,14 +73,4 @@ package WisiToken.Generate.LR.LR1_Generate is
return LR1_Items.Item_Set_List;
-- [dragon] algorithm 4.9 pg 231; figure 4.38 pg 232; procedure "items",
no tasking
- function LR1_Item_Sets_Parallel
- (Has_Empty_Production : in Token_ID_Set;
- First_Terminal_Sequence : in Token_Sequence_Arrays.Vector;
- Grammar : in WisiToken.Productions.Prod_Arrays.Vector;
- Descriptor : in WisiToken.Descriptor;
- Task_Count : in System.Multiprocessors.CPU_Range;
- Hash_Table_Size : in Positive :=
LR1_Items.Item_Set_Trees.Default_Rows)
- return LR1_Items.Item_Set_List;
- -- With tasking; used if State_Count known.
-
end WisiToken.Generate.LR.LR1_Generate;
diff --git a/wisitoken-lexer-re2c.ads b/wisitoken-lexer-re2c.ads
index 6c1d8c7e02..a57d677c2c 100644
--- a/wisitoken-lexer-re2c.ads
+++ b/wisitoken-lexer-re2c.ads
@@ -4,7 +4,7 @@
--
-- References:
--
--- [1] https://re2c.org/
+-- [1] http://re2c.org/
--
-- Copyright (C) 2017 - 2022 Free Software Foundation, Inc.
--
diff --git a/wisitoken-parse-lr-parser-parse.adb
b/wisitoken-parse-lr-parser-parse.adb
index ea3c5d7b13..e9cd8f2df9 100644
--- a/wisitoken-parse-lr-parser-parse.adb
+++ b/wisitoken-parse-lr-parser-parse.adb
@@ -348,7 +348,8 @@ begin
Recover_Duration : constant Duration := Clock - Start;
begin
Trace.Put_Clock
- ("post-recover" & Shared_Parser.Parsers.Count'Img & "
active," & Recover_Duration'Image);
+ ("post-recover" & Shared_Parser.Parsers.Count'Img & "
parsers active," &
+ Recover_Duration'Image & " seconds");
end;
end if;
diff --git a/wisitoken-parse-lr-parser.adb b/wisitoken-parse-lr-parser.adb
index 5736c89f63..914d08bbab 100644
--- a/wisitoken-parse-lr-parser.adb
+++ b/wisitoken-parse-lr-parser.adb
@@ -1090,6 +1090,12 @@ package body WisiToken.Parse.LR.Parser is
----------
-- Public subprograms, declaration order
+ overriding
+ procedure Finalize (Object : in out Parser)
+ is begin
+ Free_Table (Object.Table);
+ end Finalize;
+
procedure New_Parser
(Parser : out LR.Parser.Parser;
Lexer : in WisiToken.Lexer.Handle;
diff --git a/wisitoken-parse-lr-parser.ads b/wisitoken-parse-lr-parser.ads
index da9495faf5..eb0a1ea164 100644
--- a/wisitoken-parse-lr-parser.ads
+++ b/wisitoken-parse-lr-parser.ads
@@ -23,6 +23,7 @@
pragma License (Modified_GPL);
+with Ada.Unchecked_Deallocation;
with WisiToken.Parse.LR.Parser_Lists;
with WisiToken.Lexer;
with WisiToken.Syntax_Trees;
@@ -94,12 +95,10 @@ package WisiToken.Parse.LR.Parser is
Parsers : aliased Parser_Lists.List;
end record;
- type Parser_Access is access Parser;
+ type Parser_Access is access all Parser;
- -- It is tempting to declare Finalize here, to free Parser.Table. But
- -- Wisi.Parse_Context reuses the table between parser instances, so
- -- we can't do that. Other applications must explicitly free
- -- Parser.Table if they care.
+ overriding procedure Finalize (Object : in out Parser);
+ -- Free Table.
procedure New_Parser
(Parser : out LR.Parser.Parser;
@@ -127,4 +126,7 @@ package WisiToken.Parse.LR.Parser is
Edits : in KMN_Lists.List := KMN_Lists.Empty_List;
Pre_Edited : in Boolean := False);
+ procedure Free is new Ada.Unchecked_Deallocation (Parser, Parser_Access);
+ -- Declared last to avoid freezing rules.
+
end WisiToken.Parse.LR.Parser;
diff --git a/wisitoken-parse.ads b/wisitoken-parse.ads
index 95094c6dfe..b9c5b54b1a 100644
--- a/wisitoken-parse.ads
+++ b/wisitoken-parse.ads
@@ -507,6 +507,7 @@ package WisiToken.Parse is
type Base_Parser_Access is access all Base_Parser'Class;
type Factory is access function return Base_Parser_Access;
+ type Free_Parser is access procedure (Object : in out Base_Parser_Access);
function Source_File_Name (Item : in Base_Parser'Class) return String
is (Item.Tree.Lexer.File_Name);
diff --git a/wisitoken-parse_table-mode.el b/wisitoken-parse_table-mode.el
index 0ec43a3f7b..7685b38fdb 100644
--- a/wisitoken-parse_table-mode.el
+++ b/wisitoken-parse_table-mode.el
@@ -7,7 +7,7 @@
;; Keywords: parser
;; Version: 1.0
;; package-requires: ((emacs "25.1"))
-;; URL: http://www.nongnu.org/ada-mode/wisi/wisi.html
+;; URL: https://www.nongnu.org/ada-mode/wisi/wisi.html
;;
;; This file is part of GNU Emacs.
;;
@@ -116,7 +116,8 @@ Symbol can be a nonterminal name, or a state number."
(defun wisitok-p_t-conflict-alist ()
(let ((conflicts nil)
(nonterms (wisitok-p_t-nonterm-alist))
- line)
+ line
+ (count 0))
(save-excursion
(goto-char (point-min))
@@ -148,7 +149,10 @@ Symbol can be a nonterminal name, or a state number."
(setq conflict (concat conflict " on token " on-token))
(push (cons conflict (list (buffer-file-name) line 0)) conflicts)
- )))
+ )
+ ;; Let user know we are not hung; can take a long time in large buffers.
+ (setq count (1+ count))
+ (message "conflict %d" count)))
conflicts))
(defconst wisitok-p_t-action-nonterm-regexp "\\(?:SHIFT\\|REDUCE\\)
[[:alnum:]_]+")
diff --git a/wisitoken-user_guide.texinfo b/wisitoken-user_guide.texinfo
index fac55a8e16..a0b41c57dc 100644
--- a/wisitoken-user_guide.texinfo
+++ b/wisitoken-user_guide.texinfo
@@ -5,7 +5,7 @@
@settitle WisiToken User Guide
@copying
-Copyright @copyright{} 2014-2015, 2017-2018, 2020-2022 Stephen Leake.
+Copyright @copyright{} 2014-2015, 2017-2018, 2020-2023 Stephen Leake.
@quotation
Permission is granted to copy, distribute and/or modify this
@@ -33,7 +33,7 @@ section entitled "GNU Free Documentation License".
@contents
@node Top
-@top WisiToken User Guide version 4.0
+@top WisiToken User Guide version 4.1
@ifnottex
@insertcopying
@@ -73,7 +73,7 @@ available in the GNU ELPA package @code{wisi}.
You will also need to install a lexer generator. WisiToken supports
re2c, and other lexers can be added.
-re2c is available from @url{https://re2c.org/}; it is also packaged in
+re2c is available from @url{http://re2c.org/}; it is also packaged in
Mingw64 and Debian. WisiToken requires at least version 1.3.
The WisiToken makefile assumes the executable @code{re2c} is in
@code{$PATH}.
diff --git a/wisitoken_grammar_actions.adb b/wisitoken_grammar_actions.adb
index 8fa99c8be9..9c53fba32d 100644
--- a/wisitoken_grammar_actions.adb
+++ b/wisitoken_grammar_actions.adb
@@ -19,7 +19,7 @@
-- 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 <https://www.gnu.org/licenses/>.
+-- along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
with WisiToken_Grammar_Runtime; use WisiToken_Grammar_Runtime;
diff --git a/wisitoken_grammar_actions.ads b/wisitoken_grammar_actions.ads
index 8220a1e96b..f8a7654b7b 100644
--- a/wisitoken_grammar_actions.ads
+++ b/wisitoken_grammar_actions.ads
@@ -19,7 +19,7 @@
-- 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 <https://www.gnu.org/licenses/>.
+-- along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
with WisiToken.Syntax_Trees;
package Wisitoken_Grammar_Actions is
diff --git a/wisitoken_grammar_main.adb b/wisitoken_grammar_main.adb
index 38fbafa1b8..4816a20407 100644
--- a/wisitoken_grammar_main.adb
+++ b/wisitoken_grammar_main.adb
@@ -19,7 +19,7 @@
-- 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 <https://www.gnu.org/licenses/>.
+-- along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
with SAL;
with WisiToken.Lexer.re2c;
diff --git a/wisitoken_grammar_main.ads b/wisitoken_grammar_main.ads
index 68a76445e2..1e7b6f937a 100644
--- a/wisitoken_grammar_main.ads
+++ b/wisitoken_grammar_main.ads
@@ -19,7 +19,7 @@
-- 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 <https://www.gnu.org/licenses/>.
+-- along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
with WisiToken.Syntax_Trees;
with WisiToken.Parse.LR.Parser_No_Recover;
diff --git a/wisitoken_grammar_re2c.c b/wisitoken_grammar_re2c.c
index 29e815ffa3..712d5eb487 100644
--- a/wisitoken_grammar_re2c.c
+++ b/wisitoken_grammar_re2c.c
@@ -21,7 +21,7 @@
// 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 <https://www.gnu.org/licenses/>.
+// along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
#include <stddef.h>
#include <stdio.h>
diff --git a/wisitoken_grammar_re2c_c.ads b/wisitoken_grammar_re2c_c.ads
index bcc487b828..c9d4c55b40 100644
--- a/wisitoken_grammar_re2c_c.ads
+++ b/wisitoken_grammar_re2c_c.ads
@@ -19,7 +19,7 @@
-- 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 <https://www.gnu.org/licenses/>.
+-- along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
with Interfaces.C;
with WisiToken;