[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/wisi c80e75d 30/35: Release ada-mode 7.1.0, wisi 3.1.0
|
From: |
Stefan Monnier |
|
Subject: |
[elpa] externals/wisi c80e75d 30/35: Release ada-mode 7.1.0, wisi 3.1.0 |
|
Date: |
Sat, 28 Nov 2020 14:47:58 -0500 (EST) |
branch: externals/wisi
commit c80e75d1fab5c6d555f9f11170c54a808f8fc432
Author: Stephen Leake <stephen_leake@stephe-leake.org>
Commit: Stephen Leake <stephen_leake@stephe-leake.org>
Release ada-mode 7.1.0, wisi 3.1.0
* packages/ada-mode/*
* packages/wisi/*
---
NEWS | 20 +
README | 2 +-
emacs_wisi_common_parse.adb | 5 +-
gen_emacs_wisi_lr_parse.adb | 4 +-
gen_emacs_wisi_lr_text_rep_parse.adb | 4 +-
gen_run_wisi_lr_parse.adb | 4 +-
gen_run_wisi_lr_text_rep_parse.adb | 4 +-
recover_stats.adb | 10 +-
run_wisi_common_parse.adb | 21 +-
sal-gen_bounded_definite_stacks.ads | 4 +-
sal-gen_bounded_definite_vectors_sorted.adb | 18 +-
sal-gen_bounded_definite_vectors_sorted.ads | 43 +-
sal-gen_definite_doubly_linked_lists.adb | 26 +-
sal-gen_definite_doubly_linked_lists.ads | 38 +-
sal-gen_definite_doubly_linked_lists_sorted.adb | 32 +-
sal-gen_definite_doubly_linked_lists_sorted.ads | 45 +-
sal-gen_graphs.ads | 4 +-
sal-gen_indefinite_doubly_linked_lists.adb | 14 +-
sal-gen_indefinite_doubly_linked_lists.ads | 7 +-
sal-gen_unbounded_definite_red_black_trees.adb | 13 +-
sal-gen_unbounded_definite_red_black_trees.ads | 7 +-
sal-gen_unbounded_definite_stacks.adb | 13 +-
sal-gen_unbounded_definite_stacks.ads | 27 +-
sal-gen_unbounded_definite_vectors.adb | 1169 ++++++++++----------
sal-gen_unbounded_definite_vectors.ads | 45 +-
sal-gen_unbounded_definite_vectors_sorted.adb | 32 +-
sal-gen_unbounded_definite_vectors_sorted.ads | 24 +-
sal.adb | 4 +-
standard_common.gpr | 4 +-
wisi-prj.el | 290 +++--
wisi-process-parse.el | 41 +-
wisi-run-indent-test.el | 21 +-
wisi-skel.el | 47 +-
wisi.adb | 744 ++++++++-----
wisi.ads | 153 ++-
wisi.el | 144 +--
wisi.info | 1294 +++++++++++++++++++++++
wisi.texi | 812 ++++++++++++++
wisitoken-bnf-generate.adb | 103 +-
wisitoken-bnf-generate_packrat.adb | 4 +-
wisitoken-bnf-generate_utils.adb | 10 +-
wisitoken-bnf-generate_utils.ads | 10 +-
wisitoken-bnf-output_ada.adb | 6 +-
wisitoken-bnf-output_ada_common.adb | 91 +-
wisitoken-bnf-output_ada_emacs.adb | 9 +-
wisitoken-bnf.ads | 30 +-
wisitoken-generate-lr-lalr_generate.adb | 460 ++++----
wisitoken-generate-lr-lalr_generate.ads | 18 +-
wisitoken-generate-lr-lr1_generate.adb | 92 +-
wisitoken-generate-lr-lr1_generate.ads | 20 +-
wisitoken-generate-lr.adb | 1068 +++++++++----------
wisitoken-generate-lr.ads | 56 +-
wisitoken-generate-lr1_items.adb | 157 ++-
wisitoken-generate-lr1_items.ads | 39 +-
wisitoken-generate.adb | 141 ++-
wisitoken-generate.ads | 51 +-
wisitoken-lexer-re2c.adb | 5 +-
wisitoken-lexer-regexp.adb | 3 +-
wisitoken-parse-lr-mckenzie_recover-base.adb | 136 +--
wisitoken-parse-lr-mckenzie_recover-explore.adb | 842 ++++++++-------
wisitoken-parse-lr-mckenzie_recover-parse.adb | 15 +-
wisitoken-parse-lr-mckenzie_recover.adb | 720 +++++++------
wisitoken-parse-lr-mckenzie_recover.ads | 89 +-
wisitoken-parse-lr-parser.adb | 597 ++++++-----
wisitoken-parse-lr-parser.ads | 7 +-
wisitoken-parse-lr-parser_lists.adb | 80 +-
wisitoken-parse-lr-parser_lists.ads | 57 +-
wisitoken-parse-lr-parser_no_recover.adb | 211 ++--
wisitoken-parse-lr-parser_no_recover.ads | 11 +-
wisitoken-parse-lr.adb | 65 +-
wisitoken-parse-lr.ads | 114 +-
wisitoken-parse-packrat-generated.adb | 11 +-
wisitoken-parse-packrat-generated.ads | 7 +-
wisitoken-parse-packrat-procedural.adb | 15 +-
wisitoken-parse-packrat-procedural.ads | 7 +-
wisitoken-parse-packrat.adb | 15 +-
wisitoken-parse-packrat.ads | 14 +-
wisitoken-parse.adb | 33 +-
wisitoken-parse.ads | 18 +-
wisitoken-parse_table-mode.el | 28 +-
wisitoken-productions.adb | 38 +-
wisitoken-productions.ads | 28 +-
wisitoken-syntax_trees-lr_utils.adb | 6 +-
wisitoken-syntax_trees-lr_utils.ads | 4 +-
wisitoken-syntax_trees.adb | 571 ++++++----
wisitoken-syntax_trees.ads | 235 ++--
wisitoken-text_io_trace.ads | 3 +-
wisitoken-user_guide.info | 283 ++---
wisitoken-wisi_ada.adb | 8 +-
wisitoken.adb | 28 +-
wisitoken.ads | 58 +-
wisitoken_grammar_actions.adb | 56 +-
wisitoken_grammar_actions.ads | 56 +-
wisitoken_grammar_main.adb | 690 ++++++------
wisitoken_grammar_re2c.c | 80 +-
wisitoken_grammar_runtime.adb | 285 ++---
wisitoken_grammar_runtime.ads | 36 +-
97 files changed, 8211 insertions(+), 4908 deletions(-)
diff --git a/NEWS b/NEWS
index 277c1ea..38c8057 100644
--- a/NEWS
+++ b/NEWS
@@ -6,6 +6,26 @@ 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 3.1.0
+11 May 2020
+
+** Add Wisitoken.Syntax_Trees.Insert_Token, to allow using inserted
+ virtual terminals tokens in indent. Several related changes to
+ allow treating virtual terminals on par with actual terminals.
+
+** New elisp generic functions: wisi-xref-completion-table,
wisi-xref-completion-regexp, wisi-xref-completion-at-point-table
+
+** New elisp functions: wisi-filter-table, wisi-completion-at-point,
wisi-skel-add-token-after
+
+** wisi-get-identifier uses wisi-xref-completion-table.
+
+** wisi-prj-identifier-at-point returns (IDENT START END)
+
+** In wisi.ads: augmented tokens are no stored only in the syntax
+ tree; new functions Get_Aug_Token_Const_1, Get_Aug_Token_Const,
+ Get_Aug_Token_Var provide access to them. Parse_Data_Type contains
+ a reference to the shared Terminals.
+
* wisi 3.0.1
30 Jan 2020
diff --git a/README b/README
index f2c5329..f189c8d 100644
--- a/README
+++ b/README
@@ -1,4 +1,4 @@
-Emacs wisi package 3.0.1
+Emacs wisi package 3.1.0
The wisi package provides utilities for using generalized
error-correcting LR parsers (in external processes) to do indentation,
diff --git a/emacs_wisi_common_parse.adb b/emacs_wisi_common_parse.adb
index 183aaf7..59d20e5 100644
--- a/emacs_wisi_common_parse.adb
+++ b/emacs_wisi_common_parse.adb
@@ -2,7 +2,7 @@
--
-- See spec.
--
--- Copyright (C) 2018 - 2019 Free Software Foundation, Inc.
+-- Copyright (C) 2018 - 2020 Free Software Foundation, Inc.
--
-- This program is free software; you can redistribute it and/or
-- modify it under terms of the GNU General Public License as
@@ -24,7 +24,6 @@ with Ada.Exceptions;
with Ada.Strings.Fixed;
with Ada.Text_IO;
with GNAT.OS_Lib;
-with GNAT.Traceback.Symbolic;
with SAL;
with System.Multiprocessors;
with System.Storage_Elements;
@@ -504,8 +503,6 @@ package body Emacs_Wisi_Common_Parse is
Put_Line
("(error ""unhandled exception: " & Ada.Exceptions.Exception_Name (E)
& ": " &
Ada.Exceptions.Exception_Message (E) & """)");
- Put_Line (GNAT.Traceback.Symbolic.Symbolic_Traceback (E));
-
end Process_Stream;
end Emacs_Wisi_Common_Parse;
diff --git a/gen_emacs_wisi_lr_parse.adb b/gen_emacs_wisi_lr_parse.adb
index 951a871..0f81868 100644
--- a/gen_emacs_wisi_lr_parse.adb
+++ b/gen_emacs_wisi_lr_parse.adb
@@ -2,7 +2,7 @@
--
-- See spec.
--
--- Copyright (C) 2014, 2017 - 2019 All Rights Reserved.
+-- Copyright (C) 2014, 2017 - 2020 All Rights Reserved.
--
-- This program is free software; you can redistribute it and/or
-- modify it under terms of the GNU General Public License as
@@ -25,7 +25,7 @@ procedure Gen_Emacs_Wisi_LR_Parse
is
Trace : aliased WisiToken.Text_IO_Trace.Trace
(Descriptor'Unrestricted_Access);
Parser : WisiToken.Parse.LR.Parser.Parser;
- Parse_Data : aliased Parse_Data_Type (Parser.Line_Begin_Token'Access);
+ Parse_Data : aliased Parse_Data_Type (Parser.Terminals'Access,
Parser.Line_Begin_Token'Access);
Params : constant Process_Start_Params := Get_Process_Start_Params;
begin
diff --git a/gen_emacs_wisi_lr_text_rep_parse.adb
b/gen_emacs_wisi_lr_text_rep_parse.adb
index f74144c..31f1052 100644
--- a/gen_emacs_wisi_lr_text_rep_parse.adb
+++ b/gen_emacs_wisi_lr_text_rep_parse.adb
@@ -2,7 +2,7 @@
--
-- See spec.
--
--- Copyright (C) 2014, 2017 - 2019 All Rights Reserved.
+-- Copyright (C) 2014, 2017 - 2020 All Rights Reserved.
--
-- This program is free software; you can redistribute it and/or
-- modify it under terms of the GNU General Public License as
@@ -29,7 +29,7 @@ is
Trace : aliased WisiToken.Text_IO_Trace.Trace
(Descriptor'Unrestricted_Access);
Parser : WisiToken.Parse.LR.Parser.Parser;
- Parse_Data : aliased Parse_Data_Type (Parser.Line_Begin_Token'Access);
+ Parse_Data : aliased Parse_Data_Type (Parser.Terminals'Access,
Parser.Line_Begin_Token'Access);
Params : constant Process_Start_Params := Get_Process_Start_Params;
begin
diff --git a/gen_run_wisi_lr_parse.adb b/gen_run_wisi_lr_parse.adb
index ee63c77..84498de 100644
--- a/gen_run_wisi_lr_parse.adb
+++ b/gen_run_wisi_lr_parse.adb
@@ -2,7 +2,7 @@
--
-- See spec.
--
--- Copyright (C) 2017 - 2019 All Rights Reserved.
+-- Copyright (C) 2017 - 2020 All Rights Reserved.
--
-- This program is free software; you can redistribute it and/or
-- modify it under terms of the GNU General Public License as
@@ -24,7 +24,7 @@ procedure Gen_Run_Wisi_LR_Parse
is
Trace : aliased WisiToken.Text_IO_Trace.Trace
(Descriptor'Unrestricted_Access);
Parser : WisiToken.Parse.LR.Parser.Parser;
- Parse_Data : aliased Parse_Data_Type (Parser.Line_Begin_Token'Access);
+ Parse_Data : aliased Parse_Data_Type (Parser.Terminals'Access,
Parser.Line_Begin_Token'Access);
begin
-- Create parser first so Put_Usage has defaults from Parser.Table,
-- and Get_CL_Params can override them.
diff --git a/gen_run_wisi_lr_text_rep_parse.adb
b/gen_run_wisi_lr_text_rep_parse.adb
index 09efefd..45bc5e1 100644
--- a/gen_run_wisi_lr_text_rep_parse.adb
+++ b/gen_run_wisi_lr_text_rep_parse.adb
@@ -2,7 +2,7 @@
--
-- See spec.
--
--- Copyright (C) 2017 - 2019 All Rights Reserved.
+-- Copyright (C) 2017 - 2020 All Rights Reserved.
--
-- This program is free software; you can redistribute it and/or
-- modify it under terms of the GNU General Public License as
@@ -26,7 +26,7 @@ procedure Gen_Run_Wisi_LR_Text_Rep_Parse
is
Trace : aliased WisiToken.Text_IO_Trace.Trace
(Descriptor'Unrestricted_Access);
Parser : WisiToken.Parse.LR.Parser.Parser;
- Parse_Data : aliased Parse_Data_Type (Parser.Line_Begin_Token'Access);
+ Parse_Data : aliased Parse_Data_Type (Parser.Terminals'Access,
Parser.Line_Begin_Token'Access);
begin
-- Create parser first so Put_Usage has defaults from Parser.Table,
-- and Get_CL_Params can override them.
diff --git a/recover_stats.adb b/recover_stats.adb
index 9172cb8..e1fed7b 100644
--- a/recover_stats.adb
+++ b/recover_stats.adb
@@ -2,7 +2,7 @@
--
-- Summarize error recover log.
--
--- Copyright (C) 2019 Stephen Leake All Rights Reserved.
+-- Copyright (C) 2019 - 2020 Stephen Leake All Rights Reserved.
--
-- This program is free software; you can redistribute it and/or
-- modify it under terms of the GNU General Public License as
@@ -52,9 +52,6 @@ is
Strat_Counts_Present : Strategy_Counts := (others => 0);
-- 1 per recover event if used
- Ignore_Error : Integer := 0;
- -- ie, error is name mismatch.
-
Recover_Count_Present : Integer := 0;
-- 1 per parser in recover result
@@ -176,10 +173,8 @@ begin
Summary (Label).Recover_Count_Present := Summary
(Label).Recover_Count_Present + 1;
if not Strategy_Found then
- Summary (Label).Ignore_Error := Summary
(Label).Ignore_Error + 1;
+ raise SAL.Programmer_Error;
else
- -- We don't include Ignore_Error enqueue and check
counts in the
- -- stats, because they distort them towards 1.
Summary (Label).Enqueue_Stats.Accumulate (Long_Float
(Enqueue_Count));
Summary (Label).Check_Stats.Accumulate (Long_Float
(Check_Count));
for I in Strategies loop
@@ -265,7 +260,6 @@ begin
Summary (I).Strat_Counts_Total (J),
J'Image);
end loop;
- Put_Percent (I, Summary (I).Ignore_Error, Summary
(I).Ignore_Error, "Ignore_Error");
end if;
New_Line;
end loop;
diff --git a/run_wisi_common_parse.adb b/run_wisi_common_parse.adb
index 517b631..c79f2e7 100644
--- a/run_wisi_common_parse.adb
+++ b/run_wisi_common_parse.adb
@@ -23,7 +23,6 @@ with Ada.Exceptions;
with Ada.IO_Exceptions;
with Ada.Real_Time;
with Ada.Text_IO;
-with GNAT.Traceback.Symbolic;
with SAL;
with System.Multiprocessors;
package body Run_Wisi_Common_Parse is
@@ -134,6 +133,8 @@ package body Run_Wisi_Common_Parse is
Arg := Arg + 3;
end case;
+ WisiToken.Debug_Mode := WisiToken.Trace_Parse > Outline or
WisiToken.Trace_McKenzie > Outline;
+
elsif Argument (Arg) = "--check_limit" then
Parser.Table.McKenzie_Param.Check_Limit := Token_Index'Value
(Argument (Arg + 1));
Arg := Arg + 2;
@@ -199,7 +200,16 @@ package body Run_Wisi_Common_Parse is
Start : Ada.Real_Time.Time;
End_Line : WisiToken.Line_Number_Type;
+
+ function Image_Augmented (Aug : in Base_Token_Class_Access) return String
+ is begin
+ -- For Syntax_Trees.Print_Tree
+ return Wisi.Image (Aug, Descriptor);
+ end Image_Augmented;
+
begin
+ Parser.Trace.Set_Prefix (";; "); -- so we get the same debug messages as
Emacs_Wisi_Common_Parse
+
declare
Cl_Params : constant Command_Line_Params := Get_CL_Params (Parser);
begin
@@ -286,7 +296,7 @@ package body Run_Wisi_Common_Parse is
null;
end;
- Parser.Execute_Actions;
+ Parser.Execute_Actions (Image_Augmented'Unrestricted_Access);
case Cl_Params.Command is
when Parse =>
@@ -310,11 +320,13 @@ package body Run_Wisi_Common_Parse is
when E : WisiToken.Parse_Error =>
Clean_Up;
- Put_Line ("(parse_error """ & Ada.Exceptions.Exception_Message
(E) & """)");
+ Put_Line ("(parse_error """ & Ada.Exceptions.Exception_Name (E)
& " " &
+ Ada.Exceptions.Exception_Message (E) & """)");
when E : others => -- includes Fatal_Error
Clean_Up;
- Put_Line ("(error """ & Ada.Exceptions.Exception_Message (E) &
""")");
+ Put_Line ("(error """ & Ada.Exceptions.Exception_Name (E) & " "
&
+ Ada.Exceptions.Exception_Message (E) & """)");
end;
end loop;
@@ -339,7 +351,6 @@ package body Run_Wisi_Common_Parse is
Put_Line
("(error ""unhandled exception: " & Ada.Exceptions.Exception_Name (E)
& ": " &
Ada.Exceptions.Exception_Message (E) & """)");
- Put_Line (GNAT.Traceback.Symbolic.Symbolic_Traceback (E));
end Parse_File;
end Run_Wisi_Common_Parse;
diff --git a/sal-gen_bounded_definite_stacks.ads
b/sal-gen_bounded_definite_stacks.ads
index f743508..e2ba7ab 100644
--- a/sal-gen_bounded_definite_stacks.ads
+++ b/sal-gen_bounded_definite_stacks.ads
@@ -3,7 +3,7 @@
-- Bounded stack implementation, with full Spark verification,
-- optimized for speed.
--
--- Copyright (C) 1998-2000, 2002-2003, 2009, 2015, 2017 - 2019 Free Software
Foundation, Inc.
+-- Copyright (C) 1998-2000, 2002-2003, 2009, 2015, 2017 - 2020 Free Software
Foundation, Inc.
--
-- SAL is free software; you can redistribute it and/or modify it
-- under terms of the GNU General Public License as published by the
@@ -98,6 +98,6 @@ private
-- Top of stack is at Data (Top).
-- Data (1 .. Top) has been set at some point.
end record with
- Dynamic_Predicate => Top in 0 .. Size;
+ Dynamic_Predicate => Stack.Top in 0 .. Stack.Size;
end SAL.Gen_Bounded_Definite_Stacks;
diff --git a/sal-gen_bounded_definite_vectors_sorted.adb
b/sal-gen_bounded_definite_vectors_sorted.adb
index 9979f28..8b89a7f 100644
--- a/sal-gen_bounded_definite_vectors_sorted.adb
+++ b/sal-gen_bounded_definite_vectors_sorted.adb
@@ -2,7 +2,7 @@
--
-- See spec.
--
--- Copyright (C) 2018 - 2019 Free Software Foundation, Inc.
+-- Copyright (C) 2018 - 2020 Free Software Foundation, Inc.
--
-- This library is free software; you can redistribute it and/or modify it
-- under terms of the GNU General Public License as published by the Free
@@ -54,8 +54,16 @@ package body SAL.Gen_Bounded_Definite_Vectors_Sorted is
end if;
loop
- pragma Loop_Invariant (J < Container.Elements'Last);
+ -- These seem obvious, but gnatprove needs them (in 2019).
+ pragma Loop_Invariant (J <= Container.Last);
+ pragma Loop_Invariant (J <= Container.Elements'Last);
pragma Loop_Variant (Decreases => J);
+
+ -- This is less obvious, helps a lot.
+ pragma Loop_Invariant
+ ((for all I in J + 1 .. Container.Last => Element_Compare
+ (New_Item, Container.Elements (I)) = Less));
+
exit when J < 1;
case Element_Compare (New_Item, Container.Elements (J)) is
@@ -74,6 +82,12 @@ package body SAL.Gen_Bounded_Definite_Vectors_Sorted is
end case;
end loop;
+ -- Note that this assertion is _not_ a Loop_Invariant; the whole
+ -- point here is to find the right J.
+ pragma Assert
+ (for all I in 1 .. J - 1 =>
+ Element_Compare (Container.Elements (I), New_Item) in Less | Equal);
+
Container.Elements (J + 2 .. K + 1) := Container.Elements (J + 1 .. K);
Container.Elements (J + 1) := New_Item;
Container.Last := Container.Last + 1;
diff --git a/sal-gen_bounded_definite_vectors_sorted.ads
b/sal-gen_bounded_definite_vectors_sorted.ads
index 7bc398c..e86fbca 100644
--- a/sal-gen_bounded_definite_vectors_sorted.ads
+++ b/sal-gen_bounded_definite_vectors_sorted.ads
@@ -2,7 +2,7 @@
--
-- A simple bounded sorted vector of definite items, in Spark.
--
--- Copyright (C) 2018 - 2019 Free Software Foundation, Inc.
+-- Copyright (C) 2018 - 2020 Free Software Foundation, Inc.
--
-- This library is free software; you can redistribute it and/or modify it
-- under terms of the GNU General Public License as published by the Free
@@ -26,8 +26,10 @@ package SAL.Gen_Bounded_Definite_Vectors_Sorted
is
use all type Ada.Containers.Count_Type;
+ No_Index : constant Base_Peek_Type := 0;
+
type Vector is private with
- Default_Initial_Condition => Length (Vector) = 0;
+ Default_Initial_Condition => Last_Index (Vector) = No_Index;
function Length (Container : in Vector) return Ada.Containers.Count_Type
with
Post => Length'Result in 0 .. Capacity;
@@ -36,7 +38,7 @@ is
Post => Is_Full'Result = (Length (Container) = Capacity);
procedure Clear (Container : in out Vector) with
- Post => Length (Container) = 0;
+ Post => Last_Index (Container) = No_Index;
function First_Index (Container : in Vector) return Peek_Type
is (Peek_Type'First) with
@@ -49,37 +51,50 @@ is
Pre => Index in First_Index (Container) .. Last_Index (Container);
function Is_Sorted (Container : in Vector) return Boolean is
+ -- See comment on similar Is_Sorted below
(for all I in First_Index (Container) .. Last_Index (Container) - 1 =>
- Element_Compare (Element (Container, I), Element (Container, I + 1))
in Less | Equal);
+ (for all J in I + 1 .. Last_Index (Container) =>
+ Element_Compare (Element (Container, I), Element (Container, J)) in
Less | Equal));
procedure Insert
(Container : in out Vector;
New_Item : in Element_Type;
Ignore_If_Equal : in Boolean := False) with
- Pre => Length (Container) < Capacity,
+ Pre => Last_Index (Container) < Peek_Type (Capacity),
Post => Is_Sorted (Container) and
- (Length (Container) = Length (Container'Old) or
- Length (Container) = Length (Container'Old) + 1);
+ (if Ignore_If_Equal then
+ (Last_Index (Container) = Last_Index (Container'Old) or
+ Last_Index (Container) = Last_Index (Container'Old) + 1)
+ else
+ Last_Index (Container) = Last_Index (Container'Old) + 1);
-- Insert New_Item in sorted position. Items are sorted in increasing
-- order according to Element_Compare. New_Item is inserted after
-- Equal items, unless Ignore_If_Equal is true, in which case
-- New_Item is not inserted.
- --
- -- The presense of Ignore_If_Equal makes it too difficult to prove
- -- whether the length did or did not increase.
private
type Array_Type is array (Peek_Type range 1 .. Peek_Type (Capacity)) of
aliased Element_Type;
- No_Index : constant Base_Peek_Type := 0;
+ function Is_Sorted (Container : in Array_Type; Last : in Base_Peek_Type)
return Boolean
+ -- This is too hard for gnatprove (in 2019):
+ -- is (for all I in Container'First .. Last - 1 =>
+ -- Element_Compare (Container (I), Container (I + 1)) in Less |
Equal)
+ -- This works:
+ is (for all I in Container'First .. Last - 1 =>
+ (for all J in I + 1 .. Last =>
+ Element_Compare (Container (I), Container (J)) in Less | Equal))
+ with Pre => Last <= Container'Last;
+
+ subtype Index_Type is Base_Peek_Type range No_Index .. Base_Peek_Type
(Capacity);
+ -- Helps with proofs
type Vector is record
Elements : Array_Type;
- Last : Base_Peek_Type := No_Index;
+ Last : Index_Type := No_Index;
end record with
- Type_Invariant => Last <= Elements'Last and Is_Sorted (Vector);
+ Type_Invariant => Last <= Elements'Last and Is_Sorted (Vector.Elements,
Vector.Last);
pragma Annotate (GNATprove, Intentional, "type ""Vector"" is not fully
initialized",
- "Only items in Elements with index < Last are accessed");
+ "Only items in Elements with index <= Last are accessed");
end SAL.Gen_Bounded_Definite_Vectors_Sorted;
diff --git a/sal-gen_definite_doubly_linked_lists.adb
b/sal-gen_definite_doubly_linked_lists.adb
index f0c5776..d86441a 100644
--- a/sal-gen_definite_doubly_linked_lists.adb
+++ b/sal-gen_definite_doubly_linked_lists.adb
@@ -2,7 +2,7 @@
--
-- see spec
--
--- Copyright (C) 2017 - 2019 Free Software Foundation, Inc.
+-- Copyright (C) 2017 - 2020 Free Software Foundation, Inc.
--
-- This library is free software; you can redistribute it and/or
-- modify it under terms of the GNU General Public License as
@@ -141,18 +141,18 @@ package body SAL.Gen_Definite_Doubly_Linked_Lists is
function First (Container : in List) return Cursor
is begin
if Container.Head = null then
- return No_Element;
+ return (Ptr => null);
else
- return (Container'Unrestricted_Access, Container.Head);
+ return (Ptr => Container.Head);
end if;
end First;
function Last (Container : in List) return Cursor
is begin
if Container.Tail = null then
- return No_Element;
+ return (Ptr => null);
else
- return (Container'Unrestricted_Access, Container.Tail);
+ return (Ptr => Container.Tail);
end if;
end Last;
@@ -160,7 +160,7 @@ package body SAL.Gen_Definite_Doubly_Linked_Lists is
is begin
if Position.Ptr /= null then
if Position.Ptr.Next = null then
- Position := No_Element;
+ Position.Ptr := null;
else
Position.Ptr := Position.Ptr.Next;
end if;
@@ -173,9 +173,9 @@ package body SAL.Gen_Definite_Doubly_Linked_Lists is
return Position;
else
if Position.Ptr.Next = null then
- return No_Element;
+ return (Ptr => null);
else
- return (Position.Container, Position.Ptr.Next);
+ return (Ptr => Position.Ptr.Next);
end if;
end if;
end Next;
@@ -186,9 +186,9 @@ package body SAL.Gen_Definite_Doubly_Linked_Lists is
return Position;
else
if Position.Ptr.Prev = null then
- return No_Element;
+ return (Ptr => null);
else
- return (Position.Container, Position.Ptr.Prev);
+ return (Ptr => Position.Ptr.Prev);
end if;
end if;
end Previous;
@@ -203,7 +203,7 @@ package body SAL.Gen_Definite_Doubly_Linked_Lists is
use all type Ada.Containers.Count_Type;
begin
Delete_Node (Container, Position.Ptr);
- Position := No_Element;
+ Position := (Ptr => null);
Container.Count := Container.Count - 1;
end Delete;
@@ -223,7 +223,7 @@ package body SAL.Gen_Definite_Doubly_Linked_Lists is
is
use all type Ada.Containers.Count_Type;
begin
- if Before = No_Element then
+ if Before = (Ptr => null) then
Container.Append (Element);
else
if Before.Ptr = Container.Head then
@@ -287,7 +287,7 @@ package body SAL.Gen_Definite_Doubly_Linked_Lists is
function Iterate (Container : aliased in List) return
Iterator_Interfaces.Reversible_Iterator'Class
is begin
- return Iterator'(Container => Container'Unrestricted_Access);
+ return Iterator'(Container => Container'Access);
end Iterate;
overriding function First (Object : Iterator) return Cursor
diff --git a/sal-gen_definite_doubly_linked_lists.ads
b/sal-gen_definite_doubly_linked_lists.ads
index 9648320..8470daf 100644
--- a/sal-gen_definite_doubly_linked_lists.ads
+++ b/sal-gen_definite_doubly_linked_lists.ads
@@ -3,7 +3,7 @@
-- A generic doubly linked list with definite elements, allowing
-- permanent references to elements.
--
--- Copyright (C) 2017 - 2019 Free Software Foundation, Inc.
+-- Copyright (C) 2017 - 2020 Free Software Foundation, Inc.
--
-- This library is free software; you can redistribute it and/or
-- modify it under terms of the GNU General Public License as
@@ -64,26 +64,25 @@ package SAL.Gen_Definite_Doubly_Linked_Lists is
type Cursor is private;
- No_Element : constant Cursor;
-
function Has_Element (Position : in Cursor) return Boolean;
+ No_Element : constant Cursor;
function First (Container : in List) return Cursor;
function Last (Container : in List) return Cursor;
procedure Next (Position : in out Cursor)
- with Pre => Position /= No_Element;
+ with Pre => Has_Element (Position);
function Next (Position : in Cursor) return Cursor
- with Pre => Position /= No_Element;
+ with Pre => Has_Element (Position);
function Previous (Position : in Cursor) return Cursor
- with Pre => Position /= No_Element;
+ with Pre => Has_Element (Position);
function Element (Position : in Cursor) return Element_Type
- with Pre => Position /= No_Element;
+ with Pre => Has_Element (Position);
procedure Delete (Container : in out List; Position : in out Cursor)
- with Pre => Position /= No_Element;
+ with Pre => Has_Element (Position);
procedure Delete_First (Container : in out List);
@@ -94,26 +93,26 @@ package SAL.Gen_Definite_Doubly_Linked_Lists is
-- If Before is No_Element, insert after Last.
function Persistent_Ref (Position : in Cursor) return access Element_Type
- with Pre => Position /= No_Element;
+ with Pre => Has_Element (Position);
type Constant_Reference_Type (Element : not null access constant
Element_Type) is private with
Implicit_Dereference => Element;
function Constant_Reference (Container : in List; Position : in Cursor)
return Constant_Reference_Type
- with Inline, Pre => Position /= No_Element;
+ with Inline, Pre => Has_Element (Position);
-- Not 'Constant_Ref' because that is taken, and it is wrong for
Constant_Indexing
function Constant_Ref (Position : in Cursor) return Constant_Reference_Type
- with Inline, Pre => Position /= No_Element;
+ with Inline, Pre => Has_Element (Position);
type Variable_Reference_Type (Element : not null access Element_Type) is
private with
Implicit_Dereference => Element;
function Variable_Reference (Container : in List; Position : in Cursor)
return Variable_Reference_Type
- with Inline, Pre => Position /= No_Element;
+ with Inline, Pre => Has_Element (Position);
function Variable_Ref (Position : in Cursor) return Variable_Reference_Type
- with Inline, Pre => Position /= No_Element;
+ with Inline, Pre => Has_Element (Position);
package Iterator_Interfaces is new Ada.Iterator_Interfaces (Cursor,
Has_Element);
@@ -139,8 +138,7 @@ private
end record;
type Cursor is record
- Container : List_Access;
- Ptr : Node_Access;
+ Ptr : Node_Access;
end record;
type Constant_Reference_Type (Element : not null access constant
Element_Type) is
@@ -153,14 +151,12 @@ private
Dummy : Integer := raise Program_Error with "uninitialized reference";
end record;
- Empty_List : constant List := (Ada.Finalization.Controlled with null, null,
0);
+ No_Element : constant Cursor := (Ptr => null);
- No_Element : constant Cursor := (null, null);
+ Empty_List : constant List := (Ada.Finalization.Controlled with null, null,
0);
- type Iterator is new Iterator_Interfaces.Reversible_Iterator with
- record
- Container : List_Access;
- end record;
+ type Iterator (Container : not null access constant List) is new
Iterator_Interfaces.Reversible_Iterator with
+ null record;
overriding function First (Object : Iterator) return Cursor;
overriding function Last (Object : Iterator) return Cursor;
diff --git a/sal-gen_definite_doubly_linked_lists_sorted.adb
b/sal-gen_definite_doubly_linked_lists_sorted.adb
index 7a4bb11..702914d 100644
--- a/sal-gen_definite_doubly_linked_lists_sorted.adb
+++ b/sal-gen_definite_doubly_linked_lists_sorted.adb
@@ -2,7 +2,7 @@
--
-- See spec.
--
--- Copyright (C) 2018, 2019 Free Software Foundation, Inc.
+-- Copyright (C) 2018 - 2020 Free Software Foundation, Inc.
--
-- This library is free software; you can redistribute it and/or modify it
-- under terms of the GNU General Public License as published by the Free
@@ -375,25 +375,25 @@ package body SAL.Gen_Definite_Doubly_Linked_Lists_Sorted
is
return Position.Ptr /= null;
end Has_Element;
- function First (Container : in List) return Cursor
+ function First (Container : aliased in List) return Cursor
is begin
if Container.Head = null then
- return No_Element;
+ return (Container'Access, null);
else
- return (Container'Unrestricted_Access, Container.Head);
+ return (Container'Access, Container.Head);
end if;
end First;
- function Last (Container : in List) return Cursor
+ function Last (Container : aliased in List) return Cursor
is begin
if Container.Tail = null then
- return No_Element;
+ return (Container'Access, null);
else
- return (Container'Unrestricted_Access, Container.Tail);
+ return (Container'Access, Container.Tail);
end if;
end Last;
- function Find (Container : in List; Element : in Element_Type) return Cursor
+ function Find (Container : aliased in List; Element : in Element_Type)
return Cursor
is
Node : Node_Access;
Compare : Compare_Result;
@@ -401,11 +401,11 @@ package body SAL.Gen_Definite_Doubly_Linked_Lists_Sorted
is
Find (Container, Element, Node, Compare);
if Node = null then
- return No_Element;
+ return (Container'Access, null);
elsif Compare = Equal then
- return (Container'Unrestricted_Access, Node);
+ return (Container'Access, Node);
else
- return No_Element;
+ return (Container'Access, null);
end if;
end Find;
@@ -413,7 +413,7 @@ package body SAL.Gen_Definite_Doubly_Linked_Lists_Sorted is
is begin
if Position.Ptr /= null then
if Position.Ptr.Next = null then
- Position := No_Element;
+ Position.Ptr := null;
else
Position.Ptr := Position.Ptr.Next;
end if;
@@ -426,7 +426,7 @@ package body SAL.Gen_Definite_Doubly_Linked_Lists_Sorted is
return Position;
else
if Position.Ptr.Next = null then
- return No_Element;
+ return (Position.Container, null);
else
return (Position.Container, Position.Ptr.Next);
end if;
@@ -439,7 +439,7 @@ package body SAL.Gen_Definite_Doubly_Linked_Lists_Sorted is
return Position;
else
if Position.Ptr.Prev = null then
- return No_Element;
+ return (Position.Container, null);
else
return (Position.Container, Position.Ptr.Prev);
end if;
@@ -466,7 +466,7 @@ package body SAL.Gen_Definite_Doubly_Linked_Lists_Sorted is
Node.Prev.Next := Node.Next;
end if;
Free (Node);
- Position := No_Element;
+ Position := (Container'Access, null);
Container.Count := Container.Count - 1;
end Delete;
@@ -512,7 +512,7 @@ package body SAL.Gen_Definite_Doubly_Linked_Lists_Sorted is
function Iterate (Container : aliased in List) return
Iterator_Interfaces.Reversible_Iterator'Class
is begin
- return Iterator'(Container => Container'Unrestricted_Access);
+ return Iterator'(Container => Container'Access);
end Iterate;
overriding function First (Object : Iterator) return Cursor
diff --git a/sal-gen_definite_doubly_linked_lists_sorted.ads
b/sal-gen_definite_doubly_linked_lists_sorted.ads
index bbac90f..91ffeda 100644
--- a/sal-gen_definite_doubly_linked_lists_sorted.ads
+++ b/sal-gen_definite_doubly_linked_lists_sorted.ads
@@ -2,7 +2,7 @@
--
-- A generic sorted doubly linked list with definite elements.
--
--- Copyright (C) 2018 - 2019 Free Software Foundation, Inc.
+-- Copyright (C) 2018 - 2020 Free Software Foundation, Inc.
--
-- This library is free software; you can redistribute it and/or modify it
-- under terms of the GNU General Public License as published by the Free
@@ -81,31 +81,31 @@ package SAL.Gen_Definite_Doubly_Linked_Lists_Sorted is
--
-- Added is True if any element was not already present.
- type Cursor is private;
+ type Cursor (<>) is private;
- No_Element : constant Cursor;
+ function No_Element (Container : aliased in List) return Cursor;
function Has_Element (Position : in Cursor) return Boolean;
- function First (Container : in List) return Cursor;
- function Last (Container : in List) return Cursor;
+ function First (Container : aliased in List) return Cursor;
+ function Last (Container : aliased in List) return Cursor;
- function Find (Container : in List; Element : in Element_Type) return
Cursor;
+ function Find (Container : aliased in List; Element : in Element_Type)
return Cursor;
-- No_Element if Element not found.
procedure Next (Position : in out Cursor)
- with Pre => Position /= No_Element;
+ with Pre => Has_Element (Position);
function Next (Position : in Cursor) return Cursor
- with Pre => Position /= No_Element;
+ with Pre => Has_Element (Position);
function Previous (Position : in Cursor) return Cursor
- with Pre => Position /= No_Element;
+ with Pre => Has_Element (Position);
function Element (Position : in Cursor) return Element_Type
- with Pre => Position /= No_Element;
+ with Pre => Has_Element (Position);
procedure Delete (Container : in out List; Position : in out Cursor)
- with Pre => Position /= No_Element;
+ with Pre => Has_Element (Position);
function Pop (Container : in out List) return Element_Type
with Pre => Container.Length > 0;
@@ -115,19 +115,19 @@ package SAL.Gen_Definite_Doubly_Linked_Lists_Sorted is
Implicit_Dereference => Element;
function Constant_Reference (Container : in List; Position : in Cursor)
return Constant_Reference_Type with
- Inline, Pre => Position /= No_Element;
+ Inline, Pre => Has_Element (Position);
function Constant_Ref (Position : in Cursor) return Constant_Reference_Type
with
- Inline, Pre => Position /= No_Element;
+ Inline, Pre => Has_Element (Position);
type Variable_Reference_Type (Element : not null access Element_Type) is
private with
Implicit_Dereference => Element;
function Variable_Reference (Container : in List; Position : in Cursor)
return Variable_Reference_Type
- with Inline, Pre => Position /= No_Element;
+ with Inline, Pre => Has_Element (Position);
function Variable_Ref (Position : in Cursor) return Variable_Reference_Type
- with Inline, Pre => Position /= No_Element;
+ with Inline, Pre => Has_Element (Position);
-- User must not change the element in a way that affects the sort order.
package Iterator_Interfaces is new Ada.Iterator_Interfaces (Cursor,
Has_Element);
@@ -153,9 +153,9 @@ private
Count : Ada.Containers.Count_Type := 0;
end record;
- type Cursor is record
- Container : List_Access;
- Ptr : Node_Access;
+ type Cursor (Container : not null access constant List) is
+ record
+ Ptr : Node_Access;
end record;
type Constant_Reference_Type (Element : not null access constant
Element_Type) is
@@ -170,12 +170,11 @@ private
Empty_List : constant List := (Ada.Finalization.Controlled with null, null,
0);
- No_Element : constant Cursor := (null, null);
+ function No_Element (Container : aliased in List) return Cursor
+ is (Container'Access, null);
- type Iterator is new Iterator_Interfaces.Reversible_Iterator with
- record
- Container : List_Access;
- end record;
+ type Iterator (Container : not null access constant List) is new
Iterator_Interfaces.Reversible_Iterator with
+ null record;
overriding function First (Object : Iterator) return Cursor;
overriding function Last (Object : Iterator) return Cursor;
diff --git a/sal-gen_graphs.ads b/sal-gen_graphs.ads
index 9a66f5c..03cc1c6 100644
--- a/sal-gen_graphs.ads
+++ b/sal-gen_graphs.ads
@@ -20,7 +20,7 @@
-- Tarjan, SIAM J. Comput. Vol. 1, No 2, June 1972.
-- https://epubs.siam.org/doi/abs/10.1137/0201010
--
--- Copyright (C) 2017, 2019 Free Software Foundation All Rights Reserved.
+-- Copyright (C) 2017, 2019, 2020 Free Software Foundation All Rights
Reserved.
--
-- This library is free software; you can redistribute it and/or modify it
-- under terms of the GNU General Public License as published by the Free
@@ -131,7 +131,7 @@ package SAL.Gen_Graphs is
-- multigraphs.
--
-- Time complexity is exponential in the number of nodes. Used in
- -- unit tests for Find_Cycles_Johnson, since [2] is easier to
+ -- unit tests for Find_Cycles, since [2] is easier to
-- implement.
function Find_Cycles (Graph : in Gen_Graphs.Graph) return
Path_Arrays.Vector;
diff --git a/sal-gen_indefinite_doubly_linked_lists.adb
b/sal-gen_indefinite_doubly_linked_lists.adb
index ced09c2..71d3f61 100644
--- a/sal-gen_indefinite_doubly_linked_lists.adb
+++ b/sal-gen_indefinite_doubly_linked_lists.adb
@@ -2,7 +2,7 @@
--
-- see spec
--
--- Copyright (C) 2018, 2019 Free Software Foundation, Inc.
+-- Copyright (C) 2018 - 2020 Free Software Foundation, Inc.
--
-- This library is free software; you can redistribute it and/or
-- modify it under terms of the GNU General Public License as
@@ -118,9 +118,9 @@ package body SAL.Gen_Indefinite_Doubly_Linked_Lists is
function First (Container : in List) return Cursor
is begin
if Container.Head = null then
- return No_Element;
+ return (Ptr => null);
else
- return (Container'Unrestricted_Access, Container.Head);
+ return (Ptr => Container.Head);
end if;
end First;
@@ -128,7 +128,7 @@ package body SAL.Gen_Indefinite_Doubly_Linked_Lists is
is begin
if Position.Ptr /= null then
if Position.Ptr.Next = null then
- Position := No_Element;
+ Position.Ptr := null;
else
Position.Ptr := Position.Ptr.Next;
end if;
@@ -141,9 +141,9 @@ package body SAL.Gen_Indefinite_Doubly_Linked_Lists is
return Position;
else
if Position.Ptr.Next = null then
- return No_Element;
+ return (Ptr => null);
else
- return (Position.Container, Position.Ptr.Next);
+ return (Ptr => Position.Ptr.Next);
end if;
end if;
end Next;
@@ -169,7 +169,7 @@ package body SAL.Gen_Indefinite_Doubly_Linked_Lists is
end if;
Free (Node.Element);
Free (Node);
- Position := No_Element;
+ Position := (Ptr => null);
Container.Count := Container.Count - 1;
end Delete;
diff --git a/sal-gen_indefinite_doubly_linked_lists.ads
b/sal-gen_indefinite_doubly_linked_lists.ads
index 609e26c..b1d1cdb 100644
--- a/sal-gen_indefinite_doubly_linked_lists.ads
+++ b/sal-gen_indefinite_doubly_linked_lists.ads
@@ -3,7 +3,7 @@
-- A generic doubly linked list with indefinite elements, allowing
-- permanent references to elements.
--
--- Copyright (C) 2018 - 2019 Free Software Foundation, Inc.
+-- Copyright (C) 2018 - 2020 Free Software Foundation, Inc.
--
-- This library is free software; you can redistribute it and/or
-- modify it under terms of the GNU General Public License as
@@ -108,8 +108,7 @@ private
end record;
type Cursor is record
- Container : access List;
- Ptr : Node_Access;
+ Ptr : Node_Access;
end record;
type Constant_Reference_Type (Element : not null access constant
Element_Type) is
@@ -124,6 +123,6 @@ private
Empty_List : constant List := (Ada.Finalization.Controlled with null, null,
0);
- No_Element : constant Cursor := (null, null);
+ No_Element : constant Cursor := (Ptr => null);
end SAL.Gen_Indefinite_Doubly_Linked_Lists;
diff --git a/sal-gen_unbounded_definite_red_black_trees.adb
b/sal-gen_unbounded_definite_red_black_trees.adb
index adea0d4..b7c8c44 100644
--- a/sal-gen_unbounded_definite_red_black_trees.adb
+++ b/sal-gen_unbounded_definite_red_black_trees.adb
@@ -2,7 +2,7 @@
--
-- Generic unbounded red-black tree with definite elements.
--
--- Copyright (C) 2017 - 2019 Free Software Foundation, Inc.
+-- Copyright (C) 2017 - 2020 Free Software Foundation, Inc.
--
-- This library is free software; you can redistribute it and/or modify it
-- under terms of the GNU General Public License as published by the Free
@@ -318,7 +318,12 @@ package body SAL.Gen_Unbounded_Definite_Red_Black_Trees is
if Node = null then
raise Not_Found;
else
- return (Element => Node.all.Element'Access, Dummy => 1);
+ -- WORKAROUND: GNAT Community 2019 requires .all here, GNAT Pro 21.0w
+ -- 20200426 requires it _not_ be here. The code is technically legal
+ -- either way, so both compilers have a bug. Keeping .all for now;
+ -- just delete it if you are using 21.0w. Hopefully 21 will fix the
+ -- bug. AdaCore ticket T503-001 on Eurocontrol support contract.
+ return (Element => Node.Element'Access, Dummy => 1);
end if;
end Constant_Reference;
@@ -329,6 +334,7 @@ package body SAL.Gen_Unbounded_Definite_Red_Black_Trees is
is
pragma Unreferenced (Container);
begin
+ -- WORKAROUND: see note in Constant_Reference
return (Element => Position.Node.all.Element'Access, Dummy => 1);
end Variable_Reference;
@@ -342,7 +348,8 @@ package body SAL.Gen_Unbounded_Definite_Red_Black_Trees is
if Node = null then
raise Not_Found;
else
- return (Element => Node.all.Element'Access, Dummy => 1);
+ -- WORKAROUND: see note in Constant_Reference
+ return (Element => Node.Element'Access, Dummy => 1);
end if;
end Variable_Reference;
diff --git a/sal-gen_unbounded_definite_red_black_trees.ads
b/sal-gen_unbounded_definite_red_black_trees.ads
index b51e4b9..f886ed9 100644
--- a/sal-gen_unbounded_definite_red_black_trees.ads
+++ b/sal-gen_unbounded_definite_red_black_trees.ads
@@ -8,7 +8,7 @@
-- [1] Introduction to Algorithms, Thomas H. Cormen, Charles E.
-- Leiserson, Ronald L. Rivest, Clifford Stein.
--
--- Copyright (C) 2017 - 2019 Free Software Foundation, Inc.
+-- Copyright (C) 2017 - 2020 Free Software Foundation, Inc.
--
-- This library is free software; you can redistribute it and/or modify it
-- under terms of the GNU General Public License as published by the Free
@@ -65,13 +65,14 @@ package SAL.Gen_Unbounded_Definite_Red_Black_Trees is
(Container : aliased in Tree;
Position : in Cursor)
return Constant_Reference_Type with
- Inline;
+ Inline, Pre => Has_Element (Position);
function Constant_Reference
(Container : aliased in Tree;
Key : in Key_Type)
return Constant_Reference_Type with
Inline;
+ -- Raises Not_Found if Key not found in Container.
type Variable_Reference_Type (Element : not null access Element_Type) is
private with
Implicit_Dereference => Element;
@@ -80,7 +81,7 @@ package SAL.Gen_Unbounded_Definite_Red_Black_Trees is
(Container : aliased in Tree;
Position : in Cursor)
return Variable_Reference_Type with
- Inline;
+ Inline, Pre => Has_Element (Position);
function Variable_Reference
(Container : aliased in Tree;
diff --git a/sal-gen_unbounded_definite_stacks.adb
b/sal-gen_unbounded_definite_stacks.adb
index 2ead18f..072c104 100644
--- a/sal-gen_unbounded_definite_stacks.adb
+++ b/sal-gen_unbounded_definite_stacks.adb
@@ -2,7 +2,7 @@
--
-- see spec
--
--- Copyright (C) 1998, 2003, 2009, 2015, 2017 - 2019 Free Software
Foundation, Inc.
+-- Copyright (C) 1998, 2003, 2009, 2015, 2017 - 2020 Free Software
Foundation, Inc.
--
-- SAL is free software; you can redistribute it and/or modify it
-- under terms of the GNU General Public License as published by the
@@ -190,9 +190,18 @@ package body SAL.Gen_Unbounded_Definite_Stacks is
return Position.Container.Depth >= Position.Ptr;
end Has_Element;
+ type Iterator (Container : not null access constant Stack) is new
Iterator_Interfaces.Forward_Iterator with
+ null record;
+
+ overriding function First (Object : Iterator) return Cursor;
+
+ overriding function Next
+ (Object : Iterator;
+ Position : Cursor) return Cursor;
+
function Iterate (Container : aliased in Stack) return
Iterator_Interfaces.Forward_Iterator'Class
is begin
- return Iterator'(Container => Container'Unrestricted_Access);
+ return Iterator'(Container => Container'Access);
end Iterate;
overriding function First (Object : Iterator) return Cursor
diff --git a/sal-gen_unbounded_definite_stacks.ads
b/sal-gen_unbounded_definite_stacks.ads
index 26d0466..3d1e1e7 100644
--- a/sal-gen_unbounded_definite_stacks.ads
+++ b/sal-gen_unbounded_definite_stacks.ads
@@ -2,7 +2,7 @@
--
-- Stack implementation.
--
--- Copyright (C) 1998-2000, 2002-2003, 2009, 2015, 2017 - 2019 Free Software
Foundation, Inc.
+-- Copyright (C) 1998-2000, 2002-2003, 2009, 2015, 2017 - 2020 Free Software
Foundation, Inc.
--
-- SAL is free software; you can redistribute it and/or modify it
-- under terms of the GNU General Public License as published by the
@@ -112,14 +112,16 @@ package SAL.Gen_Unbounded_Definite_Stacks is
function Constant_Reference
(Container : aliased in Stack'Class;
Position : in Peek_Type)
- return Constant_Reference_Type with Inline;
+ return Constant_Reference_Type
+ with Inline, Pre => Position in 1 .. Container.Depth;
- type Cursor is private;
+ type Cursor (<>) is private;
function Constant_Reference
(Container : aliased in Stack'Class;
Position : in Cursor)
- return Constant_Reference_Type with Inline;
+ return Constant_Reference_Type
+ with Inline, Pre => Has_Element (Position);
function Has_Element (Position : in Cursor) return Boolean;
@@ -141,8 +143,6 @@ private
-- Data (1 .. Top) has been set at some point.
end record;
- type Stack_Access is access all Stack;
-
type Constant_Reference_Type (Element : not null access constant
Element_Type) is
record
Dummy : Integer := raise Program_Error with "uninitialized reference";
@@ -150,20 +150,9 @@ private
Empty_Stack : constant Stack := (Ada.Finalization.Controlled with
Invalid_Peek_Index, null);
- type Cursor is record
- Container : Stack_Access;
- Ptr : Peek_Type;
- end record;
-
- type Iterator is new Iterator_Interfaces.Forward_Iterator with
+ type Cursor (Container : not null access constant Stack) is
record
- Container : Stack_Access;
+ Ptr : Peek_Type;
end record;
- overriding function First (Object : Iterator) return Cursor;
-
- overriding function Next
- (Object : Iterator;
- Position : Cursor) return Cursor;
-
end SAL.Gen_Unbounded_Definite_Stacks;
diff --git a/sal-gen_unbounded_definite_vectors.adb
b/sal-gen_unbounded_definite_vectors.adb
index be77f9c..faf1b45 100644
--- a/sal-gen_unbounded_definite_vectors.adb
+++ b/sal-gen_unbounded_definite_vectors.adb
@@ -1,588 +1,581 @@
--- Abstract :
---
--- See spec.
---
--- Copyright (C) 2018 - 2019 Free Software Foundation, Inc.
---
--- This library is free software; you can redistribute it and/or modify it
--- under terms of the GNU General Public License as published by the Free
--- Software Foundation; either version 3, or (at your option) any later
--- version. This library is distributed in the hope that it will be useful,
--- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN-
--- TABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
--- As a special exception under Section 7 of GPL version 3, you are granted
--- additional permissions described in the GCC Runtime Library Exception,
--- version 3.1, as published by the Free Software Foundation.
-
-pragma License (Modified_GPL);
-
-package body SAL.Gen_Unbounded_Definite_Vectors is
-
- function To_Peek_Type (Item : in Extended_Index) return Base_Peek_Type
- is begin
- return Base_Peek_Type'Base (Item - Index_Type'First) + Peek_Type'First;
- end To_Peek_Type;
-
- function To_Index_Type (Item : in Base_Peek_Type) return Extended_Index
- is begin
- return Extended_Index (Item - Peek_Type'First) + Index_Type'First;
- end To_Index_Type;
-
- procedure Grow (Elements : in out Array_Access; Index : in Base_Peek_Type)
- is
- -- Reallocate Elements so Elements (Index) is a valid element.
-
- Old_First : constant Peek_Type := Elements'First;
- Old_Last : constant Peek_Type := Elements'Last;
- New_First : Peek_Type := Old_First;
- New_Last : Peek_Type := Old_Last;
- New_Length : Peek_Type := Elements'Length;
-
- New_Array : Array_Access;
- begin
- loop
- exit when New_First <= Index;
- New_Length := New_Length * 2;
- New_First := Peek_Type'Max (Peek_Type'First, Old_Last - New_Length +
1);
- end loop;
- loop
- exit when New_Last >= Index;
- New_Length := New_Length * 2;
- New_Last := Peek_Type'Min (Peek_Type'Last, New_First + New_Length -
1);
- end loop;
-
- New_Array := new Array_Type (New_First .. New_Last);
-
- -- We'd like to use this:
- --
- -- New_Array (New_First .. Old_First - 1) := (others => <>);
- --
- -- but that can overflow the stack, since the aggregate is allocated
- -- on the stack.
-
- for I in New_First .. Old_First - 1 loop
- New_Array (I .. I) := (others => <>);
- end loop;
-
- New_Array (Old_First .. Old_Last) := Elements.all;
-
- for I in Old_Last + 1 .. New_Last loop
- New_Array (I .. I) := (others => <>);
- end loop;
-
- Free (Elements);
- Elements := New_Array;
- end Grow;
-
- ----------
- -- public subprograms
-
- overriding procedure Finalize (Container : in out Vector)
- is begin
- Free (Container.Elements);
- Container.First := No_Index;
- Container.Last := No_Index;
- end Finalize;
-
- overriding procedure Adjust (Container : in out Vector)
- is begin
- if Container.Elements /= null then
- Container.Elements := new Array_Type'(Container.Elements.all);
- end if;
- end Adjust;
-
- function Length (Container : in Vector) return Ada.Containers.Count_Type
- is begin
- -- We assume the type ranges are sensible, so no exceptions occur
- -- here.
- if Container.Elements = null then
- return 0;
- else
- return Ada.Containers.Count_Type (To_Peek_Type (Container.Last) -
Container.Elements'First + 1);
- end if;
- end Length;
-
- function Capacity (Container : in Vector) return Ada.Containers.Count_Type
- is begin
- if Container.Elements = null then
- return 0;
- else
- return Ada.Containers.Count_Type (Container.Elements'Length);
- end if;
- end Capacity;
-
- procedure Set_Capacity
- (Container : in out Vector;
- First : in Index_Type;
- Last : in Extended_Index)
- is
- First_Peek : constant Peek_Type := To_Peek_Type (First);
- Last_Peek : constant Peek_Type := To_Peek_Type (Last);
- begin
- if Container.Elements = null then
- Container.Elements := new Array_Type (First_Peek .. Last_Peek);
- else
- if First_Peek < Container.Elements'First then
- Grow (Container.Elements, First_Peek);
- end if;
- if Last_Peek < Container.Elements'Last then
- Grow (Container.Elements, Last_Peek);
- end if;
- end if;
- end Set_Capacity;
-
- function Element (Container : Vector; Index : Index_Type) return
Element_Type
- is begin
- return Container.Elements (To_Peek_Type (Index));
- end Element;
-
- procedure Replace_Element (Container : Vector; Index : Index_Type; New_Item
: in Element_Type)
- is begin
- Container.Elements (To_Peek_Type (Index)) := New_Item;
- end Replace_Element;
-
- function First_Index (Container : Vector) return Extended_Index
- is begin
- if Container.First = No_Index then
- return No_Index + 1;
- else
- return Container.First;
- end if;
- end First_Index;
-
- function Last_Index (Container : Vector) return Extended_Index
- is begin
- return Container.Last;
- end Last_Index;
-
- procedure Append (Container : in out Vector; New_Item : in Element_Type)
- is begin
- if Container.First = No_Index then
- Container.First := Index_Type'First;
- Container.Last := Index_Type'First;
- else
- Container.Last := Container.Last + 1;
- end if;
-
- declare
- J : constant Base_Peek_Type := To_Peek_Type (Container.Last);
- begin
- if Container.Elements = null then
- Container.Elements := new Array_Type (J .. J);
-
- elsif J > Container.Elements'Last then
- Grow (Container.Elements, J);
- end if;
-
- Container.Elements (J) := New_Item;
- end;
- end Append;
-
- procedure Append (Container : in out Vector; New_Items : in Vector)
- is
- use all type Ada.Containers.Count_Type;
- Old_Last : Extended_Index := Container.Last;
- begin
- if New_Items.Length = 0 then
- return;
- end if;
-
- if Container.First = No_Index then
- Container.First := Index_Type'First;
- Old_Last := Container.First - 1;
- Container.Last := Container.First + Extended_Index
(New_Items.Length) - 1;
- else
- Container.Last := Container.Last + Extended_Index (New_Items.Length);
- end if;
-
- declare
- I : constant Peek_Type := To_Peek_Type (Old_Last + 1);
- J : constant Peek_Type := To_Peek_Type (Container.Last);
- begin
- if Container.Elements = null then
- Container.Elements := new Array_Type (I .. J);
- elsif J > Container.Elements'Last then
- Grow (Container.Elements, J);
- end if;
-
- Container.Elements (I .. J) := New_Items.Elements
- (To_Peek_Type (New_Items.First) .. To_Peek_Type (New_Items.Last));
- end;
- end Append;
-
- procedure Prepend (Container : in out Vector; New_Item : in Element_Type)
- is begin
- if Container.First = No_Index then
- Container.First := Index_Type'First;
- Container.Last := Index_Type'First;
- else
- Container.First := Container.First - 1;
- end if;
-
- declare
- J : constant Peek_Type := To_Peek_Type (Container.First);
- begin
- if Container.Elements = null then
- Container.Elements := new Array_Type (J .. J);
-
- elsif J < Container.Elements'First then
- Grow (Container.Elements, J);
- end if;
-
- Container.Elements (J) := New_Item;
- end;
- end Prepend;
-
- procedure Prepend
- (Target : in out Vector;
- Source : in Vector;
- Source_First : in Index_Type;
- Source_Last : in Index_Type)
- is
- Source_I : constant Peek_Type := To_Peek_Type (Source_First);
- Source_J : constant Peek_Type := To_Peek_Type (Source_Last);
- begin
- if Target.Elements = null then
- Target.Elements := new Array_Type'(Source.Elements (Source_I ..
Source_J));
- Target.First := Source_First;
- Target.Last := Source_Last;
- else
- declare
- New_First : constant Index_Type := Target.First - (Source_Last -
Source_First + 1);
- I : constant Peek_Type := To_Peek_Type (New_First);
- J : constant Peek_Type := To_Peek_Type (Target.First - 1);
- begin
- if Target.Elements'First > I then
- Grow (Target.Elements, I);
- end if;
- Target.Elements (I .. J) := Source.Elements (Source_I .. Source_J);
- Target.First := New_First;
- end;
- end if;
- end Prepend;
-
- procedure Insert
- (Container : in out Vector;
- Element : in Element_Type;
- Before : in Index_Type)
- is
- use all type Ada.Containers.Count_Type;
- begin
- if Container.Length = 0 then
- Container.Append (Element);
- else
- Container.Last := Container.Last + 1;
-
- declare
- J : constant Peek_Type := To_Peek_Type (Before);
- K : constant Base_Peek_Type := To_Peek_Type (Container.Last);
- begin
- if K > Container.Elements'Last then
- Grow (Container.Elements, K);
- end if;
-
- Container.Elements (J + 1 .. K) := Container.Elements (J .. K - 1);
- Container.Elements (J) := Element;
- end;
- end if;
- end Insert;
-
- procedure Merge
- (Target : in out Vector;
- Source : in out Vector)
- is
- use all type Ada.Containers.Count_Type;
- begin
- if Source.Length = 0 then
- Source.Clear;
-
- elsif Target.Length = 0 then
- Target := Source;
- Source.Clear;
-
- else
- declare
- New_First : constant Index_Type := Extended_Index'Min
(Target.First, Source.First);
- New_Last : constant Index_Type := Extended_Index'Max
(Target.Last, Source.Last);
- New_I : constant Peek_Type := To_Peek_Type (New_First);
- New_J : constant Base_Peek_Type := To_Peek_Type (New_Last);
- begin
- if New_I < Target.Elements'First then
- Grow (Target.Elements, New_I);
- end if;
- if New_J > Target.Elements'Last then
- Grow (Target.Elements, New_J);
- end if;
-
- Target.Elements (To_Peek_Type (Source.First) .. To_Peek_Type
(Source.Last)) := Source.Elements
- (To_Peek_Type (Source.First) .. To_Peek_Type (Source.Last));
-
- Target.First := New_First;
- Target.Last := New_Last;
-
- Source.Clear;
- end;
- end if;
- end Merge;
-
- function To_Vector (Item : in Element_Type; Count : in
Ada.Containers.Count_Type := 1) return Vector
- is begin
- return Result : Vector do
- for I in 1 .. Count loop
- Result.Append (Item);
- end loop;
- end return;
- end To_Vector;
-
- function "+" (Element : in Element_Type) return Vector
- is begin
- return Result : Vector do
- Result.Append (Element);
- end return;
- end "+";
-
- function "&" (Left, Right : in Element_Type) return Vector
- is begin
- return Result : Vector do
- Result.Append (Left);
- Result.Append (Right);
- end return;
- end "&";
-
- function "&" (Left : in Vector; Right : in Element_Type) return Vector
- is begin
- return Result : Vector := Left do
- Result.Append (Right);
- end return;
- end "&";
-
- procedure Set_First (Container : in out Vector; First : in Index_Type)
- is
- J : constant Peek_Type := To_Peek_Type (First);
- begin
- Container.First := First;
- if Container.Last = No_Index then
- Container.Last := First - 1;
- end if;
-
- if Container.Last >= First then
- if Container.Elements = null then
- Container.Elements := new Array_Type'(J .. To_Peek_Type
(Container.Last) => Default_Element);
-
- elsif Container.Elements'First > J then
- Grow (Container.Elements, J);
- end if;
- end if;
- end Set_First;
-
- procedure Set_Last (Container : in out Vector; Last : in Extended_Index)
- is
- J : constant Base_Peek_Type := To_Peek_Type (Last);
- begin
- Container.Last := Last;
- if Container.First = No_Index then
- Container.First := Last + 1;
- end if;
-
- if Last >= Container.First then
- if Container.Elements = null then
- Container.Elements := new Array_Type'(To_Peek_Type
(Container.First) .. J => Default_Element);
-
- elsif Container.Elements'Last < J then
- Grow (Container.Elements, J);
- end if;
- end if;
- end Set_Last;
-
- procedure Set_First_Last
- (Container : in out Vector;
- First : in Index_Type;
- Last : in Extended_Index)
- is begin
- Set_First (Container, First);
- Set_Last (Container, Last);
- end Set_First_Last;
-
- procedure Delete (Container : in out Vector; Index : in Index_Type)
- is
- J : constant Peek_Type := To_Peek_Type (Index);
- begin
- Container.Elements (J .. J) := (J => <>);
- if Index = Container.Last then
- Container.Last := Container.Last - 1;
- end if;
- end Delete;
-
- function Contains (Container : in Vector; Element : in Element_Type) return
Boolean
- is
- use all type Ada.Containers.Count_Type;
- begin
- if Container.Length = 0 then
- return False;
- else
- for It of Container.Elements.all loop
- if It = Element then
- return True;
- end if;
- end loop;
- return False;
- end if;
- end Contains;
-
- function Has_Element (Position : Cursor) return Boolean is
- begin
- return Position.Index /= Invalid_Peek_Index;
- end Has_Element;
-
- function Element (Position : Cursor) return Element_Type
- is begin
- return Position.Container.Elements (Position.Index);
- end Element;
-
- function First (Container : aliased in Vector) return Cursor
- is begin
- if Container.First = No_Index then
- return No_Element;
- else
- return (Container'Access, To_Peek_Type (Container.First));
- end if;
- end First;
-
- function Next (Position : in Cursor) return Cursor
- is begin
- if Position = No_Element then
- return No_Element;
- elsif Position.Index < To_Peek_Type (Position.Container.Last) then
- return (Position.Container, Position.Index + 1);
- else
- return No_Element;
- end if;
- end Next;
-
- procedure Next (Position : in out Cursor)
- is begin
- if Position = No_Element then
- null;
- elsif Position.Index < To_Peek_Type (Position.Container.Last) then
- Position.Index := Position.Index + 1;
- else
- Position := No_Element;
- end if;
- end Next;
-
- function Prev (Position : in Cursor) return Cursor
- is begin
- if Position = No_Element then
- return No_Element;
- elsif Position.Index > To_Peek_Type (Position.Container.First) then
- return (Position.Container, Position.Index - 1);
- else
- return No_Element;
- end if;
- end Prev;
-
- procedure Prev (Position : in out Cursor)
- is begin
- if Position = No_Element then
- null;
- elsif Position.Index > To_Peek_Type (Position.Container.First) then
- Position.Index := Position.Index - 1;
- else
- Position := No_Element;
- end if;
- end Prev;
-
- function To_Cursor
- (Container : aliased in Vector;
- Index : in Extended_Index)
- return Cursor
- is begin
- if Index not in Container.First .. Container.Last then
- return No_Element;
- else
- return (Container'Access, To_Peek_Type (Index));
- end if;
- end To_Cursor;
-
- function To_Index (Position : in Cursor) return Extended_Index
- is begin
- if Position = No_Element then
- return No_Index;
- else
- return To_Index_Type (Position.Index);
- end if;
- end To_Index;
-
- function Constant_Ref (Container : aliased Vector; Index : in Index_Type)
return Constant_Reference_Type
- is
- J : constant Peek_Type := To_Peek_Type (Index);
- begin
- return (Element => Container.Elements (J)'Access, Dummy => 1);
- end Constant_Ref;
-
- function Variable_Ref
- (Container : aliased in Vector;
- Index : in Index_Type)
- return Variable_Reference_Type
- is
- J : constant Peek_Type := To_Peek_Type (Index);
- begin
- return (Element => Container.Elements (J)'Access, Dummy => 1);
- end Variable_Ref;
-
- overriding function First (Object : Iterator) return Cursor
- is begin
- if Object.Container.Elements = null then
- return (null, Invalid_Peek_Index);
- else
- return (Object.Container, To_Peek_Type (Object.Container.First));
- end if;
- end First;
-
- overriding function Last (Object : Iterator) return Cursor
- is begin
- if Object.Container.Elements = null then
- return (null, Invalid_Peek_Index);
- else
- return (Object.Container, To_Peek_Type (Object.Container.Last));
- end if;
- end Last;
-
- overriding function Next (Object : in Iterator; Position : in Cursor)
return Cursor
- is begin
- if Position.Index = To_Peek_Type (Object.Container.Last) then
- return (null, Invalid_Peek_Index);
- else
- return (Object.Container, Position.Index + 1);
- end if;
- end Next;
-
- overriding function Previous (Object : in Iterator; Position : in Cursor)
return Cursor
- is begin
- if Position.Index = To_Peek_Type (Index_Type'First) then
- return (null, Invalid_Peek_Index);
- else
- return (Object.Container, Position.Index - 1);
- end if;
- end Previous;
-
- function Iterate (Container : aliased in Vector) return
Iterator_Interfaces.Reversible_Iterator'Class
- is begin
- return Iterator'(Container => Container'Unrestricted_Access);
- end Iterate;
-
- function Constant_Ref (Container : aliased Vector; Position : in Cursor)
return Constant_Reference_Type
- is begin
- return (Element => Container.Elements (Position.Index)'Access, Dummy =>
1);
- end Constant_Ref;
-
- function Variable_Ref
- (Container : aliased in Vector;
- Position : in Cursor)
- return Variable_Reference_Type
- is begin
- return (Element => Container.Elements (Position.Index)'Access, Dummy =>
1);
- end Variable_Ref;
-
-end SAL.Gen_Unbounded_Definite_Vectors;
+-- Abstract :
+--
+-- See spec.
+--
+-- Copyright (C) 2018 - 2020 Free Software Foundation, Inc.
+--
+-- This library is free software; you can redistribute it and/or modify it
+-- under terms of the GNU General Public License as published by the Free
+-- Software Foundation; either version 3, or (at your option) any later
+-- version. This library is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN-
+-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+-- As a special exception under Section 7 of GPL version 3, you are granted
+-- additional permissions described in the GCC Runtime Library Exception,
+-- version 3.1, as published by the Free Software Foundation.
+
+pragma License (Modified_GPL);
+
+package body SAL.Gen_Unbounded_Definite_Vectors is
+
+ function To_Peek_Type (Item : in Extended_Index) return Base_Peek_Type
+ is begin
+ return Base_Peek_Type'Base (Item - Index_Type'First) + Peek_Type'First;
+ end To_Peek_Type;
+
+ function To_Index_Type (Item : in Base_Peek_Type) return Extended_Index
+ is begin
+ return Extended_Index (Item - Peek_Type'First) + Index_Type'First;
+ end To_Index_Type;
+
+ procedure Grow (Elements : in out Array_Access; Index : in Base_Peek_Type)
+ is
+ -- Reallocate Elements so Elements (Index) is a valid element.
+
+ Old_First : constant Peek_Type := Elements'First;
+ Old_Last : constant Peek_Type := Elements'Last;
+ New_First : Peek_Type := Old_First;
+ New_Last : Peek_Type := Old_Last;
+ New_Length : Peek_Type := Elements'Length;
+
+ New_Array : Array_Access;
+ begin
+ loop
+ exit when New_First <= Index;
+ New_Length := New_Length * 2;
+ New_First := Peek_Type'Max (Peek_Type'First, Old_Last - New_Length +
1);
+ end loop;
+ loop
+ exit when New_Last >= Index;
+ New_Length := New_Length * 2;
+ New_Last := Peek_Type'Min (Peek_Type'Last, New_First + New_Length -
1);
+ end loop;
+
+ New_Array := new Array_Type (New_First .. New_Last);
+
+ -- We'd like to use this:
+ --
+ -- New_Array (New_First .. Old_First - 1) := (others => <>);
+ --
+ -- but that can overflow the stack, since the aggregate is allocated
+ -- on the stack.
+
+ for I in New_First .. Old_First - 1 loop
+ New_Array (I .. I) := (others => <>);
+ end loop;
+
+ New_Array (Old_First .. Old_Last) := Elements.all;
+
+ for I in Old_Last + 1 .. New_Last loop
+ New_Array (I .. I) := (others => <>);
+ end loop;
+
+ Free (Elements);
+ Elements := New_Array;
+ end Grow;
+
+ ----------
+ -- public subprograms
+
+ overriding procedure Finalize (Container : in out Vector)
+ is begin
+ Free (Container.Elements);
+ Container.First := No_Index;
+ Container.Last := No_Index;
+ end Finalize;
+
+ overriding procedure Adjust (Container : in out Vector)
+ is begin
+ if Container.Elements /= null then
+ Container.Elements := new Array_Type'(Container.Elements.all);
+ end if;
+ end Adjust;
+
+ function Length (Container : in Vector) return Ada.Containers.Count_Type
+ is begin
+ -- We assume the type ranges are sensible, so no exceptions occur
+ -- here.
+ if Container.Elements = null then
+ return 0;
+ else
+ return Ada.Containers.Count_Type (To_Peek_Type (Container.Last) -
Container.Elements'First + 1);
+ end if;
+ end Length;
+
+ function Capacity (Container : in Vector) return Ada.Containers.Count_Type
+ is begin
+ if Container.Elements = null then
+ return 0;
+ else
+ return Ada.Containers.Count_Type (Container.Elements'Length);
+ end if;
+ end Capacity;
+
+ procedure Set_Capacity
+ (Container : in out Vector;
+ First : in Index_Type;
+ Last : in Extended_Index)
+ is
+ First_Peek : constant Peek_Type := To_Peek_Type (First);
+ Last_Peek : constant Peek_Type := To_Peek_Type (Last);
+ begin
+ if Container.Elements = null then
+ Container.Elements := new Array_Type (First_Peek .. Last_Peek);
+ else
+ if First_Peek < Container.Elements'First then
+ Grow (Container.Elements, First_Peek);
+ end if;
+ if Last_Peek < Container.Elements'Last then
+ Grow (Container.Elements, Last_Peek);
+ end if;
+ end if;
+ end Set_Capacity;
+
+ function Element (Container : Vector; Index : Index_Type) return
Element_Type
+ is begin
+ return Container.Elements (To_Peek_Type (Index));
+ end Element;
+
+ procedure Replace_Element (Container : Vector; Index : Index_Type; New_Item
: in Element_Type)
+ is begin
+ Container.Elements (To_Peek_Type (Index)) := New_Item;
+ end Replace_Element;
+
+ function First_Index (Container : Vector) return Extended_Index
+ is begin
+ if Container.First = No_Index then
+ return No_Index + 1;
+ else
+ return Container.First;
+ end if;
+ end First_Index;
+
+ function Last_Index (Container : Vector) return Extended_Index
+ is begin
+ return Container.Last;
+ end Last_Index;
+
+ procedure Append (Container : in out Vector; New_Item : in Element_Type)
+ is begin
+ if Container.First = No_Index then
+ Container.First := Index_Type'First;
+ Container.Last := Index_Type'First;
+ else
+ Container.Last := Container.Last + 1;
+ end if;
+
+ declare
+ J : constant Base_Peek_Type := To_Peek_Type (Container.Last);
+ begin
+ if Container.Elements = null then
+ Container.Elements := new Array_Type (J .. J);
+
+ elsif J > Container.Elements'Last then
+ Grow (Container.Elements, J);
+ end if;
+
+ Container.Elements (J) := New_Item;
+ end;
+ end Append;
+
+ procedure Append (Container : in out Vector; New_Items : in Vector)
+ is
+ use all type Ada.Containers.Count_Type;
+ Old_Last : Extended_Index := Container.Last;
+ begin
+ if New_Items.Length = 0 then
+ return;
+ end if;
+
+ if Container.First = No_Index then
+ Container.First := Index_Type'First;
+ Old_Last := Container.First - 1;
+ Container.Last := Container.First + Extended_Index
(New_Items.Length) - 1;
+ else
+ Container.Last := Container.Last + Extended_Index (New_Items.Length);
+ end if;
+
+ declare
+ I : constant Peek_Type := To_Peek_Type (Old_Last + 1);
+ J : constant Peek_Type := To_Peek_Type (Container.Last);
+ begin
+ if Container.Elements = null then
+ Container.Elements := new Array_Type (I .. J);
+ elsif J > Container.Elements'Last then
+ Grow (Container.Elements, J);
+ end if;
+
+ Container.Elements (I .. J) := New_Items.Elements
+ (To_Peek_Type (New_Items.First) .. To_Peek_Type (New_Items.Last));
+ end;
+ end Append;
+
+ procedure Prepend (Container : in out Vector; New_Item : in Element_Type)
+ is begin
+ if Container.First = No_Index then
+ Container.First := Index_Type'First;
+ Container.Last := Index_Type'First;
+ else
+ Container.First := Container.First - 1;
+ end if;
+
+ declare
+ J : constant Peek_Type := To_Peek_Type (Container.First);
+ begin
+ if Container.Elements = null then
+ Container.Elements := new Array_Type (J .. J);
+
+ elsif J < Container.Elements'First then
+ Grow (Container.Elements, J);
+ end if;
+
+ Container.Elements (J) := New_Item;
+ end;
+ end Prepend;
+
+ procedure Prepend
+ (Target : in out Vector;
+ Source : in Vector;
+ Source_First : in Index_Type;
+ Source_Last : in Index_Type)
+ is
+ Source_I : constant Peek_Type := To_Peek_Type (Source_First);
+ Source_J : constant Peek_Type := To_Peek_Type (Source_Last);
+ begin
+ if Target.Elements = null then
+ Target.Elements := new Array_Type'(Source.Elements (Source_I ..
Source_J));
+ Target.First := Source_First;
+ Target.Last := Source_Last;
+ else
+ declare
+ New_First : constant Index_Type := Target.First - (Source_Last -
Source_First + 1);
+ I : constant Peek_Type := To_Peek_Type (New_First);
+ J : constant Peek_Type := To_Peek_Type (Target.First - 1);
+ begin
+ if Target.Elements'First > I then
+ Grow (Target.Elements, I);
+ end if;
+ Target.Elements (I .. J) := Source.Elements (Source_I .. Source_J);
+ Target.First := New_First;
+ end;
+ end if;
+ end Prepend;
+
+ procedure Insert
+ (Container : in out Vector;
+ Element : in Element_Type;
+ Before : in Index_Type)
+ is
+ use all type Ada.Containers.Count_Type;
+ begin
+ if Container.Length = 0 then
+ Container.Append (Element);
+ else
+ Container.Last := Container.Last + 1;
+
+ declare
+ J : constant Peek_Type := To_Peek_Type (Before);
+ K : constant Base_Peek_Type := To_Peek_Type (Container.Last);
+ begin
+ if K > Container.Elements'Last then
+ Grow (Container.Elements, K);
+ end if;
+
+ Container.Elements (J + 1 .. K) := Container.Elements (J .. K - 1);
+ Container.Elements (J) := Element;
+ end;
+ end if;
+ end Insert;
+
+ procedure Merge
+ (Target : in out Vector;
+ Source : in out Vector)
+ is
+ use all type Ada.Containers.Count_Type;
+ begin
+ if Source.Length = 0 then
+ Source.Clear;
+
+ elsif Target.Length = 0 then
+ Target := Source;
+ Source.Clear;
+
+ else
+ declare
+ New_First : constant Index_Type := Extended_Index'Min
(Target.First, Source.First);
+ New_Last : constant Index_Type := Extended_Index'Max
(Target.Last, Source.Last);
+ New_I : constant Peek_Type := To_Peek_Type (New_First);
+ New_J : constant Base_Peek_Type := To_Peek_Type (New_Last);
+ begin
+ if New_I < Target.Elements'First then
+ Grow (Target.Elements, New_I);
+ end if;
+ if New_J > Target.Elements'Last then
+ Grow (Target.Elements, New_J);
+ end if;
+
+ Target.Elements (To_Peek_Type (Source.First) .. To_Peek_Type
(Source.Last)) := Source.Elements
+ (To_Peek_Type (Source.First) .. To_Peek_Type (Source.Last));
+
+ Target.First := New_First;
+ Target.Last := New_Last;
+
+ Source.Clear;
+ end;
+ end if;
+ end Merge;
+
+ function To_Vector (Item : in Element_Type; Count : in
Ada.Containers.Count_Type := 1) return Vector
+ is begin
+ return Result : Vector do
+ for I in 1 .. Count loop
+ Result.Append (Item);
+ end loop;
+ end return;
+ end To_Vector;
+
+ function "+" (Element : in Element_Type) return Vector
+ is begin
+ return Result : Vector do
+ Result.Append (Element);
+ end return;
+ end "+";
+
+ function "&" (Left, Right : in Element_Type) return Vector
+ is begin
+ return Result : Vector do
+ Result.Append (Left);
+ Result.Append (Right);
+ end return;
+ end "&";
+
+ function "&" (Left : in Vector; Right : in Element_Type) return Vector
+ is begin
+ return Result : Vector := Left do
+ Result.Append (Right);
+ end return;
+ end "&";
+
+ procedure Set_First (Container : in out Vector; First : in Index_Type)
+ is
+ J : constant Peek_Type := To_Peek_Type (First);
+ begin
+ Container.First := First;
+ if Container.Last = No_Index then
+ Container.Last := First - 1;
+ end if;
+
+ if Container.Last >= First then
+ if Container.Elements = null then
+ Container.Elements := new Array_Type'(J .. To_Peek_Type
(Container.Last) => Default_Element);
+
+ elsif Container.Elements'First > J then
+ Grow (Container.Elements, J);
+ end if;
+ end if;
+ end Set_First;
+
+ procedure Set_Last (Container : in out Vector; Last : in Extended_Index)
+ is
+ J : constant Base_Peek_Type := To_Peek_Type (Last);
+ begin
+ Container.Last := Last;
+ if Container.First = No_Index then
+ Container.First := Last + 1;
+ end if;
+
+ if Last >= Container.First then
+ if Container.Elements = null then
+ Container.Elements := new Array_Type'(To_Peek_Type
(Container.First) .. J => Default_Element);
+
+ elsif Container.Elements'Last < J then
+ Grow (Container.Elements, J);
+ end if;
+ end if;
+ end Set_Last;
+
+ procedure Set_First_Last
+ (Container : in out Vector;
+ First : in Index_Type;
+ Last : in Extended_Index)
+ is begin
+ Set_First (Container, First);
+ Set_Last (Container, Last);
+ end Set_First_Last;
+
+ procedure Delete (Container : in out Vector; Index : in Index_Type)
+ is
+ J : constant Peek_Type := To_Peek_Type (Index);
+ begin
+ Container.Elements (J .. J) := (J => <>);
+ if Index = Container.Last then
+ Container.Last := Container.Last - 1;
+ end if;
+ end Delete;
+
+ function Contains (Container : in Vector; Element : in Element_Type) return
Boolean
+ is
+ use all type Ada.Containers.Count_Type;
+ begin
+ if Container.Length = 0 then
+ return False;
+ else
+ for It of Container.Elements.all loop
+ if It = Element then
+ return True;
+ end if;
+ end loop;
+ return False;
+ end if;
+ end Contains;
+
+ function Element (Position : Cursor) return Element_Type
+ is begin
+ return Position.Container.Elements (Position.Index);
+ end Element;
+
+ function First (Container : aliased in Vector) return Cursor
+ is
+ use all type Ada.Containers.Count_Type;
+ begin
+ if Container.Length = 0 then
+ return (Container'Access, Invalid_Peek_Index);
+ else
+ return (Container'Access, To_Peek_Type (Container.First));
+ end if;
+ end First;
+
+ function Next (Position : in Cursor) return Cursor
+ is begin
+ if Position.Index = Invalid_Peek_Index then
+ return (Position.Container, Invalid_Peek_Index);
+ elsif Position.Index < To_Peek_Type (Position.Container.Last) then
+ return (Position.Container, Position.Index + 1);
+ else
+ return (Position.Container, Invalid_Peek_Index);
+ end if;
+ end Next;
+
+ procedure Next (Position : in out Cursor)
+ is begin
+ if Position.Index = Invalid_Peek_Index then
+ null;
+ elsif Position.Index < To_Peek_Type (Position.Container.Last) then
+ Position.Index := Position.Index + 1;
+ else
+ Position := (Position.Container, Invalid_Peek_Index);
+ end if;
+ end Next;
+
+ function Prev (Position : in Cursor) return Cursor
+ is begin
+ if Position.Index = Invalid_Peek_Index then
+ return (Position.Container, Invalid_Peek_Index);
+ elsif Position.Index > To_Peek_Type (Position.Container.First) then
+ return (Position.Container, Position.Index - 1);
+ else
+ return (Position.Container, Invalid_Peek_Index);
+ end if;
+ end Prev;
+
+ procedure Prev (Position : in out Cursor)
+ is begin
+ if Position.Index = Invalid_Peek_Index then
+ null;
+ elsif Position.Index > To_Peek_Type (Position.Container.First) then
+ Position.Index := Position.Index - 1;
+ else
+ Position := (Position.Container, Invalid_Peek_Index);
+ end if;
+ end Prev;
+
+ function To_Cursor
+ (Container : aliased in Vector;
+ Index : in Extended_Index)
+ return Cursor
+ is begin
+ return (Container'Access, To_Peek_Type (Index));
+ end To_Cursor;
+
+ function To_Index (Position : in Cursor) return Extended_Index
+ is begin
+ if Position.Index = Invalid_Peek_Index then
+ return No_Index;
+ else
+ return To_Index_Type (Position.Index);
+ end if;
+ end To_Index;
+
+ function Constant_Ref (Container : aliased Vector; Index : in Index_Type)
return Constant_Reference_Type
+ is
+ J : constant Peek_Type := To_Peek_Type (Index);
+ begin
+ return (Element => Container.Elements (J)'Access, Dummy => 1);
+ end Constant_Ref;
+
+ function Variable_Ref
+ (Container : aliased in Vector;
+ Index : in Index_Type)
+ return Variable_Reference_Type
+ is
+ J : constant Peek_Type := To_Peek_Type (Index);
+ begin
+ return (Element => Container.Elements (J)'Access, Dummy => 1);
+ end Variable_Ref;
+
+ overriding function First (Object : Iterator) return Cursor
+ is begin
+ if Object.Container.Elements = null then
+ return (Object.Container, Invalid_Peek_Index);
+ else
+ return (Object.Container, To_Peek_Type (Object.Container.First));
+ end if;
+ end First;
+
+ overriding function Last (Object : Iterator) return Cursor
+ is begin
+ if Object.Container.Elements = null then
+ return (Object.Container, Invalid_Peek_Index);
+ else
+ return (Object.Container, To_Peek_Type (Object.Container.Last));
+ end if;
+ end Last;
+
+ overriding function Next (Object : in Iterator; Position : in Cursor)
return Cursor
+ is begin
+ if Position.Index = To_Peek_Type (Object.Container.Last) then
+ return (Object.Container, Invalid_Peek_Index);
+ else
+ return (Object.Container, Position.Index + 1);
+ end if;
+ end Next;
+
+ overriding function Previous (Object : in Iterator; Position : in Cursor)
return Cursor
+ is begin
+ if Position.Index = To_Peek_Type (Index_Type'First) then
+ return (Object.Container, Invalid_Peek_Index);
+ else
+ return (Object.Container, Position.Index - 1);
+ end if;
+ end Previous;
+
+ function Iterate (Container : aliased in Vector) return
Iterator_Interfaces.Reversible_Iterator'Class
+ is begin
+ return Iterator'(Container => Container'Access);
+ end Iterate;
+
+ function Constant_Ref (Container : aliased Vector; Position : in Cursor)
return Constant_Reference_Type
+ is begin
+ return (Element => Container.Elements (Position.Index)'Access, Dummy =>
1);
+ end Constant_Ref;
+
+ function Variable_Ref
+ (Container : aliased in Vector;
+ Position : in Cursor)
+ return Variable_Reference_Type
+ is begin
+ return (Element => Container.Elements (Position.Index)'Access, Dummy =>
1);
+ end Variable_Ref;
+
+end SAL.Gen_Unbounded_Definite_Vectors;
diff --git a/sal-gen_unbounded_definite_vectors.ads
b/sal-gen_unbounded_definite_vectors.ads
index 76cca13..818a223 100644
--- a/sal-gen_unbounded_definite_vectors.ads
+++ b/sal-gen_unbounded_definite_vectors.ads
@@ -8,7 +8,13 @@
-- It provides no checking of cursor tampering; higher level code
-- must ensure that.
--
--- Copyright (C) 2018 - 2019 Free Software Foundation, Inc.
+-- Design:
+--
+-- See ARM 3.10.2 "explicitly aliased" for why we need 'aliased' in
+-- several subprogram argument modes, and why Container must be an
+-- access discriminant in Cursor and Iterator.
+--
+-- Copyright (C) 2018 - 2020 Free Software Foundation, Inc.
--
-- This library is free software; you can redistribute it and/or modify it
-- under terms of the GNU General Public License as published by the Free
@@ -39,10 +45,10 @@ package SAL.Gen_Unbounded_Definite_Vectors is
No_Index : constant Extended_Index := Extended_Index'First;
type Vector is new Ada.Finalization.Controlled with private with
- Constant_Indexing => Constant_Ref,
- Variable_Indexing => Variable_Ref,
- Default_Iterator => Iterate,
- Iterator_Element => Element_Type;
+ Constant_Indexing => Constant_Ref,
+ Variable_Indexing => Variable_Ref,
+ Default_Iterator => Iterate,
+ Iterator_Element => Element_Type;
Empty_Vector : constant Vector;
@@ -68,6 +74,8 @@ package SAL.Gen_Unbounded_Definite_Vectors is
function First_Index (Container : Vector) return Extended_Index;
-- No_Index + 1 when Container is empty, so "for I in C.First_Index
-- .. C.Last_Index loop" works.
+ --
+ -- If you need No_Index for an empty Container, use To_Index
(Container.First).
function Last_Index (Container : Vector) return Extended_Index;
-- No_Index when Container is empty.
@@ -145,13 +153,11 @@ package SAL.Gen_Unbounded_Definite_Vectors is
function Variable_Ref (Container : aliased in Vector; Index : in
Index_Type) return Variable_Reference_Type
with Inline, Pre => Index in Container.First_Index .. Container.Last_Index;
- type Cursor is private;
-
- No_Element : constant Cursor;
+ type Cursor (<>) is private;
function Has_Element (Position : Cursor) return Boolean;
function Element (Position : Cursor) return Element_Type
- with Pre => Position /= No_Element;
+ with Pre => Has_Element (Position);
function First (Container : aliased in Vector) return Cursor;
function Next (Position : in Cursor) return Cursor;
procedure Next (Position : in out Cursor);
@@ -161,7 +167,8 @@ package SAL.Gen_Unbounded_Definite_Vectors is
function To_Cursor
(Container : aliased in Vector;
Index : in Extended_Index)
- return Cursor;
+ return Cursor
+ with Pre => Index = No_Index or Index in Container.First_Index ..
Container.Last_Index;
function To_Index (Position : in Cursor) return Extended_Index;
@@ -195,16 +202,14 @@ private
type Vector_Access is access constant Vector;
for Vector_Access'Storage_Size use 0;
- type Cursor is record
- Container : Vector_Access := null;
- Index : Base_Peek_Type := Invalid_Peek_Index;
- end record;
-
- type Iterator is new Iterator_Interfaces.Reversible_Iterator with
+ type Cursor (Container : not null access constant Vector) is
record
- Container : Vector_Access;
+ Index : Base_Peek_Type := Invalid_Peek_Index;
end record;
+ type Iterator (Container : not null access constant Vector) is new
Iterator_Interfaces.Reversible_Iterator with
+ null record;
+
overriding function First (Object : Iterator) return Cursor;
overriding function Last (Object : Iterator) return Cursor;
@@ -228,7 +233,11 @@ private
Empty_Vector : constant Vector := (Ada.Finalization.Controlled with others
=> <>);
- No_Element : constant Cursor := (others => <>);
+ ----------
+ -- Visible for contracts/SPARK
+
+ function Has_Element (Position : Cursor) return Boolean
+ is (Position.Index /= Invalid_Peek_Index);
----------
-- Visible for child package
diff --git a/sal-gen_unbounded_definite_vectors_sorted.adb
b/sal-gen_unbounded_definite_vectors_sorted.adb
index 6d836c5..8e40695 100644
--- a/sal-gen_unbounded_definite_vectors_sorted.adb
+++ b/sal-gen_unbounded_definite_vectors_sorted.adb
@@ -2,7 +2,7 @@
--
-- See spec.
--
--- Copyright (C) 2019 Free Software Foundation, Inc.
+-- Copyright (C) 2019 - 2020 Free Software Foundation, Inc.
--
-- This library is free software; you can redistribute it and/or modify it
-- under terms of the GNU General Public License as published by the Free
@@ -163,7 +163,6 @@ package body SAL.Gen_Unbounded_Definite_Vectors_Sorted is
(Container : in out Vector;
Length : in Ada.Containers.Count_Type)
is
- use all type Ada.Containers.Count_Type;
First_Peek : constant Peek_Type := Peek_Type'First;
Last_Peek : constant Base_Peek_Type := Base_Peek_Type (Length);
begin
@@ -312,42 +311,44 @@ package body SAL.Gen_Unbounded_Definite_Vectors_Sorted is
overriding function First (Object : Iterator) return Cursor
is begin
if Object.Container.Elements = null then
- return (null, Invalid_Peek_Index);
+ return (Index => Invalid_Peek_Index);
else
- return (Object.Container, Peek_Type'First);
+ return (Index => Peek_Type'First);
end if;
end First;
overriding function Last (Object : Iterator) return Cursor
is begin
if Object.Container.Elements = null then
- return (null, Invalid_Peek_Index);
+ return (Index => Invalid_Peek_Index);
else
- return (Object.Container, Object.Container.Last);
+ return (Index => Object.Container.Last);
end if;
end Last;
overriding function Next (Object : in Iterator; Position : in Cursor)
return Cursor
is begin
if Position.Index = Object.Container.Last then
- return (null, Invalid_Peek_Index);
+ return (Index => Invalid_Peek_Index);
else
- return (Object.Container, Position.Index + 1);
+ return (Index => Position.Index + 1);
end if;
end Next;
overriding function Previous (Object : in Iterator; Position : in Cursor)
return Cursor
- is begin
+ is
+ pragma Unreferenced (Object);
+ begin
if Position.Index = Peek_Type'First then
- return (null, Invalid_Peek_Index);
+ return (Index => Invalid_Peek_Index);
else
- return (Object.Container, Position.Index - 1);
+ return (Index => Position.Index - 1);
end if;
end Previous;
function Iterate (Container : aliased in Vector) return
Iterator_Interfaces.Reversible_Iterator'Class
is begin
- return Iterator'(Container => Container'Unrestricted_Access);
+ return Iterator'(Container => Container'Access);
end Iterate;
function Constant_Ref (Container : aliased Vector; Position : in Cursor)
return Constant_Reference_Type
@@ -355,11 +356,16 @@ package body SAL.Gen_Unbounded_Definite_Vectors_Sorted is
return (Element => Container.Elements (Position.Index)'Access, Dummy =>
1);
end Constant_Ref;
- function Last_Index (Container : aliased Vector) return Base_Peek_Type
+ function Last_Index (Container : in Vector) return Base_Peek_Type
is begin
return Container.Last;
end Last_Index;
+ function To_Index (Position : in Cursor) return Base_Peek_Type
+ is begin
+ return Position.Index;
+ end To_Index;
+
function Constant_Ref (Container : aliased Vector; Index : in Peek_Type)
return Constant_Reference_Type
is begin
return (Element => Container.Elements (Index)'Access, Dummy => 1);
diff --git a/sal-gen_unbounded_definite_vectors_sorted.ads
b/sal-gen_unbounded_definite_vectors_sorted.ads
index c197ec4..2a52c74 100644
--- a/sal-gen_unbounded_definite_vectors_sorted.ads
+++ b/sal-gen_unbounded_definite_vectors_sorted.ads
@@ -2,7 +2,7 @@
--
-- A simple unbounded sorted vector of definite items.
--
--- Copyright (C) 2019 Free Software Foundation, Inc.
+-- Copyright (C) 2019 - 2020 Free Software Foundation, Inc.
--
-- This library is free software; you can redistribute it and/or modify it
-- under terms of the GNU General Public License as published by the Free
@@ -27,6 +27,8 @@ generic
with function Key_Compare (Left, Right : in Key_Type) return Compare_Result;
package SAL.Gen_Unbounded_Definite_Vectors_Sorted is
+ use all type Ada.Containers.Count_Type;
+
type Vector is new Ada.Finalization.Controlled with private with
Constant_Indexing => Constant_Ref,
Default_Iterator => Iterate,
@@ -94,13 +96,16 @@ package SAL.Gen_Unbounded_Definite_Vectors_Sorted is
Implicit_Dereference => Element;
function Constant_Ref (Container : aliased Vector; Position : in Cursor)
return Constant_Reference_Type
- with Inline;
+ with Inline,
+ Pre => To_Index (Position) in Container.First_Index ..
Container.Last_Index;
- function First_Index (Container : aliased Vector) return Peek_Type is
(Peek_Type'First);
- function Last_Index (Container : aliased Vector) return Base_Peek_Type
+ function First_Index (Container : in Vector) return Peek_Type is
(Peek_Type'First);
+ function Last_Index (Container : in Vector) return Base_Peek_Type
with Inline;
+ function To_Index (Position : in Cursor) return Base_Peek_Type;
function Constant_Ref (Container : aliased Vector; Index : in Peek_Type)
return Constant_Reference_Type
- with Inline;
+ with Inline,
+ Pre => Index in Container.First_Index .. Container.Last_Index;
private
@@ -123,14 +128,11 @@ private
for Vector_Access'Storage_Size use 0;
type Cursor is record
- Container : Vector_Access := null;
- Index : Base_Peek_Type := No_Index;
+ Index : Base_Peek_Type := No_Index;
end record;
- type Iterator is new Iterator_Interfaces.Reversible_Iterator with
- record
- Container : Vector_Access;
- end record;
+ type Iterator (Container : not null access constant Vector) is new
Iterator_Interfaces.Reversible_Iterator
+ with null record;
overriding function First (Object : Iterator) return Cursor;
overriding function Last (Object : Iterator) return Cursor;
diff --git a/sal.adb b/sal.adb
index e3f5d52..08a2184 100644
--- a/sal.adb
+++ b/sal.adb
@@ -2,7 +2,7 @@
--
-- See spec.
--
--- Copyright (C) 1997 - 2004, 2006, 2009, 2019 Free Software Foundation, Inc.
+-- Copyright (C) 1997 - 2004, 2006, 2009, 2019, 2020 Free Software
Foundation, Inc.
--
-- SAL is free software; you can redistribute it and/or modify it
-- under terms of the GNU General Public License as published by the
@@ -26,7 +26,7 @@ package body SAL is
function Version return String is
begin
- return "SAL 3.3";
+ return "SAL 3.4";
end Version;
end SAL;
diff --git a/standard_common.gpr b/standard_common.gpr
index 2ba758a..ce019c7 100644
--- a/standard_common.gpr
+++ b/standard_common.gpr
@@ -2,7 +2,7 @@
--
-- Standard settings for all of Stephe's Ada projects.
--
--- Copyright (C) 2018, 2019 Free Software Foundation, Inc.
+-- Copyright (C) 2018 - 2020 Free Software Foundation, Inc.
--
-- This program is free software; you can redistribute it and/or
-- modify it under terms of the GNU General Public License as
@@ -61,7 +61,7 @@ project Standard_Common is
-- suppress that warning with -gnatwP.
Debug_Switches := Common_Switches &
(
- "-O0",
+ "-O0", -- we don't use -Og because that causes gdb to report
incorrect results in some cases in Ada.
"-gnata", -- assertions, pre/post-conditions
"-gnatVa", -- validity checks
"-gnateE", -- extra info in exceptions
diff --git a/wisi-prj.el b/wisi-prj.el
index 833a514..ba3932d 100644
--- a/wisi-prj.el
+++ b/wisi-prj.el
@@ -1,4 +1,4 @@
-;;; wisi-prj.el --- project definition files -*- lexical-binding:t -*-
+;;; wisi-prj.el --- project integration -*- lexical-binding:t -*-
;;
;; Copyright (C) 2019 - 2020 Free Software Foundation, Inc.
;;
@@ -184,10 +184,29 @@ after the project file PRJ-FILE-NAME is parsed."
slow refresh operations may be skipped."
nil)
-(cl-defgeneric wisi-xref-definitions (_xref project item)
+(cl-defgeneric wisi-xref-completion-table (xref project)
+ "Return a completion table of names defined in PROJECT, for navigating to
the declarations.
+The table is an alist of (ANNOTATED-SYMBOL . LOC), where:
+
+- ANNOTATED-SYMBOL is the simple name and possibly annotations
+such as function arguments, controlling type, containing package,
+and line number.
+
+- LOC is the declaration of the name as a list (FILE LINE
+COLUMN).")
+
+(cl-defgeneric wisi-xref-completion-regexp (xref)
+ "Return a regular expression matching the result of completing with
`wisi-xref-completion-table'.
+Group 1 must be the simple symbol; the rest of the item may be annotations.")
+
+(cl-defgeneric wisi-xref-completion-at-point-table (xref project)
+ "Return a completion table of names defined in PROJECT, for
`completion-at-point'.
+The table is a simple list of symbols.")
+
+(cl-defgeneric wisi-xref-definitions (xref project item)
"Return all definitions (classwide) of ITEM (an xref-item), as a list of
xref-items.")
-(cl-defgeneric wisi-xref-references (_xref project item)
+(cl-defgeneric wisi-xref-references (xref project item)
"Return all references to ITEM (an xref-item), as a list of xref-items.")
(cl-defgeneric wisi-xref-other (project &key identifier filename line column)
@@ -240,62 +259,128 @@ LINE, COLUMN are Emacs origin."
(defun wisi-show-xref (xref)
"Display XREF location."
(let ((marker (xref-location-marker (xref-item-location xref))))
+ (push-mark)
(pop-to-buffer (marker-buffer marker) (list #'display-buffer-same-window))
(goto-char (marker-position marker))))
+(defun wisi-filter-table (table file)
+ "If FILE is nil, return TABLE. Otherwise return only items in TABLE with
location FILE."
+ (cond
+ ((null file)
+ table)
+
+ (t
+ (let (result)
+ (dolist (item table)
+ (when (string= file (car (cdr item)))
+ (push item result)))
+ result))))
+
(defun wisi-get-identifier (prompt)
- "Get identifier at point, or if no identifier at point, or with user arg,
prompt for one."
+ "Get identifier at point, or if no identifier at point, or with user arg,
prompt for one.
+Single user arg completes on all identifiers in project; double
+user arg limits completion to current file."
;; Similar to xref--read-identifier, but uses a different completion
;; table, because we want a more specific reference.
- (let* ((backend (xref-find-backend))
- (def (xref-backend-identifier-at-point backend)))
+ (let* ((prj (project-current))
+ (def (xref-backend-identifier-at-point prj)))
(cond
((or current-prefix-arg
(not def))
- (let ((id
- (completing-read
- (if def
- (format "%s (default %s): " prompt def)
- prompt)
- (wisi-names t)
- nil nil nil
- 'xref--read-identifier-history def)))
+ (let* ((table (wisi-filter-table (wisi-xref-completion-table
(wisi-prj-xref prj) prj)
+ (when (equal '(16) current-prefix-arg)
(buffer-file-name))))
+ (id
+ ;; Since the user decided not to use the identifier at
+ ;; point, don't use it as the default.
+ (completing-read prompt table nil nil nil
'xref--read-identifier-history)))
(if (equal id "")
(user-error "No identifier provided")
- id)))
+
+ ;; The user may have forced exit from completing-read with a
+ ;; string that is not in the table (because gpr-query is out
+ ;; of date, for example).
+ (or (and (consp (car table)) ;; alist; return key and value.
+ (assoc id table))
+ id))))
(t def))))
(defun wisi-goto-spec/body (identifier)
"Goto declaration or body for IDENTIFIER (default symbol at point).
If no symbol at point, or with prefix arg, prompt for symbol, goto spec."
(interactive (list (wisi-get-identifier "Goto spec/body of: ")))
- (let ((prj (project-current)))
- (wisi-show-xref
- (wisi-xref-ident-make
- identifier
- (lambda (ident file line column)
- (let ((target (wisi-xref-other
- (wisi-prj-xref prj) prj
- :identifier ident
- :filename file
- :line line
- :column column)))
- (xref-make ident
- (xref-make-file-location
- (nth 0 target) ;; file
- (nth 1 target) ;; line
- (nth 2 target))) ;; column
- ))))
+ (let ((prj (project-current))
+ desired-loc)
+ (cond
+ ((consp identifier)
+ ;; alist element from wisi-xref-completion-table; desired
+ ;; location is primary declaration
+ (setq desired-loc
+ (xref-make (car identifier)
+ (xref-make-file-location
+ (nth 0 (cdr identifier)) ;; file
+ (nth 1 (cdr identifier)) ;; line
+ (nth 2 (cdr identifier)) ;; column
+ ))))
+
+ ((stringp identifier)
+ ;; from xref-backend-identifier-at-point; desired location is 'other'
+ (let ((item (wisi-xref-item identifier prj)))
+ (condition-case-unless-debug err
+ (with-slots (summary location) item
+ (let ((eieio-skip-typecheck t))
+ (with-slots (file line column) location
+ (let ((target
+ (wisi-xref-other
+ (wisi-prj-xref prj) prj
+ :identifier summary
+ :filename file
+ :line line
+ :column column)))
+ (setq desired-loc
+ (xref-make summary
+ (xref-make-file-location
+ (nth 0 target) ;; file
+ (nth 1 target) ;; line
+ (nth 2 target))) ;; column
+ )))))
+ (user-error ;; from gpr-query; current file might be new to project,
so try wisi-names
+ (let ((item (assoc identifier (wisi-names nil t))))
+ (if item
+ (setq desired-loc
+ (xref-make identifier
+ (xref-make-file-location
+ (nth 1 item) ;; file
+ (nth 2 item) ;; line
+ (nth 3 item))))
+ (signal (car err) (cdr err)))))
+ )))
+
+ (t ;; something else
+ (error "unknown case in wisi-goto-spec/body")))
+ (wisi-show-xref desired-loc)
))
(cl-defgeneric wisi-prj-identifier-at-point (_project)
- "Return the identifier at point, move point to start of
-identifier. Signal an error if no identifier is at point."
- (let ((ident (thing-at-point 'symbol)))
- (when ident
- (skip-syntax-backward "w_")
- ident)))
+ "Return (IDENT START END) giving the identifier and its bounds at point.
+Return nil if no identifier is at point."
+ ;; default implementation
+ (let ((bounds (bounds-of-thing-at-point 'symbol)))
+ (when bounds
+ (list (car bounds) (cdr bounds) (buffer-substring-no-properties (car
bounds) (cdr bounds))))))
+
+(defun wisi-completion-at-point ()
+ "For `completion-at-point-functions'."
+ (let ((prj (project-current)))
+ (when (wisi-prj-p prj)
+ (save-excursion
+ (let ((table (wisi-xref-completion-at-point-table (wisi-prj-xref prj)
prj))
+ (bounds (wisi-prj-identifier-at-point prj)))
+ (when bounds
+ ;; xref symbol table may be out of date; try dabbrevs
+ (list (nth 0 bounds) (nth 1 bounds) table :exclusive 'no))
+ )))
+ ))
(defun wisi-check-current-project (file-name &optional default-prj-function)
"If FILE-NAME (must be absolute) is found in the current
@@ -343,14 +428,15 @@ Displays a buffer in compilation-mode giving locations of
the parent type declar
(defun wisi-show-declaration-parents ()
"Display the locations of the parent type declarations of the type
identifier around point."
(interactive)
- (let ((project (wisi-check-current-project (buffer-file-name))))
+ (let* ((project (wisi-check-current-project (buffer-file-name)))
+ (id (wisi-prj-identifier-at-point project)))
(wisi-xref-parents
(wisi-prj-xref project)
project
- :identifier (wisi-prj-identifier-at-point project)
+ :identifier (nth 2 id)
:filename (file-name-nondirectory (buffer-file-name))
:line (line-number-at-pos)
- :column (current-column))
+ :column (save-excursion (goto-char (nth 0 id)) (current-column)))
))
(cl-defgeneric wisi-xref-all (xref project &key identifier filename line
column local-only append)
@@ -370,14 +456,15 @@ identifier is declared or referenced.")
"Show all references of identifier at point.
With prefix, keep previous references in output buffer."
(interactive "P")
- (let ((project (wisi-check-current-project (buffer-file-name))))
+ (let* ((project (wisi-check-current-project (buffer-file-name)))
+ (id (wisi-prj-identifier-at-point project)))
(wisi-xref-all
(wisi-prj-xref project)
project
- :identifier (wisi-prj-identifier-at-point project)
+ :identifier (nth 2 id)
:filename (file-name-nondirectory (buffer-file-name))
:line (line-number-at-pos)
- :column (current-column)
+ :column (save-excursion (goto-char (nth 0 id)) (current-column))
:local-only nil
:append append)
))
@@ -386,14 +473,15 @@ With prefix, keep previous references in output buffer."
"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))))
+ (let* ((project (wisi-check-current-project (buffer-file-name)))
+ (id (wisi-prj-identifier-at-point project)))
(wisi-xref-all
(wisi-prj-xref project)
project
- :identifier (wisi-prj-identifier-at-point project)
+ :identifier (nth 2 id)
:filename (file-name-nondirectory (buffer-file-name))
:line (line-number-at-pos)
- :column (current-column)
+ :column (save-excursion (goto-char (nth 0 id)) (current-column))
:local-only t
:append append)
))
@@ -410,14 +498,15 @@ COLUMN - Emacs column of the start of the identifier ")
(defun wisi-show-overriding ()
"Show all overridings of identifier at point."
(interactive)
- (let ((project (wisi-check-current-project (buffer-file-name))))
+ (let* ((project (wisi-check-current-project (buffer-file-name)))
+ (id (wisi-prj-identifier-at-point project)))
(wisi-xref-overriding
(wisi-prj-xref project)
project
- :identifier (wisi-prj-identifier-at-point project)
+ :identifier (nth 2 id)
:filename (file-name-nondirectory (buffer-file-name))
:line (line-number-at-pos)
- :column (current-column))
+ :column (save-excursion (goto-char (nth 0 id)) (current-column)))
))
(cl-defgeneric wisi-xref-overridden (xref project &key identifier filename
line column)
@@ -433,14 +522,15 @@ COLUMN - Emacs column of the start of the identifier")
"Show the overridden declaration of identifier at point."
(interactive)
(let* ((project (wisi-check-current-project (buffer-file-name)))
+ (id (wisi-prj-identifier-at-point project))
(target
(wisi-xref-overridden
(wisi-prj-xref project)
project
- :identifier (wisi-prj-identifier-at-point project)
+ :identifier (nth 2 id)
:filename (file-name-nondirectory (buffer-file-name))
:line (line-number-at-pos)
- :column (current-column))))
+ :column (save-excursion (goto-char (nth 0 id)) (current-column)))))
(wisi-goto-source (nth 0 target)
(nth 1 target)
@@ -511,8 +601,8 @@ absolute file name.")
(setq wisi-prj--cache (delete (cons prj-file project) wisi-prj--cache))
(setq project (wisi-prj-default project))
(wisi-prj-parse-file :prj-file prj-file :init-prj project :cache t)
- (wisi-prj-select project)))
- (wisi-xref-refresh-cache (wisi-prj-xref project) project not-full))
+ (wisi-xref-refresh-cache (wisi-prj-xref project) project not-full)
+ (wisi-prj-select project))))
(cl-defmethod wisi-prj-select ((project wisi-prj))
(setq compilation-search-path (wisi-prj-source-path project))
@@ -1139,31 +1229,85 @@ with \\[universal-argument]."
;;;; xref backend
+(defconst wisi-file-line-col-regexp
+ ;; matches Gnu-style file references:
+ ;;
C:\Projects\GDS\work_dscovr_release\common\1553\gds-mil_std_1553-utf.ads:252:25
+ ;;
/Projects/GDS/work_dscovr_release/common/1553/gds-mil_std_1553-utf.ads:252:25
+ ;; gds-mil_std_1553-utf.ads:252:25 - when wisi-xref-full-path is nil
+ "\\(\\(?:.:\\\\\\|/\\)?[^:]*\\):\\([0-9]+\\):\\([0-9]+\\)"
+ ;; 1 2 3
+ "Regexp matching <file>:<line>:<column> where <file> is an absolute file
name or basename.")
+
+(defun wisi-xref-item (identifier prj)
+ "Given IDENTIFIER, return an xref-item, with line, column nil if unknown.
+IDENTIFIER is from a user prompt with completion, or from
+`xref-backend-identifier-at-point'."
+ (let* ((t-prop (get-text-property 0 'xref-identifier identifier))
+ ident file line column)
+ (cond
+ (t-prop
+ ;; IDENTIFIER is from wisi-xref-identifier-at-point.
+ (setq ident (substring-no-properties identifier 0 nil))
+ (setq file (plist-get t-prop :file))
+ (setq line (plist-get t-prop :line))
+ (setq column (plist-get t-prop :column))
+ )
+
+ ((string-match (wisi-xref-completion-regexp (wisi-prj-xref prj))
identifier)
+ ;; IDENTIFIER is from prompt/completion on wisi-xref-completion-table
+ (setq ident (match-string 1 identifier))
+
+ (let* ((table (wisi-xref-completion-table (wisi-prj-xref prj) prj))
+ (loc (cdr (assoc identifier table))))
+
+ (setq file (nth 0 loc))
+ (setq line (nth 1 loc))
+ (setq column (nth 2 loc))
+ ))
+
+ ((string-match wisi-names-regexp identifier)
+ ;; IDENTIFIER is from prompt/completion on wisi-names.
+ (setq ident (match-string 1 identifier))
+ (setq file (buffer-file-name))
+ (when (match-string 2 identifier)
+ (setq line (string-to-number (match-string 2 identifier))))
+ )
+
+ (t
+ ;; IDENTIFIER has no line/column info
+ (setq ident identifier)
+ (setq file (buffer-file-name)))
+ )
+
+ (unless (file-name-absolute-p file)
+ (setq file (locate-file file compilation-search-path)))
+
+ (let ((eieio-skip-typecheck t)) ;; allow line, column nil.
+ (xref-make ident (xref-make-file-location file line column)))
+ ))
+
(cl-defmethod xref-backend-definitions ((prj wisi-prj) identifier)
- (wisi-xref-definitions (wisi-prj-xref prj) prj (wisi-xref-item identifier)))
+ (wisi-xref-definitions (wisi-prj-xref prj) prj (wisi-xref-item identifier
prj)))
(cl-defmethod xref-backend-identifier-at-point ((prj wisi-prj))
(save-excursion
- (condition-case nil
- (let ((ident (wisi-prj-identifier-at-point prj))) ;; moves point to
start of ident
- (put-text-property
- 0 1
- 'xref-identifier
- (list ':file (buffer-file-name)
- ':line (line-number-at-pos)
- ':column (current-column))
- ident)
- ident)
- (error
- ;; from wisi-prj-identifier-at-point; no identifier
- nil))))
-
-(cl-defmethod xref-backend-identifier-completion-table ((_prj wisi-prj))
- ;; Current buffer only.
- (wisi-names nil))
+ (let ((id (wisi-prj-identifier-at-point prj)))
+ (when id
+ (put-text-property
+ 0 1
+ 'xref-identifier
+ (list ':file (buffer-file-name)
+ ':line (line-number-at-pos)
+ ':column (save-excursion (goto-char (nth 0 id))
(current-column)))
+ (nth 2 id))
+ (nth 2 id)))))
+
+(cl-defmethod xref-backend-identifier-completion-table ((prj wisi-prj))
+ (wisi-filter-table (wisi-xref-completion-table (wisi-prj-xref prj) prj)
+ (when (equal '(16) current-prefix-arg)
(buffer-file-name))))
(cl-defmethod xref-backend-references ((prj wisi-prj) identifier)
- (wisi-xref-references (wisi-prj-xref prj) prj (wisi-xref-item identifier)))
+ (wisi-xref-references (wisi-prj-xref prj) prj (wisi-xref-item identifier
prj)))
;;;###autoload
(defun wisi-prj-xref-backend ()
diff --git a/wisi-process-parse.el b/wisi-process-parse.el
index 46abc92..bddd033 100644
--- a/wisi-process-parse.el
+++ b/wisi-process-parse.el
@@ -104,17 +104,20 @@ Otherwise add PARSER to ‘wisi-process--alist’, return it."
;; process buffer contains the process and language protocol versions.
(with-current-buffer (wisi-process--parser-buffer parser)
(goto-char (point-min))
- (search-forward-regexp "protocol: process version \\([0-9]+\\) language
version \\([0-9]+\\)")
- (unless (and (match-string 1)
- (string-equal (match-string 1)
wisi-process-parse-protocol-version)
- (match-string 2)
- (string-equal (match-string 2)
(wisi-process--parser-language-protocol-version parser)))
- (wisi-parse-kill parser)
- (error "%s parser process protocol version mismatch: elisp %s %s,
process %s %s"
- (wisi-process--parser-label parser)
- wisi-process-parse-protocol-version
(wisi-process--parser-language-protocol-version parser)
- (match-string 1) (match-string 2)))
- ))
+ (if (search-forward-regexp "protocol: process version \\([0-9]+\\)
language version \\([0-9]+\\)" nil t)
+ (unless (and (match-string 1)
+ (string-equal (match-string 1)
wisi-process-parse-protocol-version)
+ (match-string 2)
+ (string-equal (match-string 2)
(wisi-process--parser-language-protocol-version parser)))
+ (wisi-parse-kill parser)
+ (error "%s parser process protocol version mismatch: elisp %s %s,
process %s %s"
+ (wisi-process--parser-label parser)
+ wisi-process-parse-protocol-version
(wisi-process--parser-language-protocol-version parser)
+ (match-string 1) (match-string 2)))
+ ;; Search failed
+ (error "%s parser process protocol version message not found"
+ (wisi-process--parser-label parser))
+ )))
(defun wisi-process-parse--require-process (parser)
"Start the process for PARSER if not already started."
@@ -138,7 +141,6 @@ Otherwise add PARSER to ‘wisi-process--alist’, return it."
(wisi-process--parser-exec-opts parser))))
(set-process-query-on-exit-flag (wisi-process--parser-process parser)
nil)
- (setf (wisi-process--parser-busy parser) nil)
(wisi-process-parse--wait parser)
(wisi-process-parse--check-version parser)
@@ -195,7 +197,7 @@ parse region."
(if (or (and (= begin (point-min)) (= parse-end
(point-max)))
(< (point-max) wisi-partial-parse-threshold))
0 1) ;; partial parse active
- (if (> wisi-debug 0) 1 0) ;; debug-mode
+ (if (> wisi-debug 0) 1 0) ;; debug_mode
(1- wisi-debug) ;; trace_parse
wisi-trace-mckenzie
wisi-trace-action
@@ -518,8 +520,6 @@ complete."
(declare-function wisi-elisp-lexer-reset "wisi-elisp-lexer")
(defun wisi-process-parse--prepare (parser)
- (wisi-process-parse--require-process parser)
-
;; font-lock can trigger a face parse while navigate or indent parse
;; is active, due to ‘accept-process-output’ below. Signaling an
;; error tells font-lock to try again later.
@@ -541,6 +541,13 @@ complete."
;; accept-process-output below.
(setf (wisi-process--parser-busy parser) t)
+ ;; If the parser process has not started yet,
+ ;; wisi-process-parse--require-process calls
+ ;; wisi-process-parse--wait, which can let font-lock invoke the
+ ;; parser again. Thus this call must be after we set
+ ;; wisi-process--parser-busy t
+ (wisi-process-parse--require-process parser)
+
(setf (wisi-process--parser-total-wait-time parser) 0.0)
(setf (wisi-parser-lexer-errors parser) nil)
(setf (wisi-parser-parse-errors parser) nil)
@@ -598,7 +605,7 @@ complete."
(set-buffer source-buffer) ;; for put-text-property in actions
(cond
((listp response)
- ;; error of some sort
+ ;; non-syntax error of some sort
(cond
((equal '(parse_error) response)
;; Parser detected a syntax error, and recovery failed, so
signal it.
@@ -654,7 +661,7 @@ complete."
(push (make-wisi--parse-error :pos (point) :message (cadr
err)) (wisi-parser-parse-errors parser))
(signal (car err) (cdr err)))
- (error ;; ie from [C:\Windows\system32\KERNEL32.DLL], or
bug in action code above.
+ (error ;; ie from un-commented
[C:\Windows\system32\KERNEL32.DLL], or bug in action code above.
(set-buffer response-buffer)
(let ((content (buffer-substring-no-properties (point-min)
(point-max)))
(buf-name (concat (buffer-name) "-save-error")))
diff --git a/wisi-run-indent-test.el b/wisi-run-indent-test.el
index 269b3d9..8c0eef0 100644
--- a/wisi-run-indent-test.el
+++ b/wisi-run-indent-test.el
@@ -42,8 +42,9 @@ FACE may be a list."
(error "can't find '%s'" token)))
(save-match-data
- (wisi-validate-cache (line-beginning-position 0) (line-end-position 5)
nil 'face))
-
+ (wisi-validate-cache (line-beginning-position) (line-end-position) nil
'face)
+ (font-lock-ensure (line-beginning-position) (line-end-position)))
+
;; We don't use face-at-point, because it doesn't respect
;; font-lock-face set by the parser! And we want to check for
;; conflicts between font-lock-keywords and the parser.
@@ -331,12 +332,28 @@ Each item is a list (ACTION PARSE-BEGIN PARSE-END
EDIT-BEGIN)")
(wisi-case-adjust-buffer))
)
+(defvar cl-print-readably); cl-print.el, used by edebug
+
+(defun large-frame ()
+ (interactive)
+ (modify-frame-parameters
+ nil
+ (list
+ (cons 'width 120) ;; characters; fringe extra
+ (cons 'height 71) ;; characters
+ (cons 'left 0) ;; pixels
+ (cons 'top 0))))
+(define-key global-map "\C-cp" 'large-screen)
+
(defun run-test (file-name)
"Run an indentation and casing test on FILE-NAME."
(interactive "f")
(package-initialize) ;; for uniquify-files
+ ;; Let edebug display strings full-length, and show internals of records
+ (setq cl-print-readably t)
+
;; we'd like to run emacs from a makefile as:
;;
;; emacs -Q --batch -l runtest.el -f run-test-here <filename>
diff --git a/wisi-skel.el b/wisi-skel.el
index 96693fd..9af5b9b 100644
--- a/wisi-skel.el
+++ b/wisi-skel.el
@@ -1,6 +1,6 @@
;;; wisi-skel.el --- Extensions skeleton -*- lexical-binding:t -*-
-;; Copyright (C) 1987, 1993, 1994, 1996-2019 Free Software Foundation, Inc.
+;; Copyright (C) 1987, 1993, 1994, 1996-2020 Free Software Foundation, Inc.
;; Authors: Stephen Leake <stephen_leake@stephe-leake.org>
@@ -24,18 +24,42 @@
;; The primary user command is `wisi-skel-expand', which inserts the
;; skeleton associated with the previous word (possibly skipping a
;; name).
-;;
+
+(require 'skeleton)
(defvar-local wisi-skel-token-alist nil
"Alist of (STRING . ELEMENT), used by `wisi-skel-expand'.
-STRING must be a symbol in the current syntax, and is normally
-the first language keyword in the skeleton.
+STRING should be a grammar symbol in the current language.
ELEMENT may be:
- a skeleton, which is inserted
- an alist of (STRING . SKELETON). User is prompted with `completing-read',
selected skeleton is inserted.")
+(defun wisi-skel-add-token-after (alist token skel after-1 &optional after-2)
+ "Add a new entry in ALIST (should be an instance of `wisi-skel-token-alist')
+after AFTER-1. If AFTER-1 is a nested alist, add the new entry after AFTER-2."
+ (let ((tail alist)
+ done)
+ (if (string= after-1 (car (car alist)))
+ (setcdr alist (cons (cons token skel) (cdr alist)))
+
+ (while (and (not done) tail)
+ (if (string= after-1 (car-safe (car (cdr tail))))
+ (cond
+ ((symbolp (cdr (car (cdr tail))))
+ (setcdr tail (cons (cons token skel) (cdr (cdr tail))))
+ (setq done t))
+
+ ((consp (cdr (car (cdr tail))))
+ (wisi-skel-add-token-after (cdr (car (cdr tail))) token skel
after-2)
+ (setq done t))
+ )
+ ;; else
+ (setq tail (cdr tail))
+ ))
+ )))
+
(defun wisi-skel-build-prompt (alist count)
"Build a prompt from the keys of the ALIST.
The prompt consists of the first COUNT keys from the alist, separated by `|',
with
@@ -93,7 +117,8 @@ before that as the token."
(skip-syntax-forward " ")
(skip-syntax-forward "w_."))
(point)))
- (funcall (cdr skel) name)
+ (let ((skeleton-end-newline nil))
+ (funcall (cdr skel) name))
(setq handled t))
;; word in point .. end is not a token; assume it is a name
@@ -107,10 +132,18 @@ before that as the token."
;; on tokens and placeholders.
(save-excursion (wisi-case-adjust-region (point) end)))
- (wisi-skel-expand (buffer-substring-no-properties (point) end))
- (setq handled t)))
+ (condition-case-unless-debug nil
+ (progn
+ (wisi-skel-expand (buffer-substring-no-properties (point) end))
+ (setq handled t))
+ (user-error ;; leave handled nil
+ ))
+ ))
(when (not handled)
+ (setq name (buffer-substring-no-properties (point) end))
+ ;; restore point
+ (goto-char end)
(user-error "'%s' is not a skeleton token" name))
))
diff --git a/wisi.adb b/wisi.adb
index 227c45c..66b55fd 100644
--- a/wisi.adb
+++ b/wisi.adb
@@ -41,6 +41,7 @@ package body Wisi is
function Paren_In_Anchor_Line
(Data : in out Parse_Data_Type'Class;
+ Tree : in Syntax_Trees.Tree'Class;
Anchor_Token : in Augmented_Token;
Offset : in Integer)
return Integer;
@@ -48,6 +49,31 @@ package body Wisi is
----------
-- body subprograms bodies, alphabetical
+ procedure Adjust_Paren_State
+ (Data : in out Parse_Data_Type;
+ Tree : in Syntax_Trees.Tree'Class;
+ First_Token_Index : in Token_Index;
+ First_Line : in Line_Number_Type;
+ Adjust : in Integer)
+ is begin
+ for I in First_Token_Index .. Data.Terminals.Last_Index loop
+ declare
+ Aug : Augmented_Token renames Get_Aug_Token_Var (Data, Tree, I);
+ begin
+ Aug.Paren_State := Aug.Paren_State + Adjust;
+ end;
+ end loop;
+
+ for Line in First_Line .. Data.Line_Paren_State.Last_Index loop
+ Data.Line_Paren_State (Line) := Data.Line_Paren_State (Line) + Adjust;
+ end loop;
+ end Adjust_Paren_State;
+
+ function Image (Aug : in WisiToken.Base_Token_Class_Access; Descriptor : in
WisiToken.Descriptor) return String
+ is begin
+ return Image (Augmented_Token_Access (Aug).all, Descriptor);
+ end Image;
+
function Image (Anchor_IDs : in Anchor_ID_Vectors.Vector) return String
is
use Ada.Strings.Unbounded;
@@ -243,10 +269,14 @@ package body Wisi is
function Paren_In_Anchor_Line
(Data : in out Parse_Data_Type'Class;
+ Tree : in Syntax_Trees.Tree'Class;
Anchor_Token : in Augmented_Token;
Offset : in Integer)
return Integer
is
+ use Valid_Node_Index_Arrays;
+ use all type Ada.Containers.Count_Type;
+
Left_Paren_ID : Token_ID renames Data.Left_Paren_ID;
Right_Paren_ID : Token_ID renames Data.Right_Paren_ID;
@@ -255,11 +285,15 @@ package body Wisi is
Paren_Char_Pos : Buffer_Pos := Invalid_Buffer_Pos;
Text_Begin_Pos : Buffer_Pos := Invalid_Buffer_Pos;
begin
+ Find_First :
loop
declare
- Tok : Augmented_Token renames Data.Terminals (I);
+ Tok : Aug_Token_Const_Ref renames Get_Aug_Token_Const (Data, Tree,
I);
begin
- if Tok.ID = Left_Paren_ID then
+ if Tok.Deleted then
+ null;
+
+ elsif Tok.ID = Left_Paren_ID then
Paren_Count := Paren_Count + 1;
if Paren_Count = 1 then
Paren_Char_Pos := Tok.Char_Region.First;
@@ -272,11 +306,35 @@ package body Wisi is
if Tok.First then
Text_Begin_Pos := Tok.Char_Region.First;
- exit;
+ exit Find_First;
+ else
+ if Length (Tok.Inserted_Before) > 0 then
+ for Node of Tok.Inserted_Before loop
+ declare
+ Ins_Tok : Augmented_Token renames Augmented_Token
(Tree.Augmented (Node).all);
+ begin
+ if Ins_Tok.ID = Left_Paren_ID then
+ Paren_Count := Paren_Count + 1;
+ if Paren_Count = 1 then
+ Paren_Char_Pos := Tok.Char_Region.First;
+ end if;
+
+ elsif Ins_Tok.ID = Right_Paren_ID then
+ Paren_Count := Paren_Count - 1;
+
+ end if;
+
+ if Ins_Tok.First then
+ Text_Begin_Pos := Tok.Char_Region.First;
+ exit Find_First;
+ end if;
+ end;
+ end loop;
+ end if;
end if;
end;
I := I - 1;
- end loop;
+ end loop Find_First;
if Paren_Char_Pos /= Invalid_Buffer_Pos and Text_Begin_Pos /=
Invalid_Buffer_Pos then
return 1 + Offset + Integer (Paren_Char_Pos - Text_Begin_Pos);
@@ -363,10 +421,9 @@ package body Wisi is
end Put;
procedure Put
- (Item : in Parse.LR.Configuration;
- Terminals : in Augmented_Token_Arrays.Vector;
- Descriptor : in WisiToken.Descriptor;
- Embedded_Quote_Escape_Doubled : in Boolean)
+ (Item : in Parse.LR.Configuration;
+ Data : in Parse_Data_Type;
+ Tree : in Syntax_Trees.Tree)
is
use Ada.Strings.Unbounded;
use Parse.LR;
@@ -390,7 +447,7 @@ package body Wisi is
procedure Start_Edit_Region (Op : in Insert_Delete_Op)
is begin
Append (Line, "[");
- Append (Line, Buffer_Pos'Image (Terminals
(WisiToken.Parse.LR.Token_Index (Op)).Char_Region.First));
+ Append (Line, Get_Aug_Token_Const (Data, Tree, Parse.LR.Token_Index
(Op)).Char_Region.First'Image);
Append (Line, "[");
end Start_Edit_Region;
@@ -412,8 +469,8 @@ package body Wisi is
Deleted_Region := Null_Buffer_Region;
end Terminate_Edit_Region;
begin
- if Trace_Action > Detail then
- Ada.Text_IO.Put_Line (";; " & Parse.LR.Image (Item.Ops, Descriptor));
+ if Trace_Action > Outline then
+ Ada.Text_IO.Put_Line (";; " & Parse.LR.Image (Item.Ops,
Data.Descriptor.all));
end if;
Append (Line, Recover_Code);
@@ -446,7 +503,7 @@ package body Wisi is
State := Inserted;
when Delete =>
- Deleted_Region := Deleted_Region and Terminals
(Op.Del_Token_Index).Char_Region;
+ Deleted_Region := Deleted_Region and Get_Aug_Token_Const (Data,
Tree, Op.Del_Token_Index).Char_Region;
declare
Skip : Boolean := False;
begin
@@ -459,13 +516,16 @@ package body Wisi is
Append (Line, "][");
when Deleted =>
- if Embedded_Quote_Escape_Doubled and then
- ((Last_Deleted.Del_ID = Descriptor.String_1_ID and
Op.Del_ID = Descriptor.String_1_ID) or
- (Last_Deleted.Del_ID = Descriptor.String_2_ID and
Op.Del_ID = Descriptor.String_2_ID))
+ if Data.Embedded_Quote_Escape_Doubled and then
+ ((Last_Deleted.Del_ID = Data.Descriptor.String_1_ID and
+ Op.Del_ID = Data.Descriptor.String_1_ID) or
+ (Last_Deleted.Del_ID = Data.Descriptor.String_2_ID
and
+ Op.Del_ID = Data.Descriptor.String_2_ID))
then
declare
- Tok_1 : Augmented_Token renames Terminals
(Last_Deleted.Del_Token_Index);
- Tok_2 : Augmented_Token renames Terminals
(Op.Del_Token_Index);
+ Tok_1 : Augmented_Token renames Get_Aug_Token_Const
+ (Data, Tree, Last_Deleted.Del_Token_Index);
+ Tok_2 : Augmented_Token renames Get_Aug_Token_Const
(Data, Tree, Op.Del_Token_Index);
begin
if Tok_1.Char_Region.Last + 1 =
Tok_2.Char_Region.First then
-- Buffer text was '"""', lexer repair changed
it to '""""'. The
@@ -605,7 +665,7 @@ package body Wisi is
is
pragma Unreferenced (Params);
begin
- Data.Line_Begin_Pos.Set_First_Last
+ Data.Line_Begin_Char_Pos.Set_First_Last
(First => Begin_Line,
Last => End_Line);
@@ -639,10 +699,11 @@ package body Wisi is
overriding procedure Reset (Data : in out Parse_Data_Type)
is begin
- Data.Terminals.Clear;
+ Data.Last_Terminal_Node := WisiToken.Invalid_Node_Index;
+
Data.Leading_Non_Grammar.Clear;
- -- Data.Line_Begin_Pos set in Initialize, overwritten in
Lexer_To_Augmented
- -- Data.Line_Begin_Token set in WisiToken.Parse.Next_Grammar_Token.
+
+ -- Data.Line_Begin_Char_Pos set in Initialize, overwritten in
Lexer_To_Augmented
for S of Data.Line_Paren_State loop
S := 0;
@@ -651,11 +712,12 @@ package body Wisi is
Data.Navigate_Caches.Finalize;
Data.Navigate_Caches.Initialize;
- Data.End_Positions.Clear;
Data.Name_Caches.Finalize;
Data.Name_Caches.Initialize;
+ Data.End_Positions.Clear;
+
Data.Face_Caches.Finalize;
Data.Face_Caches.Initialize;
@@ -678,29 +740,30 @@ package body Wisi is
overriding
procedure Lexer_To_Augmented
(Data : in out Parse_Data_Type;
+ Tree : in out Syntax_Trees.Tree'Class;
Token : in Base_Token;
Lexer : not null access WisiToken.Lexer.Instance'Class)
is
use all type Ada.Containers.Count_Type;
begin
if Lexer.First then
- Data.Line_Begin_Pos (Token.Line) := Token.Char_Region.First;
+ Data.Line_Begin_Char_Pos (Token.Line) := Token.Char_Region.First;
- if Token.Line > Data.Line_Begin_Pos.First_Index and then
- Data.Line_Begin_Pos (Token.Line - 1) = Invalid_Buffer_Pos
+ if Token.Line > Data.Line_Begin_Char_Pos.First_Index and then
+ Data.Line_Begin_Char_Pos (Token.Line - 1) = Invalid_Buffer_Pos
then
-- Previous token contains multiple lines; ie %code in
wisitoken_grammar.wy
declare
First_Set_Line : Line_Number_Type;
begin
- for Line in reverse Data.Line_Begin_Pos.First_Index ..
Token.Line - 1 loop
- if Data.Line_Begin_Pos (Line) /= Invalid_Buffer_Pos then
+ for Line in reverse Data.Line_Begin_Char_Pos.First_Index ..
Token.Line - 1 loop
+ if Data.Line_Begin_Char_Pos (Line) /= Invalid_Buffer_Pos then
First_Set_Line := Line;
exit;
end if;
end loop;
for Line in First_Set_Line + 1 .. Token.Line - 1 loop
- Data.Line_Begin_Pos (Line) := Data.Line_Begin_Pos
(First_Set_Line); -- good enough
+ Data.Line_Begin_Char_Pos (Line) := Data.Line_Begin_Char_Pos
(First_Set_Line); -- good enough
end loop;
end;
end if;
@@ -713,11 +776,11 @@ package body Wisi is
Data.Line_Paren_State (Token.Line + 1) := Data.Current_Paren_State;
end if;
- if Data.Terminals.Length = 0 then
+ if Data.Last_Terminal_Node = Invalid_Node_Index then
Data.Leading_Non_Grammar.Append ((Token with Lexer.First));
else
declare
- Containing_Token : Augmented_Token renames Data.Terminals
(Data.Terminals.Last_Index);
+ Containing_Token : Aug_Token_Var_Ref renames Get_Aug_Token_Var
(Tree, Data.Last_Terminal_Node);
Trailing_Blank : constant Boolean :=
Token.ID = Data.Descriptor.New_Line_ID and
@@ -742,23 +805,22 @@ package body Wisi is
else
-- grammar token
declare
- Temp : constant Augmented_Token :=
- (Token.ID,
- Byte_Region => Token.Byte_Region,
- Line => Token.Line,
- Column => Token.Column,
- Char_Region => Token.Char_Region,
+ Temp : constant Augmented_Token_Access := new Augmented_Token'
+ (Token with
Deleted => False,
First => Lexer.First,
Paren_State => Data.Current_Paren_State,
- First_Terminals_Index => Data.Terminals.Last_Index + 1,
- Last_Terminals_Index => Data.Terminals.Last_Index + 1,
+ First_Terminals_Index => Data.Terminals.Last_Index,
+ Last_Terminals_Index => Data.Terminals.Last_Index,
First_Indent_Line => (if Lexer.First then Token.Line
else Invalid_Line_Number),
Last_Indent_Line => (if Lexer.First then Token.Line
else Invalid_Line_Number),
First_Trailing_Comment_Line => Invalid_Line_Number, -- Set by
Reduce
Last_Trailing_Comment_Line => Invalid_Line_Number,
- Non_Grammar => <>);
+ Non_Grammar =>
Non_Grammar_Token_Arrays.Empty_Vector,
+ Inserted_Before =>
Valid_Node_Index_Arrays.Empty_Vector);
begin
+ Data.Last_Terminal_Node := Token.Tree_Index;
+
if Token.ID = Data.Left_Paren_ID then
Data.Current_Paren_State := Data.Current_Paren_State + 1;
@@ -766,18 +828,164 @@ package body Wisi is
Data.Current_Paren_State := Data.Current_Paren_State - 1;
end if;
- Data.Terminals.Append (Temp);
+ Tree.Set_Augmented (Token.Tree_Index, Base_Token_Class_Access
(Temp));
end;
end if;
end Lexer_To_Augmented;
overriding
+ procedure Insert_Token
+ (Data : in out Parse_Data_Type;
+ Tree : in out Syntax_Trees.Tree'Class;
+ Token : in Valid_Node_Index)
+ is
+ use Valid_Node_Index_Arrays;
+
+ Before_Index : constant Token_Index := Tree.Before (Token);
+ Before_Aug : Aug_Token_Var_Ref renames Get_Aug_Token_Var (Data, Tree,
Before_Index);
+
+ -- Set data that allows using Token when computing indent.
+
+ Indent_Line : constant Line_Number_Type :=
+ (if Before_Aug.First
+ then Before_Aug.Line
+ else Invalid_Line_Number);
+
+ -- Set for Insert_After False; see below for True.
+ New_Aug : constant Augmented_Token_Access := new Augmented_Token'
+ (ID => Tree.ID (Token),
+ Tree_Index => Token,
+ Byte_Region => (First | Last =>
Before_Aug.Byte_Region.First),
+ Line => Before_Aug.Line,
+ Column => Before_Aug.Column,
+ Char_Region => (First | Last =>
Before_Aug.Char_Region.First),
+ Deleted => False,
+ First => Before_Aug.First,
+ Paren_State => Before_Aug.Paren_State,
+ First_Terminals_Index => Invalid_Token_Index,
+ Last_Terminals_Index => Invalid_Token_Index,
+ First_Indent_Line => Indent_Line,
+ Last_Indent_Line => Indent_Line,
+ First_Trailing_Comment_Line => Invalid_Line_Number,
+ Last_Trailing_Comment_Line => Invalid_Line_Number,
+ Non_Grammar => Non_Grammar_Token_Arrays.Empty_Vector,
+ Inserted_Before => Valid_Node_Index_Arrays.Empty_Vector);
+
+ Prev_Terminal : constant Node_Index := Tree.Prev_Terminal (Token);
+ -- Invalid_Node_Index if Token is inserted before first grammar token
+
+ Insert_After : Boolean := False;
+ begin
+ Tree.Set_Augmented (Token, Base_Token_Class_Access (New_Aug));
+
+ Append (Before_Aug.Inserted_Before, Token);
+
+ if Prev_Terminal /= Invalid_Node_Index and Before_Aug.First then
+ declare
+ use all type Ada.Containers.Count_Type;
+ use all type Ada.Text_IO.Count;
+
+ -- See test/ada_mode-interactive_2.adb, "Typing ..."; three tests.
+ --
+ -- When typing new code, we want a new blank line to be indented
as
+ -- if the code was there already. To accomplish that, we put the
+ -- inserted tokens at the end of the line before the Before token;
+ -- that will be after the non-grammar on the previous terminal.
+ --
+ -- Compare to test/ada_mode-recover_20.adb. There we are not
typing
+ -- new code, but there is a blank line; the right paren is placed
at
+ -- the end of the blank line, causing the comment to be indented.
+
+ Prev_Aug : Aug_Token_Var_Ref renames Get_Aug_Token_Var (Tree,
Prev_Terminal);
+
+ -- Prev_Aug.Non_Grammar must have at least one New_Line, since
+ -- Before_Aug.First is True. The whitespace after the New_Line is
not
+ -- given a token.
+ --
+ -- If the first two tokens in Prev_Non_Grammar are both New_Lines,
+ -- there is a blank line after the code line (and before any
+ -- comments); assume that is the edit point.
+ Insert_On_Blank_Line : constant Boolean :=
Prev_Aug.Non_Grammar.Length >= 2 and then
+ (Prev_Aug.Non_Grammar (Prev_Aug.Non_Grammar.First_Index).ID =
Data.Descriptor.New_Line_ID and
+ Prev_Aug.Non_Grammar (Prev_Aug.Non_Grammar.First_Index +
1).ID = Data.Descriptor.New_Line_ID);
+
+ -- In Ada, 'end' is Insert_After except when Insert_On_Blank_Line
is
+ -- True (see test/ada_mode-interactive_2.adb Record_1), so
Insert_After
+ -- needs Insert_On_Blank_Line.
+ begin
+ Insert_After := Parse_Data_Type'Class (Data).Insert_After (Tree,
Token, Insert_On_Blank_Line);
+
+ if Insert_After then
+ if Insert_On_Blank_Line then
+ declare
+ Prev_Non_Grammar : constant Non_Grammar_Token :=
+ Prev_Aug.Non_Grammar (Prev_Aug.Non_Grammar.First_Index
+ 1);
+ -- The newline nominally after the inserted token.
+ begin
+ New_Aug.Byte_Region := (First | Last =>
Prev_Non_Grammar.Byte_Region.Last - 1);
+ New_Aug.Char_Region := (First | Last =>
Prev_Non_Grammar.Char_Region.Last - 1);
+
+ New_Aug.First := True;
+ New_Aug.Line := Prev_Non_Grammar.Line;
+ New_Aug.Column := Prev_Aug.Column + Ada.Text_IO.Count
(Length (New_Aug.Char_Region)) - 1;
+
+ New_Aug.First_Indent_Line := Prev_Non_Grammar.Line;
+ New_Aug.Last_Indent_Line := Prev_Non_Grammar.Line;
+
+ for I in Prev_Aug.Non_Grammar.First_Index + 1 ..
Prev_Aug.Non_Grammar.Last_Index loop
+ New_Aug.Non_Grammar.Append (Prev_Aug.Non_Grammar (I));
+ end loop;
+
+ Prev_Aug.Non_Grammar.Set_First_Last
+ (Prev_Aug.Non_Grammar.First_Index,
Prev_Aug.Non_Grammar.First_Index);
+ end;
+ else
+ New_Aug.Byte_Region := (First | Last =>
Prev_Aug.Byte_Region.Last);
+ New_Aug.Char_Region := (First | Last =>
Prev_Aug.Char_Region.Last);
+
+ New_Aug.First := False;
+ New_Aug.Line := Prev_Aug.Line;
+ New_Aug.Column := Prev_Aug.Column + Ada.Text_IO.Count
(Length (Prev_Aug.Char_Region)) - 1;
+
+ New_Aug.First_Indent_Line := Invalid_Line_Number;
+ New_Aug.Last_Indent_Line := Invalid_Line_Number;
+
+ New_Aug.Non_Grammar := Prev_Aug.Non_Grammar;
+ Prev_Aug.Non_Grammar :=
Non_Grammar_Token_Arrays.Empty_Vector;
+
+ end if;
+
+ New_Aug.First_Trailing_Comment_Line :=
Prev_Aug.First_Trailing_Comment_Line;
+ New_Aug.Last_Trailing_Comment_Line :=
Prev_Aug.Last_Trailing_Comment_Line;
+
+ Prev_Aug.First_Trailing_Comment_Line := Invalid_Line_Number;
+ Prev_Aug.Last_Trailing_Comment_Line := Invalid_Line_Number;
+ end if;
+ end;
+ end if;
+
+ if New_Aug.First and not Insert_After then
+ Before_Aug.First := False;
+ Before_Aug.First_Indent_Line := Invalid_Line_Number;
+ Before_Aug.Last_Indent_Line := Invalid_Line_Number;
+ end if;
+
+ if New_Aug.ID = Data.Left_Paren_ID then
+ Adjust_Paren_State (Data, Tree, Before_Index, New_Aug.Line + 1, +1);
+
+ elsif New_Aug.ID = Data.Right_Paren_ID then
+ Adjust_Paren_State (Data, Tree, Before_Index, New_Aug.Line + 1, -1);
+ end if;
+ end Insert_Token;
+
+ overriding
procedure Delete_Token
(Data : in out Parse_Data_Type;
+ Tree : in out Syntax_Trees.Tree'Class;
Deleted_Token_Index : in WisiToken.Token_Index)
is
use all type Ada.Containers.Count_Type;
- Deleted_Token : Augmented_Token renames Data.Terminals
(Deleted_Token_Index);
+ Deleted_Token : Augmented_Token renames Get_Aug_Token_Var (Data,
Tree, Deleted_Token_Index);
Prev_Token_Index : Base_Token_Index := Deleted_Token_Index - 1;
Next_Token_Index : Base_Token_Index := Deleted_Token_Index + 1;
begin
@@ -799,7 +1007,7 @@ package body Wisi is
loop
exit when Prev_Token_Index = Base_Token_Index'First;
- exit when Data.Terminals (Prev_Token_Index).Deleted = False;
+ exit when Get_Aug_Token_Const (Data, Tree,
Prev_Token_Index).Deleted = False;
Prev_Token_Index := Prev_Token_Index - 1;
end loop;
@@ -808,7 +1016,7 @@ package body Wisi is
Data.Leading_Non_Grammar.Append (Deleted_Token.Non_Grammar);
else
declare
- Prev_Token : Augmented_Token renames Data.Terminals
(Prev_Token_Index);
+ Prev_Token : Augmented_Token renames Get_Aug_Token_Var (Data,
Tree, Prev_Token_Index);
begin
Prev_Token.Non_Grammar.Append (Deleted_Token.Non_Grammar);
@@ -824,20 +1032,20 @@ package body Wisi is
-- Data.Terminals.Last_Index is Wisi_EOI; it is never deleted
loop
- exit when Data.Terminals (Next_Token_Index).Deleted = False;
+ exit when Get_Aug_Token_Const (Data, Tree, Next_Token_Index).Deleted
= False;
Next_Token_Index := Next_Token_Index + 1;
exit when Next_Token_Index = Data.Terminals.Last_Index;
end loop;
if Deleted_Token.First and
(Next_Token_Index = Data.Terminals.Last_Index or else
- Data.Terminals (Next_Token_Index).Line > Deleted_Token.Line)
+ Get_Aug_Token_Const (Data, Tree, Next_Token_Index).Line >
Deleted_Token.Line)
then
-- Deleted_Token.Line is now blank; add to previous token non
-- grammar.
if Prev_Token_Index > Base_Token_Index'First then
declare
- Prev_Token : Augmented_Token renames Data.Terminals
(Prev_Token_Index);
+ Prev_Token : Augmented_Token renames Get_Aug_Token_Var (Data,
Tree, Prev_Token_Index);
begin
if Prev_Token.First_Trailing_Comment_Line = Invalid_Line_Number
then
Prev_Token.First_Trailing_Comment_Line := Deleted_Token.Line;
@@ -855,15 +1063,23 @@ package body Wisi is
end if;
if Deleted_Token.First and Next_Token_Index < Data.Terminals.Last_Index
then
- if not Data.Terminals (Next_Token_Index).First then
- declare
- Next_Token : Augmented_Token renames Data.Terminals
(Next_Token_Index);
- begin
+ declare
+ Next_Token : Augmented_Token renames Get_Aug_Token_Var (Data,
Tree, Next_Token_Index);
+ begin
+ if not Next_Token.First then
Next_Token.First := True;
Next_Token.First_Indent_Line := Deleted_Token.First_Indent_Line;
Next_Token.Last_Indent_Line := Deleted_Token.Last_Indent_Line;
- end;
- end if;
+ end if;
+ end;
+ end if;
+
+ if Deleted_Token.ID = Data.Left_Paren_ID then
+ Adjust_Paren_State (Data, Tree, Deleted_Token_Index + 1,
Deleted_Token.Line + 1, -1);
+
+ elsif Deleted_Token.ID = Data.Right_Paren_ID then
+ Adjust_Paren_State (Data, Tree, Deleted_Token_Index + 1,
Deleted_Token.Line + 1, +1);
+
end if;
end Delete_Token;
@@ -871,8 +1087,8 @@ package body Wisi is
procedure Reduce
(Data : in out Parse_Data_Type;
Tree : in out Syntax_Trees.Tree'Class;
- Nonterm : in Syntax_Trees.Valid_Node_Index;
- Tokens : in Syntax_Trees.Valid_Node_Index_Array)
+ Nonterm : in Valid_Node_Index;
+ Tokens : in Valid_Node_Index_Array)
is
Aug_Nonterm : constant Augmented_Token_Access := new Augmented_Token'
(ID => Tree.ID (Nonterm),
@@ -885,73 +1101,70 @@ package body Wisi is
for I in reverse Tokens'Range loop
-- 'reverse' to find token containing trailing comments; last
- -- non-virtual and non-empty token.
- if Tree.Byte_Region (Tokens (I)) /= Null_Buffer_Region then
- -- Token not entirely virtual
- declare
- Aug_Token : constant Aug_Token_Ref := Get_Aug_Token (Data,
Tree, Tokens (I));
- begin
+ -- non-empty token.
+ declare
+ Aug_Token : Aug_Token_Const_Ref renames Get_Aug_Token_Const_1
(Tree, Tokens (I));
+ begin
- if Data.Post_Parse_Action = Indent then
- if Aug_Token.First_Terminals_Index /=
Augmented_Token_Arrays.No_Index then
- Aug_Nonterm.First_Terminals_Index :=
Aug_Token.First_Terminals_Index;
- end if;
+ if Data.Post_Parse_Action = Indent then
+ if Aug_Token.First_Terminals_Index /= Invalid_Token_Index then
+ Aug_Nonterm.First_Terminals_Index :=
Aug_Token.First_Terminals_Index;
+ end if;
- if Aug_Nonterm.Last_Terminals_Index =
Augmented_Token_Arrays.No_Index then
- Aug_Nonterm.Last_Terminals_Index :=
Aug_Token.Last_Terminals_Index;
- end if;
+ if Aug_Nonterm.Last_Terminals_Index = Invalid_Token_Index then
+ Aug_Nonterm.Last_Terminals_Index :=
Aug_Token.Last_Terminals_Index;
+ end if;
- Aug_Nonterm.First := Aug_Nonterm.First or Aug_Token.First;
+ Aug_Nonterm.First := Aug_Nonterm.First or Aug_Token.First;
- if Aug_Token.First_Indent_Line /= Invalid_Line_Number then
- Aug_Nonterm.First_Indent_Line :=
Aug_Token.First_Indent_Line;
- elsif Trailing_Comment_Done and
Aug_Token.First_Trailing_Comment_Line /= Invalid_Line_Number then
- Aug_Nonterm.First_Indent_Line :=
Aug_Token.First_Trailing_Comment_Line;
- end if;
+ if Aug_Token.First_Indent_Line /= Invalid_Line_Number then
+ Aug_Nonterm.First_Indent_Line := Aug_Token.First_Indent_Line;
+ elsif Trailing_Comment_Done and
Aug_Token.First_Trailing_Comment_Line /= Invalid_Line_Number then
+ Aug_Nonterm.First_Indent_Line :=
Aug_Token.First_Trailing_Comment_Line;
+ end if;
- if Aug_Nonterm.Last_Indent_Line = Invalid_Line_Number then
- if Trailing_Comment_Done and
Aug_Token.Last_Trailing_Comment_Line /= Invalid_Line_Number then
- Aug_Nonterm.Last_Indent_Line :=
Aug_Token.Last_Trailing_Comment_Line;
- elsif Aug_Token.Last_Indent_Line /= Invalid_Line_Number
then
- Aug_Nonterm.Last_Indent_Line :=
Aug_Token.Last_Indent_Line;
- end if;
+ if Aug_Nonterm.Last_Indent_Line = Invalid_Line_Number then
+ if Trailing_Comment_Done and
Aug_Token.Last_Trailing_Comment_Line /= Invalid_Line_Number then
+ Aug_Nonterm.Last_Indent_Line :=
Aug_Token.Last_Trailing_Comment_Line;
+ elsif Aug_Token.Last_Indent_Line /= Invalid_Line_Number then
+ Aug_Nonterm.Last_Indent_Line :=
Aug_Token.Last_Indent_Line;
end if;
+ end if;
- if not Trailing_Comment_Done then
- Aug_Nonterm.First_Trailing_Comment_Line :=
Aug_Token.First_Trailing_Comment_Line;
- Aug_Nonterm.Last_Trailing_Comment_Line :=
Aug_Token.Last_Trailing_Comment_Line;
- Trailing_Comment_Done := True;
- end if;
+ if not Trailing_Comment_Done then
+ Aug_Nonterm.First_Trailing_Comment_Line :=
Aug_Token.First_Trailing_Comment_Line;
+ Aug_Nonterm.Last_Trailing_Comment_Line :=
Aug_Token.Last_Trailing_Comment_Line;
+ Trailing_Comment_Done := True;
+ end if;
- end if; -- Compute_Indent
+ end if; -- Compute_Indent
- if Aug_Token.Line /= Invalid_Line_Number then
- Aug_Nonterm.Line := Aug_Token.Line;
- Aug_Nonterm.Column := Aug_Token.Column;
- end if;
+ if Aug_Token.Line /= Invalid_Line_Number then
+ Aug_Nonterm.Line := Aug_Token.Line;
+ Aug_Nonterm.Column := Aug_Token.Column;
+ end if;
- if Aug_Nonterm.Char_Region.First > Aug_Token.Char_Region.First
then
- Aug_Nonterm.Char_Region.First := Aug_Token.Char_Region.First;
- end if;
+ if Aug_Nonterm.Char_Region.First > Aug_Token.Char_Region.First then
+ Aug_Nonterm.Char_Region.First := Aug_Token.Char_Region.First;
+ end if;
- if Aug_Nonterm.Char_Region.Last < Aug_Token.Char_Region.Last
then
- Aug_Nonterm.Char_Region.Last := Aug_Token.Char_Region.Last;
- end if;
+ if Aug_Nonterm.Char_Region.Last < Aug_Token.Char_Region.Last then
+ Aug_Nonterm.Char_Region.Last := Aug_Token.Char_Region.Last;
+ end if;
- Aug_Nonterm.Paren_State := Aug_Token.Paren_State;
- end;
- end if; -- Aug_Token not virtual
+ Aug_Nonterm.Paren_State := Aug_Token.Paren_State;
+ end;
end loop;
end Reduce;
procedure Statement_Action
(Data : in out Parse_Data_Type;
Tree : in Syntax_Trees.Tree;
- Nonterm : in Syntax_Trees.Valid_Node_Index;
- Tokens : in Syntax_Trees.Valid_Node_Index_Array;
+ Nonterm : in Valid_Node_Index;
+ Tokens : in Valid_Node_Index_Array;
Params : in Statement_Param_Array)
is
- Nonterm_Tok : constant Aug_Token_Ref := Get_Aug_Token (Data,
Tree, Nonterm);
+ Nonterm_Tok : Aug_Token_Const_Ref renames Get_Aug_Token_Const_1
(Tree, Nonterm);
First_Item : Boolean := True;
Start_Set : Boolean := False;
Override_Start_Set : Boolean := False;
@@ -971,11 +1184,12 @@ package body Wisi is
elsif Tree.Byte_Region (Tokens (Pair.Index)) /= Null_Buffer_Region
then
declare
use all type WisiToken.Syntax_Trees.Node_Label;
- Token : constant Aug_Token_Ref :=
- (if Pair.Class = Statement_End and then
- Tree.Label (Tokens (Pair.Index)) =
WisiToken.Syntax_Trees.Nonterm
- then To_Aug_Token_Ref (Data.Terminals
(Tree.Max_Terminal_Index (Tokens (Pair.Index))))
- else Get_Aug_Token (Data, Tree, Tokens (Pair.Index)));
+ Token : Aug_Token_Const_Ref renames Get_Aug_Token_Const_1
+ (Tree,
+ (if Pair.Class = Statement_End and then
+ Tree.Label (Tokens (Pair.Index)) =
WisiToken.Syntax_Trees.Nonterm
+ then Tree.Last_Terminal (Tokens (Pair.Index))
+ else Tokens (Pair.Index)));
Cache_Pos : constant Buffer_Pos :=
Token.Char_Region.First;
Cursor : Navigate_Cache_Trees.Cursor :=
Navigate_Cache_Trees.Find
@@ -1062,15 +1276,15 @@ package body Wisi is
procedure Name_Action
(Data : in out Parse_Data_Type;
Tree : in WisiToken.Syntax_Trees.Tree;
- Nonterm : in Syntax_Trees.Valid_Node_Index;
- Tokens : in WisiToken.Syntax_Trees.Valid_Node_Index_Array;
+ Nonterm : in Valid_Node_Index;
+ Tokens : in WisiToken.Valid_Node_Index_Array;
Name : in WisiToken.Positive_Index_Type)
is
use all type WisiToken.Syntax_Trees.Node_Label;
begin
if not (Name in Tokens'Range) then
declare
- Token : constant Aug_Token_Ref := Get_Aug_Token (Data, Tree,
Tokens (Tokens'First));
+ Token : Aug_Token_Const_Ref renames Get_Aug_Token_Const_1 (Tree,
Tokens (Tokens'First));
begin
raise Fatal_Error with Error_Message
(File_Name => Data.Lexer.File_Name,
@@ -1078,7 +1292,7 @@ package body Wisi is
Column => Token.Column,
Message => "wisi-name-action: " & Trimmed_Image
(Tree.Production_ID (Nonterm)) & " name (" &
Trimmed_Image (Name) & ") not in Tokens range (" &
SAL.Peek_Type'Image (Tokens'First) & " .." &
- SAL.Peek_Type'Image (Tokens'Last) & "); bad grammar
action.");
+ SAL.Peek_Type'Image (Tokens'Last) & "); bad grammar action.");
end;
end if;
@@ -1088,7 +1302,7 @@ package body Wisi is
declare
use Name_Cache_Trees;
- Name_Token : constant Aug_Token_Ref := Get_Aug_Token (Data,
Tree, Tokens (Name));
+ Name_Token : Aug_Token_Const_Ref renames Get_Aug_Token_Const_1 (Tree,
Tokens (Name));
Cursor : constant Name_Cache_Trees.Cursor := Find
(Data.Name_Caches.Iterate, Name_Token.Char_Region.First,
Direction => Name_Cache_Trees.Unknown);
@@ -1110,8 +1324,8 @@ package body Wisi is
procedure Motion_Action
(Data : in out Parse_Data_Type;
Tree : in Syntax_Trees.Tree;
- Nonterm : in Syntax_Trees.Valid_Node_Index;
- Tokens : in Syntax_Trees.Valid_Node_Index_Array;
+ Nonterm : in Valid_Node_Index;
+ Tokens : in Valid_Node_Index_Array;
Params : in Motion_Param_Array)
is
use Navigate_Cache_Trees;
@@ -1130,7 +1344,7 @@ package body Wisi is
if Tree.Byte_Region (Tokens (Param.Index)) /= Null_Buffer_Region then
declare
use all type WisiToken.Syntax_Trees.Node_Label;
- Token : constant Aug_Token_Ref := Get_Aug_Token (Data, Tree,
Tokens (Param.Index));
+ Token : Aug_Token_Const_Ref renames Get_Aug_Token_Const_1
(Tree, Tokens (Param.Index));
Region : constant Buffer_Region := Token.Char_Region;
Skip : Boolean := False;
begin
@@ -1221,8 +1435,8 @@ package body Wisi is
procedure Face_Apply_Action
(Data : in out Parse_Data_Type;
Tree : in Syntax_Trees.Tree;
- Nonterm : in Syntax_Trees.Valid_Node_Index;
- Tokens : in Syntax_Trees.Valid_Node_Index_Array;
+ Nonterm : in Valid_Node_Index;
+ Tokens : in Valid_Node_Index_Array;
Params : in Face_Apply_Param_Array)
is
pragma Unreferenced (Nonterm);
@@ -1236,7 +1450,7 @@ package body Wisi is
for Param of Params loop
if Tree.Byte_Region (Tokens (Param.Index)) /= Null_Buffer_Region then
declare
- Token : constant Aug_Token_Ref := Get_Aug_Token (Data, Tree,
Tokens (Param.Index));
+ Token : Aug_Token_Const_Ref renames Get_Aug_Token_Const_1
(Tree, Tokens (Param.Index));
begin
Cache_Cur := Find (Iter, Token.Char_Region.First, Direction =>
Ascending);
if Has_Element (Cache_Cur) then
@@ -1276,8 +1490,8 @@ package body Wisi is
procedure Face_Apply_List_Action
(Data : in out Parse_Data_Type;
Tree : in Syntax_Trees.Tree;
- Nonterm : in Syntax_Trees.Valid_Node_Index;
- Tokens : in Syntax_Trees.Valid_Node_Index_Array;
+ Nonterm : in Valid_Node_Index;
+ Tokens : in Valid_Node_Index_Array;
Params : in Face_Apply_Param_Array)
is
pragma Unreferenced (Nonterm);
@@ -1289,7 +1503,7 @@ package body Wisi is
for Param of Params loop
if Tree.Byte_Region (Tokens (Param.Index)) /= Null_Buffer_Region then
declare
- Token : constant Aug_Token_Ref := Get_Aug_Token (Data, Tree,
Tokens (Param.Index));
+ Token : Aug_Token_Const_Ref renames Get_Aug_Token_Const_1
(Tree, Tokens (Param.Index));
begin
Cache_Cur := Find_In_Range (Iter, Ascending,
Token.Char_Region.First, Token.Char_Region.Last);
loop
@@ -1316,8 +1530,8 @@ package body Wisi is
procedure Face_Mark_Action
(Data : in out Parse_Data_Type;
Tree : in Syntax_Trees.Tree;
- Nonterm : in Syntax_Trees.Valid_Node_Index;
- Tokens : in Syntax_Trees.Valid_Node_Index_Array;
+ Nonterm : in Valid_Node_Index;
+ Tokens : in Valid_Node_Index_Array;
Params : in Face_Mark_Param_Array)
is
pragma Unreferenced (Nonterm);
@@ -1330,7 +1544,7 @@ package body Wisi is
for Param of Params loop
if Tree.Byte_Region (Tokens (Param.Index)) /= Null_Buffer_Region then
declare
- Token : constant Aug_Token_Ref := Get_Aug_Token (Data, Tree,
Tokens (Param.Index));
+ Token : Aug_Token_Const_Ref renames Get_Aug_Token_Const_1
(Tree, Tokens (Param.Index));
begin
Cache_Cur := Find (Iter, Token.Char_Region.First, Direction =>
Ascending);
if Has_Element (Cache_Cur) then
@@ -1362,8 +1576,8 @@ package body Wisi is
procedure Face_Remove_Action
(Data : in out Parse_Data_Type;
Tree : in Syntax_Trees.Tree;
- Nonterm : in Syntax_Trees.Valid_Node_Index;
- Tokens : in Syntax_Trees.Valid_Node_Index_Array;
+ Nonterm : in Valid_Node_Index;
+ Tokens : in Valid_Node_Index_Array;
Params : in Face_Remove_Param_Array)
is
pragma Unreferenced (Nonterm);
@@ -1376,7 +1590,7 @@ package body Wisi is
for I of Params loop
if Tree.Byte_Region (Tokens (I)) /= Null_Buffer_Region then
declare
- Token : constant Aug_Token_Ref := Get_Aug_Token (Data, Tree,
Tokens (I));
+ Token : Aug_Token_Const_Ref renames Get_Aug_Token_Const_1
(Tree, Tokens (I));
begin
Cache_Cur := Find_In_Range (Iter, Ascending,
Token.Char_Region.First, Token.Char_Region.Last);
loop
@@ -1444,8 +1658,8 @@ package body Wisi is
procedure Indent_Action_0
(Data : in out Parse_Data_Type'Class;
Tree : in Syntax_Trees.Tree;
- Nonterm : in Syntax_Trees.Valid_Node_Index;
- Tokens : in Syntax_Trees.Valid_Node_Index_Array;
+ Nonterm : in Valid_Node_Index;
+ Tokens : in Valid_Node_Index_Array;
Params : in Indent_Param_Array)
is begin
if Trace_Action > Outline then
@@ -1453,14 +1667,14 @@ package body Wisi is
end if;
for I in Tokens'Range loop
- if Tree.Byte_Region (Tokens (I)) /= Null_Buffer_Region and
+ if (Tree.Is_Virtual_Terminal (Tokens (I)) or
+ Tree.Byte_Region (Tokens (I)) /= Null_Buffer_Region) and
I in Params'Range -- in some translated EBNF, not every token has
an indent param
then
declare
- use all type WisiToken.Syntax_Trees.Node_Index;
use all type SAL.Base_Peek_Type;
- Tree_Token : constant Syntax_Trees.Valid_Node_Index :=
Tokens (I);
- Token : constant Aug_Token_Ref :=
Get_Aug_Token (Data, Tree, Tree_Token);
+ Tree_Token : constant Valid_Node_Index := Tokens (I);
+ Token : Aug_Token_Const_Ref renames
Get_Aug_Token_Const_1 (Tree, Tree_Token);
Pair : Indent_Pair renames Params (I);
Code_Delta : Delta_Type;
Comment_Param : Indent_Param;
@@ -1476,7 +1690,7 @@ package body Wisi is
Code_Delta := Indent_Compute_Delta
(Data, Tree, Tokens, Pair.Code_Delta, Tree_Token,
Indenting_Comment => False);
- Indent_Token_1 (Data, Token, Code_Delta, Indenting_Comment
=> False);
+ Indent_Token_1 (Data, Tree, Token, Code_Delta,
Indenting_Comment => False);
end if;
if Token.First_Trailing_Comment_Line /= Invalid_Line_Number then
@@ -1494,7 +1708,7 @@ package body Wisi is
Comment_Delta := Indent_Compute_Delta
(Data, Tree, Tokens, Comment_Param, Tree_Token,
Indenting_Comment => True);
- Indent_Token_1 (Data, Token, Comment_Delta,
Indenting_Comment => True);
+ Indent_Token_1 (Data, Tree, Token, Comment_Delta,
Indenting_Comment => True);
end if;
end if;
end;
@@ -1505,28 +1719,30 @@ package body Wisi is
procedure Indent_Action_1
(Data : in out Parse_Data_Type'Class;
Tree : in Syntax_Trees.Tree;
- Nonterm : in Syntax_Trees.Valid_Node_Index;
- Tokens : in Syntax_Trees.Valid_Node_Index_Array;
+ Nonterm : in Valid_Node_Index;
+ Tokens : in Valid_Node_Index_Array;
N : in Positive_Index_Type;
Params : in Indent_Param_Array)
is
use all type Syntax_Trees.Node_Label;
begin
for I in Tokens'First .. N loop
- if Tree.Label (Tokens (I)) /= Virtual_Terminal and then
- Get_Aug_Token (Data, Tree, Tokens (I)).First
- then
- Indent_Action_0 (Data, Tree, Nonterm, Tokens, Params);
- return;
- end if;
+ declare
+ Aug : Aug_Token_Const_Ref renames Wisi.Get_Aug_Token_Const_1
(Tree, Tokens (I));
+ begin
+ if Tree.Label (Tokens (I)) /= Virtual_Terminal and then Aug.First
then
+ Indent_Action_0 (Data, Tree, Nonterm, Tokens, Params);
+ return;
+ end if;
+ end;
end loop;
end Indent_Action_1;
function Indent_Hanging_1
(Data : in out Parse_Data_Type;
Tree : in Syntax_Trees.Tree;
- Tokens : in Syntax_Trees.Valid_Node_Index_Array;
- Tree_Indenting : in Syntax_Trees.Valid_Node_Index;
+ Tokens : in Valid_Node_Index_Array;
+ Tree_Indenting : in Valid_Node_Index;
Indenting_Comment : in Boolean;
Delta_1 : in Simple_Indent_Param;
Delta_2 : in Simple_Indent_Param;
@@ -1534,7 +1750,7 @@ package body Wisi is
Accumulate : in Boolean)
return Delta_Type
is
- Indenting_Token : constant Aug_Token_Ref := Get_Aug_Token (Data, Tree,
Tree_Indenting);
+ Indenting_Token : Aug_Token_Const_Ref renames Get_Aug_Token_Const_1
(Tree, Tree_Indenting);
begin
if Indenting_Comment then
return Indent_Compute_Delta
@@ -1570,11 +1786,12 @@ package body Wisi is
is
use all type Ada.Containers.Count_Type;
- Last_Term : constant Base_Token_Index := Parser.Tree.Max_Terminal_Index
(Parser.Tree.Root);
+ Last_Term : constant Node_Index := Parser.Tree.Last_Terminal
(Parser.Tree.Root);
function Get_Last_Char_Pos return Buffer_Pos
is begin
- if Parser.Terminals.Length = 0 then
+
+ if Last_Term = Invalid_Node_Index then
-- All comments, or empty
if Data.Leading_Non_Grammar.Length > 0 then
return Data.Leading_Non_Grammar
(Data.Leading_Non_Grammar.Last_Index).Char_Region.Last;
@@ -1582,21 +1799,15 @@ package body Wisi is
return Buffer_Pos'First;
end if;
else
- if Last_Term = Invalid_Token_Index then
- -- All grammar tokens inserted by recover
- if Data.Leading_Non_Grammar.Length > 0 then
- return Data.Leading_Non_Grammar
(Data.Leading_Non_Grammar.Last_Index).Char_Region.Last;
- else
- return Buffer_Pos'First;
- end if;
- else
- if Data.Terminals (Last_Term).Non_Grammar.Length > 0 then
- return Data.Terminals (Last_Term).Non_Grammar
- (Data.Terminals
(Last_Term).Non_Grammar.Last_Index).Char_Region.Last;
+ declare
+ Aug : Aug_Token_Const_Ref renames Get_Aug_Token_Const_1
(Parser.Tree, Last_Term);
+ begin
+ if Aug.Non_Grammar.Length = 0 then
+ return Aug.Char_Region.Last;
else
- return Parser.Terminals (Last_Term).Char_Region.Last;
+ return Aug.Non_Grammar
(Aug.Non_Grammar.Last_Index).Char_Region.Last;
end if;
- end if;
+ end;
end if;
end Get_Last_Char_Pos;
@@ -1604,11 +1815,11 @@ package body Wisi is
function Get_Last_Line return Line_Number_Type
is begin
- for I in Data.Line_Begin_Pos.First_Index ..
Data.Line_Begin_Pos.Last_Index loop
- if Data.Line_Begin_Pos (I) = Invalid_Buffer_Pos then
+ for I in Data.Line_Begin_Char_Pos.First_Index ..
Data.Line_Begin_Char_Pos.Last_Index loop
+ if Data.Line_Begin_Char_Pos (I) = Invalid_Buffer_Pos then
raise SAL.Programmer_Error with "line_begin_pos" &
Line_Number_Type'Image (I) & " invalid";
end if;
- if Data.Line_Begin_Pos (I) > Last_Char_Pos then
+ if Data.Line_Begin_Char_Pos (I) > Last_Char_Pos then
if I > Line_Number_Type'First then
return I - 1;
else
@@ -1616,7 +1827,7 @@ package body Wisi is
end if;
end if;
end loop;
- return Data.Line_Begin_Pos.Last_Index;
+ return Data.Line_Begin_Char_Pos.Last_Index;
end Get_Last_Line;
begin
@@ -1694,7 +1905,7 @@ package body Wisi is
use Ada.Text_IO;
use Semantic_Checks;
- function Safe_Pos (Node : in Syntax_Trees.Valid_Node_Index) return
Buffer_Pos
+ function Safe_Pos (Node : in Valid_Node_Index) return Buffer_Pos
is
-- Return a reasonable position for the error at Node.
--
@@ -1712,7 +1923,7 @@ package body Wisi is
loop
if Tree.Label (N) /= Virtual_Terminal then
declare
- Ref : constant Aug_Token_Ref := Get_Aug_Token (Data, Tree,
N);
+ Ref : Aug_Token_Const_Ref renames Get_Aug_Token_Const_1
(Tree, N);
begin
if Ref.Char_Region /= Null_Buffer_Region then
return Ref.Element.Char_Region.First;
@@ -1758,7 +1969,7 @@ package body Wisi is
when Ok => "",
when Error =>
Buffer_Pos'Image (Safe_Pos
(Item.Check_Status.Begin_Name)) &
- Buffer_Pos'Image (Safe_Pos (Item.Check_Status.End_Name)) &
+ Buffer_Pos'Image (Safe_Pos
(Item.Check_Status.End_Name)) &
" ""block name error""]"));
when Parse.LR.Message =>
@@ -1768,7 +1979,7 @@ package body Wisi is
end case;
if Item.Recover.Stack.Depth > 0 then
- Put (Item.Recover, Data.Terminals, Data.Descriptor.all,
Data.Embedded_Quote_Escape_Doubled);
+ Put (Item.Recover, Data, Tree);
end if;
end loop;
end Put;
@@ -1810,24 +2021,9 @@ package body Wisi is
Offset : in Integer)
return Integer
is begin
- return Offset + Integer (Anchor_Token.Char_Region.First -
Data.Line_Begin_Pos (Anchor_Token.Line));
+ return Offset + Integer (Anchor_Token.Char_Region.First -
Data.Line_Begin_Char_Pos (Anchor_Token.Line));
end Current_Indent_Offset;
- function Find
- (Data : in Parse_Data_Type;
- ID : in Token_ID;
- Token : in Augmented_Token'Class)
- return Base_Token_Index
- is begin
- -- linear search for ID.
- for I in Token.First_Terminals_Index .. Token.Last_Terminals_Index loop
- if Data.Terminals (I).ID = ID then
- return I;
- end if;
- end loop;
- return Augmented_Token_Arrays.No_Index;
- end Find;
-
function First_Line
(Token : in Augmented_Token;
Indenting_Comment : in Boolean)
@@ -1844,26 +2040,44 @@ package body Wisi is
else Token.First_Indent_Line));
end First_Line;
- function Get_Aug_Token
- (Data : in Parse_Data_Type'Class;
- Tree : in Syntax_Trees.Tree'Class;
- Tree_Index : in Syntax_Trees.Valid_Node_Index)
- return Aug_Token_Ref
- is
- use all type Syntax_Trees.Node_Label;
- begin
- return
- (case Tree.Label (Tree_Index) is
- when Shared_Terminal => To_Aug_Token_Ref (Data.Terminals
(Tree.Terminal (Tree_Index))),
- when Virtual_Terminal => raise SAL.Programmer_Error with
"wisi_runtime.get_aug_token virtual terminal",
- when Virtual_Identifier => raise SAL.Programmer_Error with
"wisi_runtime.get_aug_token virtual identifier",
- when Nonterm => To_Aug_Token_Ref (Tree.Augmented (Tree_Index)));
- end Get_Aug_Token;
+ function Get_Aug_Token_Const_1
+ (Tree : in Syntax_Trees.Tree'Class;
+ Tree_Index : in Valid_Node_Index)
+ return Aug_Token_Const_Ref
+ is begin
+ return To_Aug_Token_Const_Ref (Tree.Augmented (Tree_Index));
+ end Get_Aug_Token_Const_1;
+
+ function Get_Aug_Token_Const
+ (Data : in Parse_Data_Type;
+ Tree : in WisiToken.Syntax_Trees.Tree'Class;
+ Token : in WisiToken.Token_Index)
+ return Aug_Token_Const_Ref
+ is begin
+ return Get_Aug_Token_Const_1 (Tree, Data.Terminals.all
(Token).Tree_Index);
+ end Get_Aug_Token_Const;
+
+ function Get_Aug_Token_Var
+ (Tree : in Syntax_Trees.Tree'Class;
+ Tree_Index : in Valid_Node_Index)
+ return Aug_Token_Var_Ref
+ is begin
+ return To_Aug_Token_Var_Ref (Tree.Augmented (Tree_Index));
+ end Get_Aug_Token_Var;
+
+ function Get_Aug_Token_Var
+ (Data : in Parse_Data_Type;
+ Tree : in WisiToken.Syntax_Trees.Tree'Class;
+ Token : in WisiToken.Token_Index)
+ return Aug_Token_Var_Ref
+ is begin
+ return Get_Aug_Token_Var (Tree, Data.Terminals.all (Token).Tree_Index);
+ end Get_Aug_Token_Var;
function Get_Text
(Data : in Parse_Data_Type;
Tree : in WisiToken.Syntax_Trees.Tree;
- Tree_Index : in WisiToken.Syntax_Trees.Valid_Node_Index)
+ Tree_Index : in WisiToken.Valid_Node_Index)
return String
is
use all type Syntax_Trees.Node_Label;
@@ -1902,7 +2116,7 @@ package body Wisi is
is
ID_Image : constant String := Image (Item.ID, Descriptor);
begin
- if Item.Line /= Invalid_Line_Number and Trace_Action <= Detail then
+ if Item.Line /= Invalid_Line_Number then
return "(" & ID_Image &
Line_Number_Type'Image (Item.Line) & ":" & Trimmed_Image (Integer
(Item.Column)) & ")";
@@ -1970,13 +2184,13 @@ package body Wisi is
function Indent_Compute_Delta
(Data : in out Parse_Data_Type'Class;
Tree : in Syntax_Trees.Tree;
- Tokens : in Syntax_Trees.Valid_Node_Index_Array;
+ Tokens : in Valid_Node_Index_Array;
Param : in Indent_Param;
- Tree_Indenting : in Syntax_Trees.Valid_Node_Index;
+ Tree_Indenting : in Valid_Node_Index;
Indenting_Comment : in Boolean)
return Delta_Type
is
- Indenting_Token : constant Aug_Token_Ref := Get_Aug_Token (Data, Tree,
Tree_Indenting);
+ Indenting_Token : Aug_Token_Const_Ref renames Get_Aug_Token_Const_1
(Tree, Tree_Indenting);
begin
-- Evaluate wisi-anchored*, wisi-hanging*.
case Param.Label is
@@ -1989,19 +2203,41 @@ package body Wisi is
return (Simple, (Int, Param.Param.Int_Delta));
when Anchored_Label =>
- if Indenting_Token.Byte_Region = Null_Buffer_Region or
- Tree.Byte_Region (Tokens (Param.Param.Anchored_Index)) =
Null_Buffer_Region
- then
- -- One of these is an entirely virtual token
- return Null_Delta;
- else
- declare
- Anchor_Token : constant Aug_Token_Ref := Get_Aug_Token
- (Data, Tree, Tokens (Param.Param.Anchored_Index));
- begin
- case Anchored_Label'(Param.Param.Label) is
- when Anchored_0 =>
- -- [2] wisi-anchored
+ declare
+ Anchor_Token : Aug_Token_Const_Ref renames Get_Aug_Token_Const_1
+ (Tree, Tokens (Param.Param.Anchored_Index));
+ begin
+ case Anchored_Label'(Param.Param.Label) is
+ when Anchored_0 =>
+ -- [2] wisi-anchored
+ return Indent_Anchored_2
+ (Data,
+ Anchor_Line => Anchor_Token.Line,
+ Last_Line => Indenting_Token.Last_Line
(Indenting_Comment),
+ Offset => Current_Indent_Offset (Data, Anchor_Token,
Param.Param.Anchored_Delta),
+ Accumulate => True);
+
+ when Anchored_1 =>
+ -- [2] wisi-anchored%
+ return Indent_Anchored_2
+ (Data,
+ Anchor_Line => Anchor_Token.Line,
+ Last_Line => Indenting_Token.Last_Line
(Indenting_Comment),
+ Offset => Paren_In_Anchor_Line (Data, Tree,
Anchor_Token, Param.Param.Anchored_Delta),
+ Accumulate => True);
+
+ when Anchored_2 =>
+ -- [2] wisi-anchored%-
+ return Indent_Anchored_2
+ (Data,
+ Anchor_Line => Anchor_Token.Line,
+ Last_Line => Indenting_Token.Last_Line
(Indenting_Comment),
+ Offset => Paren_In_Anchor_Line (Data, Tree,
Anchor_Token, Param.Param.Anchored_Delta),
+ Accumulate => False);
+
+ when Anchored_3 =>
+ -- [2] wisi-anchored*
+ if Indenting_Token.First then
return Indent_Anchored_2
(Data,
Anchor_Line => Anchor_Token.Line,
@@ -2009,50 +2245,21 @@ package body Wisi is
Offset => Current_Indent_Offset (Data,
Anchor_Token, Param.Param.Anchored_Delta),
Accumulate => True);
- when Anchored_1 =>
- -- [2] wisi-anchored%
- return Indent_Anchored_2
- (Data,
- Anchor_Line => Anchor_Token.Line,
- Last_Line => Indenting_Token.Last_Line
(Indenting_Comment),
- Offset => Paren_In_Anchor_Line (Data,
Anchor_Token, Param.Param.Anchored_Delta),
- Accumulate => True);
-
- when Anchored_2 =>
- -- [2] wisi-anchored%-
- return Indent_Anchored_2
- (Data,
- Anchor_Line => Anchor_Token.Line,
- Last_Line => Indenting_Token.Last_Line
(Indenting_Comment),
- Offset => Paren_In_Anchor_Line (Data,
Anchor_Token, Param.Param.Anchored_Delta),
- Accumulate => False);
-
- when Anchored_3 =>
- -- [2] wisi-anchored*
- if Indenting_Token.First then
- return Indent_Anchored_2
- (Data,
- Anchor_Line => Anchor_Token.Line,
- Last_Line => Indenting_Token.Last_Line
(Indenting_Comment),
- Offset => Current_Indent_Offset (Data,
Anchor_Token, Param.Param.Anchored_Delta),
- Accumulate => True);
-
- else
- return Null_Delta;
- end if;
+ else
+ return Null_Delta;
+ end if;
- when Anchored_4 =>
- -- [2] wisi-anchored*-
- return Indent_Anchored_2
- (Data,
- Anchor_Line => Anchor_Token.Line,
- Last_Line => Indenting_Token.Last_Line
(Indenting_Comment),
- Offset => Current_Indent_Offset (Data,
Anchor_Token, Param.Param.Anchored_Delta),
- Accumulate => False);
+ when Anchored_4 =>
+ -- [2] wisi-anchored*-
+ return Indent_Anchored_2
+ (Data,
+ Anchor_Line => Anchor_Token.Line,
+ Last_Line => Indenting_Token.Last_Line
(Indenting_Comment),
+ Offset => Current_Indent_Offset (Data, Anchor_Token,
Param.Param.Anchored_Delta),
+ Accumulate => False);
- end case;
- end;
- end if;
+ end case;
+ end;
when Language =>
return Param.Param.Function_Ptr
@@ -2087,6 +2294,7 @@ package body Wisi is
procedure Indent_Token_1
(Data : in out Parse_Data_Type;
+ Tree : in Syntax_Trees.Tree;
Indenting_Token : in Augmented_Token'Class;
Delta_Indent : in Delta_Type;
Indenting_Comment : in Boolean)
@@ -2127,13 +2335,15 @@ package body Wisi is
end loop;
J := Data.Line_Begin_Token.all (I);
- if Line in Data.Terminals (J).First_Trailing_Comment_Line ..
- Data.Terminals (J).Last_Trailing_Comment_Line
- then
- return J;
- else
- return Invalid_Token_Index;
- end if;
+ declare
+ Aug : Augmented_Token renames Get_Aug_Token_Const (Data,
Tree, J);
+ begin
+ if Line in Aug.First_Trailing_Comment_Line ..
Aug.Last_Trailing_Comment_Line then
+ return J;
+ else
+ return Invalid_Token_Index;
+ end if;
+ end;
end Containing_Token;
Indent : Boolean := True;
@@ -2154,7 +2364,7 @@ package body Wisi is
end loop;
elsif Containing /= Invalid_Token_Index then
- for Tok of Data.Terminals (Containing).Non_Grammar loop
+ for Tok of Get_Aug_Token_Const (Data, Tree,
Containing).Non_Grammar loop
if Tok.Line = Line and then
Tok.ID in Data.First_Comment_ID .. Data.Last_Comment_ID
and then
Tok.Column = 0
diff --git a/wisi.ads b/wisi.ads
index f871888..db37e5d 100644
--- a/wisi.ads
+++ b/wisi.ads
@@ -35,10 +35,14 @@ with WisiToken.Syntax_Trees;
package Wisi is
use all type WisiToken.Base_Buffer_Pos;
+ function Image (Aug : in WisiToken.Base_Token_Class_Access; Descriptor : in
WisiToken.Descriptor) return String;
+ -- For Syntax_Trees.Print_Tree
+
type Post_Parse_Action_Type is (Navigate, Face, Indent);
type Parse_Data_Type
- (Line_Begin_Token : not null access constant
WisiToken.Line_Begin_Token_Vectors.Vector)
+ (Terminals : not null access constant
WisiToken.Base_Token_Arrays.Vector;
+ Line_Begin_Token : not null access constant
WisiToken.Line_Begin_Token_Vectors.Vector)
is new WisiToken.Syntax_Trees.User_Data_Type with private;
procedure Initialize
@@ -63,20 +67,28 @@ package Wisi is
overriding
procedure Lexer_To_Augmented
(Data : in out Parse_Data_Type;
+ Tree : in out WisiToken.Syntax_Trees.Tree'Class;
Token : in WisiToken.Base_Token;
Lexer : not null access WisiToken.Lexer.Instance'Class);
overriding
+ procedure Insert_Token
+ (Data : in out Parse_Data_Type;
+ Tree : in out WisiToken.Syntax_Trees.Tree'Class;
+ Token : in WisiToken.Valid_Node_Index);
+
+ overriding
procedure Delete_Token
(Data : in out Parse_Data_Type;
+ Tree : in out WisiToken.Syntax_Trees.Tree'Class;
Deleted_Token_Index : in WisiToken.Token_Index);
overriding
procedure Reduce
(Data : in out Parse_Data_Type;
Tree : in out WisiToken.Syntax_Trees.Tree'Class;
- Nonterm : in WisiToken.Syntax_Trees.Valid_Node_Index;
- Tokens : in WisiToken.Syntax_Trees.Valid_Node_Index_Array);
+ Nonterm : in WisiToken.Valid_Node_Index;
+ Tokens : in WisiToken.Valid_Node_Index_Array);
type Navigate_Class_Type is (Motion, Statement_End, Statement_Override,
Statement_Start, Misc);
-- Matches [1] wisi-class-list.
@@ -91,16 +103,16 @@ package Wisi is
procedure Statement_Action
(Data : in out Parse_Data_Type;
Tree : in WisiToken.Syntax_Trees.Tree;
- Nonterm : in WisiToken.Syntax_Trees.Valid_Node_Index;
- Tokens : in WisiToken.Syntax_Trees.Valid_Node_Index_Array;
+ Nonterm : in WisiToken.Valid_Node_Index;
+ Tokens : in WisiToken.Valid_Node_Index_Array;
Params : in Statement_Param_Array);
-- Implements [2] wisi-statement-action.
procedure Name_Action
(Data : in out Parse_Data_Type;
Tree : in WisiToken.Syntax_Trees.Tree;
- Nonterm : in WisiToken.Syntax_Trees.Valid_Node_Index;
- Tokens : in WisiToken.Syntax_Trees.Valid_Node_Index_Array;
+ Nonterm : in WisiToken.Valid_Node_Index;
+ Tokens : in WisiToken.Valid_Node_Index_Array;
Name : in WisiToken.Positive_Index_Type);
-- Implements [2] wisi-name-action.
@@ -127,8 +139,8 @@ package Wisi is
procedure Motion_Action
(Data : in out Parse_Data_Type;
Tree : in WisiToken.Syntax_Trees.Tree;
- Nonterm : in WisiToken.Syntax_Trees.Valid_Node_Index;
- Tokens : in WisiToken.Syntax_Trees.Valid_Node_Index_Array;
+ Nonterm : in WisiToken.Valid_Node_Index;
+ Tokens : in WisiToken.Valid_Node_Index_Array;
Params : in Motion_Param_Array);
-- Implements [2] wisi-motion-action.
@@ -143,16 +155,16 @@ package Wisi is
procedure Face_Apply_Action
(Data : in out Parse_Data_Type;
Tree : in WisiToken.Syntax_Trees.Tree;
- Nonterm : in WisiToken.Syntax_Trees.Valid_Node_Index;
- Tokens : in WisiToken.Syntax_Trees.Valid_Node_Index_Array;
+ Nonterm : in WisiToken.Valid_Node_Index;
+ Tokens : in WisiToken.Valid_Node_Index_Array;
Params : in Face_Apply_Param_Array);
-- Implements [2] wisi-face-apply-action.
procedure Face_Apply_List_Action
(Data : in out Parse_Data_Type;
Tree : in WisiToken.Syntax_Trees.Tree;
- Nonterm : in WisiToken.Syntax_Trees.Valid_Node_Index;
- Tokens : in WisiToken.Syntax_Trees.Valid_Node_Index_Array;
+ Nonterm : in WisiToken.Valid_Node_Index;
+ Tokens : in WisiToken.Valid_Node_Index_Array;
Params : in Face_Apply_Param_Array);
-- Implements [2] wisi-face-apply-list-action.
@@ -168,8 +180,8 @@ package Wisi is
procedure Face_Mark_Action
(Data : in out Parse_Data_Type;
Tree : in WisiToken.Syntax_Trees.Tree;
- Nonterm : in WisiToken.Syntax_Trees.Valid_Node_Index;
- Tokens : in WisiToken.Syntax_Trees.Valid_Node_Index_Array;
+ Nonterm : in WisiToken.Valid_Node_Index;
+ Tokens : in WisiToken.Valid_Node_Index_Array;
Params : in Face_Mark_Param_Array);
-- Implements [2] wisi-face-mark-action.
@@ -178,8 +190,8 @@ package Wisi is
procedure Face_Remove_Action
(Data : in out Parse_Data_Type;
Tree : in WisiToken.Syntax_Trees.Tree;
- Nonterm : in WisiToken.Syntax_Trees.Valid_Node_Index;
- Tokens : in WisiToken.Syntax_Trees.Valid_Node_Index_Array;
+ Nonterm : in WisiToken.Valid_Node_Index;
+ Tokens : in WisiToken.Valid_Node_Index_Array;
Params : in Face_Remove_Param_Array);
-- Implements [2] wisi-face-remove-action.
@@ -215,8 +227,8 @@ package Wisi is
type Language_Indent_Function is access function
(Data : in out Parse_Data_Type'Class;
Tree : in WisiToken.Syntax_Trees.Tree;
- Tree_Tokens : in WisiToken.Syntax_Trees.Valid_Node_Index_Array;
- Tree_Indenting : in WisiToken.Syntax_Trees.Valid_Node_Index;
+ Tree_Tokens : in WisiToken.Valid_Node_Index_Array;
+ Tree_Indenting : in WisiToken.Valid_Node_Index;
Indenting_Comment : in Boolean;
Args : in Indent_Arg_Arrays.Vector)
return Delta_Type;
@@ -286,16 +298,16 @@ package Wisi is
procedure Indent_Action_0
(Data : in out Parse_Data_Type'Class;
Tree : in WisiToken.Syntax_Trees.Tree;
- Nonterm : in WisiToken.Syntax_Trees.Valid_Node_Index;
- Tokens : in WisiToken.Syntax_Trees.Valid_Node_Index_Array;
+ Nonterm : in WisiToken.Valid_Node_Index;
+ Tokens : in WisiToken.Valid_Node_Index_Array;
Params : in Indent_Param_Array);
-- Implements [2] wisi-indent-action.
procedure Indent_Action_1
(Data : in out Parse_Data_Type'Class;
Tree : in WisiToken.Syntax_Trees.Tree;
- Nonterm : in WisiToken.Syntax_Trees.Valid_Node_Index;
- Tokens : in WisiToken.Syntax_Trees.Valid_Node_Index_Array;
+ Nonterm : in WisiToken.Valid_Node_Index;
+ Tokens : in WisiToken.Valid_Node_Index_Array;
N : in WisiToken.Positive_Index_Type;
Params : in Indent_Param_Array);
-- Implements [2] wisi-indent-action*.
@@ -303,8 +315,8 @@ package Wisi is
function Indent_Hanging_1
(Data : in out Parse_Data_Type;
Tree : in WisiToken.Syntax_Trees.Tree;
- Tokens : in WisiToken.Syntax_Trees.Valid_Node_Index_Array;
- Tree_Indenting : in WisiToken.Syntax_Trees.Valid_Node_Index;
+ Tokens : in WisiToken.Valid_Node_Index_Array;
+ Tree_Indenting : in WisiToken.Valid_Node_Index;
Indenting_Comment : in Boolean;
Delta_1 : in Simple_Indent_Param;
Delta_2 : in Simple_Indent_Param;
@@ -377,8 +389,8 @@ private
Paren_State : Integer := 0;
-- Parenthesis nesting count, before token.
- First_Terminals_Index : WisiToken.Base_Token_Index :=
WisiToken.Base_Token_Arrays.No_Index;
- -- For virtual tokens, No_Index.
+ First_Terminals_Index : WisiToken.Base_Token_Index :=
WisiToken.Invalid_Token_Index;
+ -- For virtual tokens, Invalid_Token_Index
--
-- For terminal tokens, index of this token in Parser.Terminals.
--
@@ -410,15 +422,25 @@ private
-- For terminals, non-grammar tokens immediately following. For
-- nonterminals, empty.
+ Inserted_Before : WisiToken.Valid_Node_Index_Arrays.Vector;
+ -- Tokens inserted before this token by error recovery.
+
end record;
type Augmented_Token_Access is access all Augmented_Token;
type Augmented_Token_Access_Constant is access constant Augmented_Token;
- type Aug_Token_Ref (Element : access constant Augmented_Token) is null
record with
+
+ type Aug_Token_Const_Ref (Element : not null access constant
Augmented_Token) is null record with
Implicit_Dereference => Element;
- function To_Aug_Token_Ref (Item : in WisiToken.Base_Token_Class_Access)
return Aug_Token_Ref
+ function To_Aug_Token_Const_Ref (Item : in
WisiToken.Base_Token_Class_Access) return Aug_Token_Const_Ref
is (Element => Augmented_Token_Access_Constant (Item));
+ type Aug_Token_Var_Ref (Element : not null access Augmented_Token) is null
record with
+ Implicit_Dereference => Element;
+
+ function To_Aug_Token_Var_Ref (Item : in WisiToken.Base_Token_Class_Access)
return Aug_Token_Var_Ref
+ is (Element => Augmented_Token_Access (Item));
+
overriding
function Image
(Item : in Augmented_Token;
@@ -440,9 +462,12 @@ private
(WisiToken.Token_Index, Augmented_Token, Default_Element => (others =>
<>));
-- Index matches Base_Token_Arrays.
- function To_Aug_Token_Ref (Item : in
Augmented_Token_Arrays.Constant_Reference_Type) return Aug_Token_Ref
+ function To_Aug_Token_Const_Ref (Item : in
Augmented_Token_Arrays.Constant_Reference_Type) return Aug_Token_Const_Ref
is (Element =>
Augmented_Token_Access_Constant'(Item.Element.all'Unchecked_Access));
+ function To_Aug_Token_Var_Ref (Item : in
Augmented_Token_Arrays.Variable_Reference_Type) return Aug_Token_Var_Ref
+ is (Element =>
Augmented_Token_Access'(Item.Element.all'Unchecked_Access));
+
package Line_Paren_Vectors is new SAL.Gen_Unbounded_Definite_Vectors
(WisiToken.Line_Number_Type, Integer, Default_Element => Integer'Last);
package Line_Begin_Pos_Vectors is new SAL.Gen_Unbounded_Definite_Vectors
@@ -523,7 +548,7 @@ private
when Anchor_Int =>
Anchor_Int_IDs : Anchor_ID_Vectors.Vector; -- Largest ID first.
- Anchor_Int_Indent : Integer;
+ Anchor_Int_Indent : Integer; -- Indent for this token.
when Anchored =>
Anchored_ID : Positive;
@@ -543,7 +568,8 @@ private
(Navigate_Cache_Trees.Cursor, Navigate_Cache_Trees."=");
type Parse_Data_Type
- (Line_Begin_Token : not null access constant
WisiToken.Line_Begin_Token_Vectors.Vector)
+ (Terminals : not null access constant
WisiToken.Base_Token_Arrays.Vector;
+ Line_Begin_Token : not null access constant
WisiToken.Line_Begin_Token_Vectors.Vector)
is new WisiToken.Syntax_Trees.User_Data_Type with
record
-- Aux token info
@@ -556,20 +582,20 @@ private
-- Data from parsing
- Terminals : Augmented_Token_Arrays.Vector;
- -- All terminal grammar tokens, in lexical order. Each contains any
- -- immediately following non-grammar tokens. Does not contain
- -- nonterminal or virtual tokens.
+ -- All Augmented_Tokens are stored in the syntax tree.
+ Last_Terminal_Node : WisiToken.Node_Index :=
WisiToken.Invalid_Node_Index;
Leading_Non_Grammar : Non_Grammar_Token_Arrays.Vector;
-- non-grammar tokens before first grammar token.
- Line_Begin_Pos : Line_Begin_Pos_Vectors.Vector;
+ Line_Begin_Char_Pos : Line_Begin_Pos_Vectors.Vector;
-- Character position at the start of the first token on each line.
+ -- Cached from Line_Begin_Token to simplify indent computations.
Line_Paren_State : Line_Paren_Vectors.Vector;
-- Parenthesis nesting state at the start of each line; used by
- -- Indent. Set by Lexer_To_Augmented on New_Line_ID.
+ -- Indent. Set by Lexer_To_Augmented on New_Line_ID, updated by
+ -- Insert_Token, Delete_Token.
Current_Paren_State : Integer;
-- Current parenthesis nesting state; used by Indent. Set by
@@ -665,25 +691,43 @@ private
-- Return offset from beginning of first token on line containing
-- Anchor_Token, to beginning of Anchor_Token, plus Offset.
- function Find
+ function Get_Aug_Token_Const_1
+ (Tree : in WisiToken.Syntax_Trees.Tree'Class;
+ Tree_Index : in WisiToken.Valid_Node_Index)
+ return Aug_Token_Const_Ref;
+ -- WORKAROUND: GNAT Community 2019 can't do the overload resolution
+ -- between the two Get_Aug_Token_Const without an explicit renames,
+ -- so we add _1 to this one.
+
+ function Get_Aug_Token_Const
(Data : in Parse_Data_Type;
- ID : in WisiToken.Token_ID;
- Token : in Augmented_Token'Class)
- return WisiToken.Base_Token_Index;
- -- Return index in Parser.Terminals of first token in
- -- Token.Char_Region with ID. If not found, return
- -- No_Index.
-
- function Get_Aug_Token
- (Data : in Parse_Data_Type'Class;
- Tree : in WisiToken.Syntax_Trees.Tree'Class;
- Tree_Index : in WisiToken.Syntax_Trees.Valid_Node_Index)
- return Aug_Token_Ref;
+ Tree : in WisiToken.Syntax_Trees.Tree'Class;
+ Token : in WisiToken.Token_Index)
+ return Aug_Token_Const_Ref;
+
+ function Get_Aug_Token_Var
+ (Tree : in WisiToken.Syntax_Trees.Tree'Class;
+ Tree_Index : in WisiToken.Valid_Node_Index)
+ return Aug_Token_Var_Ref;
+
+ function Get_Aug_Token_Var
+ (Data : in Parse_Data_Type;
+ Tree : in WisiToken.Syntax_Trees.Tree'Class;
+ Token : in WisiToken.Token_Index)
+ return Aug_Token_Var_Ref;
+
+ -- function Get_First_Terminal
+ -- (Data : in Parse_Data_Type;
+ -- Tree : in WisiToken.Syntax_Trees.Tree'Class;
+ -- Token : in WisiToken.Token_Index)
+ -- return Aug_Token_Const_Ref;
+ -- Return Augmented for first Token.Inserted_Before, or if that is
+ -- empty, for Token.
function Get_Text
(Data : in Parse_Data_Type;
Tree : in WisiToken.Syntax_Trees.Tree;
- Tree_Index : in WisiToken.Syntax_Trees.Valid_Node_Index)
+ Tree_Index : in WisiToken.Valid_Node_Index)
return String;
-- Return text contained by Tree_Index token in source file
-- (lexer.buffer).
@@ -702,14 +746,15 @@ private
function Indent_Compute_Delta
(Data : in out Parse_Data_Type'Class;
Tree : in WisiToken.Syntax_Trees.Tree;
- Tokens : in WisiToken.Syntax_Trees.Valid_Node_Index_Array;
+ Tokens : in WisiToken.Valid_Node_Index_Array;
Param : in Indent_Param;
- Tree_Indenting : in WisiToken.Syntax_Trees.Valid_Node_Index;
+ Tree_Indenting : in WisiToken.Valid_Node_Index;
Indenting_Comment : in Boolean)
return Delta_Type;
procedure Indent_Token_1
(Data : in out Parse_Data_Type;
+ Tree : in WisiToken.Syntax_Trees.Tree;
Indenting_Token : in Augmented_Token'Class;
Delta_Indent : in Delta_Type;
Indenting_Comment : in Boolean);
diff --git a/wisi.el b/wisi.el
index 6cdf2b5..7dce87b 100644
--- a/wisi.el
+++ b/wisi.el
@@ -7,7 +7,7 @@
;; Keywords: parser
;; indentation
;; navigation
-;; Version: 3.0.1
+;; Version: 3.1.0
;; package-requires: ((emacs "25.0") (seq "2.20"))
;; URL: http://stephe-leake.org/ada/wisitoken.html
;;
@@ -197,15 +197,9 @@ If PARSE-RESULT is non-nil, use it instead of calling
`syntax-ppss'."
;; point may be in the middle of a word, so insert newline first,
;; then go back and indent.
(insert "\n")
- (unless (and (wisi-partial-parse-p (line-beginning-position)
(line-end-position))
- (save-excursion (progn (forward-char -1)(looking-back
"begin\\|else" (line-beginning-position)))))
- ;; Partial parse may think 'begin' is just the start of a
- ;; statement, when it's actually part of a larger declaration. So
- ;; don't indent 'begin'. Similarly for 'else'; error recovery will
- ;; probably insert 'if then' immediately before it
- (forward-char -1)
- (funcall indent-line-function)
- (forward-char 1))
+ (forward-char -1)
+ (funcall indent-line-function)
+ (forward-char 1)
(funcall indent-line-function))
;;;; token info cache
@@ -428,9 +422,11 @@ Truncate any region that overlaps POS."
"Force a parse."
(interactive)
(syntax-ppss-flush-cache (point-min)) ;; necessary after edit during
ediff-regions
- (wisi-invalidate-cache 'indent (point-min))
- (wisi-invalidate-cache 'face (point-min))
- (wisi-invalidate-cache 'navigate (point-min))
+ (setq wisi--cached-regions ;; necessary instead of wisi-invalidate after
ediff-regions
+ (list
+ (cons 'face nil)
+ (cons 'navigate nil)
+ (cons 'indent nil)))
(wisi-set-parse-try t 'indent)
(wisi-set-parse-try t 'face)
(wisi-set-parse-try t 'navigate)
@@ -782,7 +778,9 @@ Usefull if the parser appears to be hung."
(with-current-buffer wisi-error-buffer
(setq buffer-read-only nil)
(erase-buffer)
- (setq buffer-read-only t))))
+ (setq buffer-read-only t)
+ (when (get-buffer-window wisi-error-buffer)
+ (delete-window (get-buffer-window wisi-error-buffer))))))
(condition-case-unless-debug err
(save-excursion
@@ -814,6 +812,8 @@ Usefull if the parser appears to be hung."
nil))
(setq wisi-parse-failed t)
;; parser should have stored this error message in parser-error-msgs
+ (when (> wisi-debug 0)
+ (signal (car err) (cdr err)))
)
(error
;; parser failed for other reason
@@ -1439,84 +1439,6 @@ If non-nil, only repair errors in BEG END region."
))
;;; xref integration
-(defconst wisi-xref-ident-regexp "\\([^<]*\\)\\(?:<\\([0-9]+\\)>\\)?"
- "Match line number encoded into identifier by
`wisi-xref-identifier-at-point'.")
-
-(defun wisi-xref-ident-make (identifier &optional other-function)
- "Return an xref-item for IDENTIFIER."
- (let* ((t-prop (get-text-property 0 'xref-identifier identifier))
- ;; If t-prop is non-nil: identifier is from
- ;; identifier-at-point, the desired location is the ’other’
- ;; (spec/body).
- ;;
- ;; If t-prop is nil: identifier is from prompt/completion,
- ;; the line number may be included in the identifier wrapped
- ;; in <>, and the desired location is that line in the current
- ;; file.
- (ident
- (if t-prop
- (substring-no-properties identifier 0 nil)
- (string-match wisi-xref-ident-regexp identifier)
- (match-string 1 identifier)
- ))
- (file
- (if t-prop
- (plist-get t-prop ':file)
- (buffer-file-name)))
- (line
- (if t-prop
- (plist-get t-prop ':line)
- (when (match-string 2 identifier)
- (string-to-number (match-string 2 identifier)))))
- (column
- (if t-prop
- (plist-get t-prop ':column)
- 0))
- )
-
- (if t-prop
- (funcall other-function ident file line column)
-
- (xref-make ident (xref-make-file-location file (or line 1) column))
- )))
-
-(defun wisi-xref-item (identifier)
- "Given IDENTIFIER, return an xref-item, with line, column nil if unknown.
-IDENTIFIER is from a user prompt with completion, or from
-`xref-backend-identifier-at-point'."
- (let* ((t-prop (get-text-property 0 'xref-identifier identifier))
- ;; If t-prop is non-nil: identifier is from
- ;; identifier-at-point.
- ;;
- ;; If t-prop is nil: identifier is from prompt/completion,
- ;; the line number may be included in the identifier
- ;; wrapped in <>.
- (ident
- (if t-prop
- (substring-no-properties identifier 0 nil)
- (string-match wisi-xref-ident-regexp identifier)
- (match-string 1 identifier)
- ))
- (file
- (if t-prop
- (plist-get t-prop ':file)
- (buffer-file-name)))
- (line
- (if t-prop
- (plist-get t-prop ':line)
- (when (match-string 2 identifier)
- (string-to-number (match-string 2 identifier)))))
- (column
- (when t-prop
- (plist-get t-prop ':column)))
- )
-
- (unless (file-name-absolute-p file)
- (setq file (locate-file file compilation-search-path)))
-
- (let ((eieio-skip-typecheck t)) ;; allow line, column nil.
- (xref-make ident (xref-make-file-location file line column)))
- ))
(defun wisi-xref-identifier-at-point ()
(let ((ident (thing-at-point 'symbol)))
@@ -1524,9 +1446,9 @@ IDENTIFIER is from a user prompt with completion, or from
(put-text-property
0 1
'xref-identifier
- (list ':file (buffer-file-name)
- ':line (line-number-at-pos)
- ':column (current-column))
+ (list :file (buffer-file-name)
+ :line (line-number-at-pos)
+ :column (current-column))
ident)
ident)))
@@ -1558,9 +1480,14 @@ IDENTIFIER is from a user prompt with completion, or from
(let ((region (wisi-prev-name-region)))
(buffer-substring-no-properties (car region) (cdr region))))
-(defun wisi-names (append-lines)
+(defconst wisi-names-regexp "\\([^<]*\\)<\\([0-9]+\\)>"
+ "Match line number encoded into identifier by `wisi-names'.")
+
+(defun wisi-names (append-lines alist)
"List of names; each is text from one 'wisi-name property in current buffer.
-If APPEND-LINES is non-nil, each has the line number it occurs on appended."
+If APPEND-LINES is non-nil, each name has the line number it
+occurs on appended. If ALIST is non-nil, the result is an alist
+where the car is a list (FILE LINE COL)."
(when wisi--parser
;; wisi--parser is nil in a non-language buffer, like Makefile
(wisi-validate-cache (point-min) (point-max) t 'navigate)
@@ -1573,13 +1500,19 @@ If APPEND-LINES is non-nil, each has the line number it
occurs on appended."
;; number in the identifier string. This also serves to
;; disambiguate overloaded identifiers in the user interface.
(setq end-pos (next-single-property-change pos 'wisi-name))
- (push
- (if append-lines
- (format "%s<%d>"
- (buffer-substring-no-properties pos end-pos)
- (line-number-at-pos pos))
- (buffer-substring-no-properties pos end-pos))
- table)
+ (let* ((line (line-number-at-pos pos))
+ (summary
+ (if append-lines
+ (format "%s<%d>"
+ (buffer-substring-no-properties pos end-pos)
+ line)
+ (buffer-substring-no-properties pos end-pos))))
+ (if alist
+ (save-excursion
+ (goto-char pos)
+ (push (cons summary (list (buffer-file-name) line
(current-column)))
+ table))
+ (push summary table)))
(setq pos end-pos)
)
table)))
@@ -1758,7 +1691,6 @@ If APPEND-LINES is non-nil, each has the line number it
occurs on appended."
(cons 'navigate nil)
(cons 'indent nil)))
- ;; file local variables may have modified wisi-indent-calculate-functions
(setq wisi-indent-calculate-functions (append
wisi-indent-calculate-functions indent-calculate))
(set (make-local-variable 'indent-line-function) #'wisi-indent-line)
(set (make-local-variable 'indent-region-function) #'wisi-indent-region)
@@ -1773,6 +1705,8 @@ If APPEND-LINES is non-nil, each has the line number it
occurs on appended."
(set (make-local-variable 'comment-indent-function) 'wisi-comment-indent)
+ (add-hook 'completion-at-point-functions #'wisi-completion-at-point -90 t)
+
(add-hook 'hack-local-variables-hook 'wisi-post-local-vars nil t)
)
diff --git a/wisi.info b/wisi.info
new file mode 100644
index 0000000..e338347
--- /dev/null
+++ b/wisi.info
@@ -0,0 +1,1294 @@
+This is wisi.info, produced by makeinfo version 6.7 from wisi.texi.
+
+Copyright (C) 1999 - 2020 Free Software Foundation, Inc.
+
+ Permission is granted to copy, distribute and/or modify this
+ document under the terms of the GNU Free Documentation License,
+ Version 1.3 or any later version published by the Free Software
+ Foundation; with no Invariant Sections, with the Front-Cover texts
+ being "A GNU Manual", and with the Back-Cover Texts as in (a)
+ below. A copy of the license is included in the section entitled
+ "GNU Free Documentation License".
+
+ (a) The FSF's Back-Cover Text is: "You have the freedom to copy and
+ modify this GNU manual. Buying copies from the FSF supports it in
+ developing GNU and promoting software freedom."
+INFO-DIR-SECTION Emacs
+START-INFO-DIR-ENTRY
+* Wisi: (wisi). Error-correcting LR parsers and project integration.
+END-INFO-DIR-ENTRY
+
+
+File: wisi.info, Node: Top, Next: Overview, Up: (dir)
+
+Top
+***
+
+Wisi Version 3.1.0
+
+* Menu:
+
+* Overview::
+* Grammar actions::
+* Project extension::
+* GNU Free Documentation License::
+* Index::
+
+
+File: wisi.info, Node: Overview, Next: Grammar actions, Prev: Top, Up: Top
+
+1 Overview
+**********
+
+"wisi" used to be an acronym, but now it's just a name.
+
+ The wisi package provides an elisp interface to an external parser.
+It assumes the parser generator package WisiToken
+(<http://stephe-leake.org/ada/wisitoken.html>, implemented in Ada), but
+can use any parser that meets the same API. wisi provides several
+grammar actions, to implement indentation, navigating, and syntax
+highlighting (fontification).
+
+ wisi also provides an extension to Emacs 'project.el', providing
+operations useful for compilation and cross-reference.
+
+
+File: wisi.info, Node: Grammar actions, Next: Project extension, Prev:
Overview, Up: Top
+
+2 Grammar Actions
+*****************
+
+Grammar actions are specified in the grammar file, in a nonterminal
+declaration. We assume the user is familiar with parser grammars and
+grammar actions. For example, a simple "if" statement can be declared
+as:
+
+ if_statement
+ : IF expression THEN statements elsif_list ELSE statements END IF
SEMICOLON
+ %((wisi-statement-action [1 statement-start 3 motion 6 motion 10
statement-end])
+ (wisi-motion-action [1 3 5 6 10])
+ (wisi-indent-action [nil
+ [(wisi-hanging% ada-indent-broken (* 2
ada-indent-broken))
+ ada-indent-broken]
+ nil
+ [ada-indent ada-indent] nil nil
+ [ada-indent ada-indent] nil nil nil]))%
+
+ The item before ':' is the "left hand side", or "nonterminal". The
+list of tokens after ':' is the "right hand side"; in general there can
+be more than one right hand side for each nonterminal (separated by
+'|').
+
+ The items enclosed in "%()%" are the grammar actions. They are
+specified as list of elisp forms; an earlier version of the wisi package
+generated an elisp parser. We keep the elisp form because it is
+compact, and easier to read and write than the equivalent Ada code. The
+'wisi-bnf-generate' tool converts the elisp into the required Ada
+statements.
+
+ There are two classes of actions; in-parse and post-parse. WisiToken
+calls these "semantic checks" and "user actions". The in-parse actions
+are done as parsing procedes; they provide extra checks that can cause
+the parse to fail. Currently the only one provided is 'match-names'; it
+is used to check that the declaration and end names in named Ada blocks
+are the same (which can aid significantly in error correction). In the
+grammar file, in-parse actions are specified in a second '%()%' block,
+which can be omitted if empty. In this document, the term "action"
+means "post-parse action", we use "in-parse action" unless the meaning
+is clear from context.
+
+ Executing the wisi grammar actions creates text properties in the
+source file; those text properties are then used by elisp code for
+various purposes.
+
+ The text properties applied are:
+
+'wisi-cache'
+ This should be named 'wisi-navigate', but isn't for historical
+ reasons (there used to be only one kind of text property).
+
+ The property contains a 'wisi-cache' object, containing:
+
+ 'nonterm'
+ The nonterminal in the grammar production that specified the
+ action that produced this text property.
+
+ 'token'
+ A token identifier naming a token in the production right hand
+ side containing the text this text property is applied to.
+
+ 'last'
+ The position of the last character in the token, relative to
+ the first character (0 indexed). The text property is only
+ applied to the first character in the token (mostly for
+ historical reasons).
+
+ 'class'
+ A token class; see the list of possible values in
+ 'wisi-statement-action' below.
+
+ 'containing'
+ A marker pointing to the start of the containing token for
+ this token; only 'nil' for the outermost containing token in a
+ file.
+
+ 'prev'
+ A marker pointing to the previous "motion token" in the
+ statement or declaration. These are normally language
+ keywords, but can be other things.
+
+ 'next'
+ A marker pointing to the next "motion token" in the statement
+ or declaration.
+
+ 'end'
+ A marker pointing to the end of the statement or declaration.
+
+ wisi provides motion commands for going to the various markers.
+
+'wisi-name'
+ Contains no data, applied to a "name" of some sort. wisi provides
+ commands for finding the next/previous name, and returning the
+ text. Useful for the names of subprograms, which can then be used
+ to build a completion table; see
+ 'wisi-xref-identifier-completion-table'.
+
+'font-lock-face'
+ The standard font-lock property, specifying the face for the text.
+
+ Some major modes do not use this for simple keywords; they use
+ font-lock regular expressions instead. One reason for this is so
+ keywords are still highlighted when the parser fails, which can
+ happen if there are severe syntax errors.
+
+ Other items, like function and package names, are typically marked
+ with 'font-lock-face' by the parser.
+
+'fontified'
+ Another standard font-lock text property; applied whenever
+ 'font-lock-face' is.
+
+'wisi-indent'
+ Contains the indent (in characters) for the next line; applied to
+ the newline character on the preceding line. The first line in a
+ buffer is assumed to have indent 0.
+
+ Each action is classified as one of 'navigate, face, indent,
+in-parse'; when actions are executed, only one of the first three
+classes is executed (in-parse is always executed). This reflects the
+reasons the parser is run; to figure out how to go somehere (end of
+current statement, start of current procedure, etc), to apply faces for
+syntax highlighting, or to indent the code.
+
+* Menu:
+
+* Navigate actions::
+* Face actions::
+* Indent actions::
+* In-parse actions::
+
+
+File: wisi.info, Node: Navigate actions, Next: Face actions, Up: Grammar
actions
+
+2.1 Navigate actions
+====================
+
+'wisi-statement-action [TOKEN CLASS ...]'
+ The argument is a vector; alternating items are a token index (an
+ integer or label indicating a token in the right hand side) and a
+ "token class"; one of:
+
+ 'motion'
+ Create a 'wisi-cache' text property on the token, for use in a
+ subsequent 'wisi-motion-action'.
+
+ 'statement-end'
+ Create a 'wisi-cache' text property on the token, enter a
+ pointer to it in the other 'wisi-cache' objects in the
+ statement or declaration.
+
+ 'statement-start'
+ Create a 'wisi-cache' text property on the token, enter a
+ pointer to it in the other 'wisi-cache' objects (in the
+ 'containing' slot) in the statement or declaration.
+
+ 'statement-override'
+ Same as 'statement-start'; marks the token to be used as the
+ statement start if the first token is optional.
+
+ 'misc'
+ Create a 'wisi-cache' text property on the token, to be used
+ for 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
+ distinquishes them from other left parentheses, and makes it
+ possible to automatically call 'ada-format-paramlist' to
+ format the parameter list, instead of using the standard Emacs
+ 'align'.
+
+'wisi-motion-action [TOKEN ...]'
+ The argument is a vector, where each element is either a token
+ index or a vector [INDEX ID].
+
+ Each terminal token must already have a 'wisi-cache' created by a
+ 'wisi-statement-action' (this is checked at action execution, not
+ during grammar generation). This action sets the 'prev, next'
+ slots for the chain of tokens, creating a chain of motion tokens.
+
+ If TOKEN is a nonterminal without an ID specified, the 'wisi-cache'
+ must be on the first token in the nonterminal, and it is assumed to
+ have a valid pointer in the 'next' slot, indicating a chain of
+ motion tokens. That chain is linked into the chain for the current
+ right hand side.
+
+ If TOKEN is a nonterminal with an ID, the region contained by the
+ nonterminal is searched for all 'wisi-cache' with that token ID,
+ and for each one where prev/next is not already set, it is linked
+ into the motion chain.
+
+ Note that the "search" described here is done in the parser
+ process, on a tree data structure containing the data that will
+ eventually be stored in Emacs text properties.
+
+'wisi-name-action TOKEN'
+ TOKEN is a token index. Create a 'wisi-name' text property on the
+ token.
+
+
+File: wisi.info, Node: Face actions, Next: Indent actions, Prev: Navigate
actions, Up: Grammar actions
+
+2.2 Face actions
+================
+
+'wisi-face-mark-action [INDEX CLASS ...]'
+ The argument is a vector; alternating elements form pairs of INDEX
+ CLASS, where class is one of 'prefix, suffix'.
+
+ Mark the tokens as part of a compound name, for use by later face
+ actions.
+
+'wisi-face-apply-action [TOKEN PREFIX-FACE SUFFIX-FACE ...]'
+ The argument is a vector; triples of items specify TOKEN,
+ PREFIX-FACE, SUFFIX-FACE. The faces are the elisp names of face
+ objects (which must declared by an '%elisp_face' declaration).
+
+ If the token is a nonterminal, and it has been marked by a previous
+ 'wisi-face-mark-action', the specified faces are applied to the
+ prefix and suffix in the token as 'font-lock-face' text properties.
+
+ If the token is a terminal, or a non-terminal with no face mark,
+ the suffix face is applied to the entire text contained by the
+ token.
+
+'wisi-face-apply-list-action [TOKEN PREFIX-FACE SUFFIX-FACE ...]'
+ Similar to ’wisi-face-apply-action’, but applies faces to all
+ tokens marked by 'wisi-face-mark-action' in each indicated
+ production token, and does not apply a face if there are no such
+ marks.
+
+
+File: wisi.info, Node: Indent actions, Next: In-parse actions, Prev: Face
actions, Up: Grammar actions
+
+2.3 Indent actions
+==================
+
+Indents are computed for each line in a cumulative way as the grammar
+actions are executed. Initially, each indent is set to 'nil', which
+means "not computed"; this is not the same as the value '0'. The
+grammar actions are executed in a bottom-up fashion; low level
+productions are executed before higher level ones. In general, the
+indent action for a production specifies a "delta indent"; the indent is
+incremented by that amount. When all productions have been processed,
+the indent has been computed for all lines.
+
+ Indents are often given as a function call; the arguments to the
+function can be other function calls, or integer expressions.
+'wisitoken-bnf-generate' supports only simple integer expressions; those
+using integers, integer-valued variables, parenthesis, + (plus), -
+(minus), and * (multiply).
+
+'wisi-indent-action [INDENT ...]'
+ The argument is a vector, giving an indent for each token in the
+ production right-hand side.
+
+ For terminals, the indents only have meaning, and are only
+ computed, if the token is the first on a line. For nonterminals
+ where the indent is not a variant of 'wisi-hanging', the indent is
+ only computed if the first terminal token in the nonterminal is the
+ first on a line. See 'wisi-hanging' in *note Indent functions::
+ for the remaining case.
+
+ An indent can have several forms. In the descriptions below, the
+ "current token" is given by the position of the indent expression
+ in the 'wisi-indent-action' argument list.
+
+ An integer
+ This gives a delta indent; it is added to the total indent for
+ the line.
+
+ A variable name
+ The name is translated to an Ada identifier by replacing "-"
+ with "_", and applying 'Camel_Case'. The translated name must
+ identify a directly visible run-time Ada integer variable;
+ this is checked at Ada compile time. It provides an integer
+ delta indent.
+
+ For example, in Ada two indent variable names are 'ada-indent'
+ and 'ada-indent-broken', giving the basic ident, and the
+ continuation line indent. They are runtime variables so
+ different projects can specify them as part of a coding
+ standard.
+
+ A function call
+ A function that computes a delta indent. See *note Indent
+ functions::.
+
+ [CODE-INDENT , COMMENT-INDENT]
+ A vector giving separate indents for code and comments.
+
+ Normally, the indent for trailing comments (on lines with no
+ code, after all code in the token) is given by the indent of
+ the following token in the production. When the current token
+ is the last, or the following tokens may be empty, or the
+ indent of the following token would be wrong for some reason
+ (for example, it is a block end), the comment indent may be
+ specified separately. If it is not specified, and the indent
+ from the next token is not available, the indent for the
+ current token is used for code and comments.
+
+ Comment lines that are not trailing are indented by
+ CODE-INDENT.
+
+ (label . INDENT)
+ If token labels are used in a right hand side, they must be
+ given explicitly in the indent arguments, using he lisp "cons"
+ syntax. Labels are normally only used with EBNF grammars,
+ which expand into multiple right hand sides, with optional
+ tokens simply left out. Explicit labels on the indent
+ arguments allow them to be left out as well.
+
+* Menu:
+
+* Indent functions::
+* Indent example::
+
+
+File: wisi.info, Node: Indent functions, Next: Indent example, Up: Indent
actions
+
+2.3.1 Indent functions
+----------------------
+
+'wisi-anchored TOKEN OFFSET'
+ Sets the indent for the current token to be OFFSET (an integer
+ expression) from the start of TOKEN (a token index); the current
+ token is "anchored to" TOKEN.
+
+'wisi-anchored* TOKEN OFFSET'
+ Sets the indent for the current token to be OFFSET from the start
+ of TOKEN, but only if TOKEN is the first token on a line; otherwise
+ no indent
+
+'wisi-anchored*- TOKEN OFFSET'
+ Sets the indent for the current token to be OFFSET from the start
+ of TOKEN, but only if TOKEN is the first token on a line and the
+ indent for the current token accumulated so far is nil.
+
+'wisi-anchored% TOKEN OFFSET'
+ If there is an opening parenthesis containing TOKEN in the line
+ containing TOKEN, set the current indent to OFFSET from that
+ parenthesis. Otherwise, OFFSET gives an indent delta.
+
+'wisi-anchored%- TOKEN OFFSET'
+ Same as 'wisi-anchored%', but only if the current token accumulated
+ indent is nil.
+
+'wisi-hanging DELTA-1 DELTA-2'
+ The current token is assumed to be a nonterminal. If the text it
+ contains spans multiple lines, use DELTA-1 for the first line,
+ DELTA-2 for the rest. If the current token is only on one line,
+ use DELTA-1.
+
+ DELTA-1 and DELTA-2 can be any IDENT expression, except a variant
+ of 'wisi-hanging'.
+
+'wisi-hanging% DELTA-1 DELTA-2'
+ Similar to 'wisi-hanging'; if the first terminal token in the
+ current nonterminal is the first token on the first line, use
+ DELTA-1 for the first line and DELTA-2 for the rest. Otherwise,
+ use DELTA-1 for all lines.
+
+'wisi-hanging%- DELTA-1 DELTA-2'
+ Same as 'wisi-hanging%', except applied only if the current token
+ accumulated indent is nil.
+
+'Language-specific function'
+ Language-specific indent functions are specified by an
+ '%elisp_indent' declaration in the grammar file. Each function
+ specifies how many arguments it accepts; this is checked at action
+ runtime, not during grammar generation. Each argument is an INDENT
+ as described above, or a token ID prefixed by ''' (to allow
+ distinguishing token IDs from variable names).
+
+
+File: wisi.info, Node: Indent example, Prev: Indent functions, Up: Indent
actions
+
+2.3.2 Indent example
+--------------------
+
+The example 'if_statement' grammar nonterminal is:
+
+ if_statement
+ : IF expression THEN statements elsif_list ELSE statements END IF
SEMICOLON
+ %((wisi-indent-action [nil
+ [(wisi-hanging% ada-indent-broken (* 2
ada-indent-broken))
+ ada-indent-broken]
+ nil
+ [ada-indent ada-indent] nil nil
+ [ada-indent ada-indent] nil nil nil]))%
+
+ We trace how the indent is computed for this sample Ada code:
+
+ 1: if A < B and
+ 2: C < D
+ 3: -- comment on expression
+ 4: then
+ 5: if E then
+ 6: Do_E;
+ 7: -- comment on statement
+ 8: elsif F then
+ 9: G := A + Compute_Something
+ 10: (arg_1, arg_2);
+ 11: end if;
+ 12: end if;
+
+ First, the indent for the lower-level nonterminals ('expression,
+statements, elsif_list') are computed. Assume they set the indent for
+line 10 to 2 (for the hanging expression) and leave the rest at nil.
+
+ Next, the action for the inner 'if_statement' is executed. Most of
+the tokens specify an indent of 'nil', which means the current
+accumulated indent is not changed. For the others, the action is as
+follows:
+
+'expression:'
+ The expression 'E' is contained on one line, and it is not the
+ first token on that line, so the indent for line 5 is not changed.
+
+'statements: [ada-indent ada-indent]'
+ This specifies separate indents for code and trailing comments,
+ because otherwise the trailing comments would be indented with the
+ following 'THEN'; instead they are indented with the expression
+ code; see the comment on line 7.
+
+ Here 'ada-indent' is 3, so the indent for lines 6 and 7 (for the
+ first occurence of 'statments') is incremented from 'nil' to '3'.
+
+ For the second occurence of 'statements', line 9 is incremented
+ from 'nil' to '3', and line 10 from '2' to '5'.
+
+ At this point, the accumulated indents are (the indent is given after
+the line number):
+ 1: nil : if A < B and
+ 2: nil : C < D
+ 3: nil : -- comment on expression
+ 4: nil : then
+ 5: nil : if E then
+ 6: 3 : Do_E;
+ 7: 3 : -- comment on statement
+ 8: nil : elsif F then
+ 9: 3 : G := A + Compute_Something
+ 10: 5 : (arg_1, arg_2);
+ 11: nil : end if;
+ 12: nil : end if;
+
+ Then the action is executed for the outer 'if_statement':
+
+'expression: [(wisi-hanging% ada-indent-broken (* 2 ada-indent-broken))
ada-indent-broken]'
+ This specifies separate indents for code and trailing comments,
+ because otherwise the trailing comments would be indented with the
+ following 'THEN'; instead they are indented with the expression
+ code; see the comment on line 3.
+
+ In this case, 'wisi-hanging%' returns DELTA-1, which is
+ 'ada-indent-broken', which is 2. So the indent for line 2 is
+ incremented from 'nil' to '2'.
+
+ The indent for line 3 is also incremented from 'nil' to '2'.
+
+'statements: [ada-indent ada-indent]'
+ Here there is only one statement; the nested 'if_statement'. The
+ indent for lines 5 .. 11 are each incremented by 3.
+
+ The final result is:
+ 1: nil : if A < B and
+ 2: 2 : C < D
+ 3: 2 : -- comment on expression
+ 4: nil : then
+ 5: 3 : if E then
+ 6: 6 : Do_E;
+ 7: 6 : -- comment on statement
+ 8: 3 : elsif F then
+ 9: 6 : G := A + Compute_Something
+ 10: 8 : (arg_1, arg_2);
+ 11: 6 : end if;
+ 12: nil : end if;
+
+ In a full grammar, the top production should specify an indent of 0,
+not nil, for tokens that are not indented; then every line will have a
+non-nil indent. However, in normal operation a nil indent is treated as
+0; the 'wisi-indent' text property is not set for lines that have nil
+indent, and 'wisi-indent-region' detects that and uses 0 for the indent.
+You can set the variable 'wisi-debug' to a value > 0 to signal an error
+for nil indents; this is useful to catch indent errors during grammar
+development.
+
+
+File: wisi.info, Node: In-parse actions, Prev: Indent actions, Up: Grammar
actions
+
+2.4 In-parse actions
+====================
+
+'wisi-propagate-name TOKEN'
+ The argument is a token index. Set the 'name' component of the
+ left-hand-side parse-time token object to the 'name' component of
+ the identified token, if it is not empty. Otherwise use the
+ 'byte_region' component.
+
+'wisi-merge-name FIRST-TOKEN, LAST-TOKEN'
+ The arguments are token indices, giving a range of tokens.
+ LAST-TOKEN may be omitted if it is the same as FIRST-TOKEN.
+
+ Set the 'name' component of the left-hand-side to the merger of the
+ 'name' or 'byte-region' components of the identified tokens.
+
+'wisi-match-name START-TOKEN END-TOKEN'
+ The arguments are token indices. Compare the text contained by the
+ 'name' (or 'byte_region' if 'name' is empty) token components for
+ START-TOKEN and END-TOKEN; signal a parse error if they are
+ different.
+
+ The behavior when a name is missing is determined by the runtime
+ language variable given in the '%end_names_optional_option'
+ declaration; if True, a missing name that is supposed to match a
+ present name is an error. Both names missing is not an error
+ (assuming that is allowed by the grammar).
+
+
+File: wisi.info, Node: Project extension, Next: GNU Free Documentation
License, Prev: Grammar actions, Up: Top
+
+3 Project extension
+*******************
+
+wisi defines the 'cl-defstuct' 'wisi-prj', with operations suitable for
+compilation and cross-reference.
+
+ In order to use wisi projects, the user must write project files and
+customize 'project-find-functions' and 'xref-backend-functions'.
+
+* Menu:
+
+* Project files::
+* Selecting projects::
+* Casing exception files::
+* Other project functions::
+
+
+File: wisi.info, Node: Project files, Next: Selecting projects, Up: Project
extension
+
+3.1 Project files
+=================
+
+Project file names must have an extension given by
+'wisi-prj-file-extensions' (default '.adp, .prj').
+
+ Project files have a simple syntax; they may be edited directly.
+Each line specifies a project variable name and its value, separated by
+"=":
+
+ src_dir=/Projects/my_project/src_1
+ src_dir=/Projects/my_project/src_2
+
+ There must be no space between the variable name and "=", and no
+trailing spaces after the value.
+
+ Any line that does not have an "=" is a comment.
+
+ Some variables (like 'src_dir') are lists; each line in the project
+file specifies one element of the list. The value on the last line is
+the last element in the list.
+
+ A variable name that starts with '$' is set as a process environment
+variable, for processes launched from Emacs for the project.
+
+ In values, process environment variables can be referenced using the
+normal '$var' syntax.
+
+ In values, relative file names are expanded relative to the directory
+containing the project file.
+
+ Here is the list of project variables defined by wisi; major modes
+may add more.
+
+'casing' [slot: 'case-exception-files']
+ List of files containing casing exceptions. *Note Casing exception
+ files::.
+
+'src_dir' [slot: 'source-path']
+ A list of directories to search for source files.
+
+
+File: wisi.info, Node: Selecting projects, Next: Casing exception files,
Prev: Project files, Up: Project extension
+
+3.2 Selecting projects
+======================
+
+The current project can either be indicated by a global variable (called
+a "selected project"), or depend on the current buffer.
+
+ In addition, the project file can be parsed each time it is needed,
+or the result cached to improve response time,
+
+ One reason to use a selected project is to handle a hierarchy of
+projects; if projects B and C both depend on library project A, then
+when in a file of project A, there is no way to determine which of the
+three projects to return. So the user must indicate which is active, by
+using one of 'wisi-prj-select-file' or 'wisi-prj-select-cache'.
+
+ In addition, if changing from one project to another requires setting
+global resources that must also be unset (such as a syntax propertize
+hook or compilation filter hook), then the project should define
+'wisi-prj-deselect' in addition to 'wisi-prj-select'. Such projects
+require having a selected current project, so it can be deselected
+before a new one is selected. One example of such projects is ada-mode.
+
+ One way to declare each project is to add a Local Variables section
+in the main Makefile for the project; when the Makefile is first
+visited, the project is declared. In the examples here, we assume that
+approach is used; each gives an :eval line.
+
+ Note that 'wisi-prj-current-parse' and 'wisi-prj-current-cached'
+always succeed after some project is selected; no functions after them
+on 'project-find-functions' will be called. That's why the depth is 90
+for those in the examples.
+
+No caching, current project depends on current buffer
+
+ (add-hook 'project-find-functions #'wisi-prj-find-dominating-parse 0)
+
+ :eval (wisi-prj-set-dominating "foo.prj" (foo-prj-default
"prj-name"))
+
+ 'wisi-prj-set-dominating' declares the name of a project file with
+ a default project object, and ensures that the current buffer file
+ name is in 'wisi-prj--dominating'.
+
+ 'wisi-prj-find-dominating-parse' looks for the filenames in
+ 'wisi-prj--dominiating' in the parent directories of the current
+ buffer. When one is found, the associated project file is parsed,
+ using the default project object to dispatch to the appropriate
+ parsers. Then the final project object is returned.
+
+Caching, current project depends on current buffer
+
+ (add-hook 'project-find-functions #'wisi-prj-find-dominating-cached
0)
+
+ :eval (wisi-prj-cache-dominating "foo.prj" (foo-prj-default
"prj-name"))
+
+ 'wisi-prj-cache-dominating' declares the project file, parses it,
+ and saves the project object in a cache indexed by the absolute
+ project file name.
+
+ 'wisi-prj-find-dominating-cached' finds the dominating project
+ file, and retrieves the object from the cache.
+
+No caching, last selected project is current
+
+ (add-hook 'project-find-functions #'wisi-prj-current-parse 90)
+
+ :eval: (wisi-prj-select-file <prj-file> (foo-prj-default "prj-name"))
+
+ 'wisi-prj-select-file' sets the project file as the current
+ project, and saves the default project object.
+
+ 'wisi-prj-current-parse' parses the current project file, using the
+ saved default project object, and returns the project object.
+
+Caching, last selected project is current
+
+ (add-hook 'project-find-functions #'wisi-prj-current-cached 90)
+
+ :eval: (wisi-prj-select-cache <prj-file> (foo-prj-default
"prj-name"))
+
+ 'wisi-prj-select-cache' parses the project file, caches the project
+ object.
+
+ 'wisi-prj-current-cached' returns the cached current project
+ object.
+
+ In addition, the user should set 'xref-backend-functions'.
+Currently, there is only one choice for wisi projects:
+
+ (add-to-list 'xref-backend-functions #'wisi-prj-xref-backend 90)
+
+ 'wisi-prj-xref-backend' returns the current wisi project object.
+
+
+File: wisi.info, Node: Casing exception files, Next: Other project
functions, Prev: Selecting projects, Up: Project extension
+
+3.3 Casing exception files
+==========================
+
+Each line in a case exception file specifies the casing of one word or
+word fragment. If an exception is defined in multiple files, the first
+occurrence is used.
+
+ If the word starts with an asterisk ('*'), it defines the casing of a
+word fragment (or "substring"); part of a word between two underscores
+or word boundary.
+
+ For example:
+
+ DOD
+ *IO
+ GNAT
+
+ The word fragment '*IO' applies to any word containing "_io";
+'Text_IO', 'Hardware_IO', etc.
+
+
+File: wisi.info, Node: Other project functions, Prev: Casing exception
files, Up: Project extension
+
+3.4 Other project functions
+===========================
+
+'wisi-refresh-prj-cache (not-full)'
+ Refreshes all cached data in the project, and re-selects the
+ project. If NOT-FULL is non-nil, slow refresh operations are
+ skipped.
+
+ This reparses the project file, and any cross reference
+ information.
+
+'wisi-prj-select-dominating (dominating-file)'
+ Find a wisi-prj matching DOMINATING-FILE (defaults to the current
+ buffer file). If the associated project is current, do nothing.
+ If it is not current, select it.
+
+ This is useful before running 'compilation-start', to ensure the
+ correct project is current.
+
+
+File: wisi.info, Node: GNU Free Documentation License, Next: Index, Prev:
Project extension, Up: Top
+
+Appendix A GNU Free Documentation License
+*****************************************
+
+ Version 1.3, 3 November 2008
+
+ Copyright (C) 2000, 2001, 2002, 2007, 2008, 2009 Free Software
Foundation, Inc.
+ <http://fsf.org/>
+
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+ 0. PREAMBLE
+
+ The purpose of this License is to make a manual, textbook, or other
+ functional and useful document "free" in the sense of freedom: to
+ assure everyone the effective freedom to copy and redistribute it,
+ with or without modifying it, either commercially or
+ noncommercially. Secondarily, this License preserves for the
+ author and publisher a way to get credit for their work, while not
+ being considered responsible for modifications made by others.
+
+ This License is a kind of "copyleft", which means that derivative
+ works of the document must themselves be free in the same sense.
+ It complements the GNU General Public License, which is a copyleft
+ license designed for free software.
+
+ We have designed this License in order to use it for manuals for
+ free software, because free software needs free documentation: a
+ free program should come with manuals providing the same freedoms
+ that the software does. But this License is not limited to
+ software manuals; it can be used for any textual work, regardless
+ of subject matter or whether it is published as a printed book. We
+ recommend this License principally for works whose purpose is
+ instruction or reference.
+
+ 1. APPLICABILITY AND DEFINITIONS
+
+ This License applies to any manual or other work, in any medium,
+ that contains a notice placed by the copyright holder saying it can
+ be distributed under the terms of this License. Such a notice
+ grants a world-wide, royalty-free license, unlimited in duration,
+ to use that work under the conditions stated herein. The
+ "Document", below, refers to any such manual or work. Any member
+ of the public is a licensee, and is addressed as "you". You accept
+ the license if you copy, modify or distribute the work in a way
+ requiring permission under copyright law.
+
+ A "Modified Version" of the Document means any work containing the
+ Document or a portion of it, either copied verbatim, or with
+ modifications and/or translated into another language.
+
+ A "Secondary Section" is a named appendix or a front-matter section
+ of the Document that deals exclusively with the relationship of the
+ publishers or authors of the Document to the Document's overall
+ subject (or to related matters) and contains nothing that could
+ fall directly within that overall subject. (Thus, if the Document
+ is in part a textbook of mathematics, a Secondary Section may not
+ explain any mathematics.) The relationship could be a matter of
+ historical connection with the subject or with related matters, or
+ of legal, commercial, philosophical, ethical or political position
+ regarding them.
+
+ The "Invariant Sections" are certain Secondary Sections whose
+ titles are designated, as being those of Invariant Sections, in the
+ notice that says that the Document is released under this License.
+ If a section does not fit the above definition of Secondary then it
+ is not allowed to be designated as Invariant. The Document may
+ contain zero Invariant Sections. If the Document does not identify
+ any Invariant Sections then there are none.
+
+ The "Cover Texts" are certain short passages of text that are
+ listed, as Front-Cover Texts or Back-Cover Texts, in the notice
+ that says that the Document is released under this License. A
+ Front-Cover Text may be at most 5 words, and a Back-Cover Text may
+ be at most 25 words.
+
+ A "Transparent" copy of the Document means a machine-readable copy,
+ represented in a format whose specification is available to the
+ general public, that is suitable for revising the document
+ straightforwardly with generic text editors or (for images composed
+ of pixels) generic paint programs or (for drawings) some widely
+ available drawing editor, and that is suitable for input to text
+ formatters or for automatic translation to a variety of formats
+ suitable for input to text formatters. A copy made in an otherwise
+ Transparent file format whose markup, or absence of markup, has
+ been arranged to thwart or discourage subsequent modification by
+ readers is not Transparent. An image format is not Transparent if
+ used for any substantial amount of text. A copy that is not
+ "Transparent" is called "Opaque".
+
+ Examples of suitable formats for Transparent copies include plain
+ ASCII without markup, Texinfo input format, LaTeX input format,
+ SGML or XML using a publicly available DTD, and standard-conforming
+ simple HTML, PostScript or PDF designed for human modification.
+ Examples of transparent image formats include PNG, XCF and JPG.
+ Opaque formats include proprietary formats that can be read and
+ edited only by proprietary word processors, SGML or XML for which
+ the DTD and/or processing tools are not generally available, and
+ the machine-generated HTML, PostScript or PDF produced by some word
+ processors for output purposes only.
+
+ The "Title Page" means, for a printed book, the title page itself,
+ plus such following pages as are needed to hold, legibly, the
+ material this License requires to appear in the title page. For
+ works in formats which do not have any title page as such, "Title
+ Page" means the text near the most prominent appearance of the
+ work's title, preceding the beginning of the body of the text.
+
+ The "publisher" means any person or entity that distributes copies
+ of the Document to the public.
+
+ A section "Entitled XYZ" means a named subunit of the Document
+ whose title either is precisely XYZ or contains XYZ in parentheses
+ following text that translates XYZ in another language. (Here XYZ
+ stands for a specific section name mentioned below, such as
+ "Acknowledgements", "Dedications", "Endorsements", or "History".)
+ To "Preserve the Title" of such a section when you modify the
+ Document means that it remains a section "Entitled XYZ" according
+ to this definition.
+
+ The Document may include Warranty Disclaimers next to the notice
+ which states that this License applies to the Document. These
+ Warranty Disclaimers are considered to be included by reference in
+ this License, but only as regards disclaiming warranties: any other
+ implication that these Warranty Disclaimers may have is void and
+ has no effect on the meaning of this License.
+
+ 2. VERBATIM COPYING
+
+ You may copy and distribute the Document in any medium, either
+ commercially or noncommercially, provided that this License, the
+ copyright notices, and the license notice saying this License
+ applies to the Document are reproduced in all copies, and that you
+ add no other conditions whatsoever to those of this License. You
+ may not use technical measures to obstruct or control the reading
+ or further copying of the copies you make or distribute. However,
+ you may accept compensation in exchange for copies. If you
+ distribute a large enough number of copies you must also follow the
+ conditions in section 3.
+
+ You may also lend copies, under the same conditions stated above,
+ and you may publicly display copies.
+
+ 3. COPYING IN QUANTITY
+
+ If you publish printed copies (or copies in media that commonly
+ have printed covers) of the Document, numbering more than 100, and
+ the Document's license notice requires Cover Texts, you must
+ enclose the copies in covers that carry, clearly and legibly, all
+ these Cover Texts: Front-Cover Texts on the front cover, and
+ Back-Cover Texts on the back cover. Both covers must also clearly
+ and legibly identify you as the publisher of these copies. The
+ front cover must present the full title with all words of the title
+ equally prominent and visible. You may add other material on the
+ covers in addition. Copying with changes limited to the covers, as
+ long as they preserve the title of the Document and satisfy these
+ conditions, can be treated as verbatim copying in other respects.
+
+ If the required texts for either cover are too voluminous to fit
+ legibly, you should put the first ones listed (as many as fit
+ reasonably) on the actual cover, and continue the rest onto
+ adjacent pages.
+
+ If you publish or distribute Opaque copies of the Document
+ numbering more than 100, you must either include a machine-readable
+ Transparent copy along with each Opaque copy, or state in or with
+ each Opaque copy a computer-network location from which the general
+ network-using public has access to download using public-standard
+ network protocols a complete Transparent copy of the Document, free
+ of added material. If you use the latter option, you must take
+ reasonably prudent steps, when you begin distribution of Opaque
+ copies in quantity, to ensure that this Transparent copy will
+ remain thus accessible at the stated location until at least one
+ year after the last time you distribute an Opaque copy (directly or
+ through your agents or retailers) of that edition to the public.
+
+ It is requested, but not required, that you contact the authors of
+ the Document well before redistributing any large number of copies,
+ to give them a chance to provide you with an updated version of the
+ Document.
+
+ 4. MODIFICATIONS
+
+ You may copy and distribute a Modified Version of the Document
+ under the conditions of sections 2 and 3 above, provided that you
+ release the Modified Version under precisely this License, with the
+ Modified Version filling the role of the Document, thus licensing
+ distribution and modification of the Modified Version to whoever
+ possesses a copy of it. In addition, you must do these things in
+ the Modified Version:
+
+ A. Use in the Title Page (and on the covers, if any) a title
+ distinct from that of the Document, and from those of previous
+ versions (which should, if there were any, be listed in the
+ History section of the Document). You may use the same title
+ as a previous version if the original publisher of that
+ version gives permission.
+
+ B. List on the Title Page, as authors, one or more persons or
+ entities responsible for authorship of the modifications in
+ the Modified Version, together with at least five of the
+ principal authors of the Document (all of its principal
+ authors, if it has fewer than five), unless they release you
+ from this requirement.
+
+ C. State on the Title page the name of the publisher of the
+ Modified Version, as the publisher.
+
+ D. Preserve all the copyright notices of the Document.
+
+ E. Add an appropriate copyright notice for your modifications
+ adjacent to the other copyright notices.
+
+ F. Include, immediately after the copyright notices, a license
+ notice giving the public permission to use the Modified
+ Version under the terms of this License, in the form shown in
+ the Addendum below.
+
+ G. Preserve in that license notice the full lists of Invariant
+ Sections and required Cover Texts given in the Document's
+ license notice.
+
+ H. Include an unaltered copy of this License.
+
+ I. Preserve the section Entitled "History", Preserve its Title,
+ and add to it an item stating at least the title, year, new
+ authors, and publisher of the Modified Version as given on the
+ Title Page. If there is no section Entitled "History" in the
+ Document, create one stating the title, year, authors, and
+ publisher of the Document as given on its Title Page, then add
+ an item describing the Modified Version as stated in the
+ previous sentence.
+
+ J. Preserve the network location, if any, given in the Document
+ for public access to a Transparent copy of the Document, and
+ likewise the network locations given in the Document for
+ previous versions it was based on. These may be placed in the
+ "History" section. You may omit a network location for a work
+ that was published at least four years before the Document
+ itself, or if the original publisher of the version it refers
+ to gives permission.
+
+ K. For any section Entitled "Acknowledgements" or "Dedications",
+ Preserve the Title of the section, and preserve in the section
+ all the substance and tone of each of the contributor
+ acknowledgements and/or dedications given therein.
+
+ L. Preserve all the Invariant Sections of the Document, unaltered
+ in their text and in their titles. Section numbers or the
+ equivalent are not considered part of the section titles.
+
+ M. Delete any section Entitled "Endorsements". Such a section
+ may not be included in the Modified Version.
+
+ N. Do not retitle any existing section to be Entitled
+ "Endorsements" or to conflict in title with any Invariant
+ Section.
+
+ O. Preserve any Warranty Disclaimers.
+
+ If the Modified Version includes new front-matter sections or
+ appendices that qualify as Secondary Sections and contain no
+ material copied from the Document, you may at your option designate
+ some or all of these sections as invariant. To do this, add their
+ titles to the list of Invariant Sections in the Modified Version's
+ license notice. These titles must be distinct from any other
+ section titles.
+
+ You may add a section Entitled "Endorsements", provided it contains
+ nothing but endorsements of your Modified Version by various
+ parties--for example, statements of peer review or that the text
+ has been approved by an organization as the authoritative
+ definition of a standard.
+
+ You may add a passage of up to five words as a Front-Cover Text,
+ and a passage of up to 25 words as a Back-Cover Text, to the end of
+ the list of Cover Texts in the Modified Version. Only one passage
+ of Front-Cover Text and one of Back-Cover Text may be added by (or
+ through arrangements made by) any one entity. If the Document
+ already includes a cover text for the same cover, previously added
+ by you or by arrangement made by the same entity you are acting on
+ behalf of, you may not add another; but you may replace the old
+ one, on explicit permission from the previous publisher that added
+ the old one.
+
+ The author(s) and publisher(s) of the Document do not by this
+ License give permission to use their names for publicity for or to
+ assert or imply endorsement of any Modified Version.
+
+ 5. COMBINING DOCUMENTS
+
+ You may combine the Document with other documents released under
+ this License, under the terms defined in section 4 above for
+ modified versions, provided that you include in the combination all
+ of the Invariant Sections of all of the original documents,
+ unmodified, and list them all as Invariant Sections of your
+ combined work in its license notice, and that you preserve all
+ their Warranty Disclaimers.
+
+ The combined work need only contain one copy of this License, and
+ multiple identical Invariant Sections may be replaced with a single
+ copy. If there are multiple Invariant Sections with the same name
+ but different contents, make the title of each such section unique
+ by adding at the end of it, in parentheses, the name of the
+ original author or publisher of that section if known, or else a
+ unique number. Make the same adjustment to the section titles in
+ the list of Invariant Sections in the license notice of the
+ combined work.
+
+ In the combination, you must combine any sections Entitled
+ "History" in the various original documents, forming one section
+ Entitled "History"; likewise combine any sections Entitled
+ "Acknowledgements", and any sections Entitled "Dedications". You
+ must delete all sections Entitled "Endorsements."
+
+ 6. COLLECTIONS OF DOCUMENTS
+
+ You may make a collection consisting of the Document and other
+ documents released under this License, and replace the individual
+ copies of this License in the various documents with a single copy
+ that is included in the collection, provided that you follow the
+ rules of this License for verbatim copying of each of the documents
+ in all other respects.
+
+ You may extract a single document from such a collection, and
+ distribute it individually under this License, provided you insert
+ a copy of this License into the extracted document, and follow this
+ License in all other respects regarding verbatim copying of that
+ document.
+
+ 7. AGGREGATION WITH INDEPENDENT WORKS
+
+ A compilation of the Document or its derivatives with other
+ separate and independent documents or works, in or on a volume of a
+ storage or distribution medium, is called an "aggregate" if the
+ copyright resulting from the compilation is not used to limit the
+ legal rights of the compilation's users beyond what the individual
+ works permit. When the Document is included in an aggregate, this
+ License does not apply to the other works in the aggregate which
+ are not themselves derivative works of the Document.
+
+ If the Cover Text requirement of section 3 is applicable to these
+ copies of the Document, then if the Document is less than one half
+ of the entire aggregate, the Document's Cover Texts may be placed
+ on covers that bracket the Document within the aggregate, or the
+ electronic equivalent of covers if the Document is in electronic
+ form. Otherwise they must appear on printed covers that bracket
+ the whole aggregate.
+
+ 8. TRANSLATION
+
+ Translation is considered a kind of modification, so you may
+ distribute translations of the Document under the terms of section
+ 4. Replacing Invariant Sections with translations requires special
+ permission from their copyright holders, but you may include
+ translations of some or all Invariant Sections in addition to the
+ original versions of these Invariant Sections. You may include a
+ translation of this License, and all the license notices in the
+ Document, and any Warranty Disclaimers, provided that you also
+ include the original English version of this License and the
+ original versions of those notices and disclaimers. In case of a
+ disagreement between the translation and the original version of
+ this License or a notice or disclaimer, the original version will
+ prevail.
+
+ If a section in the Document is Entitled "Acknowledgements",
+ "Dedications", or "History", the requirement (section 4) to
+ Preserve its Title (section 1) will typically require changing the
+ actual title.
+
+ 9. TERMINATION
+
+ You may not copy, modify, sublicense, or distribute the Document
+ except as expressly provided under this License. Any attempt
+ otherwise to copy, modify, sublicense, or distribute it is void,
+ and will automatically terminate your rights under this License.
+
+ However, if you cease all violation of this License, then your
+ license from a particular copyright holder is reinstated (a)
+ provisionally, unless and until the copyright holder explicitly and
+ finally terminates your license, and (b) permanently, if the
+ copyright holder fails to notify you of the violation by some
+ reasonable means prior to 60 days after the cessation.
+
+ Moreover, your license from a particular copyright holder is
+ reinstated permanently if the copyright holder notifies you of the
+ violation by some reasonable means, this is the first time you have
+ received notice of violation of this License (for any work) from
+ that copyright holder, and you cure the violation prior to 30 days
+ after your receipt of the notice.
+
+ Termination of your rights under this section does not terminate
+ the licenses of parties who have received copies or rights from you
+ under this License. If your rights have been terminated and not
+ permanently reinstated, receipt of a copy of some or all of the
+ same material does not give you any rights to use it.
+
+ 10. FUTURE REVISIONS OF THIS LICENSE
+
+ The Free Software Foundation may publish new, revised versions of
+ the GNU Free Documentation License from time to time. Such new
+ versions will be similar in spirit to the present version, but may
+ differ in detail to address new problems or concerns. See
+ <http://www.gnu.org/copyleft/>.
+
+ Each version of the License is given a distinguishing version
+ number. If the Document specifies that a particular numbered
+ version of this License "or any later version" applies to it, you
+ have the option of following the terms and conditions either of
+ that specified version or of any later version that has been
+ published (not as a draft) by the Free Software Foundation. If the
+ Document does not specify a version number of this License, you may
+ choose any version ever published (not as a draft) by the Free
+ Software Foundation. If the Document specifies that a proxy can
+ decide which future versions of this License can be used, that
+ proxy's public statement of acceptance of a version permanently
+ authorizes you to choose that version for the Document.
+
+ 11. RELICENSING
+
+ "Massive Multiauthor Collaboration Site" (or "MMC Site") means any
+ World Wide Web server that publishes copyrightable works and also
+ provides prominent facilities for anybody to edit those works. A
+ public wiki that anybody can edit is an example of such a server.
+ A "Massive Multiauthor Collaboration" (or "MMC") contained in the
+ site means any set of copyrightable works thus published on the MMC
+ site.
+
+ "CC-BY-SA" means the Creative Commons Attribution-Share Alike 3.0
+ license published by Creative Commons Corporation, a not-for-profit
+ corporation with a principal place of business in San Francisco,
+ California, as well as future copyleft versions of that license
+ published by that same organization.
+
+ "Incorporate" means to publish or republish a Document, in whole or
+ in part, as part of another Document.
+
+ An MMC is "eligible for relicensing" if it is licensed under this
+ License, and if all works that were first published under this
+ License somewhere other than this MMC, and subsequently
+ incorporated in whole or in part into the MMC, (1) had no cover
+ texts or invariant sections, and (2) were thus incorporated prior
+ to November 1, 2008.
+
+ The operator of an MMC Site may republish an MMC contained in the
+ site under CC-BY-SA on the same site at any time before August 1,
+ 2009, provided the MMC is eligible for relicensing.
+
+ADDENDUM: How to use this License for your documents
+====================================================
+
+To use this License in a document you have written, include a copy of
+the License in the document and put the following copyright and license
+notices just after the title page:
+
+ Copyright (C) YEAR YOUR NAME.
+ Permission is granted to copy, distribute and/or modify this document
+ under the terms of the GNU Free Documentation License, Version 1.3
+ or any later version published by the Free Software Foundation;
+ with no Invariant Sections, no Front-Cover Texts, and no Back-Cover
+ Texts. A copy of the license is included in the section entitled ``GNU
+ Free Documentation License''.
+
+ If you have Invariant Sections, Front-Cover Texts and Back-Cover
+Texts, replace the "with...Texts." line with this:
+
+ with the Invariant Sections being LIST THEIR TITLES, with
+ the Front-Cover Texts being LIST, and with the Back-Cover Texts
+ being LIST.
+
+ If you have Invariant Sections without Cover Texts, or some other
+combination of the three, merge those two alternatives to suit the
+situation.
+
+ If your document contains nontrivial examples of program code, we
+recommend releasing these examples in parallel under your choice of free
+software license, such as the GNU General Public License, to permit
+their use in free software.
+
+
+File: wisi.info, Node: Index, Prev: GNU Free Documentation License, Up: Top
+
+Index
+*****
+
+
+
+Tag Table:
+Node: Top920
+Node: Overview1119
+Node: Grammar actions1761
+Node: Navigate actions7174
+Node: Face actions10027
+Node: Indent actions11338
+Node: Indent functions15148
+Node: Indent example17443
+Node: In-parse actions21781
+Node: Project extension23077
+Node: Project files23586
+Node: Selecting projects25006
+Node: Casing exception files29008
+Node: Other project functions29666
+Node: GNU Free Documentation License30424
+Node: Index55580
+
+End Tag Table
+
+
+Local Variables:
+coding: utf-8
+End:
diff --git a/wisi.texi b/wisi.texi
new file mode 100644
index 0000000..3b9594a
--- /dev/null
+++ b/wisi.texi
@@ -0,0 +1,812 @@
+\input texinfo @c -*-texinfo-*-
+@settitle Wisi
+
+@copying
+Copyright @copyright{} 1999 - 2020 Free Software Foundation, Inc.
+
+@quotation
+Permission is granted to copy, distribute and/or modify this document
+under the terms of the GNU Free Documentation License, Version 1.3 or
+any later version published by the Free Software Foundation; with no
+Invariant Sections, with the Front-Cover texts being ``A GNU Manual'',
+and with the Back-Cover Texts as in (a) below. A copy of the license
+is included in the section entitled ``GNU Free Documentation License''.
+
+(a) The FSF's Back-Cover Text is: ``You have the freedom to copy and
+modify this GNU manual. Buying copies from the FSF supports it in
+developing GNU and promoting software freedom.''
+@end quotation
+@end copying
+
+@dircategory Emacs
+@direntry
+* Wisi: (wisi). Error-correcting LR parsers and project integration.
+@end direntry
+
+@titlepage
+@sp 10
+@title Wisi Version 3.1.0
+@page
+@vskip 0pt plus 1filll
+@insertcopying
+@end titlepage
+
+@contents
+
+@ifnottex
+@node Top
+@top Top
+
+Wisi Version 3.1.0
+@end ifnottex
+
+@menu
+* Overview::
+* Grammar actions::
+* Project extension::
+* GNU Free Documentation License::
+* Index::
+@end menu
+
+@node Overview
+@chapter Overview
+``wisi'' used to be an acronym, but now it's just a name.
+
+The wisi package provides an elisp interface to an external parser. It
+assumes the parser generator package WisiToken
+(@url{http://stephe-leake.org/ada/wisitoken.html}, implemented in
+Ada), but can use any parser that meets the same API. wisi provides
+several grammar actions, to implement indentation, navigating, and
+syntax highlighting (fontification).
+
+wisi also provides an extension to Emacs @file{project.el}, providing
+operations useful for compilation and cross-reference.
+
+@node Grammar actions
+@chapter Grammar Actions
+
+Grammar actions are specified in the grammar file, in a nonterminal
+declaration. We assume the user is familiar with parser grammars and
+grammar actions. For example, a simple ``if'' statement can be
+declared as:
+
+@example
+if_statement
+ : IF expression THEN statements elsif_list ELSE statements END IF SEMICOLON
+ %((wisi-statement-action [1 statement-start 3 motion 6 motion 10
statement-end])
+ (wisi-motion-action [1 3 5 6 10])
+ (wisi-indent-action [nil
+ [(wisi-hanging% ada-indent-broken (* 2
ada-indent-broken))
+ ada-indent-broken]
+ nil
+ [ada-indent ada-indent] nil nil
+ [ada-indent ada-indent] nil nil nil]))%
+@end example
+
+The item before @code{:} is the ``left hand side'', or
+``nonterminal''. The list of tokens after @code{:} is the ``right hand
+side''; in general there can be more than one right hand side for each
+nonterminal (separated by @code{|}).
+
+The items enclosed in ``%()%'' are the grammar actions. They are
+specified as list of elisp forms; an earlier version of the wisi
+package generated an elisp parser. We keep the elisp form because it
+is compact, and easier to read and write than the equivalent Ada
+code. The @code{wisi-bnf-generate} tool converts the elisp into the
+required Ada statements.
+
+There are two classes of actions; in-parse and post-parse. WisiToken
+calls these ``semantic checks'' and ``user actions''. The in-parse
+actions are done as parsing procedes; they provide extra checks that
+can cause the parse to fail. Currently the only one provided is
+@code{match-names}; it is used to check that the declaration and end
+names in named Ada blocks are the same (which can aid significantly in
+error correction). In the grammar file, in-parse actions are specified
+in a second @code{%()%} block, which can be omitted if empty. In this
+document, the term ``action'' means ``post-parse action'', we use
+``in-parse action'' unless the meaning is clear from context.
+
+Executing the wisi grammar actions creates text properties in the
+source file; those text properties are then used by elisp code for
+various purposes.
+
+The text properties applied are:
+
+@table @code
+@item wisi-cache
+This should be named @code{wisi-navigate}, but isn't for historical
+reasons (there used to be only one kind of text property).
+
+The property contains a @code{wisi-cache} object, containing:
+
+@table @code
+@item nonterm
+The nonterminal in the grammar production that specified the action
+that produced this text property.
+
+@item token
+A token identifier naming a token in the production right hand side
+containing the text this text property is applied to.
+
+@item last
+The position of the last character in the token, relative to the first
+character (0 indexed). The text property is only applied to the first
+character in the token (mostly for historical reasons).
+
+@item class
+A token class; see the list of possible values in
+@code{wisi-statement-action} below.
+
+@item containing
+A marker pointing to the start of the containing token for this token;
+only @code{nil} for the outermost containing token in a file.
+
+@item prev
+A marker pointing to the previous ``motion token'' in the statement or
+declaration. These are normally language keywords, but can be other
+things.
+
+@item next
+A marker pointing to the next ``motion token'' in the statement or
+declaration.
+
+@item end
+A marker pointing to the end of the statement or declaration.
+
+@end table
+
+wisi provides motion commands for going to the various markers.
+
+@item wisi-name
+Contains no data, applied to a ``name'' of some sort. wisi provides
+commands for finding the next/previous name, and returning the
+text. Useful for the names of subprograms, which can then be used to
+build a completion table; see @code{wisi-xref-identifier-completion-table}.
+
+@item font-lock-face
+The standard font-lock property, specifying the face for the
+text.
+
+Some major modes do not use this for simple keywords; they use
+font-lock regular expressions instead. One reason for this
+is so keywords are still highlighted when the parser fails, which
+can happen if there are severe syntax errors.
+
+Other items, like function and package names, are typically marked
+with @code{font-lock-face} by the parser.
+
+@item fontified
+Another standard font-lock text property; applied whenever
+@code{font-lock-face} is.
+
+@item wisi-indent
+Contains the indent (in characters) for the next line; applied to
+the newline character on the preceding line. The first line in a
+buffer is assumed to have indent 0.
+
+@end table
+
+Each action is classified as one of @code{navigate, face, indent,
+in-parse}; when actions are executed, only one of the first three classes
+is executed (in-parse is always executed). This reflects the reasons
+the parser is run; to figure out how to go somehere (end of current
+statement, start of current procedure, etc), to apply faces for syntax
+highlighting, or to indent the code.
+
+@menu
+* Navigate actions::
+* Face actions::
+* Indent actions::
+* In-parse actions::
+@end menu
+
+@node Navigate actions
+@section Navigate actions
+@table @code
+@item wisi-statement-action [TOKEN CLASS ...]
+The argument is a vector; alternating items are a token index (an
+integer or label indicating a token in the right hand side) and a
+``token class''; one of:
+
+@table @code
+@item motion
+Create a @code{wisi-cache} text property on the token, for use in a
+subsequent @code{wisi-motion-action}.
+
+@item statement-end
+Create a @code{wisi-cache} text property on the token, enter a pointer
+to it in the other @code{wisi-cache} objects in the statement or
+declaration.
+
+@item statement-start
+Create a @code{wisi-cache} text property on the token, enter a pointer
+to it in the other @code{wisi-cache} objects (in the @code{containing}
+slot) in the statement or declaration.
+
+@item statement-override
+Same as @code{statement-start}; marks the token to be used as the
+statement start if the first token is optional.
+
+@item misc
+Create a @code{wisi-cache} text property on the token, to be used for
+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 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}.
+
+@end table
+
+@item wisi-motion-action [TOKEN ...]
+The argument is a vector, where each element is either a token index
+or a vector [INDEX ID].
+
+Each terminal token must already have a @code{wisi-cache} created by a
+@code{wisi-statement-action} (this is checked at action execution, not
+during grammar generation). This action sets the @code{prev, next}
+slots for the chain of tokens, creating a chain of motion tokens.
+
+If TOKEN is a nonterminal without an ID specified, the @code{wisi-cache}
+must be on the first token in the nonterminal, and it is assumed to
+have a valid pointer in the @code{next} slot, indicating a chain of
+motion tokens. That chain is linked into the chain for the current
+right hand side.
+
+If TOKEN is a nonterminal with an ID, the region contained by the
+nonterminal is searched for all @code{wisi-cache} with that token ID,
+and for each one where prev/next is not already set, it is linked into
+the motion chain.
+
+Note that the ``search'' described here is done in the parser process, on
+a tree data structure containing the data that will eventually be
+stored in Emacs text properties.
+
+@item wisi-name-action TOKEN
+TOKEN is a token index. Create a @code{wisi-name} text property on the
+token.
+
+@end table
+
+@node Face actions
+@section Face actions
+@table @code
+@item wisi-face-mark-action [INDEX CLASS ...]
+The argument is a vector; alternating elements form pairs of INDEX
+CLASS, where class is one of @code{prefix, suffix}.
+
+Mark the tokens as part of a compound name, for use by later face
+actions.
+
+@item wisi-face-apply-action [TOKEN PREFIX-FACE SUFFIX-FACE ...]
+The argument is a vector; triples of items specify TOKEN,
+PREFIX-FACE, SUFFIX-FACE. The faces are the elisp names of face
+objects (which must declared by an @code{%elisp_face} declaration).
+
+If the token is a nonterminal, and it has been marked by a previous
+@code{wisi-face-mark-action}, the specified faces are applied to the
+prefix and suffix in the token as @code{font-lock-face} text
+properties.
+
+If the token is a terminal, or a non-terminal with no face mark, the
+suffix face is applied to the entire text contained by the token.
+
+@item wisi-face-apply-list-action [TOKEN PREFIX-FACE SUFFIX-FACE ...]
+Similar to ’wisi-face-apply-action’, but applies faces to all tokens
+marked by @code{wisi-face-mark-action} in each indicated production
+token, and does not apply a face if there are no such marks.
+
+@end table
+
+@node Indent actions
+@section Indent actions
+
+Indents are computed for each line in a cumulative way as the grammar
+actions are executed. Initially, each indent is set to @code{nil},
+which means ``not computed''; this is not the same as the value
+@code{0}. The grammar actions are executed in a bottom-up fashion; low
+level productions are executed before higher level ones. In general,
+the indent action for a production specifies a ``delta indent''; the
+indent is incremented by that amount. When all productions have been
+processed, the indent has been computed for all lines.
+
+Indents are often given as a function call; the arguments to the
+function can be other function calls, or integer
+expressions. @code{wisitoken-bnf-generate} supports only simple integer
+expressions; those using integers, integer-valued variables,
+parenthesis, + (plus), - (minus), and * (multiply).
+
+@table @code
+@item wisi-indent-action [INDENT ...]
+The argument is a vector, giving an indent for each token in the
+production right-hand side.
+
+For terminals, the indents only have meaning, and are only computed,
+if the token is the first on a line. For nonterminals where the indent
+is not a variant of @code{wisi-hanging}, the indent is only computed
+if the first terminal token in the nonterminal is the first on a
+line. See @code{wisi-hanging} in @ref{Indent functions} for the
+remaining case.
+
+An indent can have several forms. In the descriptions below, the
+``current token'' is given by the position of the indent expression in
+the @code{wisi-indent-action} argument list.
+
+@table @asis
+@item An integer
+This gives a delta indent; it is added to the total indent for the
+line.
+
+@item A variable name
+The name is translated to an Ada identifier by replacing ``-'' with
+``_'', and applying @code{Camel_Case}. The translated name must
+identify a directly visible run-time Ada integer variable; this is
+checked at Ada compile time. It provides an integer delta indent.
+
+For example, in Ada two indent variable names are @code{ada-indent}
+and @code{ada-indent-broken}, giving the basic ident, and the
+continuation line indent. They are runtime variables so different
+projects can specify them as part of a coding standard.
+
+@item A function call
+A function that computes a delta indent. See @ref{Indent functions}.
+
+@item [CODE-INDENT , COMMENT-INDENT]
+A vector giving separate indents for code and comments.
+
+Normally, the indent for trailing comments (on lines with no code,
+after all code in the token) is given by the indent of the following
+token in the production. When the current token is the last, or the
+following tokens may be empty, or the indent of the following token
+would be wrong for some reason (for example, it is a block end), the
+comment indent may be specified separately. If it is not specified,
+and the indent from the next token is not available, the indent for
+the current token is used for code and comments.
+
+Comment lines that are not trailing are indented by CODE-INDENT.
+
+@item (label . INDENT)
+If token labels are used in a right hand side, they must be given
+explicitly in the indent arguments, using he lisp ``cons''
+syntax. Labels are normally only used with EBNF grammars, which expand
+into multiple right hand sides, with optional tokens simply left
+out. Explicit labels on the indent arguments allow them to be left out
+as well.
+
+@end table
+
+@end table
+
+@menu
+* Indent functions::
+* Indent example::
+@end menu
+
+@node Indent functions
+@subsection Indent functions
+@table @code
+@item wisi-anchored TOKEN OFFSET
+Sets the indent for the current token to be OFFSET (an integer
+expression) from the start of TOKEN (a token index); the
+current token is ``anchored to'' TOKEN.
+
+@item wisi-anchored* TOKEN OFFSET
+Sets the indent for the current token to be OFFSET from the start of
+TOKEN, but only if TOKEN is the first token on a line; otherwise no indent
+
+@item wisi-anchored*- TOKEN OFFSET
+Sets the indent for the current token to be OFFSET from the start of
+TOKEN, but only if TOKEN is the first token on a line and the indent
+for the current token accumulated so far is nil.
+
+@item wisi-anchored% TOKEN OFFSET
+If there is an opening parenthesis containing TOKEN in the line
+containing TOKEN, set the current indent to OFFSET from that
+parenthesis. Otherwise, OFFSET gives an indent delta.
+
+@item wisi-anchored%- TOKEN OFFSET
+Same as @code{wisi-anchored%}, but only if the current token
+accumulated indent is nil.
+
+@item wisi-hanging DELTA-1 DELTA-2
+The current token is assumed to be a nonterminal. If the text it
+contains spans multiple lines, use DELTA-1 for the first line, DELTA-2
+for the rest. If the current token is only on one line, use DELTA-1.
+
+DELTA-1 and DELTA-2 can be any IDENT expression, except a variant of
+@code{wisi-hanging}.
+
+@item wisi-hanging% DELTA-1 DELTA-2
+Similar to @code{wisi-hanging}; if the first terminal token in the
+current nonterminal is the first token on the first line, use DELTA-1
+for the first line and DELTA-2 for the rest. Otherwise, use DELTA-1
+for all lines.
+
+@item wisi-hanging%- DELTA-1 DELTA-2
+Same as @code{wisi-hanging%}, except applied only if the current token
+accumulated indent is nil.
+
+@item Language-specific function
+Language-specific indent functions are specified by an
+@code{%elisp_indent} declaration in the grammar file. Each function
+specifies how many arguments it accepts; this is checked at action
+runtime, not during grammar generation. Each argument is an INDENT as
+described above, or a token ID prefixed by @code{'} (to allow
+distinguishing token IDs from variable names).
+@end table
+
+@node Indent example
+@subsection Indent example
+
+The example @code{if_statement} grammar nonterminal is:
+
+@example
+if_statement
+ : IF expression THEN statements elsif_list ELSE statements END IF SEMICOLON
+ %((wisi-indent-action [nil
+ [(wisi-hanging% ada-indent-broken (* 2
ada-indent-broken))
+ ada-indent-broken]
+ nil
+ [ada-indent ada-indent] nil nil
+ [ada-indent ada-indent] nil nil nil]))%
+@end example
+
+We trace how the indent is computed for this sample Ada code:
+
+@example
+ 1: if A < B and
+ 2: C < D
+ 3: -- comment on expression
+ 4: then
+ 5: if E then
+ 6: Do_E;
+ 7: -- comment on statement
+ 8: elsif F then
+ 9: G := A + Compute_Something
+10: (arg_1, arg_2);
+11: end if;
+12: end if;
+@end example
+
+First, the indent for the lower-level nonterminals (@code{expression,
+statements, elsif_list}) are computed. Assume they set the indent for
+line 10 to 2 (for the hanging expression) and leave the rest at nil.
+
+Next, the action for the inner @code{if_statement} is executed. Most
+of the tokens specify an indent of @code{nil}, which means the current
+accumulated indent is not changed. For the others, the action is as
+follows:
+
+@table @code
+@item expression:
+The expression @code{E} is contained on one line, and it is not the
+first token on that line, so the indent for line 5 is not changed.
+
+@item statements: [ada-indent ada-indent]
+This specifies separate indents for code and trailing comments,
+because otherwise the trailing comments would be indented with the
+following @code{THEN}; instead they are indented with the expression
+code; see the comment on line 7.
+
+Here @code{ada-indent} is 3, so the indent for lines 6 and 7 (for the
+first occurence of @code{statments}) is
+incremented from @code{nil} to @code{3}.
+
+For the second occurence of @code{statements}, line 9 is incremented
+from @code{nil} to @code{3}, and line 10 from @code{2} to @code{5}.
+@end table
+
+At this point, the accumulated indents are (the indent is given after
+the line number):
+@example
+ 1: nil : if A < B and
+ 2: nil : C < D
+ 3: nil : -- comment on expression
+ 4: nil : then
+ 5: nil : if E then
+ 6: 3 : Do_E;
+ 7: 3 : -- comment on statement
+ 8: nil : elsif F then
+ 9: 3 : G := A + Compute_Something
+10: 5 : (arg_1, arg_2);
+11: nil : end if;
+12: nil : end if;
+@end example
+
+Then the action is executed for the outer @code{if_statement}:
+
+@table @code
+@item expression: [(wisi-hanging% ada-indent-broken (* 2 ada-indent-broken))
ada-indent-broken]
+This specifies separate indents for code and trailing comments,
+because otherwise the trailing comments would be indented with the
+following @code{THEN}; instead they are indented with the expression
+code; see the comment on line 3.
+
+In this case, @code{wisi-hanging%} returns DELTA-1, which is
+@code{ada-indent-broken}, which is 2. So the indent for line 2 is
+incremented from @code{nil} to @code{2}.
+
+The indent for line 3 is also incremented from @code{nil} to @code{2}.
+
+@item statements: [ada-indent ada-indent]
+Here there is only one statement; the nested @code{if_statement}. The
+indent for lines 5 .. 11 are each incremented by 3.
+@end table
+
+The final result is:
+@example
+ 1: nil : if A < B and
+ 2: 2 : C < D
+ 3: 2 : -- comment on expression
+ 4: nil : then
+ 5: 3 : if E then
+ 6: 6 : Do_E;
+ 7: 6 : -- comment on statement
+ 8: 3 : elsif F then
+ 9: 6 : G := A + Compute_Something
+10: 8 : (arg_1, arg_2);
+11: 6 : end if;
+12: nil : end if;
+@end example
+
+In a full grammar, the top production should specify an indent of 0,
+not nil, for tokens that are not indented; then every line will have a
+non-nil indent. However, in normal operation a nil indent is treated
+as 0; the @code{wisi-indent} text property is not set for lines that
+have nil indent, and @code{wisi-indent-region} detects that and uses 0
+for the indent. You can set the variable @code{wisi-debug} to a value
+> 0 to signal an error for nil indents; this is useful to catch indent
+errors during grammar development.
+
+@node In-parse actions
+@section In-parse actions
+@table @code
+
+@item wisi-propagate-name TOKEN
+The argument is a token index. Set the @code{name} component of the
+left-hand-side parse-time token object to the @code{name} component of
+the identified token, if it is not empty. Otherwise use the
+@code{byte_region} component.
+
+@item wisi-merge-name FIRST-TOKEN, LAST-TOKEN
+The arguments are token indices, giving a range of
+tokens. LAST-TOKEN may be omitted if it is the same as FIRST-TOKEN.
+
+Set the @code{name} component of the left-hand-side to the merger of
+the @code{name} or @code{byte-region} components of the identified tokens.
+
+@item wisi-match-name START-TOKEN END-TOKEN
+The arguments are token indices. Compare the text contained by the
+@code{name} (or @code{byte_region} if @code{name} is empty) token
+components for START-TOKEN and END-TOKEN; signal a parse error if they
+are different.
+
+The behavior when a name is missing is determined by the runtime
+language variable given in the @code{%end_names_optional_option}
+declaration; if True, a missing name that is supposed to match a
+present name is an error. Both names missing is not an error (assuming
+that is allowed by the grammar).
+
+@end table
+
+@node Project extension
+@chapter Project extension
+wisi defines the @code{cl-defstuct} @code{wisi-prj}, with operations
+suitable for compilation and cross-reference.
+
+In order to use wisi projects, the user must write project files and
+customize @code{project-find-functions} and
+@code{xref-backend-functions}.
+
+@menu
+* Project files::
+* Selecting projects::
+* Casing exception files::
+* Other project functions::
+@end menu
+
+@node Project files
+@section Project files
+
+Project file names must have an extension given by
+@code{wisi-prj-file-extensions} (default @file{.adp, .prj}).
+
+Project files have a simple syntax; they may be edited directly. Each
+line specifies a project variable name and its value, separated by
+``='':
+
+@example
+src_dir=/Projects/my_project/src_1
+src_dir=/Projects/my_project/src_2
+@end example
+
+There must be no space between the variable name and ``='', and no
+trailing spaces after the value.
+
+Any line that does not have an ``='' is a comment.
+
+Some variables (like @code{src_dir}) are lists; each line in the
+project file specifies one element of the list. The value on the last
+line is the last element in the list.
+
+A variable name that starts with @code{$} is set as a process
+environment variable, for processes launched from Emacs for the
+project.
+
+In values, process environment variables can be referenced
+using the normal @code{$var} syntax.
+
+In values, relative file names are expanded relative to the
+directory containing the project file.
+
+Here is the list of project variables defined by wisi; major modes may
+add more.
+
+@table @asis
+@item @code{casing} [slot: @code{case-exception-files}]
+List of files containing casing exceptions. @xref{Casing exception files}.
+
+@item @code{src_dir} [slot: @code{source-path}]
+A list of directories to search for source files.
+
+@end table
+
+@node Selecting projects
+@section Selecting projects
+The current project can either be indicated by a global variable
+(called a ``selected project''), or depend on the current buffer.
+
+In addition, the project file can be parsed each time it is needed, or
+the result cached to improve response time,
+
+One reason to use a selected project is to handle a hierarchy of
+projects; if projects B and C both depend on library project A, then
+when in a file of project A, there is no way to determine which of the
+three projects to return. So the user must indicate which is active,
+by using one of @code{wisi-prj-select-file} or
+@code{wisi-prj-select-cache}.
+
+In addition, if changing from one project to another requires setting
+global resources that must also be unset (such as a syntax propertize
+hook or compilation filter hook), then the project should define
+@code{wisi-prj-deselect} in addition to @code{wisi-prj-select}. Such
+projects require having a selected current project, so it can be
+deselected before a new one is selected. One example of such projects
+is ada-mode.
+
+One way to declare each project is to add a Local Variables section
+in the main Makefile for the project; when the Makefile is first
+visited, the project is declared. In the examples here, we assume
+that approach is used; each gives an :eval line.
+
+Note that @code{wisi-prj-current-parse} and
+@code{wisi-prj-current-cached} always succeed after some project is
+selected; no functions after them on @code{project-find-functions} will
+be called. That's why the depth is 90 for those in the examples.
+
+@table @asis
+@item No caching, current project depends on current buffer
+
+@example
+(add-hook 'project-find-functions #'wisi-prj-find-dominating-parse 0)
+
+:eval (wisi-prj-set-dominating "foo.prj" (foo-prj-default "prj-name"))
+@end example
+
+@code{wisi-prj-set-dominating} declares the name of a project file with a
+default project object, and ensures that the current buffer file name
+is in @code{wisi-prj--dominating}.
+
+@code{wisi-prj-find-dominating-parse} looks for the filenames in
+@code{wisi-prj--dominiating} in the parent directories of the current
+buffer. When one is found, the associated project file is parsed,
+using the default project object to dispatch to the appropriate
+parsers. Then the final project object is returned.
+
+@item Caching, current project depends on current buffer
+
+@example
+(add-hook 'project-find-functions #'wisi-prj-find-dominating-cached 0)
+
+:eval (wisi-prj-cache-dominating "foo.prj" (foo-prj-default "prj-name"))
+@end example
+
+@code{wisi-prj-cache-dominating} declares the project file, parses it,
+and saves the project object in a cache indexed by the absolute
+project file name.
+
+@code{wisi-prj-find-dominating-cached} finds the dominating
+project file, and retrieves the object from the cache.
+
+@item No caching, last selected project is current
+
+@example
+(add-hook 'project-find-functions #'wisi-prj-current-parse 90)
+
+:eval: (wisi-prj-select-file <prj-file> (foo-prj-default "prj-name"))
+@end example
+
+@code{wisi-prj-select-file} sets the project file as the current
+project, and saves the default project object.
+
+@code{wisi-prj-current-parse} parses the current project file, using
+the saved default project object, and returns the project object.
+
+@item Caching, last selected project is current
+
+@example
+(add-hook 'project-find-functions #'wisi-prj-current-cached 90)
+
+:eval: (wisi-prj-select-cache <prj-file> (foo-prj-default "prj-name"))
+@end example
+
+@code{wisi-prj-select-cache} parses the project file, caches the
+project object.
+
+@code{wisi-prj-current-cached} returns the cached current project
+object.
+
+@end table
+
+In addition, the user should set @code{xref-backend-functions}. Currently,
+there is only one choice for wisi projects:
+
+@example
+(add-to-list 'xref-backend-functions #'wisi-prj-xref-backend 90)
+@end example
+
+@code{wisi-prj-xref-backend} returns the current wisi project object.
+
+@node Casing exception files
+@section Casing exception files
+Each line in a case exception
+file specifies the casing of one word or word fragment. If an
+exception is defined in multiple files, the first occurrence is used.
+
+If the word starts with an asterisk (@code{*}), it defines the casing
+of a word fragment (or ``substring''); part of a word between two
+underscores or word boundary.
+
+For example:
+
+@example
+DOD
+*IO
+GNAT
+@end example
+
+The word fragment @code{*IO} applies to any word containing ``_io'';
+@code{Text_IO}, @code{Hardware_IO}, etc.
+
+@node Other project functions
+@section Other project functions
+
+@table @code
+@item wisi-refresh-prj-cache (not-full)
+Refreshes all cached data in the project, and re-selects the
+project. If NOT-FULL is non-nil, slow refresh operations are skipped.
+
+This reparses the project file, and any cross reference information.
+
+@item wisi-prj-select-dominating (dominating-file)
+ Find a wisi-prj matching DOMINATING-FILE (defaults to the current
+buffer file). If the associated project is current, do nothing. If it
+is not current, select it.
+
+This is useful before running `compilation-start', to ensure the correct
+project is current.
+
+@end table
+
+@node GNU Free Documentation License
+@appendix GNU Free Documentation License
+@include doclicense.texi
+
+@node Index, , GNU Free Documentation License, Top
+@unnumbered Index
+
+@printindex fn
+
+@bye
diff --git a/wisitoken-bnf-generate.adb b/wisitoken-bnf-generate.adb
index a7616b4..1fe407a 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 - 2019 Free Software Foundation, Inc.
+-- Copyright (C) 2012 - 2015, 2017 - 2020 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
@@ -50,9 +50,7 @@ is
use Ada.Text_IO;
First : Boolean := True;
begin
- -- verbosity meaning is actually determined by output choice;
- -- they should be consistent with this description.
- Put_Line (Standard_Error, "version 1.3.1");
+ Put_Line (Standard_Error, "version 2.0"); -- 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);
@@ -104,7 +102,11 @@ is
New_Line (Standard_Error);
Put_Line (Standard_Error, "options:");
Put_Line (Standard_Error, " --help: show this help");
- Put_Line (Standard_Error, " -v level: sets verbosity (default 0):");
+
+ -- verbosity meaning is actually determined by output choice;
+ -- they should be consistent with this description.
+ Put_Line
+ (Standard_Error, " -v <EBNF level> <Table level> <Minimal_Complete
level>: sets verbosity (default 0):");
Put_Line (Standard_Error, " 0 - only error messages to standard
error");
Put_Line (Standard_Error, " 1 - add diagnostics to standard out");
Put_Line (Standard_Error, " 2 - more diagnostics to standard out,
ignore unused tokens, unknown conflicts");
@@ -183,7 +185,11 @@ begin
elsif Argument (Arg_Next) = "-v" then
Arg_Next := Arg_Next + 1;
- WisiToken.Trace_Generate := Integer'Value (Argument (Arg_Next));
+ WisiToken.Trace_Generate_EBNF := Integer'Value (Argument
(Arg_Next));
+ Arg_Next := Arg_Next + 1;
+ WisiToken.Trace_Generate_Table := Integer'Value (Argument
(Arg_Next));
+ Arg_Next := Arg_Next + 1;
+ WisiToken.Trace_Generate_Minimal_Complete := Integer'Value
(Argument (Arg_Next));
Arg_Next := Arg_Next + 1;
elsif Argument (Arg_Next) = "--ignore_conflicts" then
@@ -284,9 +290,6 @@ begin
use all type Ada.Strings.Unbounded.Unbounded_String;
use Ada.Text_IO;
- -- Create a .parse_table file unless verbosity > 0
- Parse_Table_File : File_Type;
-
Generate_Set : Generate_Set_Access;
Multiple_Tuples : Boolean;
@@ -332,11 +335,11 @@ begin
declare
Tree : WisiToken.Syntax_Trees.Tree renames
Grammar_Parser.Parsers.First_State_Ref.Tree;
begin
- if Trace_Generate > Outline then
+ if Trace_Generate_EBNF > Outline then
Ada.Text_IO.Put_Line ("Translate EBNF tree to BNF");
end if;
- if Trace_Generate > Detail then
+ if Trace_Generate_EBNF > Detail then
Ada.Text_IO.Put_Line ("EBNF tree:");
Tree.Print_Tree (Wisitoken_Grammar_Actions.Descriptor);
Ada.Text_IO.New_Line;
@@ -344,7 +347,7 @@ begin
WisiToken_Grammar_Runtime.Translate_EBNF_To_BNF (Tree,
Input_Data);
- if Trace_Generate > Detail then
+ if Trace_Generate_EBNF > Detail then
Ada.Text_IO.New_Line;
Ada.Text_IO.Put_Line ("BNF tree:");
Tree.Print_Tree (Wisitoken_Grammar_Actions.Descriptor);
@@ -410,8 +413,28 @@ begin
(Generate_Data.Descriptor.First_Terminal,
Generate_Data.Descriptor.First_Nonterminal,
Generate_Data.Descriptor.Last_Nonterminal);
- Do_Parse_Table_File : constant Boolean := WisiToken.Trace_Generate
= 0 and
- Tuple.Gen_Alg in LALR .. Packrat_Proc;
+ Parse_Table_File_Name : constant String :=
+ (if WisiToken.Trace_Generate_Table = 0 and Tuple.Gen_Alg in LALR
.. Packrat_Proc
+ then -Output_File_Name_Root & "_" & To_Lower
(Generate_Algorithm'Image (Tuple.Gen_Alg)) &
+ (if Input_Data.If_Lexer_Present
+ then "_" & Lexer_Image (Input_Data.User_Lexer).all
+ else "") &
+ ".parse_table"
+ else "");
+
+ procedure Parse_Table_Append_Stats
+ is
+ Parse_Table_File : File_Type;
+ begin
+ Open (Parse_Table_File, Append_File, Parse_Table_File_Name);
+ Set_Output (Parse_Table_File);
+ Generate_Data.Parser_State_Count :=
+ Generate_Data.LR_Parse_Table.State_Last -
Generate_Data.LR_Parse_Table.State_First + 1;
+ WisiToken.BNF.Generate_Utils.Put_Stats (Input_Data,
Generate_Data);
+ Set_Output (Standard_Output);
+ Close (Parse_Table_File);
+ end Parse_Table_Append_Stats;
+
begin
if not Lexer_Done (Input_Data.User_Lexer) then
Lexer_Done (Input_Data.User_Lexer) := True;
@@ -424,17 +447,6 @@ begin
end case;
end if;
- if Do_Parse_Table_File then
- Create
- (Parse_Table_File, Out_File,
- -Output_File_Name_Root & "_" & To_Lower
(Generate_Algorithm'Image (Tuple.Gen_Alg)) &
- (if Input_Data.If_Lexer_Present
- then "_" & Lexer_Image (Input_Data.User_Lexer).all
- else "") &
- ".parse_table");
- Set_Output (Parse_Table_File);
- end if;
-
case Tuple.Gen_Alg is
when None =>
-- Just translate EBNF to BNF, done in Parse_Check
@@ -450,7 +462,7 @@ begin
Generate_Utils.To_Conflicts
(Generate_Data, Input_Data.Conflicts,
Input_Data.Grammar_Lexer.File_Name),
Generate_Utils.To_McKenzie_Param (Generate_Data,
Input_Data.McKenzie_Recover),
- Put_Parse_Table => True,
+ Parse_Table_File_Name,
Include_Extra => Test_Main,
Ignore_Conflicts => Ignore_Conflicts,
Partial_Recursion =>
Input_Data.Language_Params.Partial_Recursion);
@@ -464,9 +476,9 @@ begin
Duration'Image (To_Duration (Time_End - Time_Start)));
end if;
- Generate_Data.Parser_State_Count :=
- Generate_Data.LR_Parse_Table.State_Last -
Generate_Data.LR_Parse_Table.State_First + 1;
- WisiToken.BNF.Generate_Utils.Put_Stats (Input_Data,
Generate_Data);
+ if Parse_Table_File_Name /= "" then
+ Parse_Table_Append_Stats;
+ end if;
when LR1 =>
Time_Start := Clock;
@@ -477,7 +489,7 @@ begin
Generate_Utils.To_Conflicts
(Generate_Data, Input_Data.Conflicts,
Input_Data.Grammar_Lexer.File_Name),
Generate_Utils.To_McKenzie_Param (Generate_Data,
Input_Data.McKenzie_Recover),
- Put_Parse_Table => True,
+ Parse_Table_File_Name,
Include_Extra => Test_Main,
Ignore_Conflicts => Ignore_Conflicts,
Partial_Recursion =>
Input_Data.Language_Params.Partial_Recursion);
@@ -491,9 +503,9 @@ begin
Duration'Image (To_Duration (Time_End - Time_Start)));
end if;
- Generate_Data.Parser_State_Count :=
- Generate_Data.LR_Parse_Table.State_Last -
Generate_Data.LR_Parse_Table.State_First + 1;
- WisiToken.BNF.Generate_Utils.Put_Stats (Input_Data,
Generate_Data);
+ if Parse_Table_File_Name /= "" then
+ Parse_Table_Append_Stats;
+ end if;
when Packrat_Generate_Algorithm =>
-- The only significant computation done for Packrat is First,
done
@@ -503,11 +515,21 @@ begin
(Input_Data.Grammar_Lexer.File_Name, Generate_Data.Grammar,
Generate_Data.Source_Line_Map,
Generate_Data.Descriptor.First_Terminal);
- Put_Line ("Tokens:");
- WisiToken.Put_Tokens (Generate_Data.Descriptor.all);
- New_Line;
- Put_Line ("Productions:");
- WisiToken.Productions.Put (Generate_Data.Grammar,
Generate_Data.Descriptor.all);
+ if Parse_Table_File_Name /= "" then
+ declare
+ Parse_Table_File : File_Type;
+ begin
+ Create (Parse_Table_File, Out_File,
Parse_Table_File_Name);
+ Set_Output (Parse_Table_File);
+ Put_Line ("Tokens:");
+ WisiToken.Put_Tokens (Generate_Data.Descriptor.all);
+ New_Line;
+ Put_Line ("Productions:");
+ WisiToken.Productions.Put (Generate_Data.Grammar,
Generate_Data.Descriptor.all);
+ Set_Output (Standard_Output);
+ Close (Parse_Table_File);
+ end;
+ end if;
Packrat_Data.Check_All (Generate_Data.Descriptor.all);
@@ -515,11 +537,6 @@ begin
null;
end case;
- if Do_Parse_Table_File then
- Set_Output (Standard_Output);
- Close (Parse_Table_File);
- end if;
-
if WisiToken.Generate.Error then
raise WisiToken.Grammar_Error with "errors: aborting";
end if;
diff --git a/wisitoken-bnf-generate_packrat.adb
b/wisitoken-bnf-generate_packrat.adb
index 8c785c6..e76fbee 100644
--- a/wisitoken-bnf-generate_packrat.adb
+++ b/wisitoken-bnf-generate_packrat.adb
@@ -6,7 +6,7 @@
--
-- See wisitoken-parse-packrat.ads.
--
--- Copyright (C) 2018 Free Software Foundation, Inc.
+-- Copyright (C) 2018, 2020 Free Software Foundation, Inc.
--
-- This library is free software; you can redistribute it and/or modify it
-- under terms of the GNU General Public License as published by the Free
@@ -153,7 +153,7 @@ is
else Action_Names (Prod.LHS)(RHS_Index).all &
"'Access,"));
if RHS.Tokens.Length = 0 then
- Indent_Line (" Children => (1 .. 0 =>
Syntax_Trees.Invalid_Node_Index),");
+ Indent_Line (" Children => (1 .. 0 =>
Invalid_Node_Index),");
elsif RHS.Tokens.Length = 1 then
Indent_Start (" Children => ");
diff --git a/wisitoken-bnf-generate_utils.adb b/wisitoken-bnf-generate_utils.adb
index 65f64e6..0e6eb4d 100644
--- a/wisitoken-bnf-generate_utils.adb
+++ b/wisitoken-bnf-generate_utils.adb
@@ -2,7 +2,7 @@
--
-- see spec
--
--- Copyright (C) 2014, 2015, 2017 - 2019 All Rights Reserved.
+-- Copyright (C) 2014, 2015, 2017 - 2020 All Rights Reserved.
--
-- This program is free software; you can redistribute it and/or
-- modify it under terms of the GNU General Public License as
@@ -134,7 +134,8 @@ package body WisiToken.BNF.Generate_Utils is
I := I + 1;
end loop;
end if;
- RHSs (RHS_Index) := (Tokens => Tokens, Action => null, Check
=> null);
+ RHSs (RHS_Index) :=
+ (Tokens => Tokens, Action => null, Check => null,
Recursion => <>);
if Length (Right_Hand_Side.Action) > 0 then
Action_All_Empty := False;
Action_Names (RHS_Index) := new String'
@@ -287,9 +288,8 @@ package body WisiToken.BNF.Generate_Utils is
end case;
end Constant_Reference;
- type Token_Access_Constant is access constant Token_Container;
- type Iterator is new Iterator_Interfaces.Forward_Iterator with record
- Container : Token_Access_Constant;
+ type Iterator (Container : not null access constant Token_Container)
+ is new Iterator_Interfaces.Forward_Iterator with record
Non_Grammar : Boolean;
Nonterminals : Boolean;
end record;
diff --git a/wisitoken-bnf-generate_utils.ads b/wisitoken-bnf-generate_utils.ads
index 0cd7508..a2f31a2 100644
--- a/wisitoken-bnf-generate_utils.ads
+++ b/wisitoken-bnf-generate_utils.ads
@@ -3,7 +3,7 @@
-- Utilities for translating input file structures to WisiToken
-- structures needed for LALR.Generate.
--
--- Copyright (C) 2014, 2015, 2017 - 2019 Free Software Foundation, Inc.
+-- Copyright (C) 2014, 2015, 2017 - 2020 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
@@ -33,8 +33,7 @@ package WisiToken.BNF.Generate_Utils is
WisiToken_Accept_Name : constant String := "wisitoken_accept";
- type Generate_Data is limited record
- Tokens : access constant WisiToken.BNF.Tokens;
+ type Generate_Data (Tokens : not null access constant WisiToken.BNF.Tokens)
is limited record
Descriptor : WisiToken.Descriptor_Access;
Grammar : WisiToken.Productions.Prod_Arrays.Vector;
@@ -77,7 +76,7 @@ package WisiToken.BNF.Generate_Utils is
is null record
with Implicit_Dereference => Element;
- type Token_Cursor is private;
+ type Token_Cursor (<>) is private;
-- Iterate thru Keywords, Tokens, Rules in a canonical order:
--
-- 1. Non_Grammar
@@ -163,8 +162,7 @@ private
type Token_Cursor_Kind is
(Non_Grammar_Kind, Terminals_Keywords, Terminals_Others, EOI,
WisiToken_Accept, Nonterminal, Done);
- type Token_Cursor is record
- Data : not null access constant Generate_Data;
+ type Token_Cursor (Data : not null access constant Generate_Data) is record
Kind : Token_Cursor_Kind;
ID : Token_ID;
Token_Kind : WisiToken.BNF.Token_Lists.Cursor; -- Non_Grammar or
Tokens, depending on Kind
diff --git a/wisitoken-bnf-output_ada.adb b/wisitoken-bnf-output_ada.adb
index 944e216..3857a0f 100644
--- a/wisitoken-bnf-output_ada.adb
+++ b/wisitoken-bnf-output_ada.adb
@@ -4,7 +4,7 @@
-- parameters, and a parser for that grammar. The grammar parser
-- actions must be Ada.
--
--- Copyright (C) 2017 - 2019 Free Software Foundation, Inc.
+-- Copyright (C) 2017 - 2020 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
@@ -187,8 +187,8 @@ is
Indent_Line ("procedure " & Name);
Indent_Line (" (User_Data : in out
WisiToken.Syntax_Trees.User_Data_Type'Class;");
Indent_Line (" Tree : in out
WisiToken.Syntax_Trees.Tree;");
- Indent_Line (" Nonterm : in
WisiToken.Syntax_Trees.Valid_Node_Index;");
- Indent_Line (" Tokens : in
WisiToken.Syntax_Trees.Valid_Node_Index_Array)");
+ Indent_Line (" Nonterm : in
WisiToken.Valid_Node_Index;");
+ Indent_Line (" Tokens : in
WisiToken.Valid_Node_Index_Array)");
Indent_Line ("is");
Indent := Indent + 3;
diff --git a/wisitoken-bnf-output_ada_common.adb
b/wisitoken-bnf-output_ada_common.adb
index ed4ef64..3a594bb 100644
--- a/wisitoken-bnf-output_ada_common.adb
+++ b/wisitoken-bnf-output_ada_common.adb
@@ -2,7 +2,7 @@
--
-- See spec.
--
--- Copyright (C) 2017 - 2019 Free Software Foundation, Inc.
+-- Copyright (C) 2017 - 2020 Free Software Foundation, Inc.
--
-- This library is free software; you can redistribute it and/or modify it
-- under terms of the GNU General Public License as published by the Free
@@ -34,7 +34,7 @@ package body WisiToken.BNF.Output_Ada_Common is
is
use Parse.LR;
Action_Node : Parse_Action_Node_Ptr;
- First : Boolean := True;
+ First : Boolean := True;
Action : Reduce_Action_Rec;
begin
for Node of State.Action_List loop
@@ -47,8 +47,8 @@ package body WisiToken.BNF.Output_Ada_Common is
end if;
if First then
- Action := Action_Node.Item;
- First := False;
+ Action := Action_Node.Item;
+ First := False;
else
if not Equal (Action, Action_Node.Item) then
return False;
@@ -58,6 +58,9 @@ package body WisiToken.BNF.Output_Ada_Common is
return True;
end Duplicate_Reduce;
+ function Image (Item : in Boolean) return String
+ is (if Item then "True" else "False");
+
function Symbols_Image (State : in Parse.LR.Parse_State) return String
is
use all type Ada.Containers.Count_Type;
@@ -209,8 +212,8 @@ package body WisiToken.BNF.Output_Ada_Common is
Indent_Line ("procedure " & Name.all);
Indent_Line (" (User_Data : in out
WisiToken.Syntax_Trees.User_Data_Type'Class;");
Indent_Line (" Tree : in out
WisiToken.Syntax_Trees.Tree;");
- Indent_Line (" Nonterm : in
WisiToken.Syntax_Trees.Valid_Node_Index;");
- Indent_Line (" Tokens : in
WisiToken.Syntax_Trees.Valid_Node_Index_Array);");
+ Indent_Line (" Nonterm : in
WisiToken.Valid_Node_Index;");
+ Indent_Line (" Tokens : in
WisiToken.Valid_Node_Index_Array);");
end if;
end loop;
end if;
@@ -556,34 +559,37 @@ package body WisiToken.BNF.Output_Ada_Common is
Trimmed_Image (Table.States (State_Index).Action_List.Length)
& ");");
if Duplicate_Reduce (Table.States (State_Index)) then
- declare
- Node : Action_Node renames Table.States
(State_Index).Action_List (1);
- Action : constant Reduce_Action_Rec := Node.Actions.Item;
- begin
- Set_Col (Indent);
- Line := +"Add_Action (Table.States (" & Trimmed_Image
(State_Index) & "), " &
- Symbols_Image (Table.States (State_Index)) & ", " &
- Image (Action.Production) & "," &
- Count_Type'Image (Action.Token_Count) & ", ";
-
- Append
- ((if Generate_Data.Action_Names (Action.Production.LHS) =
null then "null"
- elsif Generate_Data.Action_Names
- (Action.Production.LHS)(Action.Production.RHS) = null
then "null"
- else Generate_Data.Action_Names
- (Action.Production.LHS)(Action.Production.RHS).all &
"'Access"));
- Append (", ");
- Append
- ((if Generate_Data.Check_Names (Action.Production.LHS) =
null then "null"
- elsif Generate_Data.Check_Names
- (Action.Production.LHS)(Action.Production.RHS) = null
then "null"
- else Generate_Data.Check_Names
- (Action.Production.LHS)(Action.Production.RHS).all &
"'Access"));
-
- Indent_Wrap (-Line & ");");
- Line_Count := Line_Count + 1;
- Indent := Base_Indent;
- end;
+ if Table.States (State_Index).Action_List.Length > 0 then
+ -- We only get here with Length = 0 when there's a bug in
LALR_Generate.
+ declare
+ Node : Action_Node renames Table.States
(State_Index).Action_List (1);
+ Action : constant Reduce_Action_Rec := Node.Actions.Item;
+ begin
+ Set_Col (Indent);
+ Line := +"Add_Action (Table.States (" & Trimmed_Image
(State_Index) & "), " &
+ Symbols_Image (Table.States (State_Index)) & ", " &
+ Image (Action.Production) & ", " &
+ Count_Type'Image (Action.Token_Count) & ", ";
+
+ Append
+ ((if Generate_Data.Action_Names (Action.Production.LHS)
= null then "null"
+ elsif Generate_Data.Action_Names
+ (Action.Production.LHS)(Action.Production.RHS) =
null then "null"
+ else Generate_Data.Action_Names
+ (Action.Production.LHS)(Action.Production.RHS).all
& "'Access"));
+ Append (", ");
+ Append
+ ((if Generate_Data.Check_Names (Action.Production.LHS)
= null then "null"
+ elsif Generate_Data.Check_Names
+ (Action.Production.LHS)(Action.Production.RHS) =
null then "null"
+ else Generate_Data.Check_Names
+ (Action.Production.LHS)(Action.Production.RHS).all
& "'Access"));
+
+ Indent_Wrap (-Line & ");");
+ Line_Count := Line_Count + 1;
+ Indent := Base_Indent;
+ end;
+ end if;
else
for Node of Table.States (State_Index).Action_List loop
@@ -594,8 +600,8 @@ package body WisiToken.BNF.Output_Ada_Common is
case Action_Node.Item.Verb is
when Shift =>
Line := +"Add_Action (Table.States (" & Trimmed_Image
(State_Index) & "), " &
- Trimmed_Image (Node.Symbol);
- Append (", ");
+ Trimmed_Image (Node.Symbol) & ", ";
+ Append (Image (Action_Node.Item.Production) & ", ");
Append (Trimmed_Image (Action_Node.Item.State));
Append (");");
@@ -608,7 +614,7 @@ package body WisiToken.BNF.Output_Ada_Common is
Append (", Accept_It");
end if;
Append (", ");
- Append (Image (Action_Node.Item.Production) & ",");
+ Append (Image (Action_Node.Item.Production) & ", ");
Append (Count_Type'Image
(Action_Node.Item.Token_Count) & ", ");
Append
((if Generate_Data.Action_Names
(Action_Node.Item.Production.LHS) = null then "null"
@@ -644,7 +650,7 @@ package body WisiToken.BNF.Output_Ada_Common is
when Reduce | Accept_It =>
Line := +"Add_Conflict (Table.States (" &
Trimmed_Image (State_Index) & "), " &
Trimmed_Image (Node.Symbol) & ", ";
- Append (Image (Action_Node.Item.Production) & ",");
+ Append (Image (Action_Node.Item.Production) & ", ");
Append (Count_Type'Image
(Action_Node.Item.Token_Count) & ", ");
Append
((if Generate_Data.Action_Names
(Action_Node.Item.Production.LHS) = null then "null"
@@ -700,10 +706,6 @@ package body WisiToken.BNF.Output_Ada_Common is
Indent_Wrap
("Table.States (" & Trimmed_Image (State_Index) &
").Minimal_Complete_Actions := To_Vector (" &
Strict_Image (Table.States
(State_Index).Minimal_Complete_Actions, Strict => True) & ");");
- if Table.States
(State_Index).Minimal_Complete_Actions_Recursive then
- Indent_Wrap
- ("Table.States (" & Trimmed_Image (State_Index) &
").Minimal_Complete_Actions_Recursive := True;");
- end if;
end if;
end if;
@@ -737,7 +739,7 @@ package body WisiToken.BNF.Output_Ada_Common is
for Subr in 1 .. Subr_Count loop
Indent_Line ("Subr_" & Trimmed_Image (Subr) & ";");
end loop;
- Indent_Line ("Table.Error_Action := new Parse_Action_Node'((Verb =>
Error), null);");
+ Indent_Line ("Table.Error_Action := new Parse_Action_Node'((Verb =>
Error, others => <>), null);");
Indent := Indent - 3;
Indent_Line ("end;");
end Create_LR_Parser_Table;
@@ -1170,6 +1172,7 @@ package body WisiToken.BNF.Output_Ada_Common is
Put_Line ("/*!re2c");
Indent_Line ("re2c:yyfill:enable = 0;");
+ Indent_Line ("re2c:sentinel = 4;");
New_Line;
-- Regexps used in definitions
@@ -1193,6 +1196,8 @@ package body WisiToken.BNF.Output_Ada_Common is
null;
elsif Kind (I) = "keyword" and
Input_Data.Language_Params.Case_Insensitive then
+ -- This assumes re2c regular expression syntax, where single quote
+ -- means case insensitive.
Indent_Line (Name (I) & " = '" & Strip_Quotes (Value (I)) & "';");
else
diff --git a/wisitoken-bnf-output_ada_emacs.adb
b/wisitoken-bnf-output_ada_emacs.adb
index 2de6e0c..c0e91c2 100644
--- a/wisitoken-bnf-output_ada_emacs.adb
+++ b/wisitoken-bnf-output_ada_emacs.adb
@@ -12,7 +12,7 @@
-- If run in an Emacs dynamically loaded module, the parser actions
-- call the elisp actions directly.
--
--- Copyright (C) 2012 - 2015, 2017 - 2019 Free Software Foundation, Inc.
+-- Copyright (C) 2012 - 2015, 2017 - 2020 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
@@ -1150,7 +1150,8 @@ is
"Recover_Active, Nonterm);";
elsif Is_Present (Input_Data.Tokens.Actions, Elisp_Name) then
- -- Language-specific action
+ -- Language-specific action (used in wisitoken grammar mode for
+ -- wisi-check-parens).
declare
Item : Elisp_Action_Type renames Input_Data.Tokens.Actions
(Input_Data.Tokens.Actions.Find (+Elisp_Name));
@@ -1264,8 +1265,8 @@ is
Indent_Line ("procedure " & Name);
Indent_Line (" (User_Data : in out
WisiToken.Syntax_Trees.User_Data_Type'Class;");
Indent_Line (" Tree : in out WisiToken.Syntax_Trees.Tree;");
- Indent_Line (" Nonterm : in
WisiToken.Syntax_Trees.Valid_Node_Index;");
- Indent_Line (" Tokens : in
WisiToken.Syntax_Trees.Valid_Node_Index_Array)");
+ Indent_Line (" Nonterm : in WisiToken.Valid_Node_Index;");
+ Indent_Line (" Tokens : in
WisiToken.Valid_Node_Index_Array)");
Indent_Line ("is");
Indent := Indent + 3;
diff --git a/wisitoken-bnf.ads b/wisitoken-bnf.ads
index d586c4a..5263008 100644
--- a/wisitoken-bnf.ads
+++ b/wisitoken-bnf.ads
@@ -13,7 +13,7 @@
-- [1] https://en.wikipedia.org/wiki/Backus%E2%80%93Naur_form
-- [2] http://www.nongnu.org/ada-mode/wisi/wisi-user_guide.html, (info
"(wisi-user_guide)Top")
--
--- Copyright (C) 2012 - 2015, 2017 - 2019 Free Software Foundation, Inc.
+-- Copyright (C) 2012 - 2015, 2017 - 2020 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
@@ -211,26 +211,26 @@ package WisiToken.BNF is
-- Of the %mckenzie_cost_default declaration; we assume the others
-- are near.
- Default_Insert : Natural := 0;
- Default_Delete_Terminal : Natural := 0;
- Default_Push_Back : Natural := 0; -- also
default for undo_reduce
- Delete : String_Pair_Lists.List;
- Insert : String_Pair_Lists.List;
- Push_Back : String_Pair_Lists.List;
- Undo_Reduce : String_Pair_Lists.List;
- Minimal_Complete_Cost_Delta : Integer :=
+ Default_Insert : Natural := 0;
+ Default_Delete_Terminal : Natural := 0;
+ Default_Push_Back : Natural := 0; --
also default for undo_reduce
+ Delete : String_Pair_Lists.List;
+ Insert : String_Pair_Lists.List;
+ Push_Back : String_Pair_Lists.List;
+ Undo_Reduce : String_Pair_Lists.List;
+ Minimal_Complete_Cost_Delta : Integer :=
WisiToken.Parse.LR.Default_McKenzie_Param.Minimal_Complete_Cost_Delta;
- Fast_Forward : Integer :=
+ Fast_Forward : Integer :=
WisiToken.Parse.LR.Default_McKenzie_Param.Fast_Forward;
- Matching_Begin : Integer :=
+ Matching_Begin : Integer :=
WisiToken.Parse.LR.Default_McKenzie_Param.Matching_Begin;
- Ignore_Check_Fail : Natural :=
+ Ignore_Check_Fail : Natural :=
WisiToken.Parse.LR.Default_McKenzie_Param.Ignore_Check_Fail;
- Check_Limit : WisiToken.Token_Index :=
+ Check_Limit : WisiToken.Token_Index :=
WisiToken.Parse.LR.Default_McKenzie_Param.Check_Limit;
- Check_Delta_Limit : Natural :=
+ Check_Delta_Limit : Natural :=
WisiToken.Parse.LR.Default_McKenzie_Param.Check_Delta_Limit;
- Enqueue_Limit : Natural :=
+ Enqueue_Limit : Natural :=
WisiToken.Parse.LR.Default_McKenzie_Param.Enqueue_Limit;
end record;
diff --git a/wisitoken-generate-lr-lalr_generate.adb
b/wisitoken-generate-lr-lalr_generate.adb
index 3631f64..e544078 100644
--- a/wisitoken-generate-lr-lalr_generate.adb
+++ b/wisitoken-generate-lr-lalr_generate.adb
@@ -2,7 +2,7 @@
--
-- See spec.
--
--- Copyright (C) 2002 - 2005, 2008 - 2015, 2017 - 2019 Free Software
Foundation, Inc.
+-- Copyright (C) 2002 - 2005, 2008 - 2015, 2017 - 2020 Free Software
Foundation, Inc.
--
-- This file is part of the WisiToken package.
--
@@ -22,21 +22,48 @@ pragma License (Modified_GPL);
with Ada.Containers;
with Ada.Text_IO;
-with SAL.Gen_Definite_Doubly_Linked_Lists;
+with SAL.Gen_Definite_Doubly_Linked_Lists_Sorted;
package body WisiToken.Generate.LR.LALR_Generate is
- package Item_List_Cursor_Lists is new SAL.Gen_Definite_Doubly_Linked_Lists
(LR1_Items.Item_Lists.Cursor);
+ type Item_ID is record
+ State : Unknown_State_Index := Unknown_State;
+ LHS : Token_ID := Invalid_Token_ID;
+ RHS : Productions.RHS_Arrays.Extended_Index :=
Productions.RHS_Arrays.No_Index;
+ Dot : Token_ID_Arrays.Extended_Index :=
Token_ID_Arrays.No_Index;
+ end record;
+
+ function Image (Item : in Item_ID) return String
+ is ("(" & Item.State'Image & ", " & Trimmed_Image ((Item.LHS, Item.RHS))
& ")");
+
+ function Compare (Left, Right : in Item_ID) return SAL.Compare_Result
+ is (if Left.State < Right.State then SAL.Less
+ elsif Left.State > Right.State then SAL.Greater
+ elsif Left.LHS < Right.LHS then SAL.Less
+ elsif Left.LHS > Right.LHS then SAL.Greater
+ elsif Left.RHS < Right.RHS then SAL.Less
+ elsif Left.RHS > Right.RHS then SAL.Greater
+ elsif Left.Dot < Right.Dot then SAL.Less
+ elsif Left.Dot > Right.Dot then SAL.Greater
+ else SAL.Equal);
+
+ package Item_ID_Lists is new SAL.Gen_Definite_Doubly_Linked_Lists_Sorted
(Item_ID, Compare);
type Item_Map is record
- -- Keep track of all copies of Item, so Lookaheads can be updated
- -- after they are initially copied.
- From : LR1_Items.Item_Lists.Cursor;
- To : Item_List_Cursor_Lists.List;
+ From : Item_ID;
+ To : Item_ID_Lists.List;
end record;
- package Item_Map_Lists is new SAL.Gen_Definite_Doubly_Linked_Lists
(Item_Map);
- -- IMPROVEME: should be a 3D array indexed by Prod, rhs_index,
- -- dot_index. But it's not broken or slow, so we're not fixing it.
+ function Compare (Left, Right : in Item_Map) return SAL.Compare_Result
+ is (Compare (Left.From, Right.From));
+
+ package Propagation_Lists is new
SAL.Gen_Definite_Doubly_Linked_Lists_Sorted (Item_Map, Compare);
+
+ function Item_Ref
+ (Kernels : in out LR1_Items.Item_Set_List;
+ ID : in Item_ID)
+ return LR1_Items.Item_Lists.Variable_Reference_Type
+ is (LR1_Items.Item_Lists.Variable_Ref
+ (LR1_Items.Find (Prod => (ID.LHS, ID.RHS), Dot => ID.Dot, Set =>
Kernels (ID.State))));
function Propagate_Lookahead (Descriptor : in WisiToken.Descriptor) return
Token_ID_Set_Access
is begin
@@ -51,22 +78,15 @@ package body WisiToken.Generate.LR.LALR_Generate is
----------
-- Debug output
- procedure Put
- (Grammar : in WisiToken.Productions.Prod_Arrays.Vector;
- Descriptor : in WisiToken.Descriptor;
- Propagations : in Item_Map_Lists.List)
+ procedure Put (Propagations : in Propagation_Lists.List)
is
- use LR1_Items.Item_Lists;
+ use Item_ID_Lists;
begin
for Map of Propagations loop
- Ada.Text_IO.Put ("From ");
- LR1_Items.Put (Grammar, Descriptor, Constant_Ref (Map.From),
Show_Lookaheads => True);
- Ada.Text_IO.New_Line;
+ Ada.Text_IO.Put_Line ("From " & Image (Map.From));
- for Cur of Map.To loop
- Ada.Text_IO.Put ("To ");
- LR1_Items.Put (Grammar, Descriptor, Constant_Ref (Cur),
Show_Lookaheads => True);
- Ada.Text_IO.New_Line;
+ for ID of Map.To loop
+ Ada.Text_IO.Put_Line ("To " & Image (ID));
end loop;
end loop;
end Put;
@@ -87,62 +107,68 @@ package body WisiToken.Generate.LR.LALR_Generate is
use LR1_Items.Item_Lists;
Goto_Set : Item_Set;
- Dot_ID : Token_ID;
begin
for Item of Kernel.Set loop
- if Has_Element (Item.Dot) then
-
- Dot_ID := Element (Item.Dot);
- -- ID of token after Dot
-
- -- If Symbol = EOF_Token, this is the start symbol accept
- -- production; don't need a kernel with dot after EOF.
- if (Dot_ID = Symbol and Symbol /= Descriptor.EOI_ID) and then
- not Has_Element (Find (Item.Prod, Next (Item.Dot), Goto_Set))
- then
- Goto_Set.Set.Insert
- ((Prod => Item.Prod,
- Dot => Next (Item.Dot),
- Lookaheads => new Token_ID_Set'(Item.Lookaheads.all)));
-
- if Trace_Generate > Detail then
- Ada.Text_IO.Put_Line ("LALR_Goto_Transitions 1 " & Image
(Symbol, Descriptor));
- Put (Grammar, Descriptor, Goto_Set);
+ if Item.Dot /= No_Index then
+
+ declare
+ Dot : constant Token_ID_Arrays.Cursor :=
Productions.Constant_Ref_RHS
+ (Grammar, Item.Prod).Tokens.To_Cursor (Item.Dot);
+ Dot_ID : constant Token_ID := Element (Dot);
+ Next_Dot : constant Token_ID_Arrays.Cursor := Next (Dot);
+ begin
+ -- If Symbol = EOF_Token, this is the start symbol accept
+ -- production; don't need a kernel with dot after EOF.
+
+ if (Dot_ID = Symbol and Symbol /= Descriptor.EOI_ID) and then
+ not Has_Element (Find (Item, Goto_Set))
+ then
+ Goto_Set.Set.Insert
+ ((Prod => Item.Prod,
+ Dot => To_Index (Next_Dot),
+ Lookaheads => new Token_ID_Set'(Item.Lookaheads.all)));
+
+ if Trace_Generate_Table > Detail then
+ Ada.Text_IO.Put_Line ("LALR_Goto_Transitions 1 " & Image
(Symbol, Descriptor));
+ Put (Grammar, Descriptor, Goto_Set);
+ end if;
end if;
- end if;
- if Dot_ID in Descriptor.First_Nonterminal ..
Descriptor.Last_Nonterminal and then
- First_Nonterm_Set (Dot_ID, Symbol)
- then
- -- Find the production(s) that create Dot_ID with first token
Symbol
- -- and put them in.
- for Prod of Grammar loop
- for RHS_2_I in Prod.RHSs.First_Index .. Prod.RHSs.Last_Index
loop
- declare
- P_ID : constant Production_ID := (Prod.LHS,
RHS_2_I);
- Dot_2 : constant Token_ID_Arrays.Cursor := Prod.RHSs
(RHS_2_I).Tokens.First;
- begin
- if (Dot_ID = Prod.LHS or First_Nonterm_Set (Dot_ID,
Prod.LHS)) and
- (Has_Element (Dot_2) and then Element (Dot_2) =
Symbol)
- then
- if not Has_Element (Find (P_ID, Next (Dot_2),
Goto_Set)) then
- Goto_Set.Set.Insert
- ((Prod => P_ID,
- Dot => Next (Dot_2),
- Lookaheads => Null_Lookahead (Descriptor)));
-
- -- else already in goto set
+ if Dot_ID in Descriptor.First_Nonterminal ..
Descriptor.Last_Nonterminal and then
+ First_Nonterm_Set (Dot_ID, Symbol)
+ then
+ -- Find the production(s) that create Dot_ID with first
token Symbol
+ -- and put them in.
+ for Prod of Grammar loop
+ for RHS_2_I in Prod.RHSs.First_Index ..
Prod.RHSs.Last_Index loop
+ declare
+ P_ID : constant Production_ID :=
(Prod.LHS, RHS_2_I);
+ Tokens : Token_ID_Arrays.Vector renames
Prod.RHSs (RHS_2_I).Tokens;
+ Dot_2 : constant Token_ID_Arrays.Cursor :=
Tokens.First;
+ Next_Dot_2 : constant Token_ID_Arrays.Cursor :=
Next (Dot_2);
+ begin
+ if (Dot_ID = Prod.LHS or First_Nonterm_Set (Dot_ID,
Prod.LHS)) and
+ (Has_Element (Dot_2) and then Element (Dot_2) =
Symbol)
+ then
+ if not Has_Element (Find (P_ID, To_Index
(Next_Dot_2), Goto_Set)) then
+ Goto_Set.Set.Insert
+ ((Prod => P_ID,
+ Dot => To_Index (Next_Dot_2),
+ Lookaheads => Null_Lookahead
(Descriptor)));
+
+ -- else already in goto set
+ end if;
end if;
- end if;
- end;
+ end;
+ end loop;
end loop;
- end loop;
- if Trace_Generate > Detail then
- Ada.Text_IO.Put_Line ("LALR_Goto_Transitions 2 " & Image
(Symbol, Descriptor));
- Put (Grammar, Descriptor, Goto_Set);
+ if Trace_Generate_Table > Detail then
+ Ada.Text_IO.Put_Line ("LALR_Goto_Transitions 2 " & Image
(Symbol, Descriptor));
+ Put (Grammar, Descriptor, Goto_Set);
+ end if;
end if;
- end if;
+ end;
end if; -- item.dot /= null
end loop;
@@ -155,7 +181,6 @@ package body WisiToken.Generate.LR.LALR_Generate is
Descriptor : in WisiToken.Descriptor)
return LR1_Items.Item_Set_List
is
- use all type Token_ID_Arrays.Cursor;
use all type Ada.Containers.Count_Type;
use LR1_Items;
@@ -164,28 +189,28 @@ package body WisiToken.Generate.LR.LALR_Generate is
Kernel_Tree : LR1_Items.Item_Set_Trees.Tree; -- for fast find
States_To_Check : State_Index_Queues.Queue;
Checking_State : State_Index;
-
- New_Item_Set : Item_Set :=
- (Set => Item_Lists.To_List
- ((Prod => (Grammar.First_Index, 0),
- Dot => Grammar (Grammar.First_Index).RHSs (0).Tokens.First,
- Lookaheads => Null_Lookahead (Descriptor))),
- Goto_List => <>,
- Dot_IDs => <>,
- State => First_State_Index);
-
- Found_State : Unknown_State_Index;
begin
Kernels.Set_First_Last (First_State_Index, First_State_Index - 1);
- Add (New_Item_Set, Kernels, Kernel_Tree, Descriptor, Include_Lookaheads
=> False);
+ Add (Grammar,
+ (Set => Item_Lists.To_List
+ ((Prod => (Grammar.First_Index, 0),
+ Dot => Grammar (Grammar.First_Index).RHSs
(0).Tokens.First_Index,
+ Lookaheads => Null_Lookahead (Descriptor))),
+ Goto_List => <>,
+ Dot_IDs => <>,
+ State => First_State_Index),
+ Kernels,
+ Kernel_Tree,
+ Descriptor,
+ Include_Lookaheads => False);
States_To_Check.Put (First_State_Index);
loop
exit when States_To_Check.Is_Empty;
Checking_State := States_To_Check.Get;
- if Trace_Generate > Detail then
+ if Trace_Generate_Table > Detail then
Ada.Text_IO.Put ("Checking ");
Put (Grammar, Descriptor, Kernels (Checking_State));
end if;
@@ -195,50 +220,53 @@ package body WisiToken.Generate.LR.LALR_Generate is
-- Item_Set.Dot_IDs, so we can't iterate on that here as we do in
-- LR1_Generate.
- New_Item_Set := LALR_Goto_Transitions
- (Kernels (Checking_State), Symbol, First_Nonterm_Set, Grammar,
Descriptor);
-
- if New_Item_Set.Set.Length > 0 then
-
- Found_State := Find (New_Item_Set, Kernel_Tree,
Match_Lookaheads => False);
-
- if Found_State = Unknown_State then
- New_Item_Set.State := Kernels.Last_Index + 1;
+ declare
+ New_Item_Set : Item_Set := LALR_Goto_Transitions
+ (Kernels (Checking_State), Symbol, First_Nonterm_Set,
Grammar, Descriptor);
+ Found_State : Unknown_State_Index;
+ begin
+ if New_Item_Set.Set.Length > 0 then
- States_To_Check.Put (New_Item_Set.State);
+ Found_State := Find (New_Item_Set, Kernel_Tree,
Match_Lookaheads => False);
- Add (New_Item_Set, Kernels, Kernel_Tree, Descriptor,
Include_Lookaheads => False);
+ if Found_State = Unknown_State then
+ New_Item_Set.State := Kernels.Last_Index + 1;
- if Trace_Generate > Detail then
- Ada.Text_IO.Put_Line (" adding state" &
Unknown_State_Index'Image (Kernels.Last_Index));
+ States_To_Check.Put (New_Item_Set.State);
- Ada.Text_IO.Put_Line
- (" state" & Unknown_State_Index'Image (Checking_State)
&
- " adding goto on " & Image (Symbol, Descriptor) & "
to state" &
- Unknown_State_Index'Image (Kernels.Last_Index));
- end if;
+ Add (Grammar, New_Item_Set, Kernels, Kernel_Tree,
Descriptor, Include_Lookaheads => False);
- Kernels (Checking_State).Goto_List.Insert ((Symbol,
Kernels.Last_Index));
- else
+ if Trace_Generate_Table > Detail then
+ Ada.Text_IO.Put_Line (" adding state" &
Unknown_State_Index'Image (Kernels.Last_Index));
- -- If there's not already a goto entry between these two
sets, create one.
- if not Is_In ((Symbol, Found_State), Kernels
(Checking_State).Goto_List) then
- if Trace_Generate > Detail then
Ada.Text_IO.Put_Line
(" state" & Unknown_State_Index'Image
(Checking_State) &
" adding goto on " & Image (Symbol, Descriptor) &
" to state" &
- Unknown_State_Index'Image (Found_State));
-
+ Unknown_State_Index'Image (Kernels.Last_Index));
end if;
- Kernels (Checking_State).Goto_List.Insert ((Symbol,
Found_State));
+ Kernels (Checking_State).Goto_List.Insert ((Symbol,
Kernels.Last_Index));
+ else
+
+ -- If there's not already a goto entry between these two
sets, create one.
+ if not Is_In ((Symbol, Found_State), Kernels
(Checking_State).Goto_List) then
+ if Trace_Generate_Table > Detail then
+ Ada.Text_IO.Put_Line
+ (" state" & Unknown_State_Index'Image
(Checking_State) &
+ " adding goto on " & Image (Symbol,
Descriptor) & " to state" &
+ Unknown_State_Index'Image (Found_State));
+
+ end if;
+
+ Kernels (Checking_State).Goto_List.Insert ((Symbol,
Found_State));
+ end if;
end if;
end if;
- end if;
+ end;
end loop;
end loop;
- if Trace_Generate > Detail then
+ if Trace_Generate_Table > Detail then
Ada.Text_IO.New_Line;
end if;
@@ -248,60 +276,35 @@ package body WisiToken.Generate.LR.LALR_Generate is
-- Add a propagation entry (if it doesn't already exist) from From in
-- From_Set to To_Item.
procedure Add_Propagation
- (From : in LR1_Items.Item;
- From_Set : in LR1_Items.Item_Set;
+ (From_Item : in LR1_Items.Item;
+ From_State : in State_Index;
To_Item : in LR1_Items.Item_Lists.Cursor;
- Propagations : in out Item_Map_Lists.List)
+ To_State : in State_Index;
+ Propagations : in out Propagation_Lists.List)
is
- use Item_Map_Lists;
- use Item_List_Cursor_Lists;
+ use Propagation_Lists;
use LR1_Items;
use LR1_Items.Item_Lists;
+ use Item_ID_Lists;
+
+ To_Item_Ref : constant LR1_Items.Item_Lists.Constant_Reference_Type :=
Constant_Ref (To_Item);
- From_Cur : constant Item_Lists.Cursor := Find (From, From_Set);
+ From_ID : constant Item_ID := (From_State, From_Item.Prod.LHS,
From_Item.Prod.RHS, From_Item.Dot);
+ To_ID : constant Item_ID := (To_State, To_Item_Ref.Prod.LHS,
To_Item_Ref.Prod.RHS, To_Item_Ref.Dot);
- From_Match : Item_Map_Lists.Cursor := Propagations.First;
- To_Match : Item_List_Cursor_Lists.Cursor;
+ From_Match : constant Propagation_Lists.Cursor := Propagations.Find
((From_ID, Item_ID_Lists.Empty_List));
begin
- Find_From :
- loop
- exit Find_From when not Has_Element (From_Match);
+ if not Has_Element (From_Match) then
+ Propagations.Insert ((From_ID, To_List (To_ID)));
+ else
declare
- Map : Item_Map renames Constant_Ref (From_Match);
+ To_Match : constant Item_ID_Lists.Cursor := Constant_Ref
(From_Match).To.Find (To_ID);
begin
- if From_Cur = Map.From then
-
- To_Match := Map.To.First;
- loop
- exit when not Has_Element (To_Match);
-
- declare
- use all type SAL.Compare_Result;
- Cur : Item_Lists.Cursor renames Constant_Ref
(To_Match);
- Test_Item : LR1_Items.Item renames Constant_Ref (Cur);
- begin
- if Equal = LR1_Items.Item_Compare (Test_Item,
Constant_Ref (To_Item)) then
- exit Find_From;
- end if;
- end;
- Next (To_Match);
- end loop;
- exit Find_From;
+ if not Has_Element (To_Match) then
+ Variable_Ref (From_Match).To.Insert (To_ID);
end if;
end;
-
- Next (From_Match);
- end loop Find_From;
-
- if not Has_Element (From_Match) then
- Propagations.Append ((From_Cur, To_List (To_Item)));
-
- elsif not Has_Element (To_Match) then
- Variable_Ref (From_Match).To.Append (To_Item);
-
- else
- raise SAL.Programmer_Error with "Add_Propagation: unexpected case";
end if;
end Add_Propagation;
@@ -317,7 +320,7 @@ package body WisiToken.Generate.LR.LALR_Generate is
(Source_Item : in LR1_Items.Item;
Source_Set : in LR1_Items.Item_Set;
Closure_Item : in LR1_Items.Item;
- Propagations : in out Item_Map_Lists.List;
+ Propagations : in out Propagation_Lists.List;
Descriptor : in WisiToken.Descriptor;
Grammar : in WisiToken.Productions.Prod_Arrays.Vector;
Kernels : in out LR1_Items.Item_Set_List)
@@ -328,62 +331,65 @@ package body WisiToken.Generate.LR.LALR_Generate is
Spontaneous_Count : Integer := 0;
begin
- if Trace_Generate > Outline then
+ if Trace_Generate_Table > Outline then
Ada.Text_IO.Put_Line (" closure_item: ");
LR1_Items.Put (Grammar, Descriptor, Closure_Item);
Ada.Text_IO.New_Line;
end if;
- if not Has_Element (Closure_Item.Dot) then
+ if Closure_Item.Dot = No_Index then
return;
end if;
declare
- ID : constant Token_ID := Element
(Closure_Item.Dot);
- Next_Dot : constant Token_ID_Arrays.Cursor := Next
(Closure_Item.Dot);
+ Dot : constant Token_ID_Arrays.Cursor :=
Productions.Constant_Ref_RHS
+ (Grammar, Closure_Item.Prod).Tokens.To_Cursor (Closure_Item.Dot);
+ ID : constant Token_ID := Element (Dot);
+ Next_Dot : constant Token_ID_Arrays.Cursor := Next (Dot);
Goto_State : constant Unknown_State_Index := LR1_Items.Goto_State
(Source_Set, ID);
- To_Item : constant Item_Lists.Cursor :=
- (if Goto_State = Unknown_State then Item_Lists.No_Element
- else LR1_Items.Find (Closure_Item.Prod, Next_Dot, Kernels
(Goto_State)));
begin
- if Closure_Item.Lookaheads (Descriptor.Last_Lookahead) and
Has_Element (To_Item) then
- Add_Propagation
- (From => Source_Item,
- From_Set => Source_Set,
- To_Item => To_Item,
- Propagations => Propagations);
- end if;
+ if Goto_State /= Unknown_State then
+ declare
+ To_Item : constant Item_Lists.Cursor :=
+ LR1_Items.Find (Closure_Item.Prod, To_Index (Next_Dot),
Kernels (Goto_State));
+ begin
+ if Closure_Item.Lookaheads (Descriptor.Last_Lookahead) then
+ Add_Propagation
+ (From_Item => Source_Item,
+ From_State => Source_Set.State,
+ To_Item => To_Item,
+ To_State => Goto_State,
+ Propagations => Propagations);
+ end if;
- if Has_Element (To_Item) then
- if Trace_Generate > Outline then
- Spontaneous_Count := Spontaneous_Count + 1;
- Ada.Text_IO.Put_Line (" spontaneous: " & Lookahead_Image
(Closure_Item.Lookaheads.all, Descriptor));
- end if;
+ if Trace_Generate_Table > Outline then
+ Spontaneous_Count := Spontaneous_Count + 1;
+ Ada.Text_IO.Put_Line (" spontaneous: " & Lookahead_Image
(Closure_Item.Lookaheads.all, Descriptor));
+ end if;
- LR1_Items.Include (Variable_Ref (To_Item),
Closure_Item.Lookaheads.all, Descriptor);
+ LR1_Items.Include (Variable_Ref (To_Item),
Closure_Item.Lookaheads.all, Descriptor);
+ end;
end if;
end;
end Generate_Lookahead_Info;
procedure Propagate_Lookaheads
- (List : in Item_Map_Lists.List;
- Descriptor : in WisiToken.Descriptor)
+ (Propagations : in Propagation_Lists.List;
+ Kernels : in out LR1_Items.Item_Set_List;
+ Descriptor : in WisiToken.Descriptor)
is
- -- In List, update all To lookaheads from From lookaheads,
+ -- In Propagations, update all To lookaheads from From lookaheads,
-- recursively.
-
- use LR1_Items.Item_Lists;
-
More_To_Check : Boolean := True;
Added_One : Boolean;
begin
while More_To_Check loop
More_To_Check := False;
- for Mapping of List loop
- for Copy of Mapping.To loop
+ for Map of Propagations loop
+ for ID of Map.To loop
LR1_Items.Include
- (Variable_Ref (Copy), Constant_Ref
(Mapping.From).Lookaheads.all, Added_One, Descriptor);
+ (Item_Ref (Kernels, ID), Item_Ref (Kernels,
Map.From).Lookaheads.all, Added_One, Descriptor);
More_To_Check := More_To_Check or Added_One;
end loop;
@@ -401,53 +407,41 @@ package body WisiToken.Generate.LR.LALR_Generate is
Kernels : in out LR1_Items.Item_Set_List;
Descriptor : in WisiToken.Descriptor)
is
- pragma Warnings (Off, """Kernel_Item_Set"" is not modified, could be
declared constant");
- -- WORKAROUND: GNAT GPL 2018 complains Kernel_Item_Set could be a
constant, but
- -- when we declare that, it complains the target of the assignment of
- -- .Prod, .Dot below must be a variable.
-
- Kernel_Item_Set : LR1_Items.Item_Set := -- used for temporary arg to
Closure
- (Set => LR1_Items.Item_Lists.To_List
- ((Prod => <>,
- Dot => <>,
- Lookaheads => Propagate_Lookahead (Descriptor))),
- Goto_List => <>,
- Dot_IDs => <>,
- State => <>);
-
Closure : LR1_Items.Item_Set;
-
- Propagation_List : Item_Map_Lists.List;
-
+ Propagations : Propagation_Lists.List;
begin
for Kernel of Kernels loop
- if Trace_Generate > Outline then
+ if Trace_Generate_Table > Outline then
Ada.Text_IO.Put ("Adding lookaheads for ");
LR1_Items.Put (Grammar, Descriptor, Kernel);
end if;
for Kernel_Item of Kernel.Set loop
- Kernel_Item_Set.Set (Kernel_Item_Set.Set.First).Prod :=
Kernel_Item.Prod;
- Kernel_Item_Set.Set (Kernel_Item_Set.Set.First).Dot :=
Kernel_Item.Dot;
-
Closure := LR1_Items.Closure
- (Kernel_Item_Set, Has_Empty_Production, First_Terminal_Sequence,
Grammar, Descriptor);
+ ((Set => LR1_Items.Item_Lists.To_List
+ ((Prod => Kernel_Item.Prod,
+ Dot => Kernel_Item.Dot,
+ Lookaheads => Propagate_Lookahead (Descriptor))),
+ Goto_List => <>,
+ Dot_IDs => <>,
+ State => <>),
+ Has_Empty_Production, First_Terminal_Sequence, Grammar,
Descriptor);
for Closure_Item of Closure.Set loop
Generate_Lookahead_Info
- (Kernel_Item, Kernel, Closure_Item, Propagation_List,
Descriptor, Grammar, Kernels);
+ (Kernel_Item, Kernel, Closure_Item, Propagations, Descriptor,
Grammar, Kernels);
end loop;
end loop;
end loop;
- if Trace_Generate > Outline then
+ if Trace_Generate_Table > Outline then
Ada.Text_IO.New_Line;
Ada.Text_IO.Put_Line ("Propagations:");
- Put (Grammar, Descriptor, Propagation_List);
+ Put (Propagations);
Ada.Text_IO.New_Line;
end if;
- Propagate_Lookaheads (Propagation_List, Descriptor);
+ Propagate_Lookaheads (Propagations, Kernels, Descriptor);
end Fill_In_Lookaheads;
-- Add actions for all Kernels to Table.
@@ -475,38 +469,39 @@ package body WisiToken.Generate.LR.LALR_Generate is
Conflict_Counts, Conflicts, Descriptor);
end loop;
- if Trace_Generate > Detail then
+ if Trace_Generate_Table > Detail then
Ada.Text_IO.New_Line;
end if;
end Add_Actions;
function Generate
- (Grammar : in WisiToken.Productions.Prod_Arrays.Vector;
- Descriptor : in WisiToken.Descriptor;
- Known_Conflicts : in Conflict_Lists.List := Conflict_Lists.Empty_List;
- McKenzie_Param : in McKenzie_Param_Type := Default_McKenzie_Param;
- Put_Parse_Table : in Boolean := False;
- Include_Extra : in Boolean := False;
- Ignore_Conflicts : in Boolean := False;
- Partial_Recursion : in Boolean := True)
+ (Grammar : in out WisiToken.Productions.Prod_Arrays.Vector;
+ Descriptor : in WisiToken.Descriptor;
+ Known_Conflicts : in Conflict_Lists.List :=
Conflict_Lists.Empty_List;
+ McKenzie_Param : in McKenzie_Param_Type :=
Default_McKenzie_Param;
+ Parse_Table_File_Name : in String := "";
+ Include_Extra : in Boolean := False;
+ Ignore_Conflicts : in Boolean := False;
+ Partial_Recursion : in Boolean := True)
return Parse_Table_Ptr
is
use all type Ada.Containers.Count_Type;
- Ignore_Unused_Tokens : constant Boolean := WisiToken.Trace_Generate
> Detail;
- Ignore_Unknown_Conflicts : constant Boolean := Ignore_Conflicts or
WisiToken.Trace_Generate > Detail;
+ Ignore_Unused_Tokens : constant Boolean :=
WisiToken.Trace_Generate_Table > Detail;
+ Ignore_Unknown_Conflicts : constant Boolean := Ignore_Conflicts or
WisiToken.Trace_Generate_Table > Detail;
Unused_Tokens : constant Boolean :=
WisiToken.Generate.Check_Unused_Tokens (Descriptor, Grammar);
Table : Parse_Table_Ptr;
- Has_Empty_Production : constant Token_ID_Set :=
WisiToken.Generate.Has_Empty_Production (Grammar);
+ Nullable : constant Token_Array_Production_ID :=
WisiToken.Generate.Nullable (Grammar);
+ Has_Empty_Production : constant Token_ID_Set :=
WisiToken.Generate.Has_Empty_Production (Nullable);
Recursions : constant WisiToken.Generate.Recursions :=
(if Partial_Recursion
- then WisiToken.Generate.Compute_Partial_Recursion (Grammar)
- else WisiToken.Generate.Compute_Full_Recursion (Grammar));
+ then WisiToken.Generate.Compute_Partial_Recursion (Grammar,
Descriptor)
+ else WisiToken.Generate.Compute_Full_Recursion (Grammar, Descriptor));
Minimal_Terminal_Sequences : constant Minimal_Sequence_Array :=
- Compute_Minimal_Terminal_Sequences (Descriptor, Grammar, Recursions);
+ Compute_Minimal_Terminal_Sequences (Descriptor, Grammar);
Minimal_Terminal_First : constant Token_Array_Token_ID :=
Compute_Minimal_Terminal_First (Descriptor,
Minimal_Terminal_Sequences);
@@ -526,6 +521,11 @@ package body WisiToken.Generate.LR.LALR_Generate is
begin
WisiToken.Generate.Error := False; -- necessary in unit tests; some
previous test might have encountered an error.
+ if Trace_Generate_Table + Trace_Generate_Minimal_Complete > Outline then
+ Ada.Text_IO.New_Line;
+ Ada.Text_IO.Put_Line ("LALR_Generate");
+ end if;
+
Fill_In_Lookaheads (Grammar, Has_Empty_Production,
First_Terminal_Sequence, Kernels, Descriptor);
if Unused_Tokens then
@@ -533,7 +533,7 @@ package body WisiToken.Generate.LR.LALR_Generate is
Ada.Text_IO.New_Line;
end if;
- if Trace_Generate > Detail then
+ if Trace_Generate_Table > Detail then
Ada.Text_IO.New_Line;
Ada.Text_IO.Put_Line ("LR(1) Kernels:");
LR1_Items.Put (Grammar, Descriptor, Kernels, Show_Lookaheads => True);
@@ -575,17 +575,17 @@ package body WisiToken.Generate.LR.LALR_Generate is
Unknown_Conflicts, Table.all, Descriptor);
for State in Table.States'Range loop
- if Trace_Generate > Extra then
+ if Trace_Generate_Minimal_Complete > Extra then
Ada.Text_IO.Put_Line ("Set_Minimal_Complete_Actions:" &
State_Index'Image (State));
end if;
WisiToken.Generate.LR.Set_Minimal_Complete_Actions
- (Table.States (State), Kernels (State), Descriptor, Grammar,
Minimal_Terminal_Sequences,
+ (Table.States (State), Kernels (State), Descriptor, Grammar,
Nullable, Minimal_Terminal_Sequences,
Minimal_Terminal_First);
end loop;
- if Put_Parse_Table then
+ if Parse_Table_File_Name /= "" then
WisiToken.Generate.LR.Put_Parse_Table
- (Table, "LALR", Grammar, Recursions, Minimal_Terminal_Sequences,
Kernels, Conflict_Counts, Descriptor,
+ (Table, Parse_Table_File_Name, "LALR", Grammar, Recursions,
Kernels, Conflict_Counts, Descriptor,
Include_Extra);
end if;
diff --git a/wisitoken-generate-lr-lalr_generate.ads
b/wisitoken-generate-lr-lalr_generate.ads
index 9e33931..7527a9c 100644
--- a/wisitoken-generate-lr-lalr_generate.ads
+++ b/wisitoken-generate-lr-lalr_generate.ads
@@ -2,7 +2,7 @@
--
-- Generalized LALR parse table generator.
--
--- Copyright (C) 2002 - 2003, 2009 - 2010, 2013 - 2015, 2017 - 2019 Free
Software Foundation, Inc.
+-- Copyright (C) 2002 - 2003, 2009 - 2010, 2013 - 2015, 2017 - 2020 Free
Software Foundation, Inc.
--
-- This file is part of the WisiToken package.
--
@@ -25,14 +25,14 @@ with WisiToken.Productions;
package WisiToken.Generate.LR.LALR_Generate is
function Generate
- (Grammar : in WisiToken.Productions.Prod_Arrays.Vector;
- Descriptor : in WisiToken.Descriptor;
- Known_Conflicts : in Conflict_Lists.List := Conflict_Lists.Empty_List;
- McKenzie_Param : in McKenzie_Param_Type := Default_McKenzie_Param;
- Put_Parse_Table : in Boolean := False;
- Include_Extra : in Boolean := False;
- Ignore_Conflicts : in Boolean := False;
- Partial_Recursion : in Boolean := True)
+ (Grammar : in out WisiToken.Productions.Prod_Arrays.Vector;
+ Descriptor : in WisiToken.Descriptor;
+ Known_Conflicts : in Conflict_Lists.List :=
Conflict_Lists.Empty_List;
+ McKenzie_Param : in McKenzie_Param_Type :=
Default_McKenzie_Param;
+ Parse_Table_File_Name : in String := "";
+ Include_Extra : in Boolean := False;
+ Ignore_Conflicts : in Boolean := False;
+ Partial_Recursion : in Boolean := True)
return Parse_Table_Ptr
with Pre =>
Descriptor.Last_Lookahead = Descriptor.First_Nonterminal and
diff --git a/wisitoken-generate-lr-lr1_generate.adb
b/wisitoken-generate-lr-lr1_generate.adb
index d148c67..8f688c9 100644
--- a/wisitoken-generate-lr-lr1_generate.adb
+++ b/wisitoken-generate-lr-lr1_generate.adb
@@ -2,7 +2,7 @@
--
-- See spec.
--
--- Copyright (C) 2017 - 2019 Free Software Foundation, Inc.
+-- Copyright (C) 2017 - 2020 Free Software Foundation, Inc.
--
-- This file is part of the WisiToken package.
--
@@ -41,15 +41,23 @@ package body WisiToken.Generate.LR.LR1_Generate is
Goto_Set : Item_Set;
begin
for Item of Set.Set loop
- if Item.Dot /= No_Element then
- if Element (Item.Dot) = Symbol and
- -- We don't need a state with dot after EOI in the
- -- accept production. EOI should only appear in the
- -- accept production.
- Symbol /= Descriptor.EOI_ID
- then
- Goto_Set.Set.Insert ((Item.Prod, Next (Item.Dot), new
Token_ID_Set'(Item.Lookaheads.all)));
- end if;
+ if Item.Dot /= No_Index then
+ declare
+ Dot : constant Token_ID_Arrays.Cursor :=
Productions.Constant_Ref_RHS
+ (Grammar, Item.Prod).Tokens.To_Cursor (Item.Dot);
+ begin
+ if Element (Dot) = Symbol and
+ -- We don't need a state with dot after EOI in the
+ -- accept production. EOI should only appear in the
+ -- accept production.
+ Symbol /= Descriptor.EOI_ID
+ then
+ Goto_Set.Set.Insert
+ ((Item.Prod,
+ To_Index (Next (Dot)),
+ new Token_ID_Set'(Item.Lookaheads.all)));
+ end if;
+ end;
end if;
end loop;
@@ -90,7 +98,7 @@ package body WisiToken.Generate.LR.LR1_Generate is
New_Item_Set : Item_Set := Closure
((Set => Item_Lists.To_List
((Prod => (Grammar.First_Index, 0),
- Dot => Grammar (Grammar.First_Index).RHSs
(0).Tokens.First,
+ Dot => Grammar (Grammar.First_Index).RHSs
(0).Tokens.First_Index,
Lookaheads => new Token_ID_Set'(To_Lookahead (Descriptor.EOI_ID,
Descriptor)))),
Goto_List => <>,
Dot_IDs => <>,
@@ -102,14 +110,14 @@ package body WisiToken.Generate.LR.LR1_Generate is
begin
C.Set_First_Last (First_State_Index, First_State_Index - 1);
- Add (New_Item_Set, C, C_Tree, Descriptor, Include_Lookaheads => True);
+ Add (Grammar, New_Item_Set, C, C_Tree, Descriptor, Include_Lookaheads =>
True);
States_To_Check.Put (First_State_Index);
loop
exit when States_To_Check.Is_Empty;
I := States_To_Check.Get;
- if Trace_Generate > Outline then
+ if Trace_Generate_Table > Outline then
Ada.Text_IO.Put ("Checking ");
Put (Grammar, Descriptor, C (I), Show_Lookaheads => True,
Show_Goto_List => True);
end if;
@@ -134,9 +142,9 @@ package body WisiToken.Generate.LR.LR1_Generate is
States_To_Check.Put (New_Item_Set.State);
- Add (New_Item_Set, C, C_Tree, Descriptor, Include_Lookaheads
=> True);
+ Add (Grammar, New_Item_Set, C, C_Tree, Descriptor,
Include_Lookaheads => True);
- if Trace_Generate > Outline then
+ if Trace_Generate_Table > Outline then
Ada.Text_IO.Put_Line
(" adding state" & Unknown_State_Index'Image
(C.Last_Index) & ": from state" &
Unknown_State_Index'Image (I) & " on " & Image
(Symbol, Descriptor));
@@ -148,7 +156,7 @@ package body WisiToken.Generate.LR.LR1_Generate is
-- If there's not already a goto entry between these two
sets, create one.
if not Is_In ((Symbol, Found_State), Goto_List => C
(I).Goto_List) then
- if Trace_Generate > Outline then
+ if Trace_Generate_Table > Outline then
Ada.Text_IO.Put_Line
(" adding goto on " & Image (Symbol, Descriptor) &
" to state" &
Unknown_State_Index'Image (Found_State));
@@ -162,7 +170,7 @@ package body WisiToken.Generate.LR.LR1_Generate is
end loop;
end loop;
- if Trace_Generate > Outline then
+ if Trace_Generate_Table > Outline then
Ada.Text_IO.New_Line;
end if;
@@ -186,38 +194,39 @@ package body WisiToken.Generate.LR.LR1_Generate is
(Item_Set, Table, Grammar, Has_Empty_Production, First_Nonterm_Set,
Conflict_Counts, Conflicts, Descriptor);
end loop;
- if Trace_Generate > Outline then
+ if Trace_Generate_Table > Outline then
Ada.Text_IO.New_Line;
end if;
end Add_Actions;
function Generate
- (Grammar : in WisiToken.Productions.Prod_Arrays.Vector;
- Descriptor : in WisiToken.Descriptor;
- Known_Conflicts : in Conflict_Lists.List := Conflict_Lists.Empty_List;
- McKenzie_Param : in McKenzie_Param_Type := Default_McKenzie_Param;
- Put_Parse_Table : in Boolean := False;
- Include_Extra : in Boolean := False;
- Ignore_Conflicts : in Boolean := False;
- Partial_Recursion : in Boolean := True)
+ (Grammar : in out WisiToken.Productions.Prod_Arrays.Vector;
+ Descriptor : in WisiToken.Descriptor;
+ Known_Conflicts : in Conflict_Lists.List :=
Conflict_Lists.Empty_List;
+ McKenzie_Param : in McKenzie_Param_Type :=
Default_McKenzie_Param;
+ Parse_Table_File_Name : in String := "";
+ Include_Extra : in Boolean := False;
+ Ignore_Conflicts : in Boolean := False;
+ Partial_Recursion : in Boolean := True)
return Parse_Table_Ptr
is
use type Ada.Containers.Count_Type;
- Ignore_Unused_Tokens : constant Boolean := WisiToken.Trace_Generate
> Detail;
- Ignore_Unknown_Conflicts : constant Boolean := Ignore_Conflicts or
WisiToken.Trace_Generate > Detail;
+ Ignore_Unused_Tokens : constant Boolean :=
WisiToken.Trace_Generate_Table > Detail;
+ Ignore_Unknown_Conflicts : constant Boolean := Ignore_Conflicts or
WisiToken.Trace_Generate_Table > Detail;
Unused_Tokens : constant Boolean :=
WisiToken.Generate.Check_Unused_Tokens (Descriptor, Grammar);
Table : Parse_Table_Ptr;
- Has_Empty_Production : constant Token_ID_Set :=
WisiToken.Generate.Has_Empty_Production (Grammar);
+ Nullable : constant Token_Array_Production_ID :=
WisiToken.Generate.Nullable (Grammar);
+ Has_Empty_Production : constant Token_ID_Set :=
WisiToken.Generate.Has_Empty_Production (Nullable);
Recursions : constant WisiToken.Generate.Recursions :=
(if Partial_Recursion
- then WisiToken.Generate.Compute_Partial_Recursion (Grammar)
- else WisiToken.Generate.Compute_Full_Recursion (Grammar));
+ then WisiToken.Generate.Compute_Partial_Recursion (Grammar,
Descriptor)
+ else WisiToken.Generate.Compute_Full_Recursion (Grammar, Descriptor));
Minimal_Terminal_Sequences : constant Minimal_Sequence_Array :=
- Compute_Minimal_Terminal_Sequences (Descriptor, Grammar, Recursions);
+ Compute_Minimal_Terminal_Sequences (Descriptor, Grammar);
Minimal_Terminal_First : constant Token_Array_Token_ID :=
Compute_Minimal_Terminal_First (Descriptor,
Minimal_Terminal_Sequences);
@@ -235,10 +244,13 @@ package body WisiToken.Generate.LR.LR1_Generate is
Unknown_Conflicts : Conflict_Lists.List;
Known_Conflicts_Edit : Conflict_Lists.List := Known_Conflicts;
begin
- if Trace_Generate > Outline then
+ if Trace_Generate_Table + Trace_Generate_Minimal_Complete > Outline then
Ada.Text_IO.New_Line;
- Ada.Text_IO.Put_Line ("LR(1) Item_Sets:");
- LR1_Items.Put (Grammar, Descriptor, Item_Sets);
+ Ada.Text_IO.Put_Line ("LR1_Generate:");
+ if Trace_Generate_Table > Outline then
+ Ada.Text_IO.Put_Line ("Item_Sets:");
+ LR1_Items.Put (Grammar, Descriptor, Item_Sets);
+ end if;
end if;
Table := new Parse_Table
@@ -277,22 +289,22 @@ package body WisiToken.Generate.LR.LR1_Generate is
Conflict_Counts, Unknown_Conflicts, Table.all, Descriptor);
for State in Table.States'Range loop
- if Trace_Generate > Extra then
+ if Trace_Generate_Minimal_Complete > Extra then
Ada.Text_IO.Put_Line ("Set_Minimal_Complete_Actions:" &
State_Index'Image (State));
end if;
WisiToken.Generate.LR.Set_Minimal_Complete_Actions
(Table.States (State),
LR1_Items.Filter (Item_Sets (State), Grammar, Descriptor,
LR1_Items.In_Kernel'Access),
- Descriptor, Grammar, Minimal_Terminal_Sequences,
Minimal_Terminal_First);
+ Descriptor, Grammar, Nullable, Minimal_Terminal_Sequences,
Minimal_Terminal_First);
end loop;
- if Put_Parse_Table then
+ if Parse_Table_File_Name /= "" then
WisiToken.Generate.LR.Put_Parse_Table
- (Table, "LR1", Grammar, Recursions, Minimal_Terminal_Sequences,
Item_Sets, Conflict_Counts, Descriptor,
+ (Table, Parse_Table_File_Name, "LR1", Grammar, Recursions,
Item_Sets, Conflict_Counts, Descriptor,
Include_Extra);
end if;
- if Trace_Generate > Outline then
+ if Trace_Generate_Table > Outline then
Ada.Text_IO.New_Line;
Ada.Text_IO.Put_Line ("Has_Empty_Production: " & Image
(Has_Empty_Production, Descriptor));
diff --git a/wisitoken-generate-lr-lr1_generate.ads
b/wisitoken-generate-lr-lr1_generate.ads
index 6e8ade6..d0f2d9f 100644
--- a/wisitoken-generate-lr-lr1_generate.ads
+++ b/wisitoken-generate-lr-lr1_generate.ads
@@ -7,7 +7,7 @@
-- [dragon] "Compilers Principles, Techniques, and Tools" by Aho,
-- Sethi, and Ullman (aka: "The [Red] Dragon Book").
--
--- Copyright (C) 2017 - 2019 Free Software Foundation, Inc.
+-- Copyright (C) 2017 - 2020 Free Software Foundation, Inc.
--
-- This file is part of the WisiToken package.
--
@@ -30,20 +30,22 @@ with WisiToken.Productions;
package WisiToken.Generate.LR.LR1_Generate is
function Generate
- (Grammar : in WisiToken.Productions.Prod_Arrays.Vector;
- Descriptor : in WisiToken.Descriptor;
- Known_Conflicts : in Conflict_Lists.List := Conflict_Lists.Empty_List;
- McKenzie_Param : in McKenzie_Param_Type := Default_McKenzie_Param;
- Put_Parse_Table : in Boolean := False;
- Include_Extra : in Boolean := False;
- Ignore_Conflicts : in Boolean := False;
- Partial_Recursion : in Boolean := True)
+ (Grammar : in out WisiToken.Productions.Prod_Arrays.Vector;
+ Descriptor : in WisiToken.Descriptor;
+ Known_Conflicts : in Conflict_Lists.List :=
Conflict_Lists.Empty_List;
+ McKenzie_Param : in McKenzie_Param_Type :=
Default_McKenzie_Param;
+ Parse_Table_File_Name : in String := "";
+ Include_Extra : in Boolean := False;
+ Ignore_Conflicts : in Boolean := False;
+ Partial_Recursion : in Boolean := True)
return Parse_Table_Ptr
with Pre => Descriptor.First_Nonterminal = Descriptor.Accept_ID;
-- Generate a generalized LR1 parse table for Grammar. The
-- grammar start symbol is the LHS of the first production in
-- Grammar.
--
+ -- Sets Recursive components in Grammar.
+ --
-- If Trace, output debug info to Standard_Error about generation
-- process. We don't use WisiToken.Trace here; we often want to
-- see a trace of the parser execution without the parser
diff --git a/wisitoken-generate-lr.adb b/wisitoken-generate-lr.adb
index 54ddfd6..d66746d 100644
--- a/wisitoken-generate-lr.adb
+++ b/wisitoken-generate-lr.adb
@@ -2,7 +2,7 @@
--
-- See spec.
--
--- Copyright (C) 2017 - 2019 Free Software Foundation, Inc.
+-- Copyright (C) 2017 - 2020 Free Software Foundation, Inc.
--
-- This library is free software; you can redistribute it and/or modify it
-- under terms of the GNU General Public License as published by the Free
@@ -40,8 +40,8 @@ package body WisiToken.Generate.LR is
Min_RHS : Natural := Natural'Last;
begin
for RHS in Item.First_Index .. Item.Last_Index loop
- if RHS_Set (RHS) and then Min_Length > Item (RHS).Sequence.Length then
- Min_Length := Item (RHS).Sequence.Length;
+ if RHS_Set (RHS) and then Min_Length > Item (RHS).Length then
+ Min_Length := Item (RHS).Length;
Min_RHS := RHS;
end if;
end loop;
@@ -52,63 +52,15 @@ package body WisiToken.Generate.LR is
end if;
end Min;
- function Net_Recursion (Cycle : in Recursion_Cycle; RHS : in Natural)
return Recursion
- is
- Result : Recursion := None;
- begin
- if Cycle'Length = 1 then
- for E of Cycle (Cycle'First).Edges loop
- if E.Data.RHS = RHS then
- Result := Net_Recursion (Result, E.Data.Recursive);
- end if;
- end loop;
- else
- for Item of Cycle loop
- for E of Item.Edges loop
- Result := Net_Recursion (Result, E.Data.Recursive);
- end loop;
- end loop;
- end if;
- return Result;
- end Net_Recursion;
-
- function Worst_Recursion (Cycle : in Recursion_Cycle; RHS : in Natural)
return Recursion
- is
- Result : Recursion := None;
- begin
- if Cycle'Length = 1 then
- for E of Cycle (Cycle'First).Edges loop
- if E.Data.RHS = RHS then
- Result := Worst_Recursion (Result, E.Data.Recursive);
- end if;
- end loop;
- else
- for Item of Cycle loop
- for E of Item.Edges loop
- Result := Worst_Recursion (Result, E.Data.Recursive);
- end loop;
- end loop;
- end if;
- return Result;
- end Worst_Recursion;
-
- function Worst_Recursion
- (Recursion_IDs : in Recursion_Lists.List;
- Recursions : in Generate.Recursions;
- RHS : in Natural)
- return Recursion
- is
- Result : Recursion := None;
- begin
- for ID of Recursion_IDs loop
- Result := Worst_Recursion
- (Result,
- (if Recursions.Full
- then Net_Recursion (Recursions.Recursions (ID), RHS)
- else Worst_Recursion (Recursions.Recursions (ID), RHS)));
- end loop;
- return Result;
- end Worst_Recursion;
+ function Image
+ (Nonterm : in Token_ID;
+ Sequences : in Minimal_Sequence_Array;
+ Descriptor : in WisiToken.Descriptor)
+ return String
+ is begin
+ return Trimmed_Image (Nonterm) & " " & Image (Nonterm, Descriptor) & "
==> (" &
+ Sequences (Nonterm).Min_RHS'Image & ", " & Image (Sequences
(Nonterm).Sequence, Descriptor) & ")";
+ end Image;
procedure Terminal_Sequence
(Grammar : in WisiToken.Productions.Prod_Arrays.Vector;
@@ -132,8 +84,8 @@ package body WisiToken.Generate.LR is
is
Prod : Productions.Instance renames Grammar (LHS);
begin
- if All_Sequences (LHS).Length = 0 then
- All_Sequences (LHS).Set_First_Last (Prod.RHSs.First_Index,
Prod.RHSs.Last_Index);
+ if All_Sequences (LHS).Sequence.Length = 0 then
+ All_Sequences (LHS).Sequence.Set_First_Last
(Prod.RHSs.First_Index, Prod.RHSs.Last_Index);
end if;
if RHS_Seq_Set (LHS).Length = 0 then
RHS_Seq_Set (LHS).Set_First_Last (Prod.RHSs.First_Index,
Prod.RHSs.Last_Index);
@@ -155,12 +107,12 @@ package body WisiToken.Generate.LR is
for RHS in Prod.RHSs.First_Index .. Prod.RHSs.Last_Index loop
if not RHS_Seq_Set (Nonterm)(RHS) then
- if Trace_Generate > Extra then
+ if Trace_Generate_Minimal_Complete > Extra then
Ada.Text_IO.Put_Line (Trimmed_Image ((Nonterm, RHS)) & " " &
Image (Nonterm, Descriptor) & " compute");
end if;
if Prod.RHSs (RHS).Tokens.Length = 0 then
RHS_Seq_Set (Nonterm)(RHS) := True;
- if Trace_Generate > Extra then
+ if Trace_Generate_Minimal_Complete > Extra then
Ada.Text_IO.Put_Line (Trimmed_Image (Production_ID'(Nonterm,
RHS)) & " => () empty");
end if;
@@ -170,7 +122,7 @@ package body WisiToken.Generate.LR is
ID : Token_ID renames Prod.RHSs (RHS).Tokens (I);
begin
if ID in Terminals then
- All_Sequences (Nonterm) (RHS).Sequence.Append (ID);
+ All_Sequences (Nonterm).Sequence (RHS).Append (ID);
else
if (for some RHS of RHS_Seq_Set (ID) => RHS) then
@@ -179,7 +131,7 @@ package body WisiToken.Generate.LR is
else
if ID = Nonterm or Recursing (ID) then
-- Clear partial minimal sequence; we are
starting over.
- All_Sequences (Nonterm)(RHS).Sequence.Clear;
+ All_Sequences (Nonterm).Sequence (RHS).Clear;
goto Skip;
else
@@ -192,24 +144,26 @@ package body WisiToken.Generate.LR is
-- Found a minimal sequence for ID; use it
null;
else
- All_Sequences (Nonterm)(RHS).Sequence.Clear;
+ All_Sequences (Nonterm).Sequence (RHS).Clear;
goto Skip;
end if;
end if;
end if;
declare
- Min_RHS : constant Integer := Min (All_Sequences
(ID), RHS_Seq_Set (ID));
+ Min_RHS : constant Integer := Min (All_Sequences
(ID).Sequence, RHS_Seq_Set (ID));
begin
- All_Sequences (Nonterm)(RHS).Sequence.Append
(All_Sequences (ID)(Min_RHS).Sequence);
+ All_Sequences (ID).Min_RHS := Min_RHS;
+
+ All_Sequences (Nonterm).Sequence (RHS).Append
(All_Sequences (ID).Sequence (Min_RHS));
end;
end if;
end;
end loop;
RHS_Seq_Set (Nonterm)(RHS) := True;
- if Trace_Generate > Extra then
+ if Trace_Generate_Minimal_Complete > Extra then
Ada.Text_IO.Put_Line
(Trimmed_Image (Production_ID'(Nonterm, RHS)) & " => " &
- Image (All_Sequences (Nonterm)(RHS), Descriptor));
+ Image (All_Sequences (Nonterm).Sequence (RHS),
Descriptor));
end if;
end if;
end if;
@@ -221,7 +175,7 @@ package body WisiToken.Generate.LR is
if (for some RHS of RHS_Seq_Set (Nonterm) => not RHS) then
-- Some RHSs are have unresolved recursion; we will
-- eventually try again when the recursion is resolved.
- if Trace_Generate > Extra then
+ if Trace_Generate_Minimal_Complete > Extra then
Ada.Text_IO.Put_Line
(Trimmed_Image (Nonterm) & " " & Image (Nonterm, Descriptor)
& " skipped some recursive");
end if;
@@ -231,10 +185,8 @@ package body WisiToken.Generate.LR is
All_Seq_Set (Nonterm) := True;
- if Trace_Generate > Extra then
- Ada.Text_IO.Put_Line
- (Trimmed_Image (Nonterm) & " " & Image (Nonterm, Descriptor) & "
==> " &
- Image (All_Sequences (Nonterm), Descriptor));
+ if Trace_Generate_Minimal_Complete > Extra then
+ Ada.Text_IO.Put_Line (Image (Nonterm, All_Sequences, Descriptor));
end if;
end Terminal_Sequence;
@@ -265,7 +217,7 @@ package body WisiToken.Generate.LR is
is
Matching_Action : constant Action_Arrays.Find_Reference_Type :=
Action_List.Find (Symbol);
begin
- if Trace_Generate > Detail then
+ if Trace_Generate_Table > Detail then
Ada.Text_IO.Put (Image (Symbol, Descriptor) & " => ");
Put (Descriptor, Action);
Ada.Text_IO.New_Line;
@@ -274,7 +226,7 @@ package body WisiToken.Generate.LR is
if Matching_Action.Element /= null then
if Is_In (Action, Matching_Action.Actions) then
-- Action is already in the list.
- if Trace_Generate > Detail then
+ if Trace_Generate_Table > Detail then
Ada.Text_IO.Put_Line (" - already present");
end if;
return;
@@ -352,11 +304,11 @@ package body WisiToken.Generate.LR is
-- item set. Only add it to conflicts once.
Conflicts.Append (New_Conflict);
- if Trace_Generate > Detail then
+ if Trace_Generate_Table > Detail then
Ada.Text_IO.Put_Line (" - conflict added: " & Image
(New_Conflict, Descriptor));
end if;
else
- if Trace_Generate > Detail then
+ if Trace_Generate_Table > Detail then
Ada.Text_IO.Put_Line (" - conflict duplicate: " & Image
(New_Conflict, Descriptor));
end if;
end if;
@@ -383,71 +335,78 @@ package body WisiToken.Generate.LR is
Conflicts : in out Conflict_Lists.List;
Descriptor : in WisiToken.Descriptor)
is
- use WisiToken.Token_ID_Arrays;
+ use Token_ID_Arrays;
State : constant State_Index := Closure.State;
begin
- if Trace_Generate > Detail then
+ if Trace_Generate_Table > Detail then
Ada.Text_IO.Put_Line ("adding actions for state" & State_Index'Image
(State));
end if;
for Item of Closure.Set loop
- if Item.Dot = No_Element then
- -- Pointer is at the end of the production; add a reduce action.
+ declare
+ Dot : constant Token_ID_Arrays.Cursor :=
Productions.Constant_Ref_RHS
+ (Grammar, Item.Prod).Tokens.To_Cursor (Item.Dot);
+ begin
+ if not Has_Element (Dot) then
+ Add_Lookahead_Actions
+ (Item, Table.States (State).Action_List, Grammar,
Has_Empty_Production, First_Nonterm_Set,
+ Conflict_Counts, Conflicts, Closure, Descriptor);
- Add_Lookahead_Actions
- (Item, Table.States (State).Action_List, Grammar,
Has_Empty_Production, First_Nonterm_Set,
- Conflict_Counts, Conflicts, Closure, Descriptor);
+ elsif Element (Dot) in
+ Descriptor.First_Terminal .. Descriptor.Last_Terminal
+ then
+ -- Dot is before a terminal token.
+ declare
+ use all type Ada.Containers.Count_Type;
- elsif Element (Item.Dot) in Descriptor.First_Terminal ..
Descriptor.Last_Terminal then
- -- Dot is before a terminal token.
- declare
- use all type Ada.Containers.Count_Type;
+ P_ID : constant Production_ID := Item.Prod;
- Dot_ID : constant Token_ID := Element (Item.Dot);
- -- ID of token after Item.Dot
+ Dot_ID : constant Token_ID := Element (Dot);
+ -- ID of token after Item.Dot
- Goto_State : constant Unknown_State_Index :=
LR1_Items.Goto_State (Closure, Dot_ID);
- begin
- if Dot_ID = Descriptor.EOI_ID then
- -- This is the start symbol production with dot before EOF.
- declare
- P_ID : constant Production_ID := Item.Prod;
- RHS : Productions.Right_Hand_Side renames Grammar
(P_ID.LHS).RHSs (P_ID.RHS);
- begin
- Add_Action
- (Dot_ID,
- (Accept_It, P_ID, RHS.Action, RHS.Check,
RHS.Tokens.Length - 1),
- -- EOF is not pushed on stack in parser, because the
action for EOF
- -- is Accept, not Shift.
- Table.States (State).Action_List, Closure,
- Grammar, Has_Empty_Production, First_Nonterm_Set,
Conflict_Counts, Conflicts, Descriptor);
- end;
- else
- if Goto_State /= Unknown_State then
- Add_Action
- (Dot_ID,
- (Shift, Goto_State),
- Table.States (State).Action_List,
- Closure, Grammar, Has_Empty_Production,
First_Nonterm_Set,
- Conflict_Counts, Conflicts, Descriptor);
+ Goto_State : constant Unknown_State_Index :=
LR1_Items.Goto_State (Closure, Dot_ID);
+ begin
+ if Dot_ID = Descriptor.EOI_ID then
+ -- This is the start symbol production with dot before
EOF.
+ declare
+ RHS : Productions.Right_Hand_Side renames Grammar
(P_ID.LHS).RHSs (P_ID.RHS);
+ begin
+ Add_Action
+ (Dot_ID,
+ (Accept_It, P_ID, RHS.Action, RHS.Check,
RHS.Tokens.Length - 1),
+ -- EOF is not pushed on stack in parser, because
the action for EOF
+ -- is Accept, not Shift.
+ Table.States (State).Action_List, Closure,
+ Grammar, Has_Empty_Production, First_Nonterm_Set,
Conflict_Counts, Conflicts, Descriptor);
+ end;
+ else
+ if Goto_State /= Unknown_State then
+ Add_Action
+ (Dot_ID,
+ (Shift, P_ID, Goto_State),
+ Table.States (State).Action_List,
+ Closure, Grammar, Has_Empty_Production,
First_Nonterm_Set,
+ Conflict_Counts, Conflicts, Descriptor);
+ end if;
end if;
+ end;
+ else
+ -- Dot is before a non-terminal token; no action.
+ if Trace_Generate_Table > Detail then
+ Ada.Text_IO.Put_Line (Image (Element (Dot), Descriptor) & "
=> no action");
end if;
- end;
- else
- -- Dot is before a non-terminal token; no action.
- if Trace_Generate > Detail then
- Ada.Text_IO.Put_Line (Image (Element (Item.Dot), Descriptor) &
" => no action");
end if;
- end if;
+ end;
end loop;
-- We don't place a default error action at the end of every state;
-- Parse.LR.Action_For returns Table.Error_Action when Symbol is not
found.
- Table.Error_Action := new Parse_Action_Node'((Verb =>
WisiToken.Parse.LR.Error), null);
+ Table.Error_Action := new Parse_Action_Node'((Verb =>
WisiToken.Parse.LR.Error, others => <>), null);
for Item of Closure.Goto_List loop
if Item.Symbol in Descriptor.First_Nonterminal ..
Descriptor.Last_Nonterminal then
+ -- FIXME: Goto_List has terminals; either don't need to add
those, or can use that instead of above code.
Add_Goto (Table.States (State), Item.Symbol, Item.State); -- note
list is already sorted.
end if;
end loop;
@@ -468,7 +427,7 @@ package body WisiToken.Generate.LR is
RHS : Productions.Right_Hand_Side renames Prod.RHSs (Item.Prod.RHS);
Action : constant Parse_Action_Rec := (Reduce, Item.Prod, RHS.Action,
RHS.Check, RHS.Tokens.Length);
begin
- if Trace_Generate > Detail then
+ if Trace_Generate_Table > Detail then
Ada.Text_IO.Put_Line ("processing lookaheads");
end if;
@@ -534,8 +493,6 @@ package body WisiToken.Generate.LR is
return Token_ID
is
use WisiToken.Token_ID_Arrays;
-
- ID_I : Cursor;
begin
case Action.Verb is
when Reduce | Accept_It =>
@@ -553,30 +510,34 @@ package body WisiToken.Generate.LR is
-- one, use that.
for Item of Closure.Set loop
if LR1_Items.In_Kernel (Grammar, Descriptor, Item) then
- ID_I := Item.Dot;
- loop
- if ID_I = No_Element then
- if Item.Lookaheads (Lookahead) then
- return Item.Prod.LHS;
- end if;
- else
- declare
- Dot_ID : Token_ID renames Element (ID_I);
- begin
- if Dot_ID = Lookahead or
- (Dot_ID in Descriptor.First_Nonterminal ..
Descriptor.Last_Nonterminal and then
- First (Dot_ID, Lookahead))
- then
+ declare
+ Dot : Token_ID_Arrays.Cursor := Productions.Constant_Ref_RHS
+ (Grammar, Item.Prod).Tokens.To_Cursor (Item.Dot);
+ begin
+ loop
+ if not Has_Element (Dot) then
+ if Item.Lookaheads (Lookahead) then
return Item.Prod.LHS;
end if;
- exit when Dot_ID in Descriptor.First_Nonterminal ..
Descriptor.Last_Nonterminal and then
- not Has_Empty_Production (Dot_ID);
- end;
- end if;
+ else
+ declare
+ Dot_ID : constant Token_ID := Element (Dot);
+ begin
+ if Dot_ID = Lookahead or
+ (Dot_ID in Descriptor.First_Nonterminal ..
Descriptor.Last_Nonterminal and then
+ First (Dot_ID, Lookahead))
+ then
+ return Item.Prod.LHS;
+ end if;
+ exit when Dot_ID in Descriptor.First_Nonterminal ..
Descriptor.Last_Nonterminal and then
+ not Has_Empty_Production (Dot_ID);
+ end;
+ end if;
- exit when ID_I = No_Element;
- Next (ID_I);
- end loop;
+ exit when not Has_Element (Dot);
+ Next (Dot);
+ end loop;
+ end;
end if;
end loop;
@@ -586,25 +547,29 @@ package body WisiToken.Generate.LR is
-- Lookahead (the token shifted) is starting a nonterm in a state
-- production; it is in First of that nonterm.
if LR1_Items.In_Kernel (Grammar, Descriptor, Item) then
- ID_I := Item.Dot;
- loop
- exit when ID_I = No_Element;
- declare
- Dot_ID : Token_ID renames Element (ID_I);
- begin
- if Dot_ID = Lookahead or
- (Dot_ID in Descriptor.First_Nonterminal ..
Descriptor.Last_Nonterminal and then
- First (Dot_ID, Lookahead))
- then
- return Item.Prod.LHS;
- end if;
+ declare
+ Dot : Token_ID_Arrays.Cursor := Productions.Constant_Ref_RHS
+ (Grammar, Item.Prod).Tokens.To_Cursor (Item.Dot);
+ begin
+ loop
+ exit when not Has_Element (Dot);
+ declare
+ Dot_ID : constant Token_ID := Element (Dot);
+ begin
+ if Dot_ID = Lookahead or
+ (Dot_ID in Descriptor.First_Nonterminal ..
Descriptor.Last_Nonterminal and then
+ First (Dot_ID, Lookahead))
+ then
+ return Item.Prod.LHS;
+ end if;
- exit when Dot_ID in Descriptor.First_Nonterminal ..
Descriptor.Last_Nonterminal and then
- not Has_Empty_Production (Dot_ID);
- end;
+ exit when Dot_ID in Descriptor.First_Nonterminal ..
Descriptor.Last_Nonterminal and then
+ not Has_Empty_Production (Dot_ID);
+ end;
- Next (ID_I);
- end loop;
+ Next (Dot);
+ end loop;
+ end;
end if;
end loop;
@@ -661,13 +626,20 @@ package body WisiToken.Generate.LR is
----------
-- Minimal terminal sequences.
- function Image (Item : in RHS_Sequence; Descriptor : in
WisiToken.Descriptor) return String
- is begin
- return "(" & Image (Item.Recursion) & ", " & Recursion'Image
(Item.Worst_Recursion) & ", " &
- Image (Item.Sequence, Descriptor) & ")";
- end Image;
+ function Min_Length (Item : in RHS_Sequence_Arrays.Vector) return
Ada.Containers.Count_Type
+ is
+ use Ada.Containers;
+ Min : Count_Type := Count_Type'Last;
+ begin
+ for RHS of Item loop
+ if RHS.Length < Min then
+ Min := RHS.Length;
+ end if;
+ end loop;
+ return Min;
+ end Min_Length;
- function Min (Item : in RHS_Sequence_Arrays.Vector) return RHS_Sequence
+ function Min (Item : in RHS_Sequence_Arrays.Vector) return
Token_ID_Arrays.Vector
is
use all type Ada.Containers.Count_Type;
Min_Length : Ada.Containers.Count_Type := Ada.Containers.Count_Type'Last;
@@ -675,8 +647,8 @@ package body WisiToken.Generate.LR is
begin
-- This version assumes all RHS are computed.
for RHS in Item.First_Index .. Item.Last_Index loop
- if Min_Length > Item (RHS).Sequence.Length then
- Min_Length := Item (RHS).Sequence.Length;
+ if Min_Length > Item (RHS).Length then
+ Min_Length := Item (RHS).Length;
Min_RHS := RHS;
end if;
end loop;
@@ -689,8 +661,7 @@ package body WisiToken.Generate.LR is
function Compute_Minimal_Terminal_Sequences
(Descriptor : in WisiToken.Descriptor;
- Grammar : in WisiToken.Productions.Prod_Arrays.Vector;
- Recursions : in Generate.Recursions)
+ Grammar : in WisiToken.Productions.Prod_Arrays.Vector)
return Minimal_Sequence_Array
is
-- Result (ID).Sequence.Length = 0 is a valid result (ie the
@@ -711,8 +682,8 @@ package body WisiToken.Generate.LR is
loop
exit when (for all B of All_Seq_Set => B);
Pass_Count := Pass_Count + 1;
- if Trace_Generate > Detail then
- if Trace_Generate > Extra then
+ if Trace_Generate_Minimal_Complete > Detail then
+ if Trace_Generate_Minimal_Complete > Extra then
Ada.Text_IO.New_Line;
end if;
Ada.Text_IO.Put_Line ("Compute_Minimal_Terminal_Sequences pass"
& Integer'Image (Pass_Count));
@@ -728,45 +699,10 @@ package body WisiToken.Generate.LR is
Last_Seq_Count := This_Count;
end loop;
- -- Set Result.Recursions
- for Recursion_ID in Recursions.Recursions.First_Index ..
Recursions.Recursions.Last_Index loop
- declare
- Cycle : Recursion_Cycle renames Recursions.Recursions
(Recursion_ID);
- begin
- for I in Cycle'Range loop
- declare
- Edges : constant Grammar_Graphs.Edge_Lists.List :=
- (if Recursions.Full then
- (if I = Cycle'Last
- then Cycle (Cycle'First).Edges
- else Cycle (I + 1).Edges)
- else Cycle (I).Edges);
- begin
- for E of Edges loop
- Result (Cycle (I).Vertex)(E.Data.RHS).Recursion.Append
(Recursion_ID);
- end loop;
- end;
- end loop;
- end;
- end loop;
-
- -- Set Result.Worst_Recursions
- for Nonterm in Result'Range loop
- for RHS in Result (Nonterm).First_Index .. Result
(Nonterm).Last_Index loop
- declare
- RHS_Seq : RHS_Sequence renames Result (Nonterm)(RHS);
- begin
- RHS_Seq.Worst_Recursion := Worst_Recursion
(RHS_Seq.Recursion, Recursions, RHS);
- end;
- end loop;
- end loop;
-
- if Trace_Generate > Detail then
+ if Trace_Generate_Minimal_Complete > Detail then
Ada.Text_IO.Put_Line ("Minimal_Terminal_Sequences:");
for LHS in Result'Range loop
- Ada.Text_IO.Put_Line
- (Trimmed_Image (LHS) & " " & Image (LHS, Descriptor) & " ==>
" &
- Image (Result (LHS), Descriptor));
+ Ada.Text_IO.Put_Line (Image (LHS, Result, Descriptor));
end loop;
end if;
end return;
@@ -777,13 +713,13 @@ package body WisiToken.Generate.LR is
Minimal_Terminal_Sequences : in Minimal_Sequence_Array)
return Token_Array_Token_ID
is
- use all type Ada.Containers.Count_Type;
use Token_ID_Arrays;
begin
return Result : Token_Array_Token_ID (Descriptor.First_Nonterminal ..
Descriptor.Last_Nonterminal) do
for ID in Result'Range loop
declare
- Min_Seq : Token_ID_Arrays.Vector renames Min
(Minimal_Terminal_Sequences (ID)).Sequence;
+ use all type Ada.Containers.Count_Type;
+ Min_Seq : Token_ID_Arrays.Vector renames Min
(Minimal_Terminal_Sequences (ID).Sequence);
begin
if Min_Seq.Length = 0 then
Result (ID) := Invalid_Token_ID;
@@ -800,6 +736,7 @@ package body WisiToken.Generate.LR is
Kernel : in LR1_Items.Item_Set;
Descriptor : in WisiToken.Descriptor;
Grammar : in
WisiToken.Productions.Prod_Arrays.Vector;
+ Nullable : in Token_Array_Production_ID;
Minimal_Terminal_Sequences : in Minimal_Sequence_Array;
Minimal_Terminal_First : in Token_Array_Token_ID)
is
@@ -809,20 +746,20 @@ package body WisiToken.Generate.LR is
subtype Terminals is Token_ID range Descriptor.First_Terminal ..
Descriptor.Last_Terminal;
- Working_Set : LR1_Items.Item_Lists.List := Kernel.Set;
- Recursive : Boolean := False;
-
function Find_Action (List : in Action_Arrays.Vector; ID : in Token_ID)
return Minimal_Action
is begin
+ -- ID is a terminal after Dot in an item in a kernel that has List as
+ -- the actions; return the appropriate action.
for Node of List loop
if Node.Symbol = ID then
case Node.Actions.Item.Verb is
when Shift =>
- return (Shift, ID, Node.Actions.Item.State);
+ return (Shift, Node.Actions.Item.Production, ID,
Node.Actions.Item.State);
when Reduce =>
-- Item.Dot is a nonterm that starts with a nullable
nonterm; reduce
- -- to that first.
- return (Reduce, Node.Actions.Item.Production.LHS, 0);
+ -- to that first. After any more such reductions, the
action will be
+ -- Shift ID.
+ return (Reduce, Node.Actions.Item.Production, 0);
when Accept_It | WisiToken.Parse.LR.Error =>
raise SAL.Programmer_Error;
end case;
@@ -831,337 +768,339 @@ package body WisiToken.Generate.LR is
raise SAL.Programmer_Error;
end Find_Action;
- function Min_Length (Item : in RHS_Sequence_Arrays.Vector) return
Ada.Containers.Count_Type
- is
- use Ada.Containers;
- Min : Count_Type := Count_Type'Last;
- begin
- for RHS of Item loop
- if RHS.Sequence.Length < Min then
- Min := RHS.Sequence.Length;
+ function Compute_Action (ID : in Token_ID) return Minimal_Action
+ is begin
+ if ID in Terminals then
+ return Find_Action (State.Action_List, ID);
+
+ else
+ if Minimal_Terminal_First (ID) = Invalid_Token_ID then
+ -- Item.Dot is a nullable nonterm; include a reduce to the null
+ -- nonterm, rather than a shift of the following terminal;
recover
+ -- must do the reduce first.
+ return (Reduce, (ID, Minimal_Terminal_Sequences (ID).Min_RHS),
Token_Count => 0);
+
+ else
+ return Find_Action (State.Action_List, Minimal_Terminal_First
(ID));
end if;
- end loop;
- return Min;
- end Min_Length;
+ end if;
+ end Compute_Action;
- function After_Dot_Length (Item : in LR1_Items.Item) return
Ada.Containers.Count_Type
+ function Length_After_Dot (Item : in LR1_Items.Item) return
Ada.Containers.Count_Type
is
use Ada.Containers;
Prod : constant Production_ID := Item.Prod;
- I : Token_ID_Arrays.Cursor := Item.Dot;
Result : Count_Type := 0;
Tokens : Vector renames Grammar (Prod.LHS).RHSs (Prod.RHS).Tokens;
+ I : Token_ID_Arrays.Cursor := Tokens.To_Cursor (Item.Dot);
begin
+ if not Has_Element (I) then
+ -- Can only compute this at runtime.
+ return 0;
+ end if;
+
loop
- exit when I = Token_ID_Arrays.No_Element;
+ exit when not Has_Element (I);
- if Tokens (I) in Terminals then
+ if Element (I) in Terminals then
Result := Result + 1;
else
- Result := Result + Min_Length (Minimal_Terminal_Sequences
(Tokens (I)));
+ Result := Result + Min_Length (Minimal_Terminal_Sequences
(Tokens (I)).Sequence);
end if;
Next (I);
end loop;
return Result;
- end After_Dot_Length;
+ end Length_After_Dot;
- procedure Delete_Non_Minimal
- is
- use Ada.Containers;
+ begin
+ if Kernel.State = 0 then
+ -- State 0 has dot before all tokens, which is never needed in the
+ -- Minimal_Complete_Action algorithm.
+ return;
- Min_Length : Count_Type := Count_Type'Last;
- I : LR1_Items.Item_Lists.Cursor;
- Recursive_Count : Count_Type := 0;
- Delete_Recursive : Boolean;
+ elsif (for some Item of Kernel.Set =>
+ Item.Prod.LHS = Descriptor.Accept_ID and
+ (Item.Dot /= No_Index and then Productions.Constant_Ref_RHS
+ (Grammar, Item.Prod).Tokens (Item.Dot) = Descriptor.EOI_ID))
+ then
+ -- No actions
+ return;
+ end if;
+
+ -- Set State.Kernel, and delete Items from Working_Set that are known
+ -- to be non-minimal.
+ declare
+ use Ada.Containers;
- function Immediate_Recursive return Boolean
+ function Before_Dot (Item : in LR1_Items.Item) return Token_ID
is
- -- Direct left recursion is never minimal; for example, consider
- -- ada_lite LALR state 149:
- --
- -- 61.0:association_list <= association_list ^ COMMA
association_opt
- --
- -- If we already have an association_list, adding a COMMA to it
- -- cannot be minimal.
- --
- -- Similarly, indirect left recursion is not minimal; consider
- -- ada_lite LALR states 29 and 60:
- --
- -- State 29:
- -- 103.3:name <= selected_component ^,
- --
- -- State 60:
- -- 94.0:function_specification <= FUNCTION name ^
parameter_and_result_profile
- -- 103.0:name <= name ^ LEFT_PAREN range_list
- -- 103.1:name <= name ^ actual_parameter_part
- -- 123.0:selected_component <= name ^ DOT IDENTIFIER
- --
- -- If we already have a name, adding actual_parameter_part or DOT
IDENTIFIER cannot be
- -- minimal.
-
- -- There is a trade off here between error recovery power and
risk of
- -- recursive loops. Consider ada_lite state 152:
- --
- -- 103.0:name <= name LEFT_PAREN range_list ^ RIGHT_PAREN
- -- 117.0:range_list <= range_list ^ COMMA range_g
- --
- -- Both productions are Left_Recursive, but in the first item,
dot is past
- -- the recursion, and can be usefully completed.
- --
- -- However, that might allow loops; see java_enum_ch19.wy.
- --
- -- A similar argument applies to right recursive items; from
- -- java_expressions_ch19.wy:
- --
- -- State 7:
- -- 27.0:Assignment <= LeftHandSide ^ EQUAL Expression
- --
- -- State 22:
- -- 28.0:LeftHandSide <= Identifier ^
- -- 34.0:ClassType <= Identifier ^
- --
- -- State 25:
- -- 24.1:Expression <= AssignmentExpression ^
- --
- -- State 26:
- -- 26.1:AssignmentExpression <= Assignment ^
- --
- -- Choosing LeftHandSide for the minimal action in state 22 will
lead
- -- to a loop thru state 7. However, Assignment can also occur in
- -- Statement, where it is not recursive:
- --
- -- State 1:
- -- 23.0:Statement <= LEFT_CURLY_BRACKET ^ Assignment
RIGHT_CURLY_BRACKET
- --
- -- This is not easy to check for.
- --
- -- It is not expensive to check for loops in
Minimal_Complete_Action
- -- at run-time, so given all the above we allow items that are
"past
- -- the recursion" here.
-
- Item : LR1_Items.Item renames Constant_Ref (I).Element.all;
- Prod : constant WisiToken.Production_ID := Item.Prod;
- Min_Seq : RHS_Sequence renames Minimal_Terminal_Sequences
(Prod.LHS)(Prod.RHS);
+ Tokens : Token_ID_Arrays.Vector renames Grammar
(Item.Prod.LHS).RHSs (Item.Prod.RHS).Tokens;
begin
- return Min_Seq.Worst_Recursion in Right | Left and then
- (Has_Element (Item.Dot) and then
- Item.Dot = To_Cursor (Grammar (Prod.LHS).RHSs
(Prod.RHS).Tokens, 2));
- end Immediate_Recursive;
-
- begin
- -- The absolute minimal production for an LHS may not be in this
- -- state. For example, for an Ada aggregate, the absolute minimal
- -- terminal sequence is:
- --
- -- aggregate <= LEFT_PAREN RIGHT_PAREN
- --
- -- but one state has only:
- --
- -- aggregate <= LEFT_PAREN expression_opt WITH ^ NULL RECORD
RIGHT_PAREN
- -- aggregate <= LEFT_PAREN expression_opt WITH ^ association_list
RIGHT_PAREN
- --
- -- Find the minimum tokens after dot of the productions that are
present
-
- -- First see if all are recursive
- I := Working_Set.First;
- loop
- exit when not Has_Element (I);
-
- if Immediate_Recursive then
- Recursive_Count := Recursive_Count + 1;
+ if Item.Dot = Token_ID_Arrays.No_Index then
+ return Tokens (Tokens.Last_Index);
+ else
+ return Tokens (Item.Dot - 1);
end if;
+ end Before_Dot;
+
+ type State_Label is (Unknown, Keep_Always, Keep_If_Minimal, Drop);
+ type Item_State (Label : State_Label := Unknown)
+ is record
+ case Label is
+ when Keep_Always | Keep_If_Minimal =>
+ Minimal_Action : WisiToken.Parse.LR.Minimal_Action;
+ -- Minimal_Action.Production = Invalid_Production_ID (the
default) if it is unknown.
+ when Unknown | Drop =>
+ null;
+ end case;
+ end record;
- Next (I);
- end loop;
-
- Delete_Recursive := Recursive_Count < Working_Set.Length;
+ subtype Kernel_Index is Count_Type range 1 .. Kernel.Set.Length;
+ Item_States : array (Kernel_Index) of Item_State;
+ I : Kernel_Index := Kernel_Index'First;
+ Min_Length : Count_Type := Count_Type'Last;
+ begin
+ State.Kernel.Set_First_Last (Kernel_Index'First, Kernel_Index'Last);
+ for Item of Kernel.Set loop
+ declare
+ RHS : WisiToken.Productions.Right_Hand_Side renames
+ Grammar (Item.Prod.LHS).RHSs (Item.Prod.RHS);
+ Dot_ID : constant Token_ID :=
+ (if Item.Dot = No_Index
+ then Invalid_Token_ID
+ else RHS.Tokens (Item.Dot));
+
+ -- Kernel components
+ Length_After_Dot : constant Count_Type :=
Set_Minimal_Complete_Actions.Length_After_Dot (Item);
+ Reduce_Production : constant Production_ID :=
+ (if Length_After_Dot = 0
+ then (if Dot_ID in Nullable'Range then Nullable (Dot_ID)
else Item.Prod)
+ else Invalid_Production_ID);
+ Reduce_Count : constant Count_Type :=
+ (if Reduce_Production = Invalid_Production_ID
+ then 0
+ else Grammar (Reduce_Production.LHS).RHSs
(Reduce_Production.RHS).Tokens.Length);
+ begin
+ -- Here we must compute Item_State (I).Label and
.Minimal_Action,
+ -- considering recursion.
+ --
+ -- Insert_Minimal_Complete_Actions does not need any recursion
+ -- information at runtim, because we elminate all cases where
it
+ -- might here.
+ --
+ -- The strategy in Insert_Minimal_Complete_Actions when
+ -- Item.Length_After_Dot = 0 is to compute Length_After_Dot by
doing
+ -- Reduce until a Shift is encountered, and using
Length_After_Dot
+ -- for that item. --
+ --
+ -- Consider these kernel items with possible recursion (from
+ -- ada_lite_lalr.parse_table - not listed in state order here,
to
+ -- group related productions). The recursion of each
production is
+ -- shown after ';', if not all None.
+ --
+ -- State 2:
+ -- 86.0:exit_statement <= EXIT ^ identifier_opt WHEN
expression_opt SEMICOLON
+ -- 86.1:exit_statement <= EXIT ^ identifier_opt SEMICOLON
+ --
+ -- State 43:
+ -- 103.2:name <= IDENTIFIER ^
+ --
+ -- State 30:
+ -- 103.3:name <= selected_component ^ ; ( 1 => Other_Left)
+ --
+ -- State 47:
+ -- 103.0:name <= name ^ LEFT_PAREN range_list RIGHT_PAREN
; ( 1 => Direct_Left, 3 => Other)
+ -- 103.1:name <= name ^ actual_parameter_part ; ( 1 =>
Direct_Left, 2 => Other)
+ -- 113.2:primary <= name ^ ; ( 1 => Other_Left)
+ -- 124.0:selected_component <= name ^ DOT IDENTIFIER ; ( 1
=> Other_Left)
+ --
+ -- State 68:
+ -- 95.1:generic_instantiation <= PROCEDURE name ^ IS NEW
name SEMICOLON
+ -- 103.0:name <= name ^ LEFT_PAREN range_list RIGHT_PAREN
; ( 1 => Direct_Left, 3 => Other)
+ -- 103.1:name <= name ^ actual_parameter_part ; ( 1 =>
Direct_Left, 2 => Other)
+ -- 115.0:procedure_specification <= PROCEDURE name ^
parameter_profile_opt
+ -- 124.0:selected_component <= name ^ DOT IDENTIFIER ; ( 1
=> Other_Left)
+ --
+ -- State 50:
+ -- 87.1:expression <= relation_and_list ^ ; ( 1 =>
Other_Left)
+ -- 119.0:relation_and_list <= relation_and_list ^ AND
relation ; ( 1 => Direct_Left, 3 => Other)
+ --
+ --
+ -- State 77:
+ -- 57.0:actual_parameter_part <= LEFT_PAREN ^
association_list RIGHT_PAREN ; ( 2 => Other)
+ -- 103.0:name <= name LEFT_PAREN ^ range_list RIGHT_PAREN
; ( 1 => Direct_Left, 3 => Other)
+ --
+ -- State 154:
+ -- 103.0:name <= name LEFT_PAREN range_list ^ RIGHT_PAREN
+ -- 118.0:range_list <= range_list ^ COMMA range_g
+ --
+ -- State 251:
+ -- 110.0:parameter_specification <= IDENTIFIER COLON
IDENTIFIER ^ COLON_EQUAL expression_opt
+ -- 110.1:parameter_specification <= IDENTIFIER COLON
IDENTIFIER ^
+ --
+ -- From java_enum_ch19_lr1.parse_table:
+ --
+ -- State 8:
+ -- 9.1:EnumConstantList <= EnumConstantList COMMA ^
EnumConstant ; (1 => Direct_Left, 3 => Other)
+ -- 11.0:EnumBody <= LEFT_CURLY_BRACKET EnumConstantList
COMMA ^ RIGHT_CURLY_BRACKET
+ --
+ -- From empty_production_2_lalar.parse_table:
+ --
+ -- State 5:
+ -- 8.0:declarations <= declarations ^ declaration
+ -- 9.0:body <= IS declarations ^ BEGIN SEMICOLON
+
+ -- case 0: In states 43 and 30, there is only one possible
action, so
+ -- recursion is not considered. Minimal_Action is
+ -- computed by Compute_Minimal_Action, Label is Keep_Always.
+ --
+ -- In the following, we only consider kernels where there is
more
+ -- than one item.
+ --
+ -- case 1: In state 47 production 113.2, Length_After_Dot is
0, so
+ -- recursion is not considered. We set Label to Keep_Always,
since
+ -- the true Length_After_Dot must be computed at runtime.
+ -- Minimal_Action is Reduce_Production.
+ --
+ -- Similarly in state 68 production 115.0, Length_After_Dot is 0
+ -- because parameter_profile_opt is nullable, and we set Label
to
+ -- Keep_Always, Minimal_Action to Reduce_Production.
+ --
+ -- case 2: In state 47, if LEFT_PAREN or First
+ -- (actual_parameter_part) is inserted, a recursion cycle is
followed
+ -- via 103.0 or 103.1; these have Direct_Left recursion, can
never be
+ -- minimal, and we set Label to Drop. 113.2 breaks the
recursion; it
+ -- has Length_After_Dot = 0 and is covered by case 1. 124.0 has
+ -- Other_Left; since Length_After_Dot is > 0, it follows the
+ -- recursion cycle and is never minimal, so it is the same as
+ -- Direct_Left. Similarly, in java_enum_ch19_lr1.parse_table
state 8
+ -- production 9.1, inserting EnumConstant continues the
recursion
+ -- cycle; left recursion applies even when it is not just
before the
+ -- parse point. On the other hand, in ada_lite state 154, both
+ -- productions are left recursive; 103.0 could be preserved.
In the
+ -- current algorithm, both are dropped.
+ --
+ -- It is possible for both case 1 and case 2 to apply; see
+ -- empty_production_2_lalar.parse_table State 5 above and
+ -- ada_lite_ebnf_lalr.parse_table state 46. case 1 has
precedence if
+ -- Dot = No_Element.
+ --
+ -- case 3: In state 251, there is no recursion, and
Length_After_Dot
+ -- is correct; Label is set to Keep_If_Minimal, Minimal_Action
to
+ -- Compute_Minimal_Action. In State 77, Dot_ID is
association_list
+ -- which has Other recursion; we say "there is recursion at
the parse
+ -- point". However, Length_After_Dot is correct; it assumes the
+ -- recursion-breaking case for the expansion of
association_list. So
+ -- this is the same as no recursion at the parse point
+ --
+ -- It is possible for both case 2 and 3 to be true; see
+ -- empty_production_2_lalr.parse_table state 5. Case 2 has
+ -- precedence (left recursion is worse).
+
+ if Item_States'Length = 1 then
+ -- case 0
+ Item_States (I) :=
+ (Keep_Always,
+ (if Length_After_Dot = 0
+ then (Reduce, Reduce_Production, Reduce_Count)
+ else Compute_Action (Dot_ID)));
+
+ elsif Length_After_Dot = 0 then
+ if Item.Dot /= No_Index and RHS.Recursion (1) in Direct_Left
| Other_Left then
+ -- case 2
+ Item_States (I) := (Label => Drop);
+ else
+ -- case 1
+ Item_States (I) :=
+ (Label => Keep_Always,
+ Minimal_Action => (Reduce, Reduce_Production,
Reduce_Count));
+ end if;
- I := Working_Set.First;
- loop
- exit when not Has_Element (I);
+ elsif RHS.Recursion (1) in Direct_Left | Other_Left then
+ -- case 2
+ Item_States (I) := (Label => Drop);
- if Delete_Recursive and Immediate_Recursive then
- if Trace_Generate > Extra then
- Ada.Text_IO.Put_Line ("delete " & Image (Constant_Ref
(I).Prod) & " recursive");
+ else
+ -- case 3
+ Item_States (I) := (Keep_If_Minimal, Compute_Action
(Dot_ID));
end if;
- declare
- Del : LR1_Items.Item_Lists.Cursor := I;
- begin
- Next (I);
- Working_Set.Delete (Del);
- end;
-
- else
- Recursive := Recursive or Minimal_Terminal_Sequences
- (Constant_Ref (I).Prod.LHS)(Constant_Ref
(I).Prod.RHS).Worst_Recursion in
- Left | Right;
-
- declare
- Prod_Length : constant Count_Type := After_Dot_Length
(Constant_Ref (I));
- begin
- if Min_Length > Prod_Length then
- Min_Length := Prod_Length;
- end if;
- end;
- Next (I);
- end if;
- end loop;
-
- -- Now we have the minimum length; check remaining items against that
- I := Working_Set.First;
- loop
- exit when not Has_Element (I);
- if Min_Length < After_Dot_Length (Constant_Ref (I)) then
- declare
- Del : LR1_Items.Item_Lists.Cursor := I;
- begin
- if Trace_Generate > Extra then
- Ada.Text_IO.Put_Line ("delete " & Image (Constant_Ref
(I).Prod));
+ State.Kernel (I) :=
+ (Production => Item.Prod,
+ Before_Dot => Before_Dot (Item),
+ Length_After_Dot => Length_After_Dot,
+ Reduce_Production => Reduce_Production,
+ Reduce_Count => Reduce_Count);
+
+ if Item_States (I).Label = Keep_If_Minimal then
+ if Length_After_Dot < Min_Length then
+ Min_Length := Length_After_Dot;
end if;
- Next (I);
- Working_Set.Delete (Del);
- end;
- else
- if Trace_Generate > Extra then
- Ada.Text_IO.Put_Line ("keep " & Image (Constant_Ref
(I).Prod));
end if;
- Next (I);
- end if;
- end loop;
- end Delete_Non_Minimal;
- begin
- if Kernel.State > 0 then
- declare
- use Ada.Containers;
- I : Count_Type := 1;
+ if Trace_Generate_Minimal_Complete > Extra then
+ Ada.Text_IO.Put_Line
+ ("kernel" & I'Image & " " & Strict_Image (State.Kernel
(I)) &
+ " ; " & Item_States (I).Label'Image &
+ " " & State.Kernel (I).Length_After_Dot'Image);
+ end if;
- function Before_Dot (Item : in LR1_Items.Item) return Token_ID
- is
- Tokens : Token_ID_Arrays.Vector renames Grammar
(Item.Prod.LHS).RHSs (Item.Prod.RHS).Tokens;
- begin
- if Item.Dot = Token_ID_Arrays.No_Element then
- return Tokens (Tokens.Last_Index);
- else
- return Tokens (Prev (Item.Dot));
+ if I < Kernel_Index'Last then
+ I := I + 1;
end if;
- end Before_Dot;
- begin
- State.Kernel.Set_First_Last (1, Kernel.Set.Length);
- for Item of Kernel.Set loop
- State.Kernel (I) :=
- (LHS => Item.Prod.LHS,
- Before_Dot => Before_Dot (Item),
- Length_After_Dot => After_Dot_Length (Item),
- Recursive => Minimal_Terminal_Sequences
- (Item.Prod.LHS)(Item.Prod.RHS).Worst_Recursion in Right |
Left);
+ end;
+ end loop;
- I := I + 1;
- end loop;
- end;
- end if;
+ -- It is tempting to Assert that if all items are dropped, there is a
+ -- grammar recursion cycle with no exit. But that is not true; see
+ -- java_expressions_ch19_lr1.parse_table, state 8. However, that
+ -- state should never be encountered during Insert_Minimal_Complete,
+ -- because it is never minimal. So we set Minimal_Actions to empty.
- -- The actions computed here are used in the error recovery
- -- algorithm, to decide what terminals to insert in the input stream
- -- in order to correct an error. The strategy is to complete a high
- -- level production (ie declaration or statement) as quickly as
- -- possible, because the next real token is known to be the start of
- -- a high level production, or the end of a containing block-style
- -- production.
- --
- -- The actions are empty in a state that includes the accept
- -- production. That tells the error recovery algorithm to stop using
- -- the minimal complete actions strategy.
+ -- Update State_Items based on Min_Length
+ for I in Item_States'Range loop
- if (for some Item of Working_Set =>
- Item.Prod.LHS = Descriptor.Accept_ID and
- (Has_Element (Item.Dot) and then Element (Item.Dot) =
Descriptor.EOI_ID))
- then
- -- No actions
- return;
- end if;
+ case Item_States (I).Label is
+ when Unknown =>
+ null;
- Delete_Non_Minimal;
+ when Keep_Always =>
+ pragma Assert (Item_States (I).Minimal_Action.Production /=
Invalid_Production_ID);
- State.Minimal_Complete_Actions_Recursive := Recursive;
+ when Keep_If_Minimal =>
+ if State.Kernel (I).Length_After_Dot = Min_Length then
+ null;
+ else
+ Item_States (I) := (Label => Drop);
+ end if;
- if Working_Set.Length > 0 then
- -- There are one or more productions with equal after-dot length in
- -- this state, all equally valid; the choice is determined by what
- -- input error recovery inserts.
- --
- -- We could simply choose one arbitrarily, but that can lead to loops
- -- (see discussion above in Immediate_Recursive). So we consider the
- -- higher level production. However, in general we cannot precompute
- -- what higher-level productions might be completed from each state;
- -- we must use the parse stack during error recovery. In that case,
- -- we store multiple minimal actions in the state (see
- -- Insert_Minimal_Complete_Actions in
- -- wisitoken-parse-lr-mckenzie_recover-explore.adb).
+ when Drop =>
+ null;
+ end case;
+ end loop;
- declare
- Actions : Minimal_Action_Array (1 .. Working_Set.Length) :=
(others => (others => <>));
+ -- Set State.Minimal_Actions
+ for Item_State of Item_States loop
+ case Item_State.Label is
+ when Unknown | Drop =>
+ null;
- I : Ada.Containers.Count_Type := 1;
- Skip : Boolean;
- begin
- for Item of Working_Set loop
-
- if not Has_Element (Item.Dot) then
- -- Item has no next terminal. Include a reduce action; the
- -- Minimal_Terminal_First for the resulting state will be
used.
- Actions (I) :=
- (Reduce, Item.Prod.LHS,
- Token_Count => Grammar (Item.Prod.LHS).RHSs
(Item.Prod.RHS).Tokens.Length);
+ when Keep_Always | Keep_If_Minimal =>
+ if (for some A of State.Minimal_Complete_Actions => A =
Item_State.Minimal_Action) then
+ -- Duplicate action; see
three_action_conflict_lalr.parse_table state
+ -- 3 or lalr_generator_bug_01_lalr.parse_table state 28
+ null;
else
- declare
- ID : constant Token_ID := Element (Item.Dot);
- begin
- if ID in Terminals then
- Actions (I) := Find_Action (State.Action_List, ID);
-
- else
- if Minimal_Terminal_First (ID) = Invalid_Token_ID then
- -- Item.Dot is a nullable nonterm; include a
reduce to the null
- -- nonterm, rather than a shift of the following
terminal; recover
- -- must do the reduce first.
- Actions (I) := (Reduce, ID, Token_Count => 0);
-
- else
- Actions (I) := Find_Action (State.Action_List,
Minimal_Terminal_First (ID));
- end if;
- end if;
- end;
+ pragma Assert (Item_State.Minimal_Action.Production /=
Invalid_Production_ID);
+ State.Minimal_Complete_Actions.Append
(Item_State.Minimal_Action);
end if;
- I := I + 1;
- end loop;
-
- if Actions'Length = 1 then
- State.Minimal_Complete_Actions :=
Minimal_Action_Arrays.To_Vector (Actions (Actions'First));
- else
- -- Check for duplicates; see
three_action_conflict_lalr.parse_table
- -- state 3 or lalr_generator_bug_01_lalr.parse_table state 28
- for I in Actions'Range loop
- Skip := False;
- for J in Actions'First .. I - 1 loop
- if Actions (I) = Actions (J) then
- Skip := True;
- exit;
- end if;
- end loop;
- if not Skip then
- State.Minimal_Complete_Actions.Append (Actions (I));
- end if;
- end loop;
- end if;
+ end case;
+ end loop;
- if Trace_Generate > Extra then
- Ada.Text_IO.Put_Line
- (Image (State.Minimal_Complete_Actions, Descriptor) & (if
Recursive then " recursive" else ""));
- end if;
- end;
- end if;
+ if Trace_Generate_Minimal_Complete > Extra then
+ Ada.Text_IO.Put_Line (Image (State.Minimal_Complete_Actions,
Descriptor));
+ end if;
+ end;
end Set_Minimal_Complete_Actions;
----------
@@ -1201,16 +1140,14 @@ package body WisiToken.Generate.LR is
Node_J : Parse_Action_Node_Ptr := Node_I.Actions;
begin
loop
- Put (File, Parse_Action_Verbs'Image (Node_J.Item.Verb));
+ Put (File, Node_J.Item.Verb'Image);
+ Put (File, Node_J.Item.Production.LHS'Image &
Node_J.Item.Production.RHS'Image);
case Node_J.Item.Verb is
when Shift =>
Put (File, State_Index'Image (Node_J.Item.State));
when Reduce | Accept_It =>
- Put (File, Token_ID'Image (Node_J.Item.Production.LHS) &
- Integer'Image (Node_J.Item.Production.RHS));
-
if Action_Names (Node_J.Item.Production.LHS) /= null and
then
Action_Names
(Node_J.Item.Production.LHS)(Node_J.Item.Production.RHS) /= null
then
@@ -1256,15 +1193,18 @@ package body WisiToken.Generate.LR is
New_Line (File);
if State.Kernel.Length = 0 then
- -- Not set for state 0
+ -- Kernel not set for state 0
Put_Line (File, "0 -1");
else
Put (File, Count_Type'Image (State.Kernel.First_Index));
Put (File, Count_Type'Image (State.Kernel.Last_Index));
for Item of State.Kernel loop
- Put (File, Token_ID'Image (Item.LHS) & Token_ID'Image
(Item.Before_Dot) &
- Count_Type'Image (Item.Length_After_Dot));
+ Put (File, Token_ID'Image (Item.Production.LHS) &
Item.Production.RHS'Image);
+ Put (File, Item.Before_Dot'Image);
+ Put (File, Count_Type'Image (Item.Length_After_Dot));
+ Put (File, Token_ID'Image (Item.Reduce_Production.LHS) &
Item.Reduce_Production.RHS'Image);
+ Put (File, Item.Reduce_Count'Image);
end loop;
New_Line (File);
end if;
@@ -1276,13 +1216,13 @@ package body WisiToken.Generate.LR is
Put (File, Count_Type'Image
(State.Minimal_Complete_Actions.Last_Index));
for Action of State.Minimal_Complete_Actions loop
Put (File, " ");
+ Put (File, Action.Verb'Image);
+ Put (File, Action.Production.LHS'Image &
Action.Production.RHS'Image);
case Action.Verb is
when Shift =>
- Put (File, Minimal_Verbs'Image (Action.Verb));
Put (File, Token_ID'Image (Action.ID) & State_Index'Image
(Action.State));
when Reduce =>
- Put (File, Minimal_Verbs'Image (Action.Verb));
- Put (File, Token_ID'Image (Action.Nonterm) &
Ada.Containers.Count_Type'Image (Action.Token_Count));
+ Put (File, Action.Token_Count'Image);
end case;
end loop;
end if;
@@ -1369,14 +1309,18 @@ package body WisiToken.Generate.LR is
case Item.Verb is
when Shift =>
Put ("shift and goto state" & State_Index'Image (Item.State));
+ Put (" " & Trimmed_Image (Item.Production));
+
when Reduce =>
Put
("reduce" & Count_Type'Image (Item.Token_Count) & " tokens to " &
Image (Item.Production.LHS, Descriptor));
Put (" " & Trimmed_Image (Item.Production));
+
when Accept_It =>
Put ("accept it");
Put (" " & Trimmed_Image (Item.Production));
+
when Parse.LR.Error =>
Put ("ERROR");
end case;
@@ -1439,66 +1383,56 @@ package body WisiToken.Generate.LR is
when Shift =>
Put (Image (Action.ID, Descriptor));
when Reduce =>
- Put (Image (Action.Nonterm, Descriptor));
+ Put (Image (Action.Production.LHS, Descriptor));
end case;
+ Put (" " & Trimmed_Image (Action.Production));
end;
when others =>
Put ("(");
for I in State.Minimal_Complete_Actions.First_Index ..
State.Minimal_Complete_Actions.Last_Index loop
- case State.Minimal_Complete_Actions (I).Verb is
- when Shift =>
- Put (Image (State.Minimal_Complete_Actions (I).ID, Descriptor));
- when Reduce =>
- Put (Image (State.Minimal_Complete_Actions (I).Nonterm,
Descriptor));
- end case;
+ declare
+ Action : Minimal_Action renames State.Minimal_Complete_Actions
(I);
+ begin
+ case Action.Verb is
+ when Shift =>
+ Put (Image (Action.ID, Descriptor));
+ when Reduce =>
+ Put (Image (Action.Production.LHS, Descriptor));
+ end case;
+ Put (" " & Trimmed_Image (Action.Production));
+ end;
if I < State.Minimal_Complete_Actions.Last_Index then
Put (", ");
end if;
end loop;
Put (")");
end case;
- if State.Minimal_Complete_Actions_Recursive then
- Put_Line (" recursive");
- else
- New_Line;
- end if;
+ New_Line;
end Put;
procedure Put_Parse_Table
- (Table : in Parse_Table_Ptr;
- Title : in String;
- Grammar : in WisiToken.Productions.Prod_Arrays.Vector;
- Recursions : in Generate.Recursions;
- Minimal_Terminal_Sequences : in Minimal_Sequence_Array;
- Kernels : in LR1_Items.Item_Set_List;
- Conflicts : in Conflict_Count_Lists.List;
- Descriptor : in WisiToken.Descriptor;
- Include_Extra : in Boolean := False)
+ (Table : in Parse_Table_Ptr;
+ Parse_Table_File_Name : in String;
+ Title : in String;
+ Grammar : in WisiToken.Productions.Prod_Arrays.Vector;
+ Recursions : in Generate.Recursions;
+ Kernels : in LR1_Items.Item_Set_List;
+ Conflicts : in Conflict_Count_Lists.List;
+ Descriptor : in WisiToken.Descriptor;
+ Include_Extra : in Boolean := False)
is
use all type Ada.Containers.Count_Type;
use Ada.Text_IO;
+ Parse_Table_File : File_Type;
begin
+ Create (Parse_Table_File, Out_File, Parse_Table_File_Name);
+ Set_Output (Parse_Table_File);
Put_Line ("Tokens:");
WisiToken.Put_Tokens (Descriptor);
New_Line;
Put_Line ("Productions:");
- for LHS in Grammar.First_Index .. Grammar.Last_Index loop
- declare
- Prod : WisiToken.Productions.Instance renames Grammar (LHS);
- begin
- for RHS in Prod.RHSs.First_Index .. Prod.RHSs.Last_Index loop
- Put (WisiToken.Productions.Image (Prod.LHS, RHS, Prod.RHSs
(RHS).Tokens, Descriptor));
- if not Include_Extra or Minimal_Terminal_Sequences
(LHS)(RHS).Recursion.Length = 0 then
- New_Line;
- else
- Put_Line
- (" ; " & Image (Minimal_Terminal_Sequences
(LHS)(RHS).Recursion) & " " &
- Recursion'Image (Minimal_Terminal_Sequences
(LHS)(RHS).Worst_Recursion));
- end if;
- end loop;
- end;
- end loop;
+ WisiToken.Productions.Put (Grammar, Descriptor);
if Include_Extra then
New_Line;
@@ -1509,8 +1443,8 @@ package body WisiToken.Generate.LR is
end if;
if Table.McKenzie_Param.Check_Limit /=
Default_McKenzie_Param.Check_Limit or
- Table.McKenzie_Param.Check_Delta_Limit /=
Default_McKenzie_Param.Check_Delta_Limit or
- Table.McKenzie_Param.Enqueue_Limit /=
Default_McKenzie_Param.Enqueue_Limit
+ Table.McKenzie_Param.Check_Delta_Limit /=
Default_McKenzie_Param.Check_Delta_Limit or
+ Table.McKenzie_Param.Enqueue_Limit /=
Default_McKenzie_Param.Enqueue_Limit
then
New_Line;
Put_Line ("McKenzie:");
@@ -1521,8 +1455,18 @@ package body WisiToken.Generate.LR is
Put_Line (Title & " Parse Table:");
for State_Index in Table.States'Range loop
- LR1_Items.Put
- (Grammar, Descriptor, Kernels (State_Index), Kernel_Only => True,
Show_Lookaheads => Include_Extra);
+ Put_Line ("State" & Unknown_State_Index'Image (State_Index) & ":");
+
+ declare
+ use WisiToken.Generate.LR1_Items;
+ begin
+ for Item of Kernels (State_Index).Set loop
+ if In_Kernel (Grammar, Descriptor, Item) then
+ Put (" " & Image (Grammar, Descriptor, Item,
Show_Lookaheads => False));
+ New_Line;
+ end if;
+ end loop;
+ end;
New_Line;
Put (Descriptor, Table.States (State_Index));
@@ -1559,6 +1503,8 @@ package body WisiToken.Generate.LR is
New_Line;
Put_Line (" 0 accept/reduce conflicts, 0 shift/reduce conflicts, 0
reduce/reduce conflicts");
end if;
+ Set_Output (Standard_Output);
+ Close (Parse_Table_File);
end Put_Parse_Table;
end WisiToken.Generate.LR;
diff --git a/wisitoken-generate-lr.ads b/wisitoken-generate-lr.ads
index 1bb9e2b..00257fe 100644
--- a/wisitoken-generate-lr.ads
+++ b/wisitoken-generate-lr.ads
@@ -2,7 +2,7 @@
--
-- Common utilities for LR parser table generators.
--
--- Copyright (C) 2017 - 2019 Free Software Foundation, Inc.
+-- Copyright (C) 2017 - 2020 Free Software Foundation, Inc.
--
-- This library is free software; you can redistribute it and/or modify it
-- under terms of the GNU General Public License as published by the Free
@@ -127,33 +127,27 @@ package WisiToken.Generate.LR is
----------
-- Minimal terminal sequences.
- type RHS_Sequence is
- record
- Recursion : Recursion_Lists.List;
- -- All recursion cycles involving this RHS.
-
- Worst_Recursion : WisiToken.Recursion := None; -- worst case of all
Recursion.
-
- Sequence : Token_ID_Arrays.Vector;
- end record;
-
package RHS_Sequence_Arrays is new SAL.Gen_Unbounded_Definite_Vectors
- (Natural, RHS_Sequence, Default_Element => (others => <>));
+ (Natural, Token_ID_Arrays.Vector, Default_Element =>
Token_ID_Arrays.Empty_Vector);
- function Image (Item : in RHS_Sequence; Descriptor : in
WisiToken.Descriptor) return String;
- -- Positional Ada aggregate syntax.
+ function Image is new RHS_Sequence_Arrays.Gen_Image_Aux (Descriptor,
Trimmed_Image, Image_No_Assoc);
- function Image is new RHS_Sequence_Arrays.Gen_Image_Aux (Descriptor,
Trimmed_Image, Image);
+ function Min_Length (Item : in RHS_Sequence_Arrays.Vector) return
Ada.Containers.Count_Type;
+ -- Return minimum length of elements of Item.
- function Min (Item : in RHS_Sequence_Arrays.Vector) return RHS_Sequence;
+ function Min (Item : in RHS_Sequence_Arrays.Vector) return
Token_ID_Arrays.Vector;
-- Return element of Item with minimum length;
- type Minimal_Sequence_Array is array (Token_ID range <>) of
RHS_Sequence_Arrays.Vector;
+ type Minimal_Sequence_Item is record
+ Min_RHS : Natural := Natural'Last;
+ Sequence : RHS_Sequence_Arrays.Vector;
+ end record;
+
+ type Minimal_Sequence_Array is array (Token_ID range <>) of
Minimal_Sequence_Item;
function Compute_Minimal_Terminal_Sequences
(Descriptor : in WisiToken.Descriptor;
- Grammar : in WisiToken.Productions.Prod_Arrays.Vector;
- Recursions : in Generate.Recursions)
+ Grammar : in WisiToken.Productions.Prod_Arrays.Vector)
return Minimal_Sequence_Array;
-- For each production in Grammar, compute the minimal sequence of
-- terminals that will complete it. Result is an empty sequence if
@@ -172,12 +166,12 @@ package WisiToken.Generate.LR is
Kernel : in LR1_Items.Item_Set;
Descriptor : in WisiToken.Descriptor;
Grammar : in
WisiToken.Productions.Prod_Arrays.Vector;
+ Nullable : in Token_Array_Production_ID;
Minimal_Terminal_Sequences : in Minimal_Sequence_Array;
Minimal_Terminal_First : in Token_Array_Token_ID);
-- Set State.Minimal_Complete_Actions to the set of actions that will
-- most quickly complete the productions in Kernel (which must be for
- -- State). Useful in error correction when we know the next actual
- -- terminal is a block ending or statement start.
+ -- State). Useful in error correction.
--
-- The Minimal_Complete_Actions will be empty in a state where there
-- is nothing useful to do; the accept state, or one where all
@@ -206,15 +200,15 @@ package WisiToken.Generate.LR is
-- Put Item to Ada.Text_IO.Current_Output in parse table format.
procedure Put_Parse_Table
- (Table : in Parse_Table_Ptr;
- Title : in String;
- Grammar : in WisiToken.Productions.Prod_Arrays.Vector;
- Recursions : in Generate.Recursions;
- Minimal_Terminal_Sequences : in Minimal_Sequence_Array;
- Kernels : in LR1_Items.Item_Set_List;
- Conflicts : in Conflict_Count_Lists.List;
- Descriptor : in WisiToken.Descriptor;
- Include_Extra : in Boolean := False);
- -- "Extra" is recursions, lookaheads.
+ (Table : in Parse_Table_Ptr;
+ Parse_Table_File_Name : in String;
+ Title : in String;
+ Grammar : in WisiToken.Productions.Prod_Arrays.Vector;
+ Recursions : in Generate.Recursions;
+ Kernels : in LR1_Items.Item_Set_List;
+ Conflicts : in Conflict_Count_Lists.List;
+ Descriptor : in WisiToken.Descriptor;
+ Include_Extra : in Boolean := False);
+ -- "Extra" is recursions.
end WisiToken.Generate.LR;
diff --git a/wisitoken-generate-lr1_items.adb b/wisitoken-generate-lr1_items.adb
index f394b67..37e6f0e 100644
--- a/wisitoken-generate-lr1_items.adb
+++ b/wisitoken-generate-lr1_items.adb
@@ -2,7 +2,7 @@
--
-- See spec.
--
--- Copyright (C) 2002, 2003, 2008, 2009, 2012 - 2015, 2017 - 2019 Free
Software Foundation, Inc.
+-- Copyright (C) 2002, 2003, 2008, 2009, 2012 - 2015, 2017 - 2020 Free
Software Foundation, Inc.
--
-- This file is part of the WisiToken package.
--
@@ -35,25 +35,34 @@ package body WisiToken.Generate.LR1_Items is
----------
-- body subprograms
- function Get_Dot_IDs (Set : in Item_Lists.List; Descriptor : in
WisiToken.Descriptor) return Token_ID_Arrays.Vector
+ function Get_Dot_IDs
+ (Grammar : in WisiToken.Productions.Prod_Arrays.Vector;
+ Set : in Item_Lists.List;
+ Descriptor : in WisiToken.Descriptor)
+ return Token_ID_Arrays.Vector
is
- use all type Token_ID_Arrays.Cursor;
use Item_Lists;
IDs : Token_ID_Set (Descriptor.First_Terminal ..
Descriptor.Last_Nonterminal) := (others => False);
begin
for Item of Set loop
- if Item.Dot /= Token_ID_Arrays.No_Element then
- if Element (Item.Dot) /= Descriptor.EOI_ID then
- IDs (Element (Item.Dot)) := True;
+ declare
+ use Token_ID_Arrays;
+ Dot : constant Token_ID_Arrays.Cursor :=
+ WisiToken.Productions.Constant_Ref_RHS (Grammar,
Item.Prod).Tokens.To_Cursor (Item.Dot);
+ begin
+ if Has_Element (Dot) then
+ if Element (Dot) /= Descriptor.EOI_ID then
+ IDs (Element (Dot)) := True;
+ end if;
end if;
- end if;
+ end;
end loop;
return To_Array (IDs);
end Get_Dot_IDs;
function Merge
(Prod : in Production_ID;
- Dot : in Token_ID_Arrays.Cursor;
+ Dot : in Token_ID_Arrays.Extended_Index;
Lookaheads : in Lookahead;
Existing_Set : in out Item_Set)
return Boolean
@@ -66,7 +75,7 @@ package body WisiToken.Generate.LR1_Items is
Found : constant Item_Lists.Cursor := Find (Prod, Dot, Existing_Set);
Modified : Boolean := False;
begin
- if Found = No_Element then
+ if not Has_Element (Found) then
Existing_Set.Set.Insert ((Prod, Dot, new Token_ID_Set'(Lookaheads)));
Modified := True;
@@ -104,32 +113,13 @@ package body WisiToken.Generate.LR1_Items is
end Lookahead_Image;
function Item_Compare (Left, Right : in Item) return SAL.Compare_Result
- is begin
- if Left.Prod.LHS > Right.Prod.LHS then
- return SAL.Greater;
- elsif Left.Prod.LHS < Right.Prod.LHS then
- return SAL.Less;
-
- elsif Left.Prod.RHS > Right.Prod.RHS then
- return SAL.Greater;
- elsif Left.Prod.RHS < Right.Prod.RHS then
- return SAL.Less;
-
- else
- declare
- Left_Index : Integer renames Token_ID_Arrays.To_Index (Left.Dot);
- Right_Index : Integer renames Token_ID_Arrays.To_Index (Right.Dot);
- begin
- if Left_Index > Right_Index then
- return SAL.Greater;
- elsif Left_Index < Right_Index then
- return SAL.Less;
- else
- return SAL.Equal;
- end if;
- end;
- end if;
- end Item_Compare;
+ is (if Left.Prod.LHS > Right.Prod.LHS then SAL.Greater
+ elsif Left.Prod.LHS < Right.Prod.LHS then SAL.Less
+ elsif Left.Prod.RHS > Right.Prod.RHS then SAL.Greater
+ elsif Left.Prod.RHS < Right.Prod.RHS then SAL.Less
+ elsif Left.Dot > Right.Dot then SAL.Greater
+ elsif Left.Dot < Right.Dot then SAL.Less
+ else SAL.Equal);
procedure Include
(Item : in out LR1_Items.Item;
@@ -204,18 +194,19 @@ package body WisiToken.Generate.LR1_Items is
Item : in LR1_Items.Item)
return Boolean
is
+ use all type Ada.Containers.Count_Type;
use Token_ID_Arrays;
Prod : WisiToken.Productions.Instance renames Grammar (Item.Prod.LHS);
RHS : WisiToken.Productions.Right_Hand_Side renames Prod.RHSs
(Item.Prod.RHS);
begin
return
- No_Element /= RHS.Tokens.First and
- (Item.Dot = No_Element or else
+ RHS.Tokens.Length > 0 and
+ (Item.Dot = No_Index or else
((Prod.LHS = Descriptor.Accept_ID and
- Item.Dot = RHS.Tokens.First)
+ Item.Dot = RHS.Tokens.First_Index)
-- Start symbol production with dot before first token.
or
- Item.Dot /= RHS.Tokens.First));
+ Item.Dot /= RHS.Tokens.First_Index));
end In_Kernel;
function Find
@@ -227,32 +218,12 @@ package body WisiToken.Generate.LR1_Items is
end Find;
function Find
- (Prod : in Production_ID;
- Dot : in Token_ID_Arrays.Cursor;
- Right : in Item_Set)
+ (Prod : in Production_ID;
+ Dot : in Token_ID_Arrays.Extended_Index;
+ Set : in Item_Set)
return Item_Lists.Cursor
is begin
- return Right.Set.Find ((Prod, Dot, null));
- end Find;
-
- function Find
- (Prod : in Production_ID;
- Dot : in Token_ID_Arrays.Cursor;
- Right : in Item_Set;
- Lookaheads : in Lookahead)
- return Item_Lists.Cursor
- is
- use Item_Lists;
- Result : constant Cursor := Right.Set.Find ((Prod, Dot, null));
- begin
- -- Item_Equal does not consider lookaheads
- if Result = No_Element then
- return Result;
- elsif Constant_Ref (Result).Lookaheads.all = Lookaheads then
- return Result;
- else
- return No_Element;
- end if;
+ return Set.Set.Find ((Prod, Dot, null));
end Find;
function To_Item_Set_Tree_Key
@@ -270,13 +241,13 @@ package body WisiToken.Generate.LR1_Items is
-- want it to compare first, since it is most likely to be different.
loop
- exit when Cur = No_Element;
+ exit when not Has_Element (Cur);
declare
Item_1 : Item renames Item_Set.Set (Cur);
begin
Result.Append (Integer_16 (Item_1.Prod.LHS));
Result.Append (Integer_16 (Item_1.Prod.RHS));
- Result.Append (Integer_16 (Token_ID_Arrays.To_Index
(Item_1.Dot)));
+ Result.Append (Integer_16 (Item_1.Dot));
if Include_Lookaheads then
for ID in Item_1.Lookaheads'Range loop
if Item_1.Lookaheads (ID) then
@@ -311,7 +282,8 @@ package body WisiToken.Generate.LR1_Items is
end Find;
procedure Add
- (New_Item_Set : in out Item_Set;
+ (Grammar : in WisiToken.Productions.Prod_Arrays.Vector;
+ New_Item_Set : in Item_Set;
Item_Set_Vector : in out Item_Set_List;
Item_Set_Tree : in out Item_Set_Trees.Tree;
Descriptor : in WisiToken.Descriptor;
@@ -320,8 +292,8 @@ package body WisiToken.Generate.LR1_Items is
use Item_Set_Trees;
Key : constant Item_Set_Tree_Key := To_Item_Set_Tree_Key (New_Item_Set,
Include_Lookaheads);
begin
- New_Item_Set.Dot_IDs := Get_Dot_IDs (New_Item_Set.Set, Descriptor);
Item_Set_Vector.Append (New_Item_Set);
+ Item_Set_Vector (Item_Set_Vector.Last_Index).Dot_IDs := Get_Dot_IDs
(Grammar, New_Item_Set.Set, Descriptor);
Item_Set_Tree.Insert ((Key, New_Item_Set.State));
end Add;
@@ -369,65 +341,60 @@ package body WisiToken.Generate.LR1_Items is
-- Taken literally, the algorithm modifies its input; we make a
-- copy instead.
- I : Item_Set; -- The result.
+ I : Item_Set := Set; -- The result.
- Item_I : Item_Lists.Cursor; -- iterator 'for each item in I'
+ Item_I : Item_Lists.Cursor := I.Set.First; -- iterator 'for each
item in I'
Added_Item : Boolean := False; -- 'until no more items can be added'
-
- Beta : Token_ID_Arrays.Cursor; -- into RHS.Tokens
begin
- I := Set;
-
- Item_I := I.Set.First;
loop
declare
Item : LR1_Items.Item renames I.Set (Item_I);
+ Dot : constant Token_ID_Arrays.Cursor :=
+ WisiToken.Productions.Constant_Ref_RHS (Grammar,
Item.Prod).Tokens.To_Cursor (Item.Dot);
begin
-- An item has the structure [A -> alpha Dot B Beta, a].
--
-- If B is a nonterminal, find its productions and place
-- them in the set with lookaheads from FIRST(Beta a).
- if Item.Dot /= No_Element and then
- Element (Item.Dot) in Descriptor.First_Nonterminal ..
Descriptor.Last_Nonterminal
+ if Has_Element (Dot) and then
+ Element (Dot) in Descriptor.First_Nonterminal ..
Descriptor.Last_Nonterminal
then
declare
- Prod : WisiToken.Productions.Instance renames Grammar
(Element (Item.Dot));
+ Prod : WisiToken.Productions.Instance renames Grammar
(Element (Dot));
begin
-
For_Each_RHS :
- for B in Prod.RHSs.First_Index .. Prod.RHSs.Last_Index loop
+ for J in Prod.RHSs.First_Index .. Prod.RHSs.Last_Index loop
declare
- RHS : WisiToken.Productions.Right_Hand_Side renames
Prod.RHSs (B);
- P_ID : constant Production_ID := (Prod.LHS, B);
+ RHS : WisiToken.Productions.Right_Hand_Side renames
Prod.RHSs (J);
+ P_ID : constant Production_ID := (Prod.LHS, J);
+ Beta : Token_ID_Arrays.Cursor := Next (Dot); -- tokens
after nonterminal, possibly null
begin
-- Compute FIRST (<tail of right hand side> a); loop
-- until find a terminal, a nonterminal that
-- cannot be empty, or end of production, adding
-- items on the way.
- Beta := Next (Item.Dot); -- tokens after nonterminal,
possibly null
-
First_Tail :
loop
- if Beta = No_Element then
+ if not Has_Element (Beta) then
-- Use FIRST (a); a = Item.Lookaheads.
-- Lookaheads are all terminals, so
-- FIRST (a) = a.
Added_Item := Added_Item or
- Merge (P_ID, RHS.Tokens.First,
Item.Lookaheads.all, I);
+ Merge (P_ID, To_Index (RHS.Tokens.First),
Item.Lookaheads.all, I);
exit First_Tail;
elsif Element (Beta) in Descriptor.First_Terminal
.. Descriptor.Last_Terminal then
-- FIRST (Beta) = Beta
Added_Item := Added_Item or Merge
- (P_ID, RHS.Tokens.First, To_Lookahead (Element
(Beta), Descriptor), I);
+ (P_ID, To_Index (RHS.Tokens.First),
To_Lookahead (Element (Beta), Descriptor), I);
exit First_Tail;
else
-- Beta is a nonterminal; use FIRST (Beta)
for Terminal of First_Terminal_Sequence (Element
(Beta)) loop
Added_Item := Added_Item or
- Merge (P_ID, RHS.Tokens.First, To_Lookahead
(Terminal, Descriptor), I);
+ Merge (P_ID, To_Index (RHS.Tokens.First),
To_Lookahead (Terminal, Descriptor), I);
end loop;
if Has_Empty_Production (Element (Beta)) then
@@ -444,13 +411,13 @@ package body WisiToken.Generate.LR1_Items is
end if; -- Dot is at non-terminal
end;
- if Item_Lists.Next (Item_I) = Item_Lists.No_Element then
+ if not Has_Element (Item_Lists.Next (Item_I)) then
exit when not Added_Item;
Item_I := I.Set.First;
Added_Item := False;
- if Trace_Generate > Extra then
+ if Trace_Generate_Table > Extra then
Ada.Text_IO.Put_Line (" closure:");
Put (Grammar, Descriptor, I);
end if;
@@ -480,17 +447,15 @@ package body WisiToken.Generate.LR1_Items is
is
use Token_ID_Arrays;
- I : Cursor;
-
Prod : WisiToken.Productions.Instance renames Grammar (Item.Prod.LHS);
RHS : WisiToken.Productions.Right_Hand_Side renames Prod.RHSs
(Item.Prod.RHS);
Result : Ada.Strings.Unbounded.Unbounded_String :=
+Padded_Image (Item.Prod, Width => Prod_ID_Image_Width) & ":" & Image
(Prod.LHS, Descriptor) & " <=";
- begin
- I := RHS.Tokens.First;
- while I /= No_Element loop
- if I = Item.Dot then
+ I : Cursor := RHS.Tokens.First;
+ begin
+ while Has_Element (I) loop
+ if To_Index (I) = Item.Dot then
Result := Result & " ^ ";
else
Result := Result & " ";
@@ -499,7 +464,7 @@ package body WisiToken.Generate.LR1_Items is
Next (I);
end loop;
- if Item.Dot = No_Element then
+ if Item.Dot = No_Index then
Result := Result & " ^";
end if;
diff --git a/wisitoken-generate-lr1_items.ads b/wisitoken-generate-lr1_items.ads
index 0fd8c55..43e2939 100644
--- a/wisitoken-generate-lr1_items.ads
+++ b/wisitoken-generate-lr1_items.ads
@@ -2,7 +2,7 @@
--
-- Types and operatorion for LR(1) items.
--
--- Copyright (C) 2003, 2008, 2013 - 2015, 2017 - 2019 Free Software
Foundation, Inc.
+-- Copyright (C) 2003, 2008, 2013 - 2015, 2017 - 2020 Free Software
Foundation, Inc.
--
-- This file is part of the WisiToken package.
--
@@ -95,7 +95,7 @@ package WisiToken.Generate.LR1_Items is
type Item is record
Prod : Production_ID;
- Dot : Token_ID_Arrays.Cursor; -- token after item Dot
+ Dot : Token_ID_Arrays.Extended_Index := Token_ID_Arrays.No_Index;
-- token after item Dot
Lookaheads : Token_ID_Set_Access := null;
-- Programmer must remember to copy Item.Lookaheads.all, not
-- Item.Lookaheads. Wrapping this in Ada.Finalization.Controlled
@@ -113,9 +113,19 @@ package WisiToken.Generate.LR1_Items is
function Lookahead_Image (Item : in Lookahead; Descriptor : in
WisiToken.Descriptor) return String;
-- Returns the format used in parse table output.
+ function Image
+ (Grammar : in WisiToken.Productions.Prod_Arrays.Vector;
+ Descriptor : in WisiToken.Descriptor;
+ Item : in LR1_Items.Item;
+ Show_Lookaheads : in Boolean)
+ return String;
+
function Item_Compare (Left, Right : in Item) return SAL.Compare_Result;
-- Sort Item_Lists in ascending order of Prod.Nonterm, Prod.RHS, Dot;
-- ignores Lookaheads.
+ --
+ -- In an LALR kernel there can be only one Item with Prod, but that
+ -- is not true in an Item_Set produced by Closure.
package Item_Lists is new SAL.Gen_Definite_Doubly_Linked_Lists_Sorted
(Item, Item_Compare);
@@ -194,27 +204,13 @@ package WisiToken.Generate.LR1_Items is
-- Return No_Element if not found.
function Find
- (Prod : in Production_ID;
- Dot : in Token_ID_Arrays.Cursor;
- Right : in Item_Set)
- return Item_Lists.Cursor;
- -- Return an item from Right that matches Prod, Dot.
- --
- -- Return No_Element if not found.
-
- function Find
- (Prod : in Production_ID;
- Dot : in Token_ID_Arrays.Cursor;
- Right : in Item_Set;
- Lookaheads : in Lookahead)
+ (Prod : in Production_ID;
+ Dot : in Token_ID_Arrays.Extended_Index;
+ Set : in Item_Set)
return Item_Lists.Cursor;
- -- Return an item from Right that matches Prod, Dot, and
- -- Lookaheads.
+ -- Return an item from Set that matches Prod, Dot.
--
-- Return No_Element if not found.
- --
- -- Not combined with non-Lookaheads version for speed; this is called
- -- a lot.
package Item_Set_Arrays is new SAL.Gen_Unbounded_Definite_Vectors
(State_Index, Item_Set, Default_Element => (others => <>));
@@ -270,7 +266,8 @@ package WisiToken.Generate.LR1_Items is
-- Match_Lookaheads is True in LR1_Generate.
procedure Add
- (New_Item_Set : in out Item_Set;
+ (Grammar : in WisiToken.Productions.Prod_Arrays.Vector;
+ New_Item_Set : in Item_Set;
Item_Set_Vector : in out Item_Set_List;
Item_Set_Tree : in out Item_Set_Trees.Tree;
Descriptor : in WisiToken.Descriptor;
diff --git a/wisitoken-generate.adb b/wisitoken-generate.adb
index eae0ca3..1d7bb7e 100644
--- a/wisitoken-generate.adb
+++ b/wisitoken-generate.adb
@@ -2,7 +2,7 @@
--
-- See spec.
--
--- Copyright (C) 2018, 2019 Free Software Foundation, Inc.
+-- Copyright (C) 2018 - 2020 Free Software Foundation, Inc.
--
-- This library is free software; you can redistribute it and/or modify it
-- under terms of the GNU General Public License as published by the Free
@@ -152,6 +152,48 @@ package body WisiToken.Generate is
return Unused_Tokens;
end Check_Unused_Tokens;
+ function Nullable (Grammar : in WisiToken.Productions.Prod_Arrays.Vector)
return Token_Array_Production_ID
+ is
+ use all type Ada.Containers.Count_Type;
+
+ subtype Nonterminal is Token_ID range Grammar.First_Index ..
Grammar.Last_Index;
+
+ Result : Token_Array_Production_ID := (Nonterminal =>
Invalid_Production_ID);
+ Changed : Boolean := True;
+ begin
+ loop
+ exit when not Changed;
+ Changed := False;
+
+ for Prod of Grammar loop
+ if Result (Prod.LHS) = Invalid_Production_ID then
+ for RHS_Index in Prod.RHSs.First_Index .. Prod.RHSs.Last_Index
loop
+ declare
+ RHS : WisiToken.Productions.Right_Hand_Side renames
Prod.RHSs (RHS_Index);
+ begin
+ if RHS.Tokens.Length = 0 or else
+ (RHS.Tokens (1) in Nonterminal and then Result
(RHS.Tokens (1)) /= Invalid_Production_ID)
+ then
+ Result (Prod.LHS) := (Prod.LHS, RHS_Index);
+ Changed := True;
+ end if;
+ end;
+ end loop;
+ end if;
+ end loop;
+ end loop;
+ return Result;
+ end Nullable;
+
+ function Has_Empty_Production (Nullable : in Token_Array_Production_ID)
return Token_ID_Set
+ is begin
+ return Result : Token_ID_Set := (Nullable'First .. Nullable'Last =>
False) do
+ for I in Result'Range loop
+ Result (I) := Nullable (I) /= Invalid_Production_ID;
+ end loop;
+ end return;
+ end Has_Empty_Production;
+
function Has_Empty_Production (Grammar : in
WisiToken.Productions.Prod_Arrays.Vector) return Token_ID_Set
is
use all type Ada.Containers.Count_Type;
@@ -360,12 +402,11 @@ package body WisiToken.Generate is
function To_Graph (Grammar : in WisiToken.Productions.Prod_Arrays.Vector)
return Grammar_Graphs.Graph
is
- use all type Ada.Containers.Count_Type;
subtype Nonterminals is Token_ID range Grammar.First_Index ..
Grammar.Last_Index;
Graph : Grammar_Graphs.Graph;
J : Integer := 1;
begin
- if Trace_Generate > Outline then
+ if Trace_Generate_Minimal_Complete > Outline then
Ada.Text_IO.Put_Line ("grammar graph:");
end if;
@@ -379,19 +420,12 @@ package body WisiToken.Generate is
begin
for I in Tokens.First_Index .. Tokens.Last_Index loop
if Tokens (I) in Nonterminals then
- if Trace_Generate > Detail then
+ if Trace_Generate_Minimal_Complete > Detail then
Ada.Text_IO.Put_Line
("(" & Trimmed_Image (LHS) & ", " & Trimmed_Image
(Tokens (I)) & "," & J'Image & ")");
J := J + 1;
end if;
- Graph.Add_Edge
- (LHS, Tokens (I),
- (RHS,
- Recursive =>
- (if Tokens.Length = 1 then Single
- elsif I = Tokens.First_Index then Left
- elsif I = Tokens.Last_Index then Right
- else Middle)));
+ Graph.Add_Edge (LHS, Tokens (I), (RHS, I));
end if;
end loop;
end;
@@ -399,13 +433,68 @@ package body WisiToken.Generate is
end;
end loop;
- if Trace_Generate > Outline then
+ if Trace_Generate_Minimal_Complete > Outline then
Ada.Text_IO.Put_Line ("..." & Graph.Count_Nodes'Image & " nodes" &
Graph.Count_Edges'Image & " edges.");
end if;
return Graph;
end To_Graph;
- function Compute_Full_Recursion (Grammar : in
WisiToken.Productions.Prod_Arrays.Vector) return Recursions
+ function Recursion
+ (LHS : in Token_ID;
+ Token_Index : in Positive;
+ Tokens : in Token_ID_Arrays.Vector)
+ return Recursion_Class
+ is begin
+ return
+ (if Token_Index = Tokens.First_Index then
+ (if LHS = Tokens (Tokens.First_Index)
+ then Direct_Left
+ else Other_Left)
+ elsif Token_Index = Tokens.Last_Index then
+ (if LHS = Tokens (Tokens.Last_Index)
+ then Direct_Right
+ else Other_Right)
+ else Other);
+ end Recursion;
+
+ procedure Set_Grammar_Recursions
+ (Recursions : in WisiToken.Generate.Recursions;
+ Grammar : in out WisiToken.Productions.Prod_Arrays.Vector)
+ is begin
+ for LHS of Grammar loop
+ for RHS of LHS.RHSs loop
+ RHS.Recursion.Set_First_Last (RHS.Tokens.First_Index,
RHS.Tokens.Last_Index);
+ end loop;
+ end loop;
+
+ for Path of Recursions.Recursions loop
+ declare
+ use WisiToken.Productions;
+ Previous_Item_LHS : Token_ID :=
+ (if Recursions.Full then Path (Path'Last).Vertex else
Token_ID'Last);
+ begin
+ for Item of Path loop
+ for Edge of Item.Edges loop
+ declare
+ LHS : constant Token_ID := (if Recursions.Full then
Previous_Item_LHS else Item.Vertex);
+ RHS : Right_Hand_Side renames Grammar (LHS).RHSs
(Edge.Data.RHS);
+ begin
+ RHS.Recursion (Edge.Data.Token_Index) := Recursion
+ (LHS => LHS,
+ Token_Index => Edge.Data.Token_Index,
+ Tokens => RHS.Tokens);
+ end;
+ end loop;
+ Previous_Item_LHS := Item.Vertex;
+ end loop;
+ end;
+ end loop;
+ end Set_Grammar_Recursions;
+
+ function Compute_Full_Recursion
+ (Grammar : in out WisiToken.Productions.Prod_Arrays.Vector;
+ Descriptor : in WisiToken.Descriptor)
+ return Recursions
is
Graph : constant Grammar_Graphs.Graph := To_Graph (Grammar);
begin
@@ -414,7 +503,14 @@ package body WisiToken.Generate is
Recursions => Graph.Find_Cycles)
do
Grammar_Graphs.Sort_Paths.Sort (Result.Recursions);
- if Trace_Generate > Extra then
+
+ Set_Grammar_Recursions (Result, Grammar);
+
+ if Trace_Generate_Minimal_Complete > Extra then
+ Ada.Text_IO.New_Line;
+ Ada.Text_IO.Put_Line ("Productions:");
+ WisiToken.Productions.Put (Grammar, Descriptor);
+ Ada.Text_IO.New_Line;
Ada.Text_IO.Put_Line ("full recursions:");
for I in Result.Recursions.First_Index ..
Result.Recursions.Last_Index loop
Ada.Text_IO.Put_Line (Trimmed_Image (I) & " => " &
Grammar_Graphs.Image (Result.Recursions (I)));
@@ -423,7 +519,10 @@ package body WisiToken.Generate is
end return;
end Compute_Full_Recursion;
- function Compute_Partial_Recursion (Grammar : in
WisiToken.Productions.Prod_Arrays.Vector) return Recursions
+ function Compute_Partial_Recursion
+ (Grammar : in out WisiToken.Productions.Prod_Arrays.Vector;
+ Descriptor : in WisiToken.Descriptor)
+ return Recursions
is
use Grammar_Graphs;
Graph : constant Grammar_Graphs.Graph := To_Graph (Grammar);
@@ -457,7 +556,13 @@ package body WisiToken.Generate is
Result.Recursions.Append (Path);
end;
- if Trace_Generate > Extra then
+ Set_Grammar_Recursions (Result, Grammar);
+
+ if Trace_Generate_Minimal_Complete > Extra then
+ Ada.Text_IO.New_Line;
+ Ada.Text_IO.Put_Line ("Productions:");
+ WisiToken.Productions.Put (Grammar, Descriptor);
+ Ada.Text_IO.New_Line;
Ada.Text_IO.Put_Line ("partial recursions:");
for I in Result.Recursions.First_Index ..
Result.Recursions.Last_Index loop
Ada.Text_IO.Put_Line (Trimmed_Image (I) & " => " &
Grammar_Graphs.Image (Result.Recursions (I)));
@@ -504,7 +609,7 @@ package body WisiToken.Generate is
exit when I - First + Integer (Indent) <= Max_Line_Length;
I := I - 1;
end loop;
- Indent_Line (Text (First .. I - 1));
+ Indent_Line (Trim (Text (First .. I - 1), Right));
First := I + 1;
exit when Text'Last - First + Integer (Indent) <= Max_Line_Length;
end loop;
diff --git a/wisitoken-generate.ads b/wisitoken-generate.ads
index 45d8c7c..a9c4e5a 100644
--- a/wisitoken-generate.ads
+++ b/wisitoken-generate.ads
@@ -12,7 +12,7 @@
--
-- See wisitoken.ads
--
--- Copyright (C) 2018, 2019 Free Software Foundation, Inc.
+-- Copyright (C) 2018 - 2020 Free Software Foundation, Inc.
--
-- This library is free software; you can redistribute it and/or modify it
-- under terms of the GNU General Public License as published by the Free
@@ -61,6 +61,12 @@ package WisiToken.Generate is
-- Raises Grammar_Error if there is a non-grammar token used in the
-- grammar.
+ function Nullable (Grammar : in WisiToken.Productions.Prod_Arrays.Vector)
return Token_Array_Production_ID;
+ -- If ID is nullable, Result (ID) is the production that should be
+ -- reduced to produce the null. Otherwise Result (ID) is
+ -- Invalid_Production_ID.
+
+ function Has_Empty_Production (Nullable : in Token_Array_Production_ID)
return Token_ID_Set;
function Has_Empty_Production (Grammar : in
WisiToken.Productions.Prod_Arrays.Vector) return Token_ID_Set;
-- Result (ID) is True if any production for ID can be an empty
-- production, recursively.
@@ -101,22 +107,18 @@ package WisiToken.Generate is
-- Recursion is the result of a cycle in the grammar. We can form a
-- graph representing the grammar by taking the nonterminals as the
- -- graph vertices, and the occurence of a nonterminal in a production
- -- right hand side as a directed edge connecting two nonterminals
- -- (the other is the left hand side of that production. Then
- -- recursion is represented by a cycle in the graph.
-
- type Recursion_Item is record
- RHS : Natural := 0;
- -- The edge leading to this node. We don't need the actual token
- -- number.
-
- Recursive : Recursion := None;
- -- Position of the token in the RHS.
+ -- graph vertices, and the occurrence of a nonterminal in a
+ -- production right hand side as a directed edge from the left hand
+ -- side of the production to that nonterminal. Then recursion is
+ -- represented by a cycle in the graph.
+
+ type Edge_Data is record
+ -- The edge leading to this node.
+ RHS : Natural := Natural'Last;
+ Token_Index : Positive := Positive'Last;
end record;
- function Edge_Image (Edge : in Recursion_Item) return String is
- (Trimmed_Image (Edge.RHS) & " " & Recursion'Image (Edge.Recursive));
+ function Edge_Image (Edge : in Edge_Data) return String is (Trimmed_Image
(Edge.RHS));
type Base_Recursion_Index is range 0 .. Integer'Last;
subtype Recursion_Index is Base_Recursion_Index range 1 ..
Base_Recursion_Index'Last;
@@ -124,7 +126,7 @@ package WisiToken.Generate is
function Trimmed_Image is new SAL.Gen_Trimmed_Image (Base_Recursion_Index);
package Grammar_Graphs is new SAL.Gen_Graphs
- (Edge_Data => Recursion_Item,
+ (Edge_Data => Generate.Edge_Data,
Default_Edge_Data => (others => <>),
Vertex_Index => Token_ID,
Invalid_Vertex => Invalid_Token_ID,
@@ -152,14 +154,23 @@ package WisiToken.Generate is
function To_Graph (Grammar : in WisiToken.Productions.Prod_Arrays.Vector)
return Grammar_Graphs.Graph;
- function Compute_Full_Recursion (Grammar : in
WisiToken.Productions.Prod_Arrays.Vector) return Recursions;
- -- Each element of result is a cycle in the grammar.
-
- function Compute_Partial_Recursion (Grammar : in
WisiToken.Productions.Prod_Arrays.Vector) return Recursions;
+ function Compute_Full_Recursion
+ (Grammar : in out WisiToken.Productions.Prod_Arrays.Vector;
+ Descriptor : in WisiToken.Descriptor)
+ return Recursions;
+ -- Each element of result is a cycle in the grammar. Also sets
+ -- Recursive components in Grammar.
+
+ function Compute_Partial_Recursion
+ (Grammar : in out WisiToken.Productions.Prod_Arrays.Vector;
+ Descriptor : in WisiToken.Descriptor)
+ return Recursions;
-- Each element of the result contains all members of a non-trivial
-- strongly connected component in the grammar, in arbitrary order.
-- This is an approximation to the full recursion, when that is too
-- hard to compute (ie for Java).
+ --
+ -- Also sets Recursive components in Grammar.
----------
-- Indented text output. Mostly used for code generation in wisi,
diff --git a/wisitoken-lexer-re2c.adb b/wisitoken-lexer-re2c.adb
index d66088d..46cccb6 100644
--- a/wisitoken-lexer-re2c.adb
+++ b/wisitoken-lexer-re2c.adb
@@ -2,7 +2,7 @@
--
-- see spec.
--
--- Copyright (C) 2017 - 2019 Free Software Foundation, Inc.
+-- Copyright (C) 2017 - 2020 Free Software Foundation, Inc.
--
-- This file is part of the WisiToken package.
--
@@ -179,7 +179,8 @@ package body WisiToken.Lexer.re2c is
procedure Build_Token
is begin
Token :=
- (ID => Lexer.ID,
+ (ID => Lexer.ID,
+ Tree_Index => Invalid_Node_Index,
Byte_Region =>
(if Lexer.ID = Lexer.Descriptor.EOI_ID and then
Lexer.Byte_Position = Integer (Base_Buffer_Pos'First)
diff --git a/wisitoken-lexer-regexp.adb b/wisitoken-lexer-regexp.adb
index 3e5a421..d464289 100644
--- a/wisitoken-lexer-regexp.adb
+++ b/wisitoken-lexer-regexp.adb
@@ -2,7 +2,7 @@
--
-- See spec
--
--- Copyright (C) 2015, 2017 - 2019 Free Software Foundation, Inc.
+-- Copyright (C) 2015, 2017 - 2020 Free Software Foundation, Inc.
--
-- This file is part of the WisiToken package.
--
@@ -242,6 +242,7 @@ package body WisiToken.Lexer.Regexp is
Token :=
(ID => Lexer.ID,
+ Tree_Index => Invalid_Node_Index,
Byte_Region => (Buffer_Pos (Lexer.Lexeme_Head), Buffer_Pos
(Lexer.Lexeme_Tail)),
Line => Invalid_Line_Number,
Column => Ada.Text_IO.Count (Lexer.Lexeme_Head),
diff --git a/wisitoken-parse-lr-mckenzie_recover-base.adb
b/wisitoken-parse-lr-mckenzie_recover-base.adb
index d8b03f3..344461b 100644
--- a/wisitoken-parse-lr-mckenzie_recover-base.adb
+++ b/wisitoken-parse-lr-mckenzie_recover-base.adb
@@ -2,7 +2,7 @@
--
-- Base utilities for McKenzie_Recover
--
--- Copyright (C) 2018, 2019 Free Software Foundation, Inc.
+-- Copyright (C) 2018 - 2020 Free Software Foundation, Inc.
--
-- This library is free software; you can redistribute it and/or modify it
-- under terms of the GNU General Public License as published by the Free
@@ -30,49 +30,56 @@ package body WisiToken.Parse.LR.McKenzie_Recover.Base is
return Boolean
is
Done_Count : SAL.Base_Peek_Type := 0;
+ Skip : Boolean;
begin
-- Return True if all parsers are done, or if any parser has a config
-- available to check.
for P_Status of Parser_Status loop
+ Skip := False;
+
case P_Status.Recover_State is
when Active | Ready =>
if P_Status.Parser_State.Recover.Config_Heap.Count > 0 then
if P_Status.Parser_State.Recover.Check_Count -
Check_Delta_Limit >= Min_Success_Check_Count then
-- fail; another parser succeeded, this one taking too long.
Done_Count := Done_Count + 1;
+ Skip := True;
elsif Total_Enqueue_Count +
P_Status.Parser_State.Recover.Config_Full_Count >= Enqueue_Limit then
-- fail
Done_Count := Done_Count + 1;
+ Skip := True;
end if;
end if;
- case P_Status.Recover_State is
- when Active =>
- if P_Status.Parser_State.Recover.Config_Heap.Count > 0 then
- -- Still working
- return True;
- else
- if P_Status.Active_Workers = 0 then
- -- fail; no configs left to check.
- Done_Count := Done_Count + 1;
+ if not Skip then
+ case P_Status.Recover_State is
+ when Active =>
+ if P_Status.Parser_State.Recover.Config_Heap.Count > 0 then
+ -- Still working
+ return True;
+ else
+ if P_Status.Active_Workers = 0 then
+ -- fail; no configs left to check.
+ Done_Count := Done_Count + 1;
+ end if;
end if;
- end if;
- when Ready =>
- if P_Status.Parser_State.Recover.Config_Heap.Count > 0 and then
- P_Status.Parser_State.Recover.Config_Heap.Min_Key <=
P_Status.Parser_State.Recover.Results.Min_Key
- then
- -- Still more to check.
- return True;
+ when Ready =>
+ if P_Status.Parser_State.Recover.Config_Heap.Count > 0 and
then
+ P_Status.Parser_State.Recover.Config_Heap.Min_Key <=
P_Status.Parser_State.Recover.Results.Min_Key
+ then
+ -- Still more to check.
+ return True;
- elsif P_Status.Active_Workers = 0 then
- Done_Count := Done_Count + 1;
- end if;
+ elsif P_Status.Active_Workers = 0 then
+ Done_Count := Done_Count + 1;
+ end if;
- when others =>
- null;
- end case;
+ when others =>
+ null;
+ end case;
+ end if;
when Success | Fail =>
Done_Count := Done_Count + 1;
@@ -101,7 +108,7 @@ package body WisiToken.Parse.LR.McKenzie_Recover.Base is
Error_ID := Ada.Exceptions.Null_Id;
for I in Parsers.Iterate loop
- if Parsers.Reference (I).Recover_Insert_Delete.Length > 0 then
+ if Parsers.Reference (I).Recover_Insert_Delete_Current /=
Recover_Op_Arrays.No_Index then
-- Previous error recovery resume not finished; this is
supposed to
-- be checked in Parser.
raise SAL.Programmer_Error;
@@ -135,6 +142,7 @@ package body WisiToken.Parse.LR.McKenzie_Recover.Base is
(Parsers, Parser_Status, Min_Success_Check_Count,
Total_Enqueue_Count, Check_Delta_Limit, Enqueue_Limit)
is
Done_Count : SAL.Base_Peek_Type := 0;
+ Skip : Boolean;
Min_Cost : Integer := Integer'Last;
Min_Cost_Index : SAL.Base_Peek_Type;
@@ -168,6 +176,8 @@ package body WisiToken.Parse.LR.McKenzie_Recover.Base is
-- No task_id in outline trace messages, because they may appear in
-- .parse_good
for I in Parser_Status'Range loop
+ Skip := False;
+
declare
P_Status : Base.Parser_Status renames Parser_Status (I);
begin
@@ -186,6 +196,7 @@ package body WisiToken.Parse.LR.McKenzie_Recover.Base is
P_Status.Fail_Mode := Fail_Check_Delta;
Done_Count := Done_Count + 1;
+ Skip := True;
elsif Total_Enqueue_Count +
P_Status.Parser_State.Recover.Config_Full_Count >= Enqueue_Limit then
if Trace_McKenzie > Outline then
@@ -200,48 +211,51 @@ package body WisiToken.Parse.LR.McKenzie_Recover.Base is
P_Status.Fail_Mode := Fail_Enqueue_Limit;
Done_Count := Done_Count + 1;
+ Skip := True;
end if;
end if;
- case P_Status.Recover_State is
- when Active =>
- if P_Status.Parser_State.Recover.Config_Heap.Count > 0
then
- if P_Status.Parser_State.Recover.Config_Heap.Min_Key <
Min_Cost then
- Min_Cost :=
P_Status.Parser_State.Recover.Config_Heap.Min_Key;
- Min_Cost_Index := I;
- -- not done
- end if;
- else
- if P_Status.Active_Workers = 0 then
- -- No configs left to check (rarely happens with
real languages).
- if Trace_McKenzie > Outline then
- Put_Line
- (Trace.all, P_Status.Parser_State.Label,
"fail; no configs left", Task_ID => False);
+ if not Skip then
+ case P_Status.Recover_State is
+ when Active =>
+ if P_Status.Parser_State.Recover.Config_Heap.Count > 0
then
+ if
P_Status.Parser_State.Recover.Config_Heap.Min_Key < Min_Cost then
+ Min_Cost :=
P_Status.Parser_State.Recover.Config_Heap.Min_Key;
+ Min_Cost_Index := I;
+ -- not done
+ end if;
+ else
+ if P_Status.Active_Workers = 0 then
+ -- No configs left to check (rarely happens
with real languages).
+ if Trace_McKenzie > Outline then
+ Put_Line
+ (Trace.all, P_Status.Parser_State.Label,
"fail; no configs left", Task_ID => False);
+ end if;
+ P_Status.Recover_State := Fail;
+ P_Status.Fail_Mode := Fail_No_Configs_Left;
+
+ Done_Count := Done_Count + 1;
end if;
- P_Status.Recover_State := Fail;
- P_Status.Fail_Mode := Fail_No_Configs_Left;
-
- Done_Count := Done_Count + 1;
end if;
- end if;
- when Ready =>
- if P_Status.Parser_State.Recover.Config_Heap.Count > 0
and then
- P_Status.Parser_State.Recover.Config_Heap.Min_Key <=
- P_Status.Parser_State.Recover.Results.Min_Key
- then
- -- Still more to check. We don't check Min_Cost here
so this parser
- -- can finish quickly.
- Set_Outputs (I);
- return;
-
- elsif P_Status.Active_Workers = 0 then
- P_Status.Recover_State := Success;
- Done_Count := Done_Count + 1;
- end if;
- when others =>
- null;
- end case;
+ when Ready =>
+ if P_Status.Parser_State.Recover.Config_Heap.Count > 0
and then
+ P_Status.Parser_State.Recover.Config_Heap.Min_Key <=
+ P_Status.Parser_State.Recover.Results.Min_Key
+ then
+ -- Still more to check. We don't check Min_Cost
here so this parser
+ -- can finish quickly.
+ Set_Outputs (I);
+ return;
+
+ elsif P_Status.Active_Workers = 0 then
+ P_Status.Recover_State := Success;
+ Done_Count := Done_Count + 1;
+ end if;
+ when others =>
+ null;
+ end case;
+ end if;
when Success | Fail =>
Done_Count := Done_Count + 1;
@@ -395,7 +409,7 @@ package body WisiToken.Parse.LR.McKenzie_Recover.Base is
Error_Message := +Exception_Message (E);
if Debug_Mode then
Trace.Put_Line (Exception_Name (E) & ": " & Exception_Message (E));
- Trace.Put_Line (GNAT.Traceback.Symbolic.Symbolic_Traceback (E));
+ Trace.Put_Line (GNAT.Traceback.Symbolic.Symbolic_Traceback (E));
-- includes Prefix
end if;
end Fatal;
diff --git a/wisitoken-parse-lr-mckenzie_recover-explore.adb
b/wisitoken-parse-lr-mckenzie_recover-explore.adb
index b6c9e43..2741dff 100644
--- a/wisitoken-parse-lr-mckenzie_recover-explore.adb
+++ b/wisitoken-parse-lr-mckenzie_recover-explore.adb
@@ -2,7 +2,7 @@
--
-- See spec.
--
--- Copyright (C) 2018 - 2019 Free Software Foundation, Inc.
+-- Copyright (C) 2018 - 2020 Free Software Foundation, Inc.
--
-- This library is free software; you can redistribute it and/or modify it
-- under terms of the GNU General Public License as published by the Free
@@ -38,7 +38,7 @@ package body WisiToken.Parse.LR.McKenzie_Recover.Explore is
use Config_Op_Arrays;
McKenzie_Param : McKenzie_Param_Type renames Shared.Table.McKenzie_Param;
- Op : constant Config_Op := (Insert, ID, Config.Current_Shared_Token,
State, Config.Stack.Depth);
+ Op : constant Config_Op := (Insert, ID, Config.Current_Shared_Token);
begin
Config.Strategy_Counts (Strategy) := Config.Strategy_Counts (Strategy) +
1;
@@ -69,7 +69,7 @@ package body WisiToken.Parse.LR.McKenzie_Recover.Explore is
Super.Config_Full ("do_shift stack", Parser_Index);
raise Bad_Config;
else
- Config.Stack.Push ((State, Syntax_Trees.Invalid_Node_Index, (ID,
Virtual => True, others => <>)));
+ Config.Stack.Push ((State, Invalid_Node_Index, (ID, Virtual => True,
others => <>)));
end if;
if Trace_McKenzie > Detail then
Base.Put
@@ -144,7 +144,7 @@ package body WisiToken.Parse.LR.McKenzie_Recover.Explore is
raise Bad_Config;
end if;
- Config.Stack.Push ((New_State, Syntax_Trees.Invalid_Node_Index,
Nonterm));
+ Config.Stack.Push ((New_State, Invalid_Node_Index, Nonterm));
if Trace_McKenzie > Extra and Label'Length > 0 then
Put_Line
@@ -196,7 +196,12 @@ package body WisiToken.Parse.LR.McKenzie_Recover.Explore is
raise SAL.Programmer_Error with "found test case for Do_Reduce
Accept_It";
when Error =>
- null;
+ if Trace_McKenzie > Extra and Label'Length > 0 then
+ Put_Line
+ (Super.Trace.all, Super.Label (Parser_Index), Label & ": error
on " &
+ Image (Inserted_ID, Super.Trace.Descriptor.all) &
+ " in state" & State_Index'Image (Config.Stack.Peek.State));
+ end if;
end case;
loop
@@ -235,24 +240,35 @@ package body WisiToken.Parse.LR.McKenzie_Recover.Explore
is
end if;
end Do_Reduce_2;
- function Fast_Forward
+ function Edit_Point_Matches_Ops (Config : in Configuration) return Boolean
+ is
+ use Config_Op_Arrays, Config_Op_Array_Refs;
+ pragma Assert (Length (Config.Ops) > 0);
+ Op : Config_Op renames Constant_Ref (Config.Ops, Last_Index
(Config.Ops));
+ begin
+ return Config.Current_Shared_Token =
+ (case Op.Op is
+ when Fast_Forward => Op.FF_Token_Index,
+ when Undo_Reduce => Invalid_Token_Index, -- ie, "we don't know", so
return False.
+ when Push_Back => Op.PB_Token_Index,
+ when Insert => Op.Ins_Token_Index,
+ when Delete => Op.Del_Token_Index + 1);
+ end Edit_Point_Matches_Ops;
+
+ procedure Fast_Forward
(Super : not null access Base.Supervisor;
Shared : not null access Base.Shared;
Parser_Index : in SAL.Base_Peek_Type;
Local_Config_Heap : in out Config_Heaps.Heap_Type;
- Config : in out Configuration)
- return Non_Success_Status
+ Config : in Configuration)
is
-- Apply the ops in Config; they were inserted by some fix.
- -- Return Abandon if Config should be abandoned, otherwise Continue.
-- Leaves Config.Error_Token, Config.Check_Status set.
- --
- -- If there are conflicts, all are parsed; if more than one succeed,
- -- all are enqueued in Local_Config_Heap, and this returns Abandon.
+ -- If there are conflicts, all are parsed; if more than one succeed.
+ -- All configs are enqueued in Local_Config_Heap.
use Parse.Parse_Item_Arrays;
use Config_Op_Arrays;
- use all type Ada.Containers.Count_Type;
Parse_Items : aliased Parse.Parse_Item_Arrays.Vector;
@@ -262,56 +278,43 @@ package body WisiToken.Parse.LR.McKenzie_Recover.Explore
is
All_Conflicts => True,
Trace_Prefix => "fast_forward");
begin
- -- This solution is from Language_Fixes; any cost increase is done
there.
+ -- This solution is from Language_Fixes (see gate on call site
+ -- below); any cost increase is done there.
+ --
+ -- We used to handle the Parse_Items.Length = 1 case specially, and
+ -- return Continue. Maintaining that requires too much code
+ -- duplication.
- if Length (Parse_Items) = 1 then
+ for I in First_Index (Parse_Items) .. Last_Index (Parse_Items) loop
declare
- Item : Parse.Parse_Item renames
Parse.Parse_Item_Array_Refs.Constant_Ref (Parse_Items, 1);
+ Item : Parse.Parse_Item renames
Parse.Parse_Item_Array_Refs.Variable_Ref (Parse_Items, I);
begin
if Item.Parsed and Item.Config.Current_Insert_Delete =
No_Insert_Delete then
-- Item.Config.Error_Token.ID, Check_Status are correct.
- Config := Item.Config;
- if Is_Full (Config.Ops) then
- Super.Config_Full ("fast_forward 1", Parser_Index);
- return Abandon;
- else
- Append (Config.Ops, (Fast_Forward,
Config.Current_Shared_Token));
- end if;
- Config.Minimal_Complete_State := None;
- Config.Matching_Begin_Done := False;
- return Continue;
- else
- return Abandon;
- end if;
- end;
- else
- for I in First_Index (Parse_Items) .. Last_Index (Parse_Items) loop
- declare
- Item : Parse.Parse_Item renames
Parse.Parse_Item_Array_Refs.Variable_Ref (Parse_Items, I);
- begin
- if Item.Parsed and Item.Config.Current_Insert_Delete =
No_Insert_Delete then
- if Is_Full (Config.Ops) then
- Super.Config_Full ("fast_forward 2", Parser_Index);
- return Abandon;
+ if not Edit_Point_Matches_Ops (Item.Config) then
+
+ if Is_Full (Item.Config.Ops) then
+ Super.Config_Full ("fast_forward 1", Parser_Index);
+ raise Bad_Config;
else
Append (Item.Config.Ops, (Fast_Forward,
Item.Config.Current_Shared_Token));
end if;
- Item.Config.Minimal_Complete_State := None;
- Item.Config.Matching_Begin_Done := False;
- Local_Config_Heap.Add (Item.Config);
+ end if;
- if Trace_McKenzie > Detail then
- Base.Put ("fast forward enqueue", Super, Shared,
Parser_Index, Item.Config);
- end if;
+ Item.Config.Minimal_Complete_State := None;
+ Item.Config.Matching_Begin_Done := False;
+ Local_Config_Heap.Add (Item.Config);
+
+ if Trace_McKenzie > Detail then
+ Base.Put ("fast forward enqueue", Super, Shared,
Parser_Index, Item.Config);
end if;
- end;
- end loop;
- return Abandon;
- end if;
- exception
- when Bad_Config =>
- return Abandon;
+ end if;
+ exception
+ when Bad_Config =>
+ null;
+ end;
+ end loop;
end Fast_Forward;
function Check
@@ -326,32 +329,38 @@ package body WisiToken.Parse.LR.McKenzie_Recover.Explore
is
use Parse.Parse_Item_Arrays;
use all type Semantic_Checks.Check_Status_Label;
- McKenzie_Param : McKenzie_Param_Type renames Shared.Table.McKenzie_Param;
-
Parse_Items : aliased Parse.Parse_Item_Arrays.Vector;
Result : Check_Status := Continue;
+ begin
+ if Length (Config.Ops) > 0 then
+ declare
+ Op : Config_Op renames Constant_Ref (Config.Ops, Last_Index
(Config.Ops));
+ begin
+ case Op.Op is
+ when Push_Back =>
+ -- Check would undo the Push_Back, leading to
+ -- duplicate results. See test_mckenzie_recover.adb
Do_Delete_First and
+ -- three_action_conflict_lalr.parse_good for examples.
+ return Continue;
- function Max_Push_Back_Token_Index (Ops : aliased in
Config_Op_Arrays.Vector) return WisiToken.Base_Token_Index
- is
- Result : WisiToken.Base_Token_Index :=
WisiToken.Base_Token_Index'First;
- begin
- -- For Ops since last Fast_Forward, return maximum Token_Index in a
- -- Push_Back. If there are no such ops, return a value that will be
- -- less than the current token index.
- for I in reverse First_Index (Ops) .. Last_Index (Ops) loop
- declare
- Op : Config_Op renames Constant_Ref (Ops, I);
- begin
- exit when Op.Op = Fast_Forward;
- if Op.Op = Push_Back and then Op.PB_Token_Index > Result then
- Result := Op.PB_Token_Index;
+ when Undo_Reduce =>
+ if Config.Check_Status.Label /= Ok then
+ -- This is the "ignore error" solution for a check fail;
check it.
+ Config.Check_Status := (Label => Ok);
+ Config.Error_Token.ID := Invalid_Token_ID;
+
+ else
+ -- Check would undo the Undo_Reduce, leading to
+ -- duplicate results.
+ return Continue;
end if;
- end;
- end loop;
- return Result;
- end Max_Push_Back_Token_Index;
+ when others =>
+ -- Check it
+ null;
+ end case;
+ end;
+ end if;
- begin
if Parse.Parse
(Super, Shared, Parser_Index, Parse_Items, Config,
Config.Resume_Token_Goal,
All_Conflicts => False,
@@ -360,6 +369,9 @@ package body WisiToken.Parse.LR.McKenzie_Recover.Explore is
Config.Error_Token.ID := Invalid_Token_ID;
-- FIXME: if there were conflicts, enqueue them; they might yield a
-- cheaper or same cost solution?
+ if Trace_McKenzie > Extra then
+ Put_Line (Super.Trace.all, Super.Label (Parser_Index), "check
result: SUCCESS");
+ end if;
return Success;
end if;
@@ -395,37 +407,33 @@ package body WisiToken.Parse.LR.McKenzie_Recover.Explore
is
end;
-- All Parse_Items either failed or were not parsed; if they failed
- -- and made progress, enqueue them so Language_Fixes can try to fix
- -- them.
+ -- and made progress, enqueue them.
for I in First_Index (Parse_Items) .. Last_Index (Parse_Items) loop
declare
Item : Parse.Parse_Item renames
Parse.Parse_Item_Array_Refs.Variable_Ref (Parse_Items, I);
begin
- if Item.Config.Error_Token.ID /= Invalid_Token_ID and then
- Item.Shift_Count > 0 and then
- Max_Push_Back_Token_Index (Item.Config.Ops) <
Item.Config.Current_Shared_Token - 1
+ -- When Parse starts above, Config.Current_Shared_Token matches
+ -- Config.Ops. So if Item.Config.Current_Shared_Token >
+ -- Config.Current_Shared_Token, it made some progress. Append or
+ -- update a Fast_Forward to indicate the changed edit point.
+ if Item.Config.Error_Token.ID /= Invalid_Token_ID and
+ Item.Config.Current_Shared_Token > Config.Current_Shared_Token
then
- -- Some progress was made; explore at the new error point. It
is
- -- likely that there is only one actual error point, and this
moves
- -- away from it, so we give it a cost.
- begin
- Item.Config.Minimal_Complete_State := None;
- Item.Config.Matching_Begin_Done := False;
- if Constant_Ref (Item.Config.Ops, Last_Index
(Item.Config.Ops)).Op = Fast_Forward then
- Item.Config.Cost := Item.Config.Cost +
McKenzie_Param.Fast_Forward;
- Variable_Ref (Item.Config.Ops, Last_Index
(Item.Config.Ops)).FF_Token_Index :=
- Item.Config.Current_Shared_Token;
- else
- Item.Config.Cost := Item.Config.Cost +
McKenzie_Param.Fast_Forward;
+ Item.Config.Minimal_Complete_State := None;
+ Item.Config.Matching_Begin_Done := False;
- if Is_Full (Item.Config.Ops) then
- Super.Config_Full ("check 1", Parser_Index);
- raise Bad_Config;
- else
- Append (Item.Config.Ops, (Fast_Forward,
Item.Config.Current_Shared_Token));
- end if;
+ if Constant_Ref (Item.Config.Ops, Last_Index
(Item.Config.Ops)).Op = Fast_Forward then
+ -- Update the trailing Fast_Forward.
+ Variable_Ref (Item.Config.Ops, Last_Index
(Item.Config.Ops)).FF_Token_Index :=
+ Item.Config.Current_Shared_Token;
+ else
+ if Is_Full (Item.Config.Ops) then
+ Super.Config_Full ("check 1", Parser_Index);
+ raise Bad_Config;
+ else
+ Append (Item.Config.Ops, (Fast_Forward,
Item.Config.Current_Shared_Token));
end if;
- end;
+ end if;
Local_Config_Heap.Add (Item.Config);
if Trace_McKenzie > Detail then
Base.Put ("new error point ", Super, Shared, Parser_Index,
Item.Config);
@@ -455,7 +463,7 @@ package body WisiToken.Parse.LR.McKenzie_Recover.Explore is
function To_Reduce_Action (Item : in Minimal_Action) return
Reduce_Action_Rec
is begin
- return (Reduce, (Item.Nonterm, 0), null, null, Item.Token_Count);
+ return (Reduce, Item.Production, null, null, Item.Token_Count);
end To_Reduce_Action;
Local_Config_Heap : Config_Heaps.Heap_Type; -- never used, because
Do_Language_Fixes is False.
@@ -467,7 +475,7 @@ package body WisiToken.Parse.LR.McKenzie_Recover.Explore is
case Actions.Length is
when 0 =>
if (for some Item of Table.States (Config.Stack.Peek.State).Kernel
=>
- Item.LHS = Super.Trace.Descriptor.Accept_ID)
+ Item.Production.LHS = Super.Trace.Descriptor.Accept_ID)
then
return True;
else
@@ -509,6 +517,7 @@ package body WisiToken.Parse.LR.McKenzie_Recover.Explore is
is
Trace : WisiToken.Trace'Class renames Super.Trace.all;
McKenzie_Param : McKenzie_Param_Type renames Shared.Table.McKenzie_Param;
+ Prev_Recover : constant WisiToken.Base_Token_Index :=
Super.Parser_State (Parser_Index).Resume_Token_Goal;
Token : constant Recover_Token := Config.Stack.Peek.Token;
begin
@@ -519,10 +528,15 @@ package body WisiToken.Parse.LR.McKenzie_Recover.Explore
is
-- to give this operation zero cost. But then we keep doing push_back
-- forever, making no progress. So we give it a cost.
- if not Token.Virtual then
- -- If Virtual, this is from earlier in this recover session; no point
- -- in trying to redo it.
+ if Token.Min_Terminal_Index /= Invalid_Token_Index and
+ -- No point in pushing back an empty nonterm; that leads to duplicate
+ -- solutions with Undo_Reduce; see test_mckenzie_recover.adb Error_2.
+ (Prev_Recover = Invalid_Token_Index or else Prev_Recover <
Token.Min_Terminal_Index)
+ -- Don't push back past previous error recover (that would require
+ -- keeping track of previous inserts/deletes, and would not be useful
+ -- in most cases).
+ then
declare
use Config_Op_Arrays;
New_Config : Configuration := Config;
@@ -561,19 +575,59 @@ package body WisiToken.Parse.LR.McKenzie_Recover.Explore
is
function Just_Pushed_Back_Or_Deleted (Config : in Configuration; ID : in
Token_ID) return Boolean
is
use Config_Op_Arrays, Config_Op_Array_Refs;
- use all type Ada.Containers.Count_Type;
+ Last_Token_Index : WisiToken.Token_Index := Config.Current_Shared_Token;
+ -- Index of token in last op checked.
begin
- if Length (Config.Ops) = 0 then
- return False;
- else
+ -- This function is called when considering whether to insert ID before
+ -- Config.Current_Shared_Token.
+ --
+ -- We need to consider more than one recent op here; see
test_mckenzie_recover.adb
+ -- Check_Multiple_Delete_For_Insert. Checking only one op allows this
solution there:
+ --
+ -- ... (DELETE, END, 7), (DELETE, SEMICOLON, 8), (INSERT, END, 9),
(INSERT, SEMICOLON, 9)
+ --
+ for I in reverse First_Index (Config.Ops) .. Last_Index (Config.Ops) loop
declare
- Last_Op : Config_Op renames Constant_Ref (Config.Ops, Last_Index
(Config.Ops));
+ Op : Config_Op renames Constant_Ref (Config.Ops, I);
begin
- return
- (Last_Op.Op = Push_Back and then Last_Op.PB_ID = ID) or
- (Last_Op.Op = Delete and then Last_Op.Del_ID = ID);
+ case Op.Op is
+ when Push_Back =>
+ -- The case we are preventing for Push_Back is typically one
of:
+ -- (PUSH_BACK, Identifier, 2), (INSERT, Identifier, 2)
+ -- (PUSH_BACK, Identifier, 2), (PUSH_BACK, END, 3), (INSERT,
Identifier, 3), (INSERT, END, 3),
+ if Op.PB_Token_Index = Last_Token_Index then
+ if Op.PB_ID = ID then
+ return True;
+ else
+ if Op.PB_Token_Index = WisiToken.Token_Index'First then
+ return False;
+ else
+ Last_Token_Index := Op.PB_Token_Index - 1;
+ end if;
+ end if;
+ else
+ -- Op is at a different edit point.
+ return False;
+ end if;
+
+ when Delete =>
+ if Op.Del_Token_Index = Last_Token_Index - 1 then
+ if Op.Del_ID = ID then
+ return True;
+ else
+ Last_Token_Index := Op.Del_Token_Index;
+ end if;
+ else
+ -- Op is at a different edit point.
+ return False;
+ end if;
+
+ when Fast_Forward | Insert | Undo_Reduce =>
+ return False;
+ end case;
end;
- end if;
+ end loop;
+ return False;
end Just_Pushed_Back_Or_Deleted;
procedure Try_Undo_Reduce
@@ -583,45 +637,40 @@ package body WisiToken.Parse.LR.McKenzie_Recover.Explore
is
Config : in Configuration;
Local_Config_Heap : in out Config_Heaps.Heap_Type)
is
- Trace : WisiToken.Trace'Class renames Super.Trace.all;
- McKenzie_Param : McKenzie_Param_Type renames Shared.Table.McKenzie_Param;
+ use Config_Op_Arrays;
- Token : constant Recover_Token := Config.Stack.Peek.Token;
+ Trace : WisiToken.Trace'Class renames Super.Trace.all;
+ McKenzie_Param : McKenzie_Param_Type renames Shared.Table.McKenzie_Param;
+ Token : constant Recover_Token := Config.Stack.Peek.Token;
+ New_Config : Configuration := Config;
+ Token_Count : Ada.Containers.Count_Type;
begin
-- Try expanding the nonterm on the stack top, to allow pushing_back
-- its components, or insert and other operations at that point.
- if Undo_Reduce_Valid (Config.Stack, Super.Parser_State
(Parser_Index).Tree) then
- declare
- use Config_Op_Arrays;
- New_Config : Configuration := Config;
- Token_Count : Ada.Containers.Count_Type;
- begin
- New_Config.Error_Token.ID := Invalid_Token_ID;
- New_Config.Check_Status := (Label =>
WisiToken.Semantic_Checks.Ok);
+ New_Config.Error_Token.ID := Invalid_Token_ID;
+ New_Config.Check_Status := (Label => WisiToken.Semantic_Checks.Ok);
- Token_Count := Undo_Reduce (New_Config.Stack, Super.Parser_State
(Parser_Index).Tree);
+ Token_Count := Undo_Reduce (New_Config.Stack, Super.Parser_State
(Parser_Index).Tree);
- if Token.Min_Terminal_Index /= Invalid_Token_Index then
- -- If Token is empty no cost increase.
- New_Config.Cost := New_Config.Cost + McKenzie_Param.Undo_Reduce
(Token.ID);
- end if;
+ if Token.Min_Terminal_Index /= Invalid_Token_Index then
+ -- If Token is empty no cost increase.
+ New_Config.Cost := New_Config.Cost + McKenzie_Param.Undo_Reduce
(Token.ID);
+ end if;
- if Is_Full (New_Config.Ops) then
- Super.Config_Full ("undo_reduce 1", Parser_Index);
- raise Bad_Config;
- else
- Append (New_Config.Ops, (Undo_Reduce, Token.ID, Token_Count));
- end if;
- New_Config.Strategy_Counts (Undo_Reduce) :=
New_Config.Strategy_Counts (Undo_Reduce) + 1;
+ if Is_Full (New_Config.Ops) then
+ Super.Config_Full ("undo_reduce 1", Parser_Index);
+ raise Bad_Config;
+ else
+ Append (New_Config.Ops, (Undo_Reduce, Token.ID, Token_Count));
+ end if;
+ New_Config.Strategy_Counts (Undo_Reduce) := New_Config.Strategy_Counts
(Undo_Reduce) + 1;
- Local_Config_Heap.Add (New_Config);
+ Local_Config_Heap.Add (New_Config);
- if Trace_McKenzie > Detail then
- Base.Put ("undo_reduce " & Image (Token.ID,
Trace.Descriptor.all), Super, Shared,
- Parser_Index, New_Config);
- end if;
- end;
+ if Trace_McKenzie > Detail then
+ Base.Put ("undo_reduce " & Image (Token.ID, Trace.Descriptor.all),
Super, Shared,
+ Parser_Index, New_Config);
end if;
end Try_Undo_Reduce;
@@ -673,8 +722,8 @@ package body WisiToken.Parse.LR.McKenzie_Recover.Explore is
": undo push_back");
end if;
elsif ID = Current_Token then
- -- This needed because we allow explore when the error
is not at the
- -- explore point; it prevents inserting useless tokens
(ie
+ -- This is needed because we allow explore when the
error is not at
+ -- the explore point; it prevents inserting useless
tokens (ie
-- 'identifier ;' in ada_lite).
if Trace_McKenzie > Extra then
Put_Line
@@ -759,8 +808,9 @@ package body WisiToken.Parse.LR.McKenzie_Recover.Explore is
Inserted_Last : Integer := Inserted'First - 1;
type Work_Item is record
- Action : Minimal_Action;
- Config : Configuration;
+ Action : Minimal_Action;
+ Cost_Delta : Integer;
+ Config : Configuration;
end record;
package Item_Queues is new SAL.Gen_Bounded_Definite_Queues (Work_Item);
@@ -771,39 +821,24 @@ package body WisiToken.Parse.LR.McKenzie_Recover.Explore
is
-- Minimal_Complete_Actions encountered. That is limited by compound
-- statement nesting, and by the frequency of such actions.
- function To_Reduce_Action (Action : in Minimal_Action) return
Reduce_Action_Rec
- is (Reduce, (Action.Nonterm, 0), null, null, Action.Token_Count);
-
- procedure Minimal_Do_Shift (Action : in Minimal_Action; Config : in out
Configuration)
- is
- use Config_Op_Arrays, Config_Op_Array_Refs;
- begin
- -- Check for a cycle. We compare stack depth as well as state, so
- -- nested compound statements don't look like a cycle; see
- -- test_mckenzie_recover Push_Back_1. We don't check for cycles in
- -- Insert_From_Action_List because we assume cost eliminates cycles
- -- there; Minimal_Complete_Delta is usually negative, so cost does
- -- not necessarily increase here.
- for I in reverse First_Index (Config.Ops) .. Last_Index (Config.Ops)
loop
- declare
- Op : Config_Op renames Constant_Ref (Config.Ops, I);
- begin
- if Op.Op = Insert and then
- (Op.Ins_ID = Action.ID and Op.State = Action.State and
Op.Stack_Depth = Config.Stack.Depth)
- then
- if Trace_McKenzie > Extra then
- Put_Line
- (Super.Trace.all, Super.Label (Parser_Index),
"Minimal_Complete_Actions: abandon " &
- Image (Action.ID, Descriptor) & Action.State'Image &
": cycle");
- end if;
- return;
- end if;
- end;
- end loop;
+ procedure Safe_Add_Work (Label : in String; Item : in Work_Item)
+ is begin
+ if Is_Full (Work) then
+ Super.Config_Full ("Minimal_Complete_Actions " & Label,
Parser_Index);
+ raise Bad_Config;
+ else
+ Add (Work, Item);
+ end if;
+ end Safe_Add_Work;
- -- We don't check Action.ID = Current_Token; the error is at the
- -- explore point, so ID is valid.
+ function To_Reduce_Action (Action : in Minimal_Action) return
Reduce_Action_Rec
+ is (Reduce, Action.Production, null, null, Action.Token_Count);
+ procedure Minimal_Do_Shift
+ (Action : in Minimal_Action;
+ Cost_Delta : in Integer;
+ Config : in out Configuration)
+ is begin
if Just_Pushed_Back_Or_Deleted (Config, Action.ID) then
if Trace_McKenzie > Extra then
Put_Line
@@ -814,101 +849,167 @@ package body
WisiToken.Parse.LR.McKenzie_Recover.Explore is
Config.Check_Status := (Label =>
WisiToken.Semantic_Checks.Ok);
Config.Minimal_Complete_State := Active;
Inserted_Last := Inserted_Last + 1;
- Inserted (Inserted_Last) := Action.ID;
+ if Inserted_Last <= Inserted'Last then
+ Inserted (Inserted_Last) := Action.ID;
+ else
+ Super.Config_Full ("minimal_do_shift Inserted", Parser_Index);
+ raise Bad_Config;
+ end if;
Do_Shift
("Minimal_Complete_Actions", Super, Shared, Parser_Index,
Local_Config_Heap, Config,
- Action.State, Action.ID,
Table.McKenzie_Param.Minimal_Complete_Cost_Delta,
+ Action.State, Action.ID, Cost_Delta,
Strategy => Minimal_Complete);
end if;
end Minimal_Do_Shift;
procedure Enqueue_Min_Actions
- (Label : in String;
- Actions : in Minimal_Action_Arrays.Vector;
- Recursive : in Boolean;
- Config : in Configuration;
- Reduce_Only : in Boolean)
+ (Label : in String;
+ Actions : in Minimal_Action_Arrays.Vector;
+ Config : in Configuration)
is
use SAL;
Length : array (Actions.First_Index .. Actions.Last_Index) of
Count_Type := (others => Count_Type'Last);
- Item_Not_Recursive : array (Actions.First_Index ..
Actions.Last_Index) of Boolean := (others => False);
-
- Not_Recursive_Count : Count_Type := 0;
- Min_Length : Count_Type := Count_Type'Last;
- Use_Recursive : Boolean;
+ Min_Length : Count_Type := Count_Type'Last;
begin
- -- Enqueue non-minimal actions on Work,
if Trace_McKenzie > Extra then
Put_Line
(Super.Trace.all, Super.Label (Parser_Index),
"Minimal_Complete_Actions: " & Label &
- Image (Actions, Descriptor) & (if Recursive then " recursive"
else ""));
+ Image (Actions, Descriptor));
end if;
if Actions.Length = 0 then
return;
elsif Actions.Length = 1 then
- if (not Reduce_Only) or Actions (Actions.First_Index).Verb =
Reduce then
- if Is_Full (Work) then
- Super.Config_Full ("Minimal_Complete_Actions 1",
Parser_Index);
- raise Bad_Config;
- else
- Add (Work, (Actions (Actions.First_Index), Config));
- end if;
- end if;
+ Safe_Add_Work
+ ("1", (Actions (Actions.First_Index),
Table.McKenzie_Param.Minimal_Complete_Cost_Delta, Config));
return;
end if;
+ -- More than one minimal action in State; try to use next states and
+ -- recursion to pick one.
+ Actions_Loop :
for I in Actions.First_Index .. Actions.Last_Index loop
declare
- Action : Minimal_Action renames Actions (I);
- Next_State : constant State_Index :=
+ function Matches (Item : in Kernel_Info; Action : in
Minimal_Action) return Boolean
+ is begin
+ case Action.Verb is
+ when Shift =>
+ return Item.Before_Dot = Action.ID;
+ when Reduce =>
+ return Item.Before_Dot = Action.Production.LHS;
+ end case;
+ end Matches;
+
+ function Length_After_Dot
+ (Item : in Kernel_Info;
+ Action : in Minimal_Action;
+ Stack : in Recover_Stacks.Stack)
+ return Ada.Containers.Count_Type
+ is
+ Match_ID : Token_ID;
+ New_Stack : Recover_Stacks.Stack := Stack;
+ Next_State : Unknown_State_Index;
+ Result : Ada.Containers.Count_Type;
+ Min_Result : Ada.Containers.Count_Type :=
Ada.Containers.Count_Type'Last;
+ begin
+ case Action.Verb is
+ when Shift =>
+ New_Stack.Push
+ ((Action.State, Invalid_Node_Index, (ID => Action.ID,
others => <>)));
+ Next_State := Action.State;
+ Match_ID := Action.ID;
+
+ when Reduce =>
+ New_Stack.Pop (SAL.Base_Peek_Type (Action.Token_Count));
+ Next_State := Goto_For (Shared.Table.all,
New_Stack.Peek.State, Action.Production.LHS);
+ if Next_State = Unknown_State then
+ -- We get here when Insert_From_Action_Table started
us down a bad path
+ raise Bad_Config;
+ end if;
+
+ New_Stack.Push
+ ((Next_State, Invalid_Node_Index, (ID =>
Action.Production.LHS, others => <>)));
+ Match_ID := Action.Production.LHS;
+ end case;
+
+ if Trace_McKenzie > Extra then
+ Super.Trace.Put (Next_State'Image & " " & Trimmed_Image
(Item.Production));
+ end if;
+
+ for Item of Shared.Table.States (Next_State).Kernel loop
+ if Item.Before_Dot = Match_ID then
+ if Item.Length_After_Dot = 0 then
+ Result := Length_After_Dot
+ (Item, (Reduce, Item.Reduce_Production,
Item.Reduce_Count), New_Stack);
+ else
+ Result := Item.Length_After_Dot;
+ end if;
+ end if;
+
+ if Result < Min_Result then
+ Min_Result := Result;
+ end if;
+ end loop;
+ return Min_Result;
+ end Length_After_Dot;
+
+ Action : constant Minimal_Action := Actions (I);
+ Next_State : constant State_Index :=
(case Action.Verb is
- when Shift => Action.State,
+ when Shift => Action.State,
when Reduce => Goto_For
(Shared.Table.all,
Config.Stack.Peek (Base_Peek_Type (Action.Token_Count) +
1).State,
- Action.Nonterm));
- Before_Dot : constant Token_ID :=
- (case Action.Verb is
- when Shift => Action.ID,
- when Reduce => Action.Nonterm);
- Kernel : Kernel_Info_Arrays.Vector renames
Shared.Table.States (Next_State).Kernel;
+ Action.Production.LHS));
begin
- if (not Reduce_Only) or Action.Verb = Reduce then
- for Item of Kernel loop
- Item_Not_Recursive (I) := Item_Not_Recursive (I) or not
Item.Recursive;
- if Item.Before_Dot = Before_Dot and
- Item.Length_After_Dot < Length (I)
- then
- Length (I) := Item.Length_After_Dot;
- if Length (I) < Min_Length then
- Min_Length := Length (I);
+ if Trace_McKenzie > Extra then
+ Super.Trace.Put
+ ("task" & Task_Attributes.Value'Image &
+ Super.Label (Parser_Index)'Image & ":
Minimal_Complete_Actions: " &
+ Image (Action, Descriptor));
+ end if;
+
+ for Item of Shared.Table.States (Next_State).Kernel loop
+
+ if Matches (Item, Action) then
+ -- For Action.Verb = Reduce, more than one item may match
+ if Item.Length_After_Dot = 0 then
+ -- Set Length from a non-zero-length non-recursive
item.
+ Length (I) := Length_After_Dot (Item, Action,
Config.Stack);
+
+ elsif Item.Length_After_Dot < Length (I) then
+ if Trace_McKenzie > Extra then
+ -- Length_After_Dot outputs this in other branch
+ Super.Trace.Put (Next_State'Image & " " &
Trimmed_Image (Item.Production));
end if;
+ Length (I) := Item.Length_After_Dot;
+
end if;
- end loop;
+
+ if Trace_McKenzie > Extra then
+ Super.Trace.Put (" length" & Length (I)'Image);
+ end if;
+ if Length (I) < Min_Length then
+ Min_Length := Length (I);
+ end if;
+ end if;
+ end loop;
+ if Trace_McKenzie > Extra then
+ Super.Trace.New_Line;
end if;
end;
- if Item_Not_Recursive (I) then
- Not_Recursive_Count := Not_Recursive_Count + 1;
- end if;
- end loop;
-
- Use_Recursive := Recursive and Not_Recursive_Count > 0 and
Not_Recursive_Count < Actions.Length;
+ end loop Actions_Loop;
for I in Length'Range loop
- if (Use_Recursive and Item_Not_Recursive (I)) or ((not
Use_Recursive) and Length (I) = Min_Length) then
- if Is_Full (Work) then
- Super.Config_Full ("Minimal_Complete_Actions 2",
Parser_Index);
- raise Bad_Config;
- else
- Add (Work, (Actions (I), Config));
- end if;
+ if Length (I) = Min_Length then
+ Safe_Add_Work ("2", (Actions (I),
Table.McKenzie_Param.Minimal_Complete_Cost_Delta, Config));
+
elsif Trace_McKenzie > Extra then
Put_Line
(Super.Trace.all, Super.Label (Parser_Index),
"Minimal_Complete_Actions: drop " &
- Image (Actions (I), Descriptor));
+ Image (Actions (I), Descriptor) & " not minimal or
recursive");
end if;
end loop;
end Enqueue_Min_Actions;
@@ -927,11 +1028,7 @@ package body WisiToken.Parse.LR.McKenzie_Recover.Explore
is
return Token_ID_Arrays.Empty_Vector;
end if;
- Enqueue_Min_Actions
- ("",
- Table.States (Orig_Config.Stack.Peek.State).Minimal_Complete_Actions,
- Table.States
(Orig_Config.Stack.Peek.State).Minimal_Complete_Actions_Recursive,
- Orig_Config, Reduce_Only => False);
+ Enqueue_Min_Actions ("", Table.States
(Orig_Config.Stack.Peek.State).Minimal_Complete_Actions, Orig_Config);
loop
exit when Is_Empty (Work);
@@ -952,7 +1049,6 @@ package body WisiToken.Parse.LR.McKenzie_Recover.Explore is
declare
Reduce_Action : Reduce_Action_Rec := To_Reduce_Action
(Item.Action);
Actions : Minimal_Action_Arrays.Vector;
- Recursive : Boolean;
begin
loop
Do_Reduce_1
@@ -960,8 +1056,7 @@ package body WisiToken.Parse.LR.McKenzie_Recover.Explore is
Reduce_Action,
Do_Language_Fixes => False);
- Actions := Table.States
(Item.Config.Stack.Peek.State).Minimal_Complete_Actions;
- Recursive := Table.States
(Item.Config.Stack.Peek.State).Minimal_Complete_Actions_Recursive;
+ Actions := Table.States
(Item.Config.Stack.Peek.State).Minimal_Complete_Actions;
case Actions.Length is
when 0 =>
@@ -974,32 +1069,36 @@ package body WisiToken.Parse.LR.McKenzie_Recover.Explore
is
when 1 =>
case Actions (Actions.First_Index).Verb is
when Shift =>
- Minimal_Do_Shift (Actions (Actions.First_Index),
Item.Config);
+ Minimal_Do_Shift (Actions (Actions.First_Index),
Item.Cost_Delta, Item.Config);
exit;
when Reduce =>
Reduce_Action := To_Reduce_Action (Actions
(Actions.First_Index));
end case;
when others =>
- Enqueue_Min_Actions ("multiple actions ", Actions,
Recursive, Item.Config, Reduce_Only => True);
+ Enqueue_Min_Actions ("multiple actions ", Actions,
Item.Config);
exit;
end case;
end loop;
end;
when Shift =>
- Minimal_Do_Shift (Item.Action, Item.Config);
+ Minimal_Do_Shift (Item.Action, Item.Cost_Delta, Item.Config);
end case;
end;
end loop;
if Inserted_Last = Inserted'First - 1 then
+ -- Nothing inserted this round.
if Orig_Config.Minimal_Complete_State = Active then
Orig_Config.Minimal_Complete_State := Done;
end if;
end if;
return To_Vector (Inserted (1 .. Inserted_Last));
+ exception
+ when Bad_Config =>
+ return Token_ID_Arrays.Empty_Vector;
end Insert_Minimal_Complete_Actions;
procedure Insert_Matching_Begin
@@ -1014,7 +1113,7 @@ package body WisiToken.Parse.LR.McKenzie_Recover.Explore
is
Descriptor : WisiToken.Descriptor renames Super.Trace.Descriptor.all;
begin
-- We don't check for insert = current token; that's either ok or a
- -- severe bug in Language_Use_Minimal_Complete.
+ -- severe bug in Shared.Language_Matching_Begin_Tokens.
if Config.Matching_Begin_Done then
if Trace_McKenzie > Extra then
@@ -1090,7 +1189,6 @@ package body WisiToken.Parse.LR.McKenzie_Recover.Explore
is
Local_Config_Heap : in out Config_Heaps.Heap_Type)
is
use all type
WisiToken.Parse.LR.Parser.Language_Matching_Begin_Tokens_Access;
- use all type Ada.Containers.Count_Type;
Tokens : Token_ID_Array_1_3;
Matching_Begin_Tokens : Token_ID_Arrays.Vector;
Forbid_Minimal_Insert : Boolean := False;
@@ -1100,7 +1198,7 @@ package body WisiToken.Parse.LR.McKenzie_Recover.Explore
is
if Shared.Language_Matching_Begin_Tokens /= null then
Current_Token_ID_Peek_3
(Shared.Terminals.all, Config.Current_Shared_Token,
Config.Insert_Delete, Config.Current_Insert_Delete,
- Super.Parser_State (Parser_Index).Prev_Deleted, Tokens);
+ Tokens);
Shared.Language_Matching_Begin_Tokens (Tokens, Config,
Matching_Begin_Tokens, Forbid_Minimal_Insert);
end if;
@@ -1115,12 +1213,12 @@ package body
WisiToken.Parse.LR.McKenzie_Recover.Explore is
Insert_Matching_Begin (Super, Shared, Parser_Index, Config,
Local_Config_Heap, Matching_Begin_Tokens);
end if;
- -- We always do all three Insert_Minimal_Complete (unless
+ -- We always do all three; Insert_Minimal_Complete (unless
-- Forbid_Minimal_Insert), Insert_Matching_Begin,
-- Insert_From_Action_List; in general it's not possible to tell when
-- one will be better (see test_mckenzie_recover.adb
-- Always_Minimal_Complete, Always_Matching_Begin).
- -- Insert_From_Action does not insert the Minimal_Inserted tokens,
+ -- Insert_From_Action_List does not insert the Minimal_Inserted tokens,
-- and it will never insert the Matching_Begin_Tokens, so there is no
-- duplication. Insert_From_Action_List will normally be more
-- expensive.
@@ -1150,7 +1248,6 @@ package body WisiToken.Parse.LR.McKenzie_Recover.Explore
is
Check_Limit : WisiToken.Token_Index renames
Shared.Table.McKenzie_Param.Check_Limit;
Current_Line : constant Line_Number_Type :=
Shared.Terminals.all (Config.Current_Shared_Token).Line;
- Lexer_Error_Token_Index : Base_Token_Index;
Lexer_Error_Token : Base_Token;
function Recovered_Lexer_Error (Line : in Line_Number_Type) return
Base_Token_Index
@@ -1167,6 +1264,8 @@ package body WisiToken.Parse.LR.McKenzie_Recover.Explore
is
return Invalid_Token_Index;
end Recovered_Lexer_Error;
+ Lexer_Error_Token_Index : constant Base_Token_Index :=
Recovered_Lexer_Error (Current_Line);
+
function String_ID_Set (String_ID : in Token_ID) return Token_ID_Set
is begin
if Shared.Language_String_ID_Set = null then
@@ -1182,8 +1281,6 @@ package body WisiToken.Parse.LR.McKenzie_Recover.Explore
is
Matching : in SAL.Peek_Type;
String_Literal_ID : in Token_ID)
is
- use Parse.Parse_Item_Arrays;
-
Saved_Shared_Token : constant WisiToken.Token_Index :=
New_Config.Current_Shared_Token;
Tok : Recover_Token;
@@ -1198,8 +1295,13 @@ package body WisiToken.Parse.LR.McKenzie_Recover.Explore
is
raise Bad_Config;
end if;
for I in 1 .. Matching loop
- Tok := New_Config.Stack.Pop.Token;
- Append (New_Config.Ops, (Push_Back, Tok.ID,
Tok.Min_Terminal_Index));
+ if Push_Back_Valid (New_Config) then
+ Tok := New_Config.Stack.Pop.Token;
+ Append (New_Config.Ops, (Push_Back, Tok.ID,
Tok.Min_Terminal_Index));
+ else
+ -- Probably pushing back thru a previously inserted token
+ raise Bad_Config;
+ end if;
end loop;
New_Config.Current_Shared_Token := Tok.Min_Terminal_Index;
@@ -1230,8 +1332,9 @@ package body WisiToken.Parse.LR.McKenzie_Recover.Explore
is
raise SAL.Programmer_Error;
end;
- if not Has_Space
- (New_Config.Ops, Ada.Containers.Count_Type (Saved_Shared_Token - 1
- New_Config.Current_Shared_Token))
+ if New_Config.Current_Shared_Token < Saved_Shared_Token - 1 and then
+ (not Has_Space
+ (New_Config.Ops, Ada.Containers.Count_Type (Saved_Shared_Token -
1 - New_Config.Current_Shared_Token)))
then
Super.Config_Full ("insert quote 2 " & Label, Parser_Index);
raise Bad_Config;
@@ -1245,14 +1348,65 @@ package body
WisiToken.Parse.LR.McKenzie_Recover.Explore is
end String_Literal_In_Stack;
+ procedure Push_Back_Tokens
+ (Full_Label : in String;
+ New_Config : in out Configuration;
+ Min_Pushed_Back_Index : out Base_Token_Index)
+ is
+ Item : Recover_Stack_Item;
+ begin
+ loop
+ Item := New_Config.Stack.Peek;
+ if Item.Token.Virtual then
+ -- Don't push back an inserted token
+ exit;
+
+ elsif Item.Token.Byte_Region = Null_Buffer_Region then
+ -- Don't need push_back for an empty token
+ New_Config.Stack.Pop;
+
+ elsif Item.Tree_Index = Invalid_Node_Index then
+ -- Item was pushed on stack during recovery, and we do not know
+ -- its Line. To avoid crossing a line boundary, we stop
push_backs
+ -- here.
+ exit;
+
+ else
+ if Shared.Terminals.all
+ (Super.Parser_State (Parser_Index).Tree.First_Shared_Terminal
(Item.Tree_Index)).Line = Current_Line
+ -- Don't let push_back cross a line boundary.
+ then
+ if Is_Full (New_Config.Ops) then
+ Super.Config_Full (Full_Label, Parser_Index);
+ raise Bad_Config;
+ else
+ New_Config.Stack.Pop;
+ Append (New_Config.Ops, (Push_Back, Item.Token.ID,
Item.Token.Min_Terminal_Index));
+ end if;
+ end if;
+
+ exit;
+ end if;
+ end loop;
+ Min_Pushed_Back_Index := Item.Token.Min_Terminal_Index;
+ end Push_Back_Tokens;
+
procedure Finish
(Label : in String;
New_Config : in out Configuration;
First, Last : in Base_Token_Index)
- is begin
+ is
+ Adj_First : constant Base_Token_Index := (if First =
Invalid_Token_Index then Last else First);
+ Adj_Last : constant Base_Token_Index := (if Last =
Invalid_Token_Index then First else Last);
+ begin
-- Delete tokens First .. Last; either First - 1 or Last + 1 should
-- be a String_Literal. Leave Current_Shared_Token at Last + 1.
+ if Adj_Last = Invalid_Token_Index or Adj_First = Invalid_Token_Index
then
+ pragma Assert (False);
+ raise Bad_Config;
+ end if;
+
New_Config.Error_Token.ID := Invalid_Token_ID;
New_Config.Check_Status := (Label => WisiToken.Semantic_Checks.Ok);
@@ -1264,7 +1418,7 @@ package body WisiToken.Parse.LR.McKenzie_Recover.Explore
is
raise Bad_Config;
end if;
- for I in First .. Last loop
+ for I in Adj_First .. Adj_Last loop
Append (New_Config.Ops, (Delete, Shared.Terminals.all (I).ID, I));
end loop;
New_Config.Current_Shared_Token := Last + 1;
@@ -1274,7 +1428,7 @@ package body WisiToken.Parse.LR.McKenzie_Recover.Explore
is
if New_Config.Resume_Token_Goal - Check_Limit <
New_Config.Current_Shared_Token then
New_Config.Resume_Token_Goal := New_Config.Current_Shared_Token +
Check_Limit;
- if Trace_McKenzie > Detail then
+ if Trace_McKenzie > Extra then
Put_Line
(Super.Trace.all, Super.Label (Parser_Index),
"resume_token_goal:" & WisiToken.Token_Index'Image
(New_Config.Resume_Token_Goal));
@@ -1296,11 +1450,12 @@ package body
WisiToken.Parse.LR.McKenzie_Recover.Explore is
-- before, at, or after that string literal.
--
-- Here we assume the parse error in Config.Error_Token is due to
- -- putting the balancing quote in the wrong place, and attempt to
- -- find a better place to put the balancing quote. Then all tokens
- -- from the balancing quote to the unbalanced quote are now part of a
- -- string literal, so delete them, leaving just the string literal
- -- created by Lexer error recovery.
+ -- putting the balancing quote in the wrong place (although we do
+ -- check that; see test_mckenzie_recover.adb String_Quote_6), and
+ -- attempt to find a better place to put the balancing quote. Then
+ -- all tokens from the balancing quote to the unbalanced quote are
+ -- now part of a string literal, so delete them, leaving just the
+ -- string literal created by Lexer error recovery.
-- First we check to see if there is an unbalanced quote in the
-- current line; if not, just return. Some lexer errors are for other
@@ -1311,8 +1466,6 @@ package body WisiToken.Parse.LR.McKenzie_Recover.Explore
is
Config.String_Quote_Checked := Current_Line;
- Lexer_Error_Token_Index := Recovered_Lexer_Error (Current_Line);
-
if Lexer_Error_Token_Index = Invalid_Token_Index then
return;
end if;
@@ -1331,23 +1484,11 @@ package body
WisiToken.Parse.LR.McKenzie_Recover.Explore is
-- test_mckenzie_recover.adb String_Quote_0. So far we have not found
-- a test case for more than one token.
declare
- New_Config : Configuration := Config;
- Token : Recover_Token;
+ New_Config : Configuration := Config;
+ Min_Pushed_Back_Index : Base_Token_Index;
begin
- loop
- Token := New_Config.Stack.Pop.Token;
- if Token.Byte_Region /= Null_Buffer_Region then
- if Is_Full (New_Config.Ops) then
- Super.Config_Full ("insert quote 4 a", Parser_Index);
- raise Bad_Config;
- else
- Append (New_Config.Ops, (Push_Back, Token.ID,
Token.Min_Terminal_Index));
- end if;
- exit;
- end if;
- end loop;
-
- Finish ("a", New_Config, Token.Min_Terminal_Index,
Config.Current_Shared_Token - 1);
+ Push_Back_Tokens ("insert quote 4 a", New_Config,
Min_Pushed_Back_Index);
+ Finish ("a", New_Config, Min_Pushed_Back_Index,
Config.Current_Shared_Token - 1);
Local_Config_Heap.Add (New_Config);
end;
@@ -1412,25 +1553,13 @@ package body
WisiToken.Parse.LR.McKenzie_Recover.Explore is
-- case d: Assume a missing quote belongs somewhere farther before
-- the current token; try one non-empty (as in case a above). See
- -- test_mckenzie_recover.adb String_Quote_4.
+ -- test_mckenzie_recover.adb String_Quote_4, String_Quote_6.
declare
- New_Config : Configuration := Config;
- Token : Recover_Token;
+ New_Config : Configuration := Config;
+ Min_Pushed_Back_Index : Base_Token_Index;
begin
- loop
- Token := New_Config.Stack.Pop.Token;
- if Token.Byte_Region /= Null_Buffer_Region then
- if Is_Full (New_Config.Ops) then
- Super.Config_Full ("insert quote 5 d", Parser_Index);
- raise Bad_Config;
- else
- Append (New_Config.Ops, (Push_Back, Token.ID,
Token.Min_Terminal_Index));
- end if;
- exit;
- end if;
- end loop;
-
- Finish ("d", New_Config, Token.Min_Terminal_Index,
Lexer_Error_Token_Index - 1);
+ Push_Back_Tokens ("insert quote 5 d", New_Config,
Min_Pushed_Back_Index);
+ Finish ("d", New_Config, Min_Pushed_Back_Index,
Lexer_Error_Token_Index - 1);
Local_Config_Heap.Add (New_Config);
exception
when SAL.Container_Empty =>
@@ -1482,7 +1611,6 @@ package body WisiToken.Parse.LR.McKenzie_Recover.Explore
is
-- Try deleting (= skipping) the current shared input token.
use Config_Op_Arrays, Config_Op_Array_Refs;
- use all type Ada.Containers.Count_Type;
Trace : WisiToken.Trace'Class renames Super.Trace.all;
EOF_ID : Token_ID renames Trace.Descriptor.EOI_ID;
Check_Limit : WisiToken.Token_Index renames
Shared.Table.McKenzie_Param.Check_Limit;
@@ -1496,7 +1624,7 @@ package body WisiToken.Parse.LR.McKenzie_Recover.Explore
is
(Length (Config.Ops) = 0 or else
-- Don't delete an ID we just inserted; waste of time
(not Equal (Constant_Ref (Config.Ops, Last_Index (Config.Ops)),
- (Insert, ID, Config.Current_Shared_Token, 1, 0))))
+ (Insert, ID, Config.Current_Shared_Token))))
then
declare
New_Config : Configuration := Config;
@@ -1535,10 +1663,6 @@ package body WisiToken.Parse.LR.McKenzie_Recover.Explore
is
Append (New_Config.Ops, (Delete, ID,
Config.Current_Shared_Token));
end if;
New_Config.Current_Shared_Token := New_Config.Current_Shared_Token
+ 1;
- loop
- exit when not Super.Parser_State
(Parser_Index).Prev_Deleted.Contains (New_Config.Current_Shared_Token);
- New_Config.Current_Shared_Token :=
New_Config.Current_Shared_Token + 1;
- end loop;
if New_Config.Resume_Token_Goal - Check_Limit <
New_Config.Current_Shared_Token then
New_Config.Resume_Token_Goal := New_Config.Current_Shared_Token
+ Check_Limit;
@@ -1596,24 +1720,16 @@ package body
WisiToken.Parse.LR.McKenzie_Recover.Explore is
-- adding ops to Config (except as noted); Language_Fixes should use
-- McKenzie_Recover.Insert, Delete instead.
if Config.Current_Insert_Delete = 1 then
- -- Config.Current_Insert_Delete > 1 is a programming error.
+ -- Config is from Language_Fixes.
- case Fast_Forward (Super, Shared, Parser_Index, Local_Config_Heap,
Config) is
- when Abandon =>
- -- We know Local_Config_Heap is empty; just tell
- -- Super we are done working.
- Super.Put (Parser_Index, Local_Config_Heap);
- return;
- when Continue =>
- -- We don't increase cost for this Fast_Forward, since it is due
to a
- -- Language_Fixes.
- null;
- end case;
+ Fast_Forward (Super, Shared, Parser_Index, Local_Config_Heap, Config);
+ Super.Put (Parser_Index, Local_Config_Heap);
+ return;
end if;
pragma Assert (Config.Current_Insert_Delete = 0);
+ -- Config.Current_Insert_Delete > 1 is a programming error.
- -- Language_Fixes: let it enqueue configs.
if Config.Error_Token.ID /= Invalid_Token_ID then
if Shared.Language_Fixes = null then
null;
@@ -1625,58 +1741,55 @@ package body
WisiToken.Parse.LR.McKenzie_Recover.Explore is
-- The solutions enqueued by Language_Fixes should be lower cost
than
-- others (typically 0), so they will be checked first.
+ end if;
- if Config.Check_Status.Label = Ok then
- -- Parse table Error action.
- --
- -- We don't clear Config.Error_Token here, because
- -- Language_Use_Minimal_Complete_Actions needs it. We only
clear it
- -- when a parse results in no error (or a different error), or
a
- -- push_back moves the Current_Token.
- null;
+ if Config.Check_Status.Label = Ok then
+ -- Parse table Error action.
+ --
+ -- We don't clear Config.Error_Token here, because
+ -- Language_Use_Minimal_Complete_Actions needs it. We only clear
it
+ -- when a parse results in no error (or a different error), or a
+ -- push_back moves the Current_Token.
+ null;
- else
- -- Assume "ignore check error" is a viable solution. But give
it a
- -- cost, so a solution provided by Language_Fixes is preferred.
+ else
+ -- Assume "ignore check error" is a viable solution. But give it a
+ -- cost, so a solution provided by Language_Fixes is preferred.
- declare
- New_State : Unknown_State_Index;
- begin
- Config.Cost := Config.Cost +
Table.McKenzie_Param.Ignore_Check_Fail;
+ declare
+ New_State : Unknown_State_Index;
+ begin
+ Config.Cost := Config.Cost +
Table.McKenzie_Param.Ignore_Check_Fail;
+ Config.Strategy_Counts (Ignore_Error) := Config.Strategy_Counts
(Ignore_Error) + 1;
- -- finish reduce.
- Config.Stack.Pop (SAL.Base_Peek_Type
(Config.Check_Token_Count));
+ -- finish reduce.
+ Config.Stack.Pop (SAL.Base_Peek_Type
(Config.Check_Token_Count));
- New_State := Goto_For (Table, Config.Stack.Peek.State,
Config.Error_Token.ID);
+ New_State := Goto_For (Table, Config.Stack.Peek.State,
Config.Error_Token.ID);
- if New_State = Unknown_State then
- if Config.Stack.Depth = 1 then
- -- Stack is empty, and we did not get Accept; really
bad syntax got
- -- us here; abandon this config. See
ada_mode-recover_bad_char.adb.
- Super.Put (Parser_Index, Local_Config_Heap);
- return;
- else
- raise SAL.Programmer_Error with
- "process_one found test case for new_state =
Unknown; old state " &
- Trimmed_Image (Config.Stack.Peek.State) & " nonterm
" & Image
- (Config.Error_Token.ID, Trace.Descriptor.all);
- end if;
+ if New_State = Unknown_State then
+ if Config.Stack.Depth = 1 then
+ -- Stack is empty, and we did not get Accept; really bad
syntax got
+ -- us here; abandon this config. See
ada_mode-recover_bad_char.adb.
+ Super.Put (Parser_Index, Local_Config_Heap);
+ return;
+ else
+ raise SAL.Programmer_Error with
+ "process_one found test case for new_state = Unknown;
old state " &
+ Trimmed_Image (Config.Stack.Peek.State) & " nonterm " &
Image
+ (Config.Error_Token.ID, Trace.Descriptor.all);
end if;
+ end if;
- Config.Stack.Push ((New_State,
Syntax_Trees.Invalid_Node_Index, Config.Error_Token));
-
- -- We clear Check_Status and Error_Token so the check error
is ignored.
- Config.Check_Status := (Label => Ok);
+ Config.Stack.Push ((New_State, Invalid_Node_Index,
Config.Error_Token));
- Config.Error_Token.ID := Invalid_Token_ID;
- end;
- end if;
+ -- We _don't_ clear Check_Status and Error_Token here; Check
needs
+ -- them, and sets them as appropriate.
+ end;
end if;
end if;
- -- Call Check to see if this config succeeds. Note that Check does
- -- more than Fast_Forward, so the fact that Fast_Forward succeeds
- -- does not mean we don't need to call Check.
+ -- Call Check to see if this config succeeds.
case Check (Super, Shared, Parser_Index, Config, Local_Config_Heap) is
when Success =>
Super.Success (Parser_Index, Config, Local_Config_Heap);
@@ -1711,14 +1824,15 @@ package body
WisiToken.Parse.LR.McKenzie_Recover.Explore is
Try_Insert_Terminal (Super, Shared, Parser_Index, Config,
Local_Config_Heap);
- if None_Since_FF (Config.Ops, Delete) and then
- None_Since_FF (Config.Ops, Insert) and then
- Config.Stack.Depth > 1 and then -- can't delete the first state
+ if Push_Back_Valid (Config) and then
(not Check_Reduce_To_Start (Super, Shared, Parser_Index, Config))
- -- If Config reduces to the start nonterm, there's no point in
push_back.
+ -- If Config reduces to the start nonterm, there's no point in
Push_Back or Undo_Reduce.
then
Try_Push_Back (Super, Shared, Parser_Index, Config,
Local_Config_Heap);
- Try_Undo_Reduce (Super, Shared, Parser_Index, Config,
Local_Config_Heap);
+
+ if Undo_Reduce_Valid (Config.Stack, Super.Parser_State
(Parser_Index).Tree) then
+ Try_Undo_Reduce (Super, Shared, Parser_Index, Config,
Local_Config_Heap);
+ end if;
end if;
if None_Since_FF (Config.Ops, Insert) then
@@ -1733,9 +1847,11 @@ package body WisiToken.Parse.LR.McKenzie_Recover.Explore
is
Config.String_Quote_Checked < Shared.Terminals.all
(Config.Current_Shared_Token).Line)
then
-- See if there is a mismatched quote. The solution is to delete
- -- tokens, replacing them with a string literal. So we try this when
- -- it is ok to try delete.
- Try_Insert_Quote (Super, Shared, Parser_Index, Config,
Local_Config_Heap);
+ -- tokens, nominally replacing them with an expanded string literal.
+ -- So we try this when it is ok to try delete.
+ if None_Since_FF (Config.Ops, Insert) then
+ Try_Insert_Quote (Super, Shared, Parser_Index, Config,
Local_Config_Heap);
+ end if;
end if;
Super.Put (Parser_Index, Local_Config_Heap);
diff --git a/wisitoken-parse-lr-mckenzie_recover-parse.adb
b/wisitoken-parse-lr-mckenzie_recover-parse.adb
index 5db933e..b56bba6 100644
--- a/wisitoken-parse-lr-mckenzie_recover-parse.adb
+++ b/wisitoken-parse-lr-mckenzie_recover-parse.adb
@@ -2,7 +2,7 @@
--
-- See spec
--
--- Copyright (C) 2018 - 2019 Free Software Foundation, Inc.
+-- Copyright (C) 2018 - 2020 Free Software Foundation, Inc.
--
-- This library is free software; you can redistribute it and/or modify it
-- under terms of the GNU General Public License as published by the Free
@@ -110,8 +110,7 @@ package body WisiToken.Parse.LR.McKenzie_Recover.Parse is
-- Parse_Items.
use Parse_Item_Arrays;
- use Sorted_Insert_Delete_Arrays;
- use all type Ada.Containers.Count_Type;
+ use Config_Op_Arrays;
use all type Semantic_Checks.Check_Status_Label;
Trace : WisiToken.Trace'Class renames Super.Trace.all;
@@ -130,8 +129,7 @@ package body WisiToken.Parse.LR.McKenzie_Recover.Parse is
Terminals_Current => Config.Current_Shared_Token,
Restore_Terminals_Current => Restore_Terminals_Current,
Insert_Delete => Config.Insert_Delete,
- Current_Insert_Delete => Config.Current_Insert_Delete,
- Prev_Deleted => Super.Parser_State
(Parser_Index).Prev_Deleted);
+ Current_Insert_Delete => Config.Current_Insert_Delete);
New_State : Unknown_State_Index;
Success : Boolean := True;
@@ -202,7 +200,7 @@ package body WisiToken.Parse.LR.McKenzie_Recover.Parse is
Config.Stack.Push
((Action.Item.State,
- Syntax_Trees.Invalid_Node_Index,
+ Invalid_Node_Index,
(Current_Token.ID,
Byte_Region => Current_Token.Byte_Region,
Min_Terminal_Index =>
@@ -217,8 +215,7 @@ package body WisiToken.Parse.LR.McKenzie_Recover.Parse is
Terminals_Current => Config.Current_Shared_Token,
Restore_Terminals_Current => Restore_Terminals_Current,
Insert_Delete => Config.Insert_Delete,
- Current_Insert_Delete => Config.Current_Insert_Delete,
- Prev_Deleted => Super.Parser_State
(Parser_Index).Prev_Deleted);
+ Current_Insert_Delete => Config.Current_Insert_Delete);
when Reduce =>
declare
@@ -244,7 +241,7 @@ package body WisiToken.Parse.LR.McKenzie_Recover.Parse is
raise Bad_Config;
end if;
- Config.Stack.Push ((New_State,
Syntax_Trees.Invalid_Node_Index, Nonterm));
+ Config.Stack.Push ((New_State, Invalid_Node_Index, Nonterm));
when Semantic_Checks.Error =>
Config.Error_Token := Nonterm;
diff --git a/wisitoken-parse-lr-mckenzie_recover.adb
b/wisitoken-parse-lr-mckenzie_recover.adb
index 6fa41d8..24c33d2 100644
--- a/wisitoken-parse-lr-mckenzie_recover.adb
+++ b/wisitoken-parse-lr-mckenzie_recover.adb
@@ -140,7 +140,7 @@ package body WisiToken.Parse.LR.McKenzie_Recover is
when Message => raise SAL.Programmer_Error));
if Trace_McKenzie > Extra then
Put_Line
- (Trace, Parser_State.Label, Parser_Lists.Image
+ (Trace, Parser_State.Label, "stack: " & Parser_Lists.Image
(Parser_State.Stack, Trace.Descriptor.all,
Parser_State.Tree));
end if;
end if;
@@ -168,6 +168,7 @@ package body WisiToken.Parse.LR.McKenzie_Recover is
if Shared_Parser.Language_Fixes = null then
-- The only fix is to ignore the error.
if Trace_McKenzie > Detail then
+ Config.Strategy_Counts (Ignore_Error) := 1;
Put ("enqueue", Trace, Parser_State.Label,
Shared_Parser.Terminals, Config,
Task_ID => False);
end if;
@@ -207,7 +208,7 @@ package body WisiToken.Parse.LR.McKenzie_Recover is
Parsers : Parser_Lists.List renames Shared_Parser.Parsers;
- Current_Parser : Parser_Lists.Cursor;
+ Skip_Next : Boolean := False;
Super : aliased Base.Supervisor
(Trace'Access,
@@ -287,15 +288,13 @@ package body WisiToken.Parse.LR.McKenzie_Recover is
end if;
end;
- -- Adjust parser state for each successful recovery.
+ -- Spawn new parsers for multiple solutions.
--
-- One option here would be to keep only the parser with the least
-- cost fix. However, the normal reason for having multiple parsers
-- is to resolve a grammar ambiguity; the least cost fix might
-- resolve the ambiguity the wrong way. As could any other fix, of
-- course.
-
- -- Spawn new parsers for multiple solutions.
--
-- We could try to check here for redundant solutions; configs for a
-- parser that have the same or "equivalent" ops. But those will be
@@ -375,339 +374,273 @@ package body WisiToken.Parse.LR.McKenzie_Recover is
-- We don't use 'for Parser_State of Parsers loop' here,
-- because we might need to terminate a parser.
- Current_Parser := Parsers.First;
- loop
- exit when Current_Parser.Is_Done;
-
- if Current_Parser.State_Ref.Recover.Success then
- begin
- -- Can't have active 'renames State_Ref' when terminate a
parser
- declare
- use Parser_Lists;
- use Config_Op_Arrays, Config_Op_Array_Refs;
- use Sorted_Insert_Delete_Arrays;
-
- Parser_State : Parser_Lists.Parser_State renames
Current_Parser.State_Ref;
-
- Descriptor : WisiToken.Descriptor renames
Shared_Parser.Trace.Descriptor.all;
- Tree : Syntax_Trees.Tree renames Parser_State.Tree;
- Data : McKenzie_Data renames Parser_State.Recover;
- Result : Configuration renames Data.Results.Peek;
+ declare
+ Current_Parser : Parser_Lists.Cursor := Parsers.First;
+ begin
+ loop
+ exit when Current_Parser.Is_Done;
- Min_Op_Token_Index : WisiToken.Token_Index :=
WisiToken.Token_Index'Last;
- Min_Push_Back_Token_Index : WisiToken.Token_Index :=
WisiToken.Token_Index'Last;
+ if Current_Parser.State_Ref.Recover.Success then
+ begin
+ -- Can't have active 'renames State_Ref' when terminate a
parser
+ declare
+ use Parser_Lists;
+ use Config_Op_Arrays, Config_Op_Array_Refs;
- Stack_Matches_Ops : Boolean := True;
- Shared_Token_Changed : Boolean := False;
- Current_Token_Virtual : Boolean := False;
+ Parser_State : Parser_Lists.Parser_State renames
Current_Parser.State_Ref;
- Sorted_Insert_Delete : aliased
Sorted_Insert_Delete_Arrays.Vector;
+ Descriptor : WisiToken.Descriptor renames
Shared_Parser.Trace.Descriptor.all;
+ Stack : Parser_Stacks.Stack renames
Parser_State.Stack;
+ Tree : Syntax_Trees.Tree renames Parser_State.Tree;
+ Data : McKenzie_Data renames Parser_State.Recover;
+ Result : Configuration renames Data.Results.Peek;
- procedure Apply_Prev_Token
- is begin
- loop
- exit when not Parser_State.Prev_Deleted.Contains
(Parser_State.Shared_Token);
- Parser_State.Shared_Token := Parser_State.Shared_Token
+ 1;
- end loop;
- end Apply_Prev_Token;
-
- begin
- -- The verb will be reset by the main parser; just indicate
the
- -- parser recovered from the error.
- Parser_State.Set_Verb (Shift);
-
- Parser_State.Errors (Parser_State.Errors.Last).Recover :=
Result;
-
- Parser_State.Resume_Token_Goal := Result.Resume_Token_Goal;
-
- if Trace_McKenzie > Extra then
- Put_Line (Trace, Parser_State.Label, "before Ops
applied:", Task_ID => False);
- Put_Line
- (Trace, Parser_State.Label, "stack " & Image
(Parser_State.Stack, Descriptor, Tree),
- Task_ID => False);
- Put_Line
- (Trace, Parser_State.Label, "Shared_Token " & Image
- (Parser_State.Shared_Token, Shared_Parser.Terminals,
Descriptor),
- Task_ID => False);
- Put_Line
- (Trace, Parser_State.Label, "Current_Token " &
Parser_State.Tree.Image
- (Parser_State.Current_Token, Descriptor),
- Task_ID => False);
- end if;
+ Stack_Matches_Ops : Boolean := True;
+ Shared_Token_Changed : Boolean := False;
+ Current_Token_Virtual : Boolean := False;
+ First_Insert : Boolean := True;
+ begin
+ -- The verb will be reset by the main parser; just
indicate the
+ -- parser recovered from the error.
+ Parser_State.Set_Verb (Shift);
+
+ Parser_State.Errors (Parser_State.Errors.Last).Recover :=
Result;
+
+ Parser_State.Resume_Token_Goal :=
Result.Resume_Token_Goal;
+
+ if Trace_McKenzie > Extra then
+ Put_Line (Trace, Parser_State.Label, "before Ops
applied:", Task_ID => False);
+ Put_Line
+ (Trace, Parser_State.Label, "stack " & Image (Stack,
Descriptor, Tree),
+ Task_ID => False);
+ Put_Line
+ (Trace, Parser_State.Label, "Shared_Token " & Image
+ (Parser_State.Shared_Token,
Shared_Parser.Terminals, Descriptor),
+ Task_ID => False);
+ Put_Line
+ (Trace, Parser_State.Label, "Current_Token " &
Parser_State.Tree.Image
+ (Parser_State.Current_Token, Descriptor),
+ Task_ID => False);
+ end if;
+
+ -- We don't apply all Ops to the parser stack here,
because there can
+ -- be other input tokens between the inserts and
deletes, and there
+ -- can be conflicts; we let the main parser handle that.
We can apply
+ -- all ops up to the first insert.
+ --
+ -- Other than Add_Terminal, there's no need to modify
+ -- Parser_State.Tree. Any tree nodes created by the
failed parse that
+ -- are pushed back are useful for error repair, and will
just be
+ -- ignored in future parsing. This also avoids enlarging
a
+ -- non-flushed branched tree, which saves time and space.
+ --
+ -- Language_Fixes may abuse the rules about adding Ops,
so we check
+ -- that as much as is reasonable here. We use Assert to
get an
+ -- immediate error in a debug build, and raise
Bad_Config to avoid
+ -- further corruption in a release build.
+
+ for I in First_Index (Result.Ops) .. Last_Index
(Result.Ops) loop
+ declare
+ Op : Config_Op renames Constant_Ref (Result.Ops, I);
+ begin
+ case Op.Op is
+ when Fast_Forward =>
+ -- The parser would do shifts and reduces for
the tokens we are
+ -- skipping here
+ Stack_Matches_Ops := False;
- -- We don't apply all Ops to the parser stack here, because
that
- -- requires updating the syntax tree as well, and we want
to let the
- -- main parser do that, partly as a double check on the
algorithms
- -- here.
- --
- -- However, the main parser can only apply Insert and
Delete ops; we
- -- must apply Push_Back and Undo_Reduce here. Note that
Fast_Forward
- -- ops are just for bookkeeping.
- --
- -- In order to apply Undo_Reduce, we also need to apply any
preceding
- -- ops. See test_mckenzie_recover.adb Missing_Name_2 for an
example
- -- of multiple Undo_Reduce. On the other hand, Push_Back
can be
- -- applied without the preceding ops.
- --
- -- A Push_Back can go back past preceding ops, including
Undo_Reduce;
- -- there's no point in applying ops that are later
superceded by such
- -- a Push_Back. See test_mckenzie_recover.adb
Out_Of_Order_Ops for an
- -- example.
- --
- -- Push_Back can also go back past a previous error
recovery; we must
- -- apply Parser_State.Prev_Deleted here as well, when
computing
- -- Shared_Token.
- --
- -- So first we go thru Ops to find the earliest Push_Back.
Then we
- -- apply ops that are before that point, up to the first
Insert or
- -- Fast_Forward. After that, we enqueue Insert and Delete
ops on
- -- Parser_State.Recover_Insert_Delete, in token_index
order, and any
- -- Undo_Reduce are rejected.
- --
- -- Then the main parser parses the edited input stream.
- --
- -- There's no need to modify Parser_State.Tree. Any tree
nodes
- -- created by the failed parse that are pushed back are
useful for
- -- error repair, and will just be ignored in future
parsing. This
- -- also avoids enlarging a non-flushed branched tree, which
saves
- -- time and space.
-
- for I in First_Index (Result.Ops) .. Last_Index (Result.Ops)
loop
- declare
- Op : Config_Op renames Constant_Ref (Result.Ops, I);
- begin
- case Op.Op is
- when Fast_Forward =>
- if Op.FF_Token_Index < Min_Op_Token_Index then
- Min_Op_Token_Index := Op.FF_Token_Index;
- end if;
-
- when Undo_Reduce =>
- null;
-
- when Push_Back =>
- if Op.PB_Token_Index /= Invalid_Token_Index then
- if Op.PB_Token_Index < Min_Op_Token_Index then
- Min_Op_Token_Index := Op.PB_Token_Index;
- end if;
- if Op.PB_Token_Index < Min_Push_Back_Token_Index
then
- Min_Push_Back_Token_Index :=
Op.PB_Token_Index;
- end if;
- end if;
+ when Undo_Reduce =>
+ -- If Stack_Matches_Ops, we must do the
Stack.Pop and Pushes, and we
+ -- can use Stack.Peek to check if the
Undo_Reduce is valid.
+ --
+ -- If not Stack_Matches_Ops, we have to assume
Undo_Reduce is valid.
+ --
+ -- See test_mckenzie_recover.adb Extra_Begin
for an example of Undo_Reduce
+ -- after other ops.
+ if Stack_Matches_Ops then
+ if not (Tree.Is_Nonterm (Stack.Peek.Token) and
+ (I = First_Index (Result.Ops) or
else
+ Push_Back_Valid
+ (Tree.First_Shared_Terminal
(Stack.Peek.Token), Result.Ops, I - 1)))
+ then
+ pragma Assert (False);
+ if Trace_McKenzie > Outline then
+ Put_Line
+ (Trace, Parser_State.Label, "invalid
Undo_Reduce in apply config",
+ Task_ID => False);
+ end if;
+ raise Bad_Config;
+ end if;
- when Insert =>
- if Op.Ins_Token_Index /= Invalid_Token_Index then
- if Op.Ins_Token_Index < Min_Op_Token_Index then
- Min_Op_Token_Index := Op.Ins_Token_Index;
- end if;
- if Op.Ins_Token_Index <
Min_Push_Back_Token_Index then
- Min_Push_Back_Token_Index :=
Op.Ins_Token_Index;
+ for C of Tree.Children (Stack.Pop.Token) loop
+ Stack.Push ((Tree.State (C), C));
+ end loop;
end if;
- end if;
- when Delete =>
- if Op.Del_Token_Index /= Invalid_Token_Index then
- if Op.Del_Token_Index < Min_Op_Token_Index then
- Min_Op_Token_Index := Op.Del_Token_Index;
- end if;
- if Op.Del_Token_Index <
Min_Push_Back_Token_Index then
- Min_Push_Back_Token_Index :=
Op.Del_Token_Index;
- end if;
- end if;
-
- end case;
- end;
- end loop;
-
- for I in First_Index (Result.Ops) .. Last_Index (Result.Ops)
loop
- declare
- Op : Config_Op renames Constant_Ref (Result.Ops, I);
- begin
- case Op.Op is
- when Fast_Forward =>
- Stack_Matches_Ops := False;
-
- when Undo_Reduce =>
- if not Stack_Matches_Ops then
- if Trace_McKenzie > Outline then
- Put_Line
- (Trace, Parser_State.Label, "Undo_Reduce
after insert or fast_forward",
- Task_ID => False);
- end if;
- raise Bad_Config;
- end if;
-
- declare
- Item : constant Parser_Lists.Parser_Stack_Item
:= Parser_State.Stack.Pop;
- begin
- case Tree.Label (Item.Token) is
- when Syntax_Trees.Shared_Terminal |
- Syntax_Trees.Virtual_Identifier |
- Syntax_Trees.Virtual_Terminal =>
+ when Push_Back =>
+ -- If Stack_Matches_Ops, we must do the
Stack.Pop, and can use that
+ -- to check if the Push_Back is valid.
+ --
+ -- If not Stack_Matches_Ops, we have to assume
Op.PB_Token_Index is
+ -- correct, and we do not do Stack.Pop. We can
still check the target
+ -- token index against the previous ops.
+ --
+ -- See test_mckenzie_recover.adb Erorr_2 for an
example of Push_Back
+ -- after other ops.
+ if not
+ (I = First_Index (Result.Ops) or else
+ Push_Back_Valid
+ (Target_Token_Index =>
+ (if Stack_Matches_Ops
+ then Tree.First_Shared_Terminal
(Stack.Peek.Token)
+ else Op.PB_Token_Index),
+ Ops => Result.Ops,
+ Prev_Op => I - 1))
+ then
if Trace_McKenzie > Outline then
Put_Line
- (Trace, Parser_State.Label, "expecting
nonterminal, found " &
- Image (Tree.ID (Item.Token),
Trace.Descriptor.all),
+ (Trace, Parser_State.Label, "invalid
Push_Back in apply config op" & I'Image,
Task_ID => False);
end if;
+ pragma Assert (False);
raise Bad_Config;
-
- when Syntax_Trees.Nonterm =>
- for C of Tree.Children (Item.Token) loop
- Parser_State.Stack.Push ((Tree.State (C),
C));
- end loop;
- end case;
- end;
-
- when Push_Back =>
- if Stack_Matches_Ops then
- Parser_State.Stack.Pop;
- if Op.PB_Token_Index /= Invalid_Token_Index then
- Parser_State.Shared_Token :=
Op.PB_Token_Index;
- Shared_Token_Changed := True;
end if;
- elsif Op.PB_Token_Index = Min_Op_Token_Index then
- loop
- -- Multiple push_backs can have the same
Op.PB_Token_Index, so we may
- -- already be at the target.
- exit when Parser_State.Shared_Token <=
Op.PB_Token_Index and
- (Parser_State.Stack.Depth = 1 or else
- Tree.Min_Terminal_Index
(Parser_State.Stack (1).Token) /= Invalid_Token_Index);
- -- also push back empty tokens.
-
- declare
- Item : constant
Parser_Lists.Parser_Stack_Item := Parser_State.Stack.Pop;
-
- Min_Index : constant Base_Token_Index :=
- Parser_State.Tree.Min_Terminal_Index
(Item.Token);
- begin
- if Min_Index /= Invalid_Token_Index then
- Shared_Token_Changed := True;
- Parser_State.Shared_Token := Min_Index;
- end if;
- end;
- end loop;
- pragma Assert (Parser_State.Shared_Token =
Op.PB_Token_Index);
- end if;
-
- when Insert =>
- if Stack_Matches_Ops and Op.Ins_Token_Index =
Parser_State.Shared_Token then
- -- This is the first Insert. Even if a later
Push_Back supercedes it,
- -- we record Stack_Matches_Ops false here.
- Stack_Matches_Ops := False;
+ if Stack_Matches_Ops then
+ Stack.Pop;
- if Op.Ins_Token_Index <=
Min_Push_Back_Token_Index then
- Parser_State.Current_Token :=
Parser_State.Tree.Add_Terminal (Op.Ins_ID);
- Current_Token_Virtual := True;
- else
- if Is_Full (Sorted_Insert_Delete) then
- raise Bad_Config;
- else
- Insert (Sorted_Insert_Delete, Op);
+ if Op.PB_Token_Index /= Invalid_Token_Index
then
+ -- Pushing back an empty nonterm has no
effect on the input stream.
+ Parser_State.Shared_Token :=
Op.PB_Token_Index;
+ Shared_Token_Changed := True;
end if;
end if;
- else
- if Is_Full (Sorted_Insert_Delete) then
- raise Bad_Config;
- else
- Insert (Sorted_Insert_Delete, Op);
+
+ when Insert =>
+ Recover_Op_Arrays.Append
+ (Parser_State.Recover_Insert_Delete,
+ (Op => Insert,
+ Ins_ID => Op.Ins_ID,
+ Ins_Token_Index => Op.Ins_Token_Index,
+ Ins_Tree_Node => Invalid_Node_Index));
+
+ if Parser_State.Recover_Insert_Delete_Current =
No_Index then
+ Parser_State.Recover_Insert_Delete_Current :=
+ Recover_Op_Arrays.Last_Index
(Parser_State.Recover_Insert_Delete);
end if;
- end if;
-
- when Delete =>
- if Stack_Matches_Ops and Op.Del_Token_Index =
Parser_State.Shared_Token then
- -- We can apply multiple deletes.
- Parser_State.Shared_Token := Op.Del_Token_Index
+ 1;
- Apply_Prev_Token;
- Shared_Token_Changed := True;
- else
- if Is_Full (Sorted_Insert_Delete) then
- raise Bad_Config;
+
+ if First_Insert and Op.Ins_Token_Index =
Parser_State.Shared_Token then
+ -- We need First_Insert here, not just
Stack_Matches_Ops, when the
+ -- first insert is preceeded only by
Push_Back and Undo_Reduce, with
+ -- at least one Undo_Reduce (so
Stack_Matches_Ops is False when we
+ -- get here). See test_mckenzie_recover.adb
Missing_Name_3
+
+ First_Insert := False;
+
+ -- Normally Insert is completed by
Stack.Push; we let the main parser
+ -- do that.
+ Stack_Matches_Ops := False;
+
+ -- Add_Terminal is normally done in the
lexer phase, so we do this here.
+ Parser_State.Current_Token :=
Parser_State.Tree.Add_Terminal
+ (Op.Ins_ID, Op.Ins_Token_Index);
+ Recover_Op_Array_Refs.Variable_Ref
+ (Parser_State.Recover_Insert_Delete,
+ Recover_Op_Arrays.Last_Index
(Parser_State.Recover_Insert_Delete)).Ins_Tree_Node :=
+ Parser_State.Current_Token;
+
+ Current_Token_Virtual :=
True;
+ Parser_State.Recover_Insert_Delete_Current :=
No_Index;
else
- Insert (Sorted_Insert_Delete, Op);
+ -- Let main parser handle it
+ null;
end if;
- end if;
- end case;
- end;
- end loop;
-
- -- We may not have processed the current Insert or Delete
above, if
- -- they are after a fast_forward.
- for I in First_Index (Sorted_Insert_Delete) .. Last_Index
(Sorted_Insert_Delete) loop
- declare
- Op : Insert_Delete_Op renames
Insert_Delete_Array_Refs.Constant_Ref (Sorted_Insert_Delete, I);
- begin
- if Token_Index (Op) = Parser_State.Shared_Token and
not Current_Token_Virtual then
- case Insert_Delete_Op_Label'(Op.Op) is
- when Insert =>
- Parser_State.Current_Token :=
Parser_State.Tree.Add_Terminal (ID (Op));
- Current_Token_Virtual := True;
when Delete =>
- Parser_State.Shared_Token := Op.Del_Token_Index
+ 1;
- Apply_Prev_Token;
- Shared_Token_Changed := True;
+ Recover_Op_Arrays.Append
+ (Parser_State.Recover_Insert_Delete,
+ (Op => Delete,
+ Del_ID => Op.Del_ID,
+ Del_Token_Index => Op.Del_Token_Index));
+
+ if Stack_Matches_Ops and Op.Del_Token_Index =
Parser_State.Shared_Token then
+ -- Delete has no effect on Stack, so we can
apply multiple deletes.
+ Parser_State.Shared_Token :=
Op.Del_Token_Index + 1;
+ Shared_Token_Changed := True;
+
+ Parser_State.Recover_Insert_Delete_Current :=
No_Index;
+ else
+ if Parser_State.Recover_Insert_Delete_Current
= No_Index then
+ Parser_State.Recover_Insert_Delete_Current
:=
+ Recover_Op_Arrays.Last_Index
(Parser_State.Recover_Insert_Delete);
+ end if;
+
+ end if;
+
end case;
- else
- Parser_State.Recover_Insert_Delete.Put (Op);
- end if;
- end;
- end loop;
-
- -- If not Shared_Token_Changed, Shared_Token is the error
token,
- -- which is the next token to read. If
Shared_Token_Changed, we have
- -- set Shared_Token consistent with that; it is the next
token to
- -- read. If Current_Token_Virtual, then after all the
virtual tokens
- -- are inserted, the main parser would normally increment
- -- Parser_State.Shared_Token to get the next token, but we
don't want
- -- that now. We could set Shared_Token to 1 less, but this
way the
- -- debug messages all show the expected Shared_Terminal.
-
- Parser_State.Inc_Shared_Token := not Current_Token_Virtual;
-
- -- The main parser always sets Current_Token to be the
syntax tree
- -- node containing Shared_Token; ensure that is true here
(virtual
- -- tokens where handled above).
-
- if (not Current_Token_Virtual) and Shared_Token_Changed then
- Parser_State.Current_Token :=
Parser_State.Tree.Add_Terminal
- (Parser_State.Shared_Token, Shared_Parser.Terminals);
- end if;
+ end;
+ end loop;
- if Trace_McKenzie > Extra then
- Put_Line (Trace, Parser_State.Label, "after Ops
applied:", Task_ID => False);
- Put_Line
- (Trace, Parser_State.Label, "stack " &
Parser_Lists.Image
- (Parser_State.Stack, Descriptor, Tree),
- Task_ID => False);
- Put_Line
- (Trace, Parser_State.Label, "Shared_Token " & Image
- (Parser_State.Shared_Token, Shared_Parser.Terminals,
Descriptor), Task_ID => False);
- Put_Line
- (Trace, Parser_State.Label, "Current_Token " &
Parser_State.Tree.Image
- (Parser_State.Current_Token, Descriptor), Task_ID =>
False);
- Put_Line
- (Trace, Parser_State.Label, "recover_insert_delete " &
Image
- (Parser_State.Recover_Insert_Delete, Descriptor),
Task_ID => False);
- Put_Line
- (Trace, Parser_State.Label, "inc_shared_token " &
Boolean'Image (Parser_State.Inc_Shared_Token) &
- " parser verb " & All_Parse_Action_Verbs'Image
(Parser_State.Verb),
- Task_ID => False);
+ -- If not Shared_Token_Changed, Shared_Token is the
error token,
+ -- which is the next token to read. If
Shared_Token_Changed, we have
+ -- set Shared_Token consistent with that; it is the next
token to
+ -- read. If Current_Token_Virtual, then after all the
virtual tokens
+ -- are inserted, the main parser would normally increment
+ -- Parser_State.Shared_Token to get the next token, but
we don't want
+ -- that now. We could set Shared_Token to 1 less, but
this way the
+ -- debug messages all show the expected Shared_Terminal.
+
+ Parser_State.Inc_Shared_Token := not
Current_Token_Virtual;
+
+ -- The main parser always sets Current_Token to be the
syntax tree
+ -- node containing Shared_Token; ensure that is true
here (virtual
+ -- tokens where handled above).
+
+ if (not Current_Token_Virtual) and Shared_Token_Changed
then
+ Parser_State.Current_Token := Shared_Parser.Terminals
+ (Parser_State.Shared_Token).Tree_Index;
+ end if;
+
+ if Trace_McKenzie > Extra then
+ Put_Line (Trace, Parser_State.Label, "after Ops
applied:", Task_ID => False);
+ Put_Line
+ (Trace, Parser_State.Label, "stack " &
Parser_Lists.Image
+ (Stack, Descriptor, Tree),
+ Task_ID => False);
+ Put_Line
+ (Trace, Parser_State.Label, "Shared_Token " & Image
+ (Parser_State.Shared_Token,
Shared_Parser.Terminals, Descriptor), Task_ID => False);
+ Put_Line
+ (Trace, Parser_State.Label, "Current_Token " &
Parser_State.Tree.Image
+ (Parser_State.Current_Token, Descriptor), Task_ID
=> False);
+ Put_Line
+ (Trace, Parser_State.Label, "recover_insert_delete" &
+ Parser_State.Recover_Insert_Delete_Current'Image
& ":" &
+ Image (Parser_State.Recover_Insert_Delete,
Descriptor), Task_ID => False);
+ Put_Line
+ (Trace, Parser_State.Label, "inc_shared_token " &
+ Boolean'Image (Parser_State.Inc_Shared_Token),
+ Task_ID => False);
+ end if;
+ end;
+ exception
+ when Bad_Config =>
+ if Parsers.Count = 1 then
+ -- Oops. just give up
+ return Fail_Programmer_Error;
end if;
+ Parsers.Terminate_Parser (Current_Parser, "bad config in
recover", Trace, Shared_Parser.Terminals);
+ -- Terminate advances Current_Parser
+ Skip_Next := True;
end;
- exception
- when Bad_Config =>
- if Parsers.Count = 1 then
- -- Oops. just give up
- return Fail_Programmer_Error;
- end if;
- Parsers.Terminate_Parser (Current_Parser, "bad config in
recover", Trace, Shared_Parser.Terminals);
- end;
- end if;
- Current_Parser.Next;
- end loop;
-
+ end if;
+ if Skip_Next then
+ Skip_Next := False;
+ else
+ Current_Parser.Next;
+ end if;
+ end loop;
+ end;
if Shared_Parser.Post_Recover /= null then
Shared_Parser.Post_Recover.all;
end if;
@@ -717,7 +650,8 @@ package body WisiToken.Parse.LR.McKenzie_Recover is
exception
when E : others =>
if Debug_Mode then
- Trace.Put (Ada.Exceptions.Exception_Name (E) & ": " &
Ada.Exceptions.Exception_Message (E));
+ Trace.Put (Ada.Exceptions.Exception_Name (E) & ": " &
Ada.Exceptions.Exception_Message (E), Prefix => True);
+ Trace.New_Line;
raise;
else
return Fail_Programmer_Error;
@@ -737,13 +671,12 @@ package body WisiToken.Parse.LR.McKenzie_Recover is
(Terminals : in Base_Token_Arrays.Vector;
Terminals_Current : in out WisiToken.Base_Token_Index;
Restore_Terminals_Current : out WisiToken.Base_Token_Index;
- Insert_Delete : aliased in out
Sorted_Insert_Delete_Arrays.Vector;
- Current_Insert_Delete : in out SAL.Base_Peek_Type;
- Prev_Deleted : in
Recover_Token_Index_Arrays.Vector)
+ Insert_Delete : aliased in out Config_Op_Arrays.Vector;
+ Current_Insert_Delete : in out SAL.Base_Peek_Type)
return Base_Token
is
- use Sorted_Insert_Delete_Arrays;
- use Insert_Delete_Array_Refs;
+ use Config_Op_Arrays;
+ use Config_Op_Array_Refs;
procedure Inc_I_D
is begin
@@ -778,11 +711,7 @@ package body WisiToken.Parse.LR.McKenzie_Recover is
return (ID => ID (Op), others => <>);
when Delete =>
- Terminals_Current := Terminals_Current + 1;
- loop
- exit when not Prev_Deleted.Contains (Terminals_Current);
- Terminals_Current := Terminals_Current + 1;
- end loop;
+ Terminals_Current := Terminals_Current + 1;
Restore_Terminals_Current := Terminals_Current;
Inc_I_D;
end case;
@@ -796,11 +725,11 @@ package body WisiToken.Parse.LR.McKenzie_Recover is
function Current_Token_ID_Peek
(Terminals : in Base_Token_Arrays.Vector;
Terminals_Current : in Base_Token_Index;
- Insert_Delete : aliased in Sorted_Insert_Delete_Arrays.Vector;
+ Insert_Delete : aliased in Config_Op_Arrays.Vector;
Current_Insert_Delete : in SAL.Base_Peek_Type)
return Token_ID
is
- use Insert_Delete_Array_Refs;
+ use Config_Op_Array_Refs;
Result : Token_ID;
begin
@@ -836,9 +765,8 @@ package body WisiToken.Parse.LR.McKenzie_Recover is
procedure Current_Token_ID_Peek_3
(Terminals : in Base_Token_Arrays.Vector;
Terminals_Current : in Base_Token_Index;
- Insert_Delete : aliased in
Sorted_Insert_Delete_Arrays.Vector;
+ Insert_Delete : aliased in Config_Op_Arrays.Vector;
Current_Insert_Delete : in SAL.Base_Peek_Type;
- Prev_Deleted : in Recover_Token_Index_Arrays.Vector;
Tokens : out Token_ID_Array_1_3)
is
Terminals_Next : WisiToken.Token_Index := Terminals_Current + 1;
@@ -851,16 +779,9 @@ package body WisiToken.Parse.LR.McKenzie_Recover is
-- First set Tokens from Terminals; may be overridden by
-- Insert_Delete below.
Tokens (1) := Terminals (Terminals_Current).ID;
- loop
- exit when not Prev_Deleted.Contains (Terminals_Next);
- Terminals_Next := Terminals_Next + 1;
- end loop;
if Terminals_Next <= Terminals.Last_Index then
Tokens (2) := Terminals (Terminals_Next).ID;
- loop
- Terminals_Next := Terminals_Next + 1;
- exit when not Prev_Deleted.Contains (Terminals_Next);
- end loop;
+ Terminals_Next := Terminals_Next + 1;
if Terminals_Next <= Terminals.Last_Index then
Tokens (3) := Terminals (Terminals_Next).ID;
else
@@ -876,7 +797,7 @@ package body WisiToken.Parse.LR.McKenzie_Recover is
else
for I in Tokens'Range loop
declare
- use Sorted_Insert_Delete_Arrays, Insert_Delete_Array_Refs;
+ use Config_Op_Arrays, Config_Op_Array_Refs;
J : constant SAL.Base_Peek_Type := Current_Insert_Delete +
SAL.Peek_Type (I) - 1;
begin
if (J in First_Index (Insert_Delete) .. Last_Index
(Insert_Delete)) and then
@@ -906,7 +827,6 @@ package body WisiToken.Parse.LR.McKenzie_Recover is
ID : in Token_ID)
is
use Config_Op_Arrays;
- use Sorted_Insert_Delete_Arrays;
Op : constant Config_Op := (Delete, ID, Config.Current_Shared_Token);
begin
Check (Terminals (Config.Current_Shared_Token).ID, ID);
@@ -914,7 +834,7 @@ package body WisiToken.Parse.LR.McKenzie_Recover is
raise Bad_Config;
end if;
Append (Config.Ops, Op);
- Insert (Config.Insert_Delete, Op);
+ Append (Config.Insert_Delete, Op);
Config.Current_Insert_Delete := 1;
end Delete_Check;
@@ -934,18 +854,31 @@ package body WisiToken.Parse.LR.McKenzie_Recover is
Index : in out WisiToken.Token_Index)
is
use Config_Op_Arrays;
- use Sorted_Insert_Delete_Arrays;
Op : constant Config_Op := (Delete, Terminals (Index).ID, Index);
begin
if Is_Full (Config.Ops) or Is_Full (Config.Insert_Delete) then
raise Bad_Config;
end if;
Append (Config.Ops, Op);
- Insert (Config.Insert_Delete, Op);
+ Append (Config.Insert_Delete, Op);
Config.Current_Insert_Delete := 1;
Index := Index + 1;
end Delete;
+ function Find_ID
+ (Config : in Configuration;
+ ID : in Token_ID)
+ return Boolean
+ is begin
+ for I in 1 .. Config.Stack.Depth - 1 loop
+ -- Depth has Invalid_Token_ID
+ if ID = Config.Stack.Peek (I).Token.ID then
+ return True;
+ end if;
+ end loop;
+ return False;
+ end Find_ID;
+
procedure Find_ID
(Config : in Configuration;
ID : in Token_ID;
@@ -1081,14 +1014,13 @@ package body WisiToken.Parse.LR.McKenzie_Recover is
procedure Insert (Config : in out Configuration; Index : in
WisiToken.Token_Index; ID : in Token_ID)
is
use Config_Op_Arrays;
- use Sorted_Insert_Delete_Arrays;
- Op : constant Config_Op := (Insert, ID, Index, Unknown_State, 0);
+ Op : constant Config_Op := (Insert, ID, Index);
begin
if Is_Full (Config.Ops) or Is_Full (Config.Insert_Delete) then
raise Bad_Config;
end if;
Append (Config.Ops, Op);
- Insert (Config.Insert_Delete, Op);
+ Append (Config.Insert_Delete, Op);
Config.Current_Insert_Delete := 1;
end Insert;
@@ -1096,21 +1028,15 @@ package body WisiToken.Parse.LR.McKenzie_Recover is
(Terminals : in Base_Token_Arrays.Vector;
Terminals_Current : in out Base_Token_Index;
Restore_Terminals_Current : in out WisiToken.Base_Token_Index;
- Insert_Delete : aliased in out
Sorted_Insert_Delete_Arrays.Vector;
- Current_Insert_Delete : in out SAL.Base_Peek_Type;
- Prev_Deleted : in
Recover_Token_Index_Arrays.Vector)
+ Insert_Delete : aliased in out Config_Op_Arrays.Vector;
+ Current_Insert_Delete : in out SAL.Base_Peek_Type)
return Base_Token
is
- use Sorted_Insert_Delete_Arrays, Insert_Delete_Array_Refs;
+ use Config_Op_Arrays, Config_Op_Array_Refs;
function Next_Terminal return Base_Token
is begin
- Terminals_Current := Terminals_Current + 1;
- loop
- exit when not Prev_Deleted.Contains (Terminals_Current);
- Terminals_Current := Terminals_Current + 1;
- end loop;
-
+ Terminals_Current := Terminals_Current + 1;
Restore_Terminals_Current := Terminals_Current;
return Terminals (Terminals_Current);
end Next_Terminal;
@@ -1146,10 +1072,82 @@ package body WisiToken.Parse.LR.McKenzie_Recover is
end loop;
end Next_Token;
+ function Push_Back_Valid
+ (Target_Token_Index : in WisiToken.Base_Token_Index;
+ Ops : in Config_Op_Arrays.Vector;
+ Prev_Op : in Positive_Index_Type)
+ return Boolean
+ is
+ use Config_Op_Arrays;
+ Fast_Forward_Seen : Boolean := False;
+ begin
+ -- We require a Fast_Forward after Insert or Delete, to eliminate
+ -- duplicate results from push_back before and after a
+ -- delete (see test_mckenzie_recover.adb Extra_Begin).
+ --
+ -- If Target_Token_Index is greater than the new current terminal
+ -- implied by Prev_Op, the Push_Back is valid. Otherwise, it is
+ -- invalid (it should have been done first); we only need to look at
+ -- one op other than Fast_Forward.
+ for I in reverse First_Index (Ops) .. Prev_Op loop
+ declare
+ Op : Config_Op renames Element (Ops, I);
+ begin
+ case Op.Op is
+ when Fast_Forward =>
+ -- We need to see the op before the Fast_Forward to tell if
Push_Back
+ -- to Target_Token_Index is ok.
+ Fast_Forward_Seen := True;
+
+ when Undo_Reduce =>
+ -- We don't know what the new terminal is from this op. We'll
just
+ -- have to trust the programmers.
+ return True;
+
+ when Push_Back =>
+ -- If neither the proposed Push_Back nor Op is for an empty
token,
+ -- successive Push_Backs have decreasing targets; see
+ -- test_mckenzie_recover.adb Missing_Name_0.
+ --
+ -- However, if there is a Fast_Forward between two Push_Backs,
+ -- Target_Token_Index must be >= Op.PB_Token_Index. See
+ -- ada-mode-recover_27.adb.
+ --
+ -- If called from Undo_Reduce_Valid where the Undo_Reduce
token is
+ -- empty, we get Target_Token_Index = Op.PB_Token_Index.
+ return Target_Token_Index = Invalid_Token_Index or else
+ Op.PB_Token_Index = Invalid_Token_Index or else
+ (if Fast_Forward_Seen
+ then Target_Token_Index > Op.PB_Token_Index
+ else Target_Token_Index <= Op.PB_Token_Index);
+
+ when Insert =>
+ -- If Target_Token_Index = Op.Ins_Token_Index, we want the edit
+ -- point to be at the same token as before; that's ok.
+ --
+ -- If Target_Token_Index > Ins_Token_Index, the Push_Back is
partway
+ -- into a Fast_Forward.
+ return Fast_Forward_Seen and
+ (Target_Token_Index = Invalid_Token_Index or else
+ Target_Token_Index >= Op.Ins_Token_Index);
+
+ when Delete =>
+ -- As for Insert
+ return Fast_Forward_Seen and
+ (Target_Token_Index = Invalid_Token_Index or else
+ Target_Token_Index >= Op.Del_Token_Index);
+ end case;
+ end;
+ end loop;
+ -- We can only get here if the only ops in Ops are Fast_Forward,
+ -- which is a programming error.
+ pragma Assert (False);
+ raise Bad_Config;
+ end Push_Back_Valid;
+
procedure Push_Back (Config : in out Configuration)
is
use Config_Op_Arrays, Config_Op_Array_Refs;
- use Sorted_Insert_Delete_Arrays;
Item : constant Recover_Stack_Item := Config.Stack.Pop;
Token_Index : constant Base_Token_Index :=
Item.Token.Min_Terminal_Index;
@@ -1171,7 +1169,7 @@ package body WisiToken.Parse.LR.McKenzie_Recover is
if Is_Full (Config.Insert_Delete) then
raise Bad_Config;
end if;
- Insert (Config.Insert_Delete, Constant_Ref (Config.Ops, I),
Ignore_If_Equal => True);
+ Append (Config.Insert_Delete, Constant_Ref (Config.Ops, I));
end if;
end loop;
end if;
@@ -1184,7 +1182,6 @@ package body WisiToken.Parse.LR.McKenzie_Recover is
procedure Push_Back_Check (Config : in out Configuration; Expected_ID : in
Token_ID)
is begin
- pragma Assert (Config.Stack.Depth > 1);
Check (Config.Stack.Peek (1).Token.ID, Expected_ID);
Push_Back (Config);
end Push_Back_Check;
@@ -1192,7 +1189,11 @@ package body WisiToken.Parse.LR.McKenzie_Recover is
procedure Push_Back_Check (Config : in out Configuration; Expected : in
Token_ID_Array)
is begin
for ID of Expected loop
- Push_Back_Check (Config, ID);
+ if Push_Back_Valid (Config) then
+ Push_Back_Check (Config, ID);
+ else
+ raise Bad_Config;
+ end if;
end loop;
end Push_Back_Check;
@@ -1209,7 +1210,7 @@ package body WisiToken.Parse.LR.McKenzie_Recover is
-- Build a string, call trace.put_line once, so output from multiple
-- tasks is not interleaved (mostly).
- use Insert_Delete_Array_Refs;
+ use Config_Op_Array_Refs;
use all type Ada.Strings.Unbounded.Unbounded_String;
use all type WisiToken.Semantic_Checks.Check_Status_Label;
@@ -1269,11 +1270,8 @@ package body WisiToken.Parse.LR.McKenzie_Recover is
is
Nonterm_Item : constant Recover_Stack_Item := Recover_Stacks.Pop (Stack);
begin
- if Nonterm_Item.Token.Byte_Region = Null_Buffer_Region then
- return 0;
- end if;
declare
- Children : constant Syntax_Trees.Valid_Node_Index_Array :=
Tree.Children (Nonterm_Item.Tree_Index);
+ Children : constant Valid_Node_Index_Array := Tree.Children
(Nonterm_Item.Tree_Index);
begin
for C of Children loop
Stack.Push ((Tree.State (C), C, Tree.Recover_Token (C)));
diff --git a/wisitoken-parse-lr-mckenzie_recover.ads
b/wisitoken-parse-lr-mckenzie_recover.ads
index dedad36..2f33cd2 100644
--- a/wisitoken-parse-lr-mckenzie_recover.ads
+++ b/wisitoken-parse-lr-mckenzie_recover.ads
@@ -11,7 +11,7 @@
-- [Grune 2008] Parsing Techniques, A Practical Guide, Second
-- Edition. Dick Grune, Ceriel J.H. Jacobs.
--
--- Copyright (C) 2017 - 2019 Free Software Foundation, Inc.
+-- Copyright (C) 2017 - 2020 Free Software Foundation, Inc.
--
-- This library is free software; you can redistribute it and/or modify it
-- under terms of the GNU General Public License as published by the Free
@@ -30,6 +30,7 @@ with Ada.Task_Attributes;
with WisiToken.Parse.LR.Parser;
with WisiToken.Lexer;
package WisiToken.Parse.LR.McKenzie_Recover is
+ use all type Ada.Containers.Count_Type;
Bad_Config : exception;
-- Raised when a config is determined to violate some programming
@@ -51,7 +52,6 @@ package WisiToken.Parse.LR.McKenzie_Recover is
-- and forces at least three.
private
- use all type WisiToken.Syntax_Trees.Node_Index;
----------
-- Visible for language-specific child packages. Alphabetical.
@@ -65,9 +65,8 @@ private
(Terminals : in Base_Token_Arrays.Vector;
Terminals_Current : in out Base_Token_Index;
Restore_Terminals_Current : out WisiToken.Base_Token_Index;
- Insert_Delete : aliased in out
Sorted_Insert_Delete_Arrays.Vector;
- Current_Insert_Delete : in out SAL.Base_Peek_Type;
- Prev_Deleted : in
Recover_Token_Index_Arrays.Vector)
+ Insert_Delete : aliased in out Config_Op_Arrays.Vector;
+ Current_Insert_Delete : in out SAL.Base_Peek_Type)
return Base_Token;
-- Return the current token, from either Terminals or Insert_Delete;
-- set up for Next_Token.
@@ -77,7 +76,7 @@ private
function Current_Token_ID_Peek
(Terminals : in Base_Token_Arrays.Vector;
Terminals_Current : in Base_Token_Index;
- Insert_Delete : aliased in Sorted_Insert_Delete_Arrays.Vector;
+ Insert_Delete : aliased in Config_Op_Arrays.Vector;
Current_Insert_Delete : in SAL.Base_Peek_Type)
return Token_ID;
-- Return the current token from either Terminals or
@@ -86,9 +85,8 @@ private
procedure Current_Token_ID_Peek_3
(Terminals : in Base_Token_Arrays.Vector;
Terminals_Current : in Base_Token_Index;
- Insert_Delete : aliased in
Sorted_Insert_Delete_Arrays.Vector;
+ Insert_Delete : aliased in Config_Op_Arrays.Vector;
Current_Insert_Delete : in SAL.Base_Peek_Type;
- Prev_Deleted : in Recover_Token_Index_Arrays.Vector;
Tokens : out Token_ID_Array_1_3);
-- Return the current token (in Tokens (1)) from either Terminals or
-- Insert_Delete, without setting up for Next_Token. Return the two
@@ -124,6 +122,13 @@ private
Index : in out WisiToken.Token_Index);
-- Same as Delete_Check, without the check.
+ function Find_ID
+ (Config : in Configuration;
+ ID : in Token_ID)
+ return Boolean;
+ -- Search Config.Stack for a token with ID, starting at
+ -- stack top. Return True if found, False if not.
+
procedure Find_ID
(Config : in Configuration;
ID : in Token_ID;
@@ -189,9 +194,8 @@ private
(Terminals : in Base_Token_Arrays.Vector;
Terminals_Current : in out Base_Token_Index;
Restore_Terminals_Current : in out Base_Token_Index;
- Insert_Delete : aliased in out
Sorted_Insert_Delete_Arrays.Vector;
- Current_Insert_Delete : in out SAL.Base_Peek_Type;
- Prev_Deleted : in
Recover_Token_Index_Arrays.Vector)
+ Insert_Delete : aliased in out Config_Op_Arrays.Vector;
+ Current_Insert_Delete : in out SAL.Base_Peek_Type)
return Base_Token;
-- Return the next token, from either Terminals or Insert_Delete;
-- update Terminals_Current or Current_Insert_Delete.
@@ -206,24 +210,38 @@ private
-- Insert_Delete contains only Insert and Delete ops, in token_index
-- order. Those ops are applied when Terminals_Current =
-- op.token_index.
- --
- -- Prev_Deleted contains tokens deleted in previous recover
- -- operations; those are skipped.
- procedure Push_Back (Config : in out Configuration);
+ function Push_Back_Valid
+ (Target_Token_Index : in WisiToken.Base_Token_Index;
+ Ops : in Config_Op_Arrays.Vector;
+ Prev_Op : in Positive_Index_Type)
+ return Boolean;
+
+ function Push_Back_Valid (Config : in Configuration) return Boolean
+ is (Config.Stack.Depth > 1 and then
+ (not Config.Stack.Peek.Token.Virtual and
+ -- If Virtual, this is from earlier in this recover session; no
point
+ -- in trying to redo it.
+ (Config_Op_Arrays.Length (Config.Ops) = 0 or else
+ Push_Back_Valid
+ (Config.Stack.Peek.Token.Min_Terminal_Index,
+ Config.Ops,
+ Config_Op_Arrays.Last_Index (Config.Ops)))));
+
+ procedure Push_Back (Config : in out Configuration)
+ with Pre => Push_Back_Valid (Config);
-- Pop the top Config.Stack item, set Config.Current_Shared_Token to
-- the first terminal in that item. If the item is empty,
-- Config.Current_Shared_Token is unchanged.
- --
- -- If any earlier Insert or Delete items in Config.Ops are for a
- -- token_index after that first terminal, they are added to
- -- Config.Insert_Delete in token_index order.
- procedure Push_Back_Check (Config : in out Configuration; Expected_ID : in
Token_ID);
+ procedure Push_Back_Check (Config : in out Configuration; Expected_ID : in
Token_ID)
+ with Pre => Push_Back_Valid (Config);
-- In effect, call Check and Push_Back.
procedure Push_Back_Check (Config : in out Configuration; Expected : in
Token_ID_Array);
-- Call Push_Back_Check for each item in Expected.
+ --
+ -- Raises Bad_Config if any of the push_backs is invalid.
procedure Put
(Message : in String;
@@ -243,19 +261,28 @@ private
-- Put message to Trace, with parser and task info.
function Undo_Reduce_Valid
- (Stack : in Recover_Stacks.Stack;
- Tree : in Syntax_Trees.Tree)
+ (Stack : in Recover_Stacks.Stack;
+ Tree : in Syntax_Trees.Tree)
return Boolean
+ -- Check if Undo_Reduce is valid when there is no previous Config_Op.
+ --
+ -- Undo_Reduce needs to know what tokens the nonterm contains, to
+ -- push them on the stack. Thus we need a valid Tree index. It is
+ -- tempting to also allow an empty nonterm when Tree_Index is
+ -- invalid, but that fails when the real Undo_Reduce results in
+ -- another empty nonterm on the stack; see test_mckenzie_recover.adb
+ -- Error_During_Resume_3.
is (Stack.Depth > 1 and then
- ((Stack.Peek.Tree_Index /=
WisiToken.Syntax_Trees.Invalid_Node_Index and then
- Tree.Is_Nonterm (Stack.Peek.Tree_Index)) or
- (Stack.Peek.Tree_Index =
WisiToken.Syntax_Trees.Invalid_Node_Index and
- (not Stack.Peek.Token.Virtual and
- Stack.Peek.Token.Byte_Region = Null_Buffer_Region))));
- -- Undo_Reduce needs to know what tokens the nonterm contains, to
- -- push them on the stack. Thus we need either a valid Tree index, or
- -- an empty nonterm. If Token.Virtual, we can't trust
- -- Token.Byte_Region to determine empty.
+ Stack.Peek.Tree_Index /= Invalid_Node_Index and then
+ Tree.Is_Nonterm (Stack.Peek.Tree_Index));
+
+ function Undo_Reduce_Valid
+ (Stack : in Recover_Stacks.Stack;
+ Tree : in Syntax_Trees.Tree;
+ Ops : in Config_Op_Arrays.Vector;
+ Prev_Op : in Positive_Index_Type)
+ return Boolean
+ is (Undo_Reduce_Valid (Stack, Tree) and then Push_Back_Valid
(Stack.Peek.Token.Min_Terminal_Index, Ops, Prev_Op));
function Undo_Reduce
(Stack : in out Recover_Stacks.Stack;
diff --git a/wisitoken-parse-lr-parser.adb b/wisitoken-parse-lr-parser.adb
index 44c1ac0..a3dded3 100644
--- a/wisitoken-parse-lr-parser.adb
+++ b/wisitoken-parse-lr-parser.adb
@@ -2,7 +2,7 @@
--
-- See spec.
--
--- Copyright (C) 2002 - 2005, 2008 - 2015, 2017 - 2019 Free Software
Foundation, Inc.
+-- Copyright (C) 2002 - 2005, 2008 - 2015, 2017 - 2020 Free Software
Foundation, Inc.
--
-- This file is part of the WisiToken package.
--
@@ -36,7 +36,7 @@ package body WisiToken.Parse.LR.Parser is
function Reduce_Stack_1
(Current_Parser : in Parser_Lists.Cursor;
Action : in Reduce_Action_Rec;
- Nonterm : out WisiToken.Syntax_Trees.Valid_Node_Index;
+ Nonterm : out WisiToken.Valid_Node_Index;
Lexer : in WisiToken.Lexer.Handle;
Trace : in out WisiToken.Trace'Class)
return WisiToken.Semantic_Checks.Check_Status_Label
@@ -49,7 +49,7 @@ package body WisiToken.Parse.LR.Parser is
use all type Semantic_Checks.Semantic_Check;
Parser_State : Parser_Lists.Parser_State renames
Current_Parser.State_Ref.Element.all;
- Children_Tree : Syntax_Trees.Valid_Node_Index_Array (1 ..
SAL.Base_Peek_Type (Action.Token_Count));
+ Children_Tree : Valid_Node_Index_Array (1 .. SAL.Base_Peek_Type
(Action.Token_Count));
begin
for I in reverse Children_Tree'Range loop
Children_Tree (I) := Parser_State.Stack.Pop.Token;
@@ -75,7 +75,9 @@ package body WisiToken.Parse.LR.Parser is
begin
Status := Action.Check (Lexer, Nonterm_Token, Children_Token,
Recover_Active => False);
- Parser_State.Tree.Set_Name_Region (Nonterm, Nonterm_Token.Name);
+ if Nonterm_Token.Name /= Null_Buffer_Region then
+ Parser_State.Tree.Set_Name_Region (Nonterm, Nonterm_Token.Name);
+ end if;
if Trace_Parse > Detail then
Trace.Put_Line ("semantic check " & Semantic_Checks.Image
(Status, Trace.Descriptor.all));
@@ -118,7 +120,7 @@ package body WisiToken.Parse.LR.Parser is
Parser_State : Parser_Lists.Parser_State renames
Current_Parser.State_Ref;
Trace : WisiToken.Trace'Class renames Shared_Parser.Trace.all;
- Nonterm : WisiToken.Syntax_Trees.Valid_Node_Index;
+ Nonterm : WisiToken.Valid_Node_Index;
Status : Semantic_Checks.Check_Status_Label;
begin
if Trace_Parse > Detail then
@@ -223,40 +225,47 @@ package body WisiToken.Parse.LR.Parser is
procedure Do_Deletes
(Shared_Parser : in out LR.Parser.Parser;
Parser_State : in out Parser_Lists.Parser_State)
- is begin
+ is
+ use Recover_Op_Arrays, Recover_Op_Array_Refs;
+ Ins_Del : Vector renames Parser_State.Recover_Insert_Delete;
+ Ins_Del_Cur : Extended_Index renames
Parser_State.Recover_Insert_Delete_Current;
+ begin
if Trace_Parse > Extra then
Shared_Parser.Trace.Put_Line
(Integer'Image (Parser_State.Label) & ": shared_token:" &
WisiToken.Token_Index'Image (Parser_State.Shared_Token) &
" inc_shared_token: " & Boolean'Image
(Parser_State.Inc_Shared_Token) &
- " recover_insert_delete: " &
- Image (Parser_State.Recover_Insert_Delete,
Shared_Parser.Trace.Descriptor.all));
+ " recover_insert_delete:" &
+ (if Parser_State.Recover_Insert_Delete_Current = No_Index
+ then ""
+ else Parser_State.Recover_Insert_Delete_Current'Image & " " &
+ Image
+ (Constant_Ref (Parser_State.Recover_Insert_Delete,
Parser_State.Recover_Insert_Delete_Current),
+ Shared_Parser.Trace.Descriptor.all)));
end if;
loop
- if Parser_State.Recover_Insert_Delete.Length > 0 and then
- Parser_State.Recover_Insert_Delete.Peek.Op = Delete and then
- Parser_State.Recover_Insert_Delete.Peek.Del_Token_Index =
- (if Parser_State.Inc_Shared_Token
- then Parser_State.Shared_Token + 1
- else Parser_State.Shared_Token)
- then
- Parser_State.Shared_Token := Parser_State.Shared_Token + 1;
- -- We don't reset Inc_Shared_Token here; only after the next
token is
- -- actually used.
- Parser_State.Prev_Deleted.Append
(Parser_State.Recover_Insert_Delete.Peek.Del_Token_Index);
- Parser_State.Recover_Insert_Delete.Drop;
-
- elsif Parser_State.Prev_Deleted.Contains
- ((if Parser_State.Inc_Shared_Token
- then Parser_State.Shared_Token + 1
- else Parser_State.Shared_Token))
- then
- Parser_State.Shared_Token := Parser_State.Shared_Token + 1;
-
- else
- exit;
- end if;
+ exit when Ins_Del_Cur = Recover_Op_Arrays.No_Index;
+ declare
+ Op : Recover_Op renames Constant_Ref (Ins_Del, Ins_Del_Cur);
+ begin
+ if Op.Op = Delete and then
+ Op.Del_Token_Index =
+ (if Parser_State.Inc_Shared_Token
+ then Parser_State.Shared_Token + 1
+ else Parser_State.Shared_Token)
+ then
+ Parser_State.Shared_Token := Parser_State.Shared_Token + 1;
+ -- We don't reset Inc_Shared_Token here; only after the next
token is
+ -- actually used.
+ Ins_Del_Cur := Ins_Del_Cur + 1;
+ if Ins_Del_Cur > Last_Index (Ins_Del) then
+ Ins_Del_Cur := No_Index;
+ end if;
+ else
+ exit;
+ end if;
+ end;
end loop;
end Do_Deletes;
@@ -296,7 +305,12 @@ package body WisiToken.Parse.LR.Parser is
Parser_State.Set_Verb (Shift);
if Parser_State.Resume_Active then
- if Parser_State.Resume_Token_Goal <= Parser_State.Shared_Token
then
+ -- There may still be ops left in Recover_Insert_Delete after
we get
+ -- to Resume_Token_Goal, probably from a Language_Fix or
string quote
+ -- fix that deletes a lot of tokens.
+ if Parser_State.Resume_Token_Goal <= Parser_State.Shared_Token
and
+ Parser_State.Recover_Insert_Delete_Current =
Recover_Op_Arrays.No_Index
+ then
Parser_State.Resume_Active := False;
if Trace_Parse > Detail then
Shared_Parser.Trace.Put_Line (Integer'Image
(Parser_State.Label) & ": resume_active: False");
@@ -397,14 +411,28 @@ package body WisiToken.Parse.LR.Parser is
Trace : WisiToken.Trace'Class renames Shared_Parser.Trace.all;
- Current_Verb : All_Parse_Action_Verbs;
- Error_Recovered : Boolean := False;
- Current_Parser : Parser_Lists.Cursor;
- Action : Parse_Action_Node_Ptr;
- Zombie_Count : SAL.Base_Peek_Type;
+ Current_Verb : All_Parse_Action_Verbs;
+ Action : Parse_Action_Node_Ptr;
+ Zombie_Count : SAL.Base_Peek_Type;
procedure Check_Error (Check_Parser : in out Parser_Lists.Cursor)
- is begin
+ is
+ procedure Report_Error
+ is begin
+ Shared_Parser.Parsers.First_State_Ref.Errors.Append
+ ((Label => LR.Message,
+ First_Terminal => Trace.Descriptor.First_Terminal,
+ Last_Terminal => Trace.Descriptor.Last_Terminal,
+ Recover => <>,
+ Msg => +"error during resume"));
+ if Debug_Mode then
+ raise SAL.Programmer_Error with Check_Parser.Label'Image & ":
error during resume";
+ else
+ raise Syntax_Error;
+ end if;
+ end Report_Error;
+
+ begin
if Check_Parser.Verb = Error then
-- This parser errored on last input. This is how grammar
conflicts
-- are resolved when the input text is valid, in which case we
should
@@ -423,16 +451,7 @@ package body WisiToken.Parse.LR.Parser is
else
if Shared_Parser.Parsers.Count = 1 then
- if Trace_Parse > Outline then
- Trace.Put_Line (Integer'Image (Check_Parser.Label) & ":
error during resume");
- end if;
- Shared_Parser.Parsers.First_State_Ref.Errors.Append
- ((Label => LR.Message,
- First_Terminal => Trace.Descriptor.First_Terminal,
- Last_Terminal => Trace.Descriptor.Last_Terminal,
- Recover => <>,
- Msg => +"error during resume"));
- raise Syntax_Error;
+ Report_Error;
else
-- This is ok if a conflict occured during resume - we
assume this is
@@ -443,7 +462,7 @@ package body WisiToken.Parse.LR.Parser is
(Check_Parser, "error in conflict during resume",
Shared_Parser.Trace.all,
Shared_Parser.Terminals);
else
- raise SAL.Programmer_Error with "error during resume";
+ Report_Error;
end if;
end if;
end if;
@@ -461,13 +480,13 @@ package body WisiToken.Parse.LR.Parser is
Shared_Parser.User_Data.Reset;
end if;
- Shared_Parser.Lex_All;
-
Shared_Parser.String_Quote_Checked := Invalid_Line_Number;
Shared_Parser.Shared_Tree.Clear;
Shared_Parser.Parsers := Parser_Lists.New_List
(Shared_Tree => Shared_Parser.Shared_Tree'Unchecked_Access);
+ Shared_Parser.Lex_All;
+
Shared_Parser.Parsers.First.State_Ref.Stack.Push
((Shared_Parser.Table.State_First, others => <>));
Main_Loop :
@@ -502,33 +521,62 @@ package body WisiToken.Parse.LR.Parser is
end if;
elsif Parser_State.Verb = Shift then
- if Parser_State.Recover_Insert_Delete.Length > 0 and then
- Parser_State.Recover_Insert_Delete.Peek.Op = Insert and
then
- Parser_State.Recover_Insert_Delete.Peek.Ins_Token_Index =
- (if Parser_State.Inc_Shared_Token
- then Parser_State.Shared_Token + 1
- else Parser_State.Shared_Token)
- then
- Parser_State.Current_Token :=
Parser_State.Tree.Add_Terminal
- (Parser_State.Recover_Insert_Delete.Get.Ins_ID);
+ declare
+ function Insert_Virtual return Boolean
+ is
+ use Recover_Op_Arrays, Recover_Op_Array_Refs;
+ Ins_Del : Vector renames
Parser_State.Recover_Insert_Delete;
+ Ins_Del_Cur : Extended_Index renames
Parser_State.Recover_Insert_Delete_Current;
+ Result : Boolean := False;
+ begin
+ if Ins_Del_Cur /= No_Index then
+ declare
+ Op : Recover_Op renames Variable_Ref (Ins_Del,
Ins_Del_Cur);
+ begin
+ if Op.Op = Insert and then
+ Op.Ins_Token_Index =
+ (if Parser_State.Inc_Shared_Token
+ then Parser_State.Shared_Token + 1
+ else Parser_State.Shared_Token)
+ then
+ Result := True;
+
+ Parser_State.Current_Token :=
Parser_State.Tree.Add_Terminal
+ (Op.Ins_ID, Before => Op.Ins_Token_Index);
+
+ Op.Ins_Tree_Node :=
Parser_State.Current_Token;
+
+ Ins_Del_Cur := Ins_Del_Cur + 1;
+ if Ins_Del_Cur > Last_Index (Ins_Del) then
+ Ins_Del_Cur := No_Index;
+ end if;
+ end if;
+ end;
+ end if;
+ return Result;
+ end Insert_Virtual;
+ begin
+ if Insert_Virtual then
+ null;
- elsif (if Parser_State.Inc_Shared_Token
- then Parser_State.Shared_Token + 1
- else Parser_State.Shared_Token) <=
Shared_Parser.Terminals.Last_Index
- then
- if Parser_State.Inc_Shared_Token then
- -- Inc_Shared_Token is only set False by
McKenzie_Recover; see there
- -- for when/why. Don't increment past wisi_eoi
(happens when input
- -- buffer is empty; test_mckenzie_recover.adb
Empty_Comments).
- Parser_State.Shared_Token := Parser_State.Shared_Token
+ 1;
- else
- Parser_State.Inc_Shared_Token := True;
- end if;
+ elsif (if Parser_State.Inc_Shared_Token
+ then Parser_State.Shared_Token + 1
+ else Parser_State.Shared_Token) <=
Shared_Parser.Terminals.Last_Index
+ then
+ if Parser_State.Inc_Shared_Token then
+ -- Inc_Shared_Token is only set False by
McKenzie_Recover; see there
+ -- for when/why. Don't increment past wisi_eoi
(happens when input
+ -- buffer is empty; test_mckenzie_recover.adb
Empty_Comments).
+ Parser_State.Shared_Token :=
Parser_State.Shared_Token + 1;
+ else
+ Parser_State.Inc_Shared_Token := True;
+ end if;
- Parser_State.Current_Token :=
Parser_State.Tree.Add_Terminal
- (Parser_State.Shared_Token, Shared_Parser.Terminals);
+ Parser_State.Current_Token := Shared_Parser.Terminals
+ (Parser_State.Shared_Token).Tree_Index;
- end if;
+ end if;
+ end;
if Trace_Parse > Extra then
Trace.Put_Line
@@ -542,7 +590,7 @@ package body WisiToken.Parse.LR.Parser is
-- All parsers accepted or are zombies.
declare
Count : constant SAL.Base_Peek_Type :=
Shared_Parser.Parsers.Count;
- Temp : Parser_Lists.Cursor;
+ Current_Parser : Parser_Lists.Cursor :=
Shared_Parser.Parsers.First;
begin
if Count = 1 then
-- Nothing more to do
@@ -550,15 +598,17 @@ package body WisiToken.Parse.LR.Parser is
elsif Zombie_Count + 1 = Count then
-- All but one are zombies
- Current_Parser := Shared_Parser.Parsers.First;
loop
if Current_Parser.Verb = Accept_It then
Current_Parser.Next;
else
- Temp := Current_Parser;
- Current_Parser.Next;
- Shared_Parser.Parsers.Terminate_Parser
- (Temp, "zombie", Shared_Parser.Trace.all,
Shared_Parser.Terminals);
+ declare
+ Temp : Parser_Lists.Cursor := Current_Parser;
+ begin
+ Current_Parser.Next;
+ Shared_Parser.Parsers.Terminate_Parser
+ (Temp, "zombie", Shared_Parser.Trace.all,
Shared_Parser.Terminals);
+ end;
end if;
exit when Current_Parser.Is_Done;
end loop;
@@ -574,8 +624,8 @@ package body WisiToken.Parse.LR.Parser is
Recover_Cost : Integer;
Min_Recover_Cost : Integer :=
Integer'Last;
Recover_Ops_Length : Ada.Containers.Count_Type;
- Max_Recover_Ops_Length : Ada.Containers.Count_Type :=
Ada.Containers.Count_Type'First;
- Recover_Cur : Parser_Lists.Cursor;
+ Min_Recover_Ops_Length : Ada.Containers.Count_Type :=
Ada.Containers.Count_Type'Last;
+ Recover_Cur : Parser_Lists.Cursor :=
Current_Parser;
begin
Current_Parser := Shared_Parser.Parsers.First;
loop
@@ -585,22 +635,23 @@ package body WisiToken.Parse.LR.Parser is
end if;
Current_Parser.Next;
else
- Temp := Current_Parser;
- Current_Parser.Next;
- Shared_Parser.Parsers.Terminate_Parser
- (Temp, "zombie", Shared_Parser.Trace.all,
Shared_Parser.Terminals);
+ declare
+ Temp : Parser_Lists.Cursor := Current_Parser;
+ begin
+ Current_Parser.Next;
+ Shared_Parser.Parsers.Terminate_Parser
+ (Temp, "zombie", Shared_Parser.Trace.all,
Shared_Parser.Terminals);
+ end;
end if;
exit when Current_Parser.Is_Done;
end loop;
if Error_Parser_Count > 0 then
-- There was at least one error. We assume that
caused the ambiguous
- -- parse, and we pick the parser with the minimum
cost and maximum
- -- recover ops length to allow the parse to succeed.
We terminate the
- -- other parsers so the remaining parser executes
actions. Among
- -- equal costs, we pick the maximum recover ops
length because it's
- -- probably due to Minimal_Complete_Actions finishing
a
- -- statement/declaration.
+ -- parse, and we pick the parser with the minimum
cost and minimum
+ -- recover ops length (consistent with
Duplicate_State) to allow the
+ -- parse to succeed. We terminate the other parsers
so the remaining
+ -- parser can do Execute_Actions.
--
-- If there are multiple errors, this metric is not
very meaningful.
--
@@ -610,13 +661,13 @@ package body WisiToken.Parse.LR.Parser is
Recover_Cost := Current_Parser.Min_Recover_Cost;
if Recover_Cost < Min_Recover_Cost then
Min_Recover_Cost := Recover_Cost;
- Max_Recover_Ops_Length :=
Current_Parser.Max_Recover_Ops_Length;
+ Min_Recover_Ops_Length :=
Current_Parser.Max_Recover_Ops_Length;
Recover_Cur := Current_Parser;
elsif Recover_Cost = Min_Recover_Cost then
Recover_Ops_Length :=
Current_Parser.Max_Recover_Ops_Length;
- if Recover_Ops_Length > Max_Recover_Ops_Length
then
- Max_Recover_Ops_Length := Recover_Ops_Length;
+ if Recover_Ops_Length < Min_Recover_Ops_Length
then
+ Min_Recover_Ops_Length := Recover_Ops_Length;
Recover_Cur := Current_Parser;
end if;
end if;
@@ -629,10 +680,18 @@ package body WisiToken.Parse.LR.Parser is
if Current_Parser = Recover_Cur then
Current_Parser.Next;
else
- Temp := Current_Parser;
- Current_Parser.Next;
- Shared_Parser.Parsers.Terminate_Parser
- (Temp, "recover cost/length",
Shared_Parser.Trace.all, Shared_Parser.Terminals);
+ declare
+ Temp : Parser_Lists.Cursor := Current_Parser;
+ begin
+ Current_Parser.Next;
+ Shared_Parser.Parsers.Terminate_Parser
+ (Temp,
+ (if Recover_Cost = Min_Recover_Cost and
then
+ Recover_Ops_Length =
Min_Recover_Ops_Length
+ then "random"
+ else "recover cost/length"),
+ Shared_Parser.Trace.all,
Shared_Parser.Terminals);
+ end;
end if;
exit when Current_Parser.Is_Done;
end loop;
@@ -791,178 +850,179 @@ package body WisiToken.Parse.LR.Parser is
raise WisiToken.Syntax_Error;
end if;
- -- Immediately execute Do_Action for Current_Token, since it
changed
- -- in error recovery; this sets Parser.Verb. This replaces the
- -- execution of Do_Action that resulted in Error.
- Error_Recovered := True;
-
+ -- Recover sets Parser.Verb to Shift for all active parsers, to
+ -- indicate it no longer has an error. Set Current_Verb to
reflect
+ -- that.
+ Current_Verb := Shift;
end;
end case;
-- We don't use 'for Parser_State of Parsers loop' here,
-- because terminate on error and spawn on conflict require
-- changing the parser list.
- Current_Parser := Shared_Parser.Parsers.First;
- Action_Loop :
- loop
- exit Action_Loop when Current_Parser.Is_Done;
-
- -- We don't check duplicate state during resume, because the
tokens
- -- inserted/deleted by error recover may cause initially duplicate
- -- states to diverge.
- if not Current_Parser.State_Ref.Resume_Active and
- Shared_Parser.Terminate_Same_State and
- Current_Verb = Shift and
- (for all Parser of Shared_Parser.Parsers =>
Parser.Recover_Insert_Delete.Count = 0)
- then
- Shared_Parser.Parsers.Duplicate_State
- (Current_Parser, Shared_Parser.Trace.all,
Shared_Parser.Terminals);
- -- If Duplicate_State terminated Current_Parser,
Current_Parser now
- -- points to the next parser. Otherwise it is unchanged.
- end if;
+ declare
+ Current_Parser : Parser_Lists.Cursor :=
Shared_Parser.Parsers.First;
+ begin
+ Action_Loop :
+ loop
+ exit Action_Loop when Current_Parser.Is_Done;
+
+ -- We don't check duplicate state during resume, because the
tokens
+ -- inserted/deleted by error recover may cause initially
duplicate
+ -- states to diverge.
+ if not Current_Parser.State_Ref.Resume_Active and
+ Shared_Parser.Terminate_Same_State and
+ Current_Verb = Shift
+ then
+ Shared_Parser.Parsers.Duplicate_State
+ (Current_Parser, Shared_Parser.Trace.all,
Shared_Parser.Terminals);
+ -- If Duplicate_State terminated Current_Parser,
Current_Parser now
+ -- points to the next parser. Otherwise it is unchanged.
+ end if;
- exit Action_Loop when Current_Parser.Is_Done;
+ exit Action_Loop when Current_Parser.Is_Done;
- if Trace_Parse > Extra then
- if Error_Recovered then
- Trace.Put_Line (Integer'Image (Current_Parser.Label) &
".error_recovered");
- else
+ if Trace_Parse > Extra then
Trace.Put_Line
("current_verb: " & Parse_Action_Verbs'Image
(Current_Verb) &
"," & Integer'Image (Current_Parser.Label) &
".verb: " & Parse_Action_Verbs'Image
(Current_Parser.Verb));
end if;
- end if;
- -- Each branch of the following 'if' calls either
Current_Parser.Free
- -- (which advances to the next parser) or Current_Parser.Next.
+ -- Each branch of the following 'if' calls either
Current_Parser.Free
+ -- (which advances to the next parser) or Current_Parser.Next.
- if Current_Parser.Verb = Error then
- -- This parser is a zombie; see Check_Error above.
- --
- -- Check to see if it is time to terminate it
- if Shared_Parser.Enable_McKenzie_Recover and then
- Current_Parser.State_Ref.Zombie_Token_Count <=
Shared_Parser.Table.McKenzie_Param.Check_Limit
- then
- if Trace_Parse > Detail then
- Trace.Put_Line (Integer'Image (Current_Parser.Label) & ":
zombie");
- end if;
+ if Current_Parser.Verb = Error then
+ -- This parser is a zombie; see Check_Error above.
+ --
+ -- Check to see if it is time to terminate it
+ if Shared_Parser.Enable_McKenzie_Recover and then
+ Current_Parser.State_Ref.Zombie_Token_Count <=
Shared_Parser.Table.McKenzie_Param.Check_Limit
+ then
+ if Trace_Parse > Detail then
+ Trace.Put_Line (Integer'Image (Current_Parser.Label) &
": zombie");
+ end if;
- Current_Parser.Next;
- else
- Shared_Parser.Parsers.Terminate_Parser
- (Current_Parser, "zombie", Shared_Parser.Trace.all,
Shared_Parser.Terminals);
- end if;
+ Current_Parser.Next;
+ else
+ Shared_Parser.Parsers.Terminate_Parser
+ (Current_Parser, "zombie", Shared_Parser.Trace.all,
Shared_Parser.Terminals);
+ end if;
- elsif Current_Parser.Verb = Current_Verb or Error_Recovered then
+ elsif Current_Parser.Verb = Current_Verb then
- if Trace_Parse > Extra then
- Parser_Lists.Put_Top_10 (Trace, Current_Parser);
- end if;
+ if Trace_Parse > Extra then
+ Parser_Lists.Put_Top_10 (Trace, Current_Parser);
+ end if;
- declare
- State : Parser_Lists.Parser_State renames
Current_Parser.State_Ref.Element.all;
- begin
- Action := Action_For
- (Table => Shared_Parser.Table.all,
- State => State.Stack.Peek.State,
- ID => State.Tree.ID (State.Current_Token));
- end;
+ declare
+ State : Parser_Lists.Parser_State renames
Current_Parser.State_Ref.Element.all;
+ begin
+ Action := Action_For
+ (Table => Shared_Parser.Table.all,
+ State => State.Stack.Peek.State,
+ ID => State.Tree.ID (State.Current_Token));
+ end;
- declare
- Conflict : Parse_Action_Node_Ptr := Action.Next;
- begin
- loop
- exit when Conflict = null;
- -- Spawn a new parser (before modifying Current_Parser
stack).
+ declare
+ Conflict : Parse_Action_Node_Ptr := Action.Next;
+ begin
+ loop
+ exit when Conflict = null;
+ -- Spawn a new parser (before modifying
Current_Parser stack).
- Current_Parser.State_Ref.Conflict_During_Resume :=
Current_Parser.State_Ref.Resume_Active;
+ Current_Parser.State_Ref.Conflict_During_Resume :=
Current_Parser.State_Ref.Resume_Active;
- if Shared_Parser.Parsers.Count =
Shared_Parser.Max_Parallel then
- -- If errors were recovered, terminate a parser that
used the
- -- highest cost solution.
- declare
- use all type WisiToken.Parse.LR.Parser_Lists.Cursor;
- Max_Recover_Cost : Integer := 0;
- Max_Parser : Parser_Lists.Cursor;
- Cur : Parser_Lists.Cursor :=
Shared_Parser.Parsers.First;
- begin
- loop
- exit when Cur.Is_Done;
- if Cur.Total_Recover_Cost > Max_Recover_Cost then
- Max_Parser := Cur;
- Max_Recover_Cost := Cur.Total_Recover_Cost;
+ if Shared_Parser.Parsers.Count =
Shared_Parser.Max_Parallel then
+ -- If errors were recovered, terminate a parser
that used the
+ -- highest cost solution.
+ declare
+ use all type
WisiToken.Parse.LR.Parser_Lists.Cursor;
+ Max_Recover_Cost : Integer := 0;
+ Cur : Parser_Lists.Cursor :=
Shared_Parser.Parsers.First;
+ Max_Parser : Parser_Lists.Cursor := Cur;
+ begin
+ loop
+ exit when Cur.Is_Done;
+ if Cur.Total_Recover_Cost > Max_Recover_Cost
then
+ Max_Parser := Cur;
+ Max_Recover_Cost := Cur.Total_Recover_Cost;
+ end if;
+ Cur.Next;
+ end loop;
+
+ if Max_Recover_Cost > 0 then
+ if Max_Parser = Current_Parser then
+ Current_Parser.Next;
+
+ Shared_Parser.Parsers.Terminate_Parser
+ (Max_Parser, "too many parsers; max
error repair cost", Trace,
+ Shared_Parser.Terminals);
+
+ -- We changed Current_Parser, so start
over
+ goto Continue_Action_Loop;
+ else
+ Shared_Parser.Parsers.Terminate_Parser
+ (Max_Parser, "too many parsers; max
error repair cost", Trace,
+ Shared_Parser.Terminals);
+ end if;
end if;
- Cur.Next;
- end loop;
+ end;
+ end if;
- if Max_Recover_Cost > 0 then
- if Max_Parser = Current_Parser then
- Current_Parser.Next;
- Shared_Parser.Parsers.Terminate_Parser
- (Current_Parser, "too many parsers; max
error repair cost", Trace,
- Shared_Parser.Terminals);
- exit Action_Loop;
- else
- Shared_Parser.Parsers.Terminate_Parser
- (Max_Parser, "too many parsers; max error
repair cost", Trace,
- Shared_Parser.Terminals);
- end if;
+ if Shared_Parser.Parsers.Count =
Shared_Parser.Max_Parallel then
+ declare
+ Parser_State : Parser_Lists.Parser_State renames
Current_Parser.State_Ref;
+ Token : Base_Token renames
Shared_Parser.Terminals (Parser_State.Shared_Token);
+ begin
+ raise WisiToken.Parse_Error with Error_Message
+ (Shared_Parser.Lexer.File_Name, Token.Line,
Token.Column,
+ "too many parallel parsers required in
grammar state" &
+ State_Index'Image
(Parser_State.Stack.Peek.State) &
+ "; simplify grammar, or increase
max-parallel (" &
+ SAL.Base_Peek_Type'Image
(Shared_Parser.Max_Parallel) & ")");
+ end;
+
+ else
+ if Trace_Parse > Outline then
+ declare
+ Parser_State : Parser_Lists.Parser_State
renames Current_Parser.State_Ref;
+ begin
+ Trace.Put_Line
+ (Integer'Image (Current_Parser.Label) & ":
" &
+ Trimmed_Image
(Parser_State.Stack.Peek.State) & ": " &
+ Parser_State.Tree.Image
+ (Parser_State.Current_Token,
Trace.Descriptor.all) & " : " &
+ "spawn" & Integer'Image
(Shared_Parser.Parsers.Last_Label + 1) & ", (" &
+ Trimmed_Image (1 + Integer
(Shared_Parser.Parsers.Count)) & " active)");
+ end;
end if;
- end;
- end if;
- if Shared_Parser.Parsers.Count =
Shared_Parser.Max_Parallel then
- declare
- Parser_State : Parser_Lists.Parser_State renames
Current_Parser.State_Ref;
- Token : Base_Token renames Shared_Parser.Terminals
(Parser_State.Shared_Token);
- begin
- raise WisiToken.Parse_Error with Error_Message
- (Shared_Parser.Lexer.File_Name, Token.Line,
Token.Column,
- "too many parallel parsers required in grammar
state" &
- State_Index'Image
(Parser_State.Stack.Peek.State) &
- "; simplify grammar, or increase max-parallel
(" &
- SAL.Base_Peek_Type'Image
(Shared_Parser.Max_Parallel) & ")");
- end;
+ Shared_Parser.Parsers.Prepend_Copy (Current_Parser);
+ Do_Action (Conflict.Item,
Shared_Parser.Parsers.First, Shared_Parser);
- else
- if Trace_Parse > Outline then
+ -- We must terminate error parsers immediately in
order to avoid
+ -- zombie parsers during recovery.
declare
- Parser_State : Parser_Lists.Parser_State renames
Current_Parser.State_Ref;
+ Temp : Parser_Lists.Cursor :=
Shared_Parser.Parsers.First;
begin
- Trace.Put_Line
- (Integer'Image (Current_Parser.Label) & ": " &
- Trimmed_Image
(Parser_State.Stack.Peek.State) & ": " &
- Parser_State.Tree.Image
(Parser_State.Current_Token, Trace.Descriptor.all) & " : " &
- "spawn" & Integer'Image
(Shared_Parser.Parsers.Last_Label + 1) & ", (" &
- Trimmed_Image (1 + Integer
(Shared_Parser.Parsers.Count)) & " active)");
+ Check_Error (Temp);
end;
end if;
- Shared_Parser.Parsers.Prepend_Copy (Current_Parser);
- Do_Action (Conflict.Item, Shared_Parser.Parsers.First,
Shared_Parser);
-
- -- We must terminate error parsers immediately in
order to avoid
- -- zombie parsers during recovery.
- declare
- Temp : Parser_Lists.Cursor :=
Shared_Parser.Parsers.First;
- begin
- Check_Error (Temp);
- end;
- end if;
-
- Conflict := Conflict.Next;
- end loop;
- end;
- Do_Action (Action.Item, Current_Parser, Shared_Parser);
- Check_Error (Current_Parser);
+ Conflict := Conflict.Next;
+ end loop;
+ end;
+ Do_Action (Action.Item, Current_Parser, Shared_Parser);
+ Check_Error (Current_Parser);
- else
- -- Current parser is waiting for others to catch up
- Current_Parser.Next;
- end if;
- end loop Action_Loop;
- Error_Recovered := False;
+ else
+ -- Current parser is waiting for others to catch up
+ Current_Parser.Next;
+ end if;
+ <<Continue_Action_Loop>>
+ end loop Action_Loop;
+ end;
end loop Main_Loop;
if Trace_Parse > Outline then
@@ -998,7 +1058,8 @@ package body WisiToken.Parse.LR.Parser is
end if;
if Debug_Mode then
- Ada.Text_IO.Put_Line (GNAT.Traceback.Symbolic.Symbolic_Traceback
(E));
+ Trace.Put_Line (GNAT.Traceback.Symbolic.Symbolic_Traceback (E));
-- includes Prefix
+ Trace.New_Line;
end if;
-- Emacs displays the exception message in the echo area; easy to
miss
@@ -1015,8 +1076,19 @@ package body WisiToken.Parse.LR.Parser is
end if;
end Tree;
+ overriding function Tree_Var_Ref (Shared_Parser : aliased in out Parser)
return Syntax_Trees.Tree_Variable_Reference
+ is begin
+ if Shared_Parser.Parsers.Count > 1 then
+ raise WisiToken.Parse_Error with "ambigous parse";
+ else
+ return (Element => Shared_Parser.Parsers.First_State_Ref.Tree'Access);
+ end if;
+ end Tree_Var_Ref;
+
overriding
- procedure Execute_Actions (Parser : in out LR.Parser.Parser)
+ procedure Execute_Actions
+ (Parser : in out LR.Parser.Parser;
+ Image_Augmented : in Syntax_Trees.Image_Augmented := null)
is
use all type Syntax_Trees.User_Data_Access;
use all type WisiToken.Syntax_Trees.Semantic_Action;
@@ -1025,7 +1097,7 @@ package body WisiToken.Parse.LR.Parser is
procedure Process_Node
(Tree : in out Syntax_Trees.Tree;
- Node : in Syntax_Trees.Valid_Node_Index)
+ Node : in Valid_Node_Index)
is
use all type Syntax_Trees.Node_Label;
begin
@@ -1034,7 +1106,7 @@ package body WisiToken.Parse.LR.Parser is
end if;
declare
- Tree_Children : constant Syntax_Trees.Valid_Node_Index_Array :=
Tree.Children (Node);
+ Tree_Children : constant Valid_Node_Index_Array := Tree.Children
(Node);
begin
Parser.User_Data.Reduce (Tree, Node, Tree_Children);
if Tree.Action (Node) /= null then
@@ -1043,7 +1115,7 @@ package body WisiToken.Parse.LR.Parser is
exception
when E : others =>
declare
- Token : Base_Token renames Parser.Terminals
(Tree.Min_Terminal_Index (Node));
+ Token : Base_Token renames Parser.Terminals
(Tree.First_Shared_Terminal (Node));
begin
raise WisiToken.Parse_Error with Error_Message
(Parser.Lexer.File_Name, Token.Line, Token.Column,
@@ -1062,31 +1134,36 @@ package body WisiToken.Parse.LR.Parser is
end if;
declare
- use Config_Op_Arrays, Config_Op_Array_Refs;
+ use Recover_Op_Arrays, Recover_Op_Array_Refs;
Parser_State : Parser_Lists.Parser_State renames
Parser.Parsers.First_State_Ref;
begin
+ pragma Assert (Parser_State.Tree.Flushed);
+
+ Parser_State.Tree.Set_Parents;
+
if Trace_Action > Outline then
if Trace_Action > Extra then
- Parser_State.Tree.Print_Tree (Descriptor,
Parser_State.Tree.Root);
+ Parser_State.Tree.Print_Tree (Descriptor,
Parser_State.Tree.Root, Image_Augmented);
+ Parser.Trace.New_Line;
end if;
Parser.Trace.Put_Line
(Integer'Image (Parser_State.Label) & ": root node: " &
Parser_State.Tree.Image
(Parser_State.Tree.Root, Descriptor));
end if;
- for Err of Parser_State.Errors loop
- for I in First_Index (Err.Recover.Ops) .. Last_Index
(Err.Recover.Ops) loop
- declare
- Op : Config_Op renames Constant_Ref (Err.Recover.Ops, I);
- begin
- case Op.Op is
- when Delete =>
- Parser.User_Data.Delete_Token (Op.Del_Token_Index);
- when others =>
- null;
- end case;
- end;
- end loop;
+ for I in First_Index (Parser_State.Recover_Insert_Delete) ..
+ Last_Index (Parser_State.Recover_Insert_Delete)
+ loop
+ declare
+ Op : Recover_Op renames Constant_Ref
(Parser_State.Recover_Insert_Delete, I);
+ begin
+ case Op.Op is
+ when Insert =>
+ Parser.User_Data.Insert_Token (Parser_State.Tree,
Op.Ins_Tree_Node);
+ when Delete =>
+ Parser.User_Data.Delete_Token (Parser_State.Tree,
Op.Del_Token_Index);
+ end case;
+ end;
end loop;
Parser.User_Data.Initialize_Actions (Parser_State.Tree);
@@ -1121,7 +1198,7 @@ package body WisiToken.Parse.LR.Parser is
case Item.Label is
when Action =>
declare
- Index : constant Base_Token_Index :=
Parser_State.Tree.Min_Terminal_Index (Item.Error_Token);
+ Index : constant Base_Token_Index :=
Parser_State.Tree.First_Shared_Terminal (Item.Error_Token);
begin
if Index = Invalid_Token_Index then
-- Error_Token is virtual
diff --git a/wisitoken-parse-lr-parser.ads b/wisitoken-parse-lr-parser.ads
index 18f476e..46626fd 100644
--- a/wisitoken-parse-lr-parser.ads
+++ b/wisitoken-parse-lr-parser.ads
@@ -5,7 +5,7 @@
-- In a child package of Parser.LR partly for historical reasons,
-- partly to allow McKenzie_Recover to be in a sibling package.
--
--- Copyright (C) 2002, 2003, 2009, 2010, 2013-2015, 2017 - 2019 Free Software
Foundation, Inc.
+-- Copyright (C) 2002, 2003, 2009, 2010, 2013-2015, 2017 - 2020 Free Software
Foundation, Inc.
--
-- This file is part of the WisiToken package.
--
@@ -141,10 +141,13 @@ package WisiToken.Parse.LR.Parser is
-- an appropriate error message.
overriding function Tree (Shared_Parser : in Parser) return
Syntax_Trees.Tree;
+ overriding function Tree_Var_Ref (Shared_Parser : aliased in out Parser)
return Syntax_Trees.Tree_Variable_Reference;
-- If there is one parser in Parsers, return its tree. Otherwise,
-- raise Parse_Error for an ambiguous parse.
- overriding procedure Execute_Actions (Parser : in out LR.Parser.Parser);
+ overriding procedure Execute_Actions
+ (Parser : in out LR.Parser.Parser;
+ Image_Augmented : in Syntax_Trees.Image_Augmented := null);
-- Call User_Data.Delete_Token on any tokens deleted by error
-- recovery, then User_Data.Reduce and the grammar semantic actions
-- on all nonterms in the syntax tree.
diff --git a/wisitoken-parse-lr-parser_lists.adb
b/wisitoken-parse-lr-parser_lists.adb
index 480e86f..553f772 100644
--- a/wisitoken-parse-lr-parser_lists.adb
+++ b/wisitoken-parse-lr-parser_lists.adb
@@ -2,7 +2,7 @@
--
-- see spec
--
--- Copyright (C) 2014 - 2019 All Rights Reserved.
+-- Copyright (C) 2014 - 2020 All Rights Reserved.
--
-- The WisiToken package is free software; you can redistribute it
-- and/or modify it under terms of the GNU General Public License as
@@ -38,7 +38,6 @@ package body WisiToken.Parse.LR.Parser_Lists is
begin
for I in 1 .. Last loop
declare
- use all type WisiToken.Syntax_Trees.Node_Index;
Item : Parser_Stack_Item renames Stack.Peek (I);
begin
Result := Result &
@@ -46,7 +45,7 @@ package body WisiToken.Parse.LR.Parser_Lists is
(if I = Stack.Depth
then ""
else
- (if Item.Token = Syntax_Trees.Invalid_Node_Index -- From
recover fast-forward
+ (if Item.Token = Invalid_Node_Index -- From recover
fast-forward
then ""
else Tree.Image (Item.Token, Descriptor) & ", ")));
end;
@@ -96,11 +95,6 @@ package body WisiToken.Parse.LR.Parser_Lists is
return Cursor.Ptr = No_Element;
end Is_Done;
- function Active_Parser_Count (Cursor : in Parser_Lists.Cursor) return
SAL.Base_Peek_Type
- is begin
- return Cursor.Elements.Length;
- end Active_Parser_Count;
-
function Label (Cursor : in Parser_Lists.Cursor) return Natural
is begin
return Parser_State_Lists.Constant_Ref (Cursor.Ptr).Label;
@@ -162,17 +156,25 @@ package body WisiToken.Parse.LR.Parser_Lists is
Terminals : in Base_Token_Arrays.Vector)
is
State : Parser_State renames Parser_State_Lists.Constant_Ref
(Current.Ptr).Element.all;
+
+ procedure Free (Cursor : in out Parser_Lists.Cursor'Class)
+ is
+ Temp : Parser_State_Lists.Cursor := Cursor.Ptr;
+ begin
+ Parser_State_Lists.Next (Cursor.Ptr);
+ Parser_State_Lists.Delete (Cursor.Elements.all, Temp);
+ end Free;
begin
if Trace_Parse > Outline then
Trace.Put_Line
(Integer'Image (Current.Label) & ": terminate (" &
Trimmed_Image (Integer (Parsers.Count) - 1) & " active)" &
": " & Message & Image
- (State.Tree.Min_Terminal_Index (State.Current_Token),
+ (State.Tree.First_Shared_Terminal (State.Current_Token),
Terminals, Trace.Descriptor.all));
end if;
- Current.Free;
+ Free (Current);
if Parsers.Count = 1 then
Parsers.First.State_Ref.Tree.Flush;
@@ -244,6 +246,7 @@ package body WisiToken.Parse.LR.Parser_Lists is
if Other.Max_Recover_Ops_Length = Current.Max_Recover_Ops_Length
then
Parsers.Terminate_Parser (Other, "duplicate state: random",
Trace, Terminals);
else
+ -- Keep the minimum ops length
if Other.Max_Recover_Ops_Length >
Current.Max_Recover_Ops_Length then
null;
else
@@ -305,37 +308,29 @@ package body WisiToken.Parse.LR.Parser_Lists is
-- override a few, to avoid copying large items like Recover.
-- We copy Recover.Enqueue_Count .. Check_Count for unit tests.
New_Item :=
- (Shared_Token => Item.Shared_Token,
- Recover_Insert_Delete => Item.Recover_Insert_Delete,
- Prev_Deleted => Item.Prev_Deleted,
- Current_Token => Item.Current_Token,
- Inc_Shared_Token => Item.Inc_Shared_Token,
- Stack => Item.Stack,
- Tree => Item.Tree,
- Recover =>
- (Enqueue_Count => Item.Recover.Enqueue_Count,
- Config_Full_Count => Item.Recover.Config_Full_Count,
- Check_Count => Item.Recover.Check_Count,
- others => <>),
- Resume_Active => Item.Resume_Active,
- Resume_Token_Goal => Item.Resume_Token_Goal,
- Conflict_During_Resume => Item.Conflict_During_Resume,
- Zombie_Token_Count => 0,
- Errors => Item.Errors,
- Label => List.Parser_Label,
- Verb => Item.Verb);
+ (Shared_Token => Item.Shared_Token,
+ Recover_Insert_Delete => Item.Recover_Insert_Delete,
+ Recover_Insert_Delete_Current =>
Item.Recover_Insert_Delete_Current,
+ Current_Token => Item.Current_Token,
+ Inc_Shared_Token => Item.Inc_Shared_Token,
+ Stack => Item.Stack,
+ Tree => Item.Tree,
+ Recover =>
+ (Enqueue_Count => Item.Recover.Enqueue_Count,
+ Config_Full_Count => Item.Recover.Config_Full_Count,
+ Check_Count => Item.Recover.Check_Count,
+ others => <>),
+ Resume_Active => Item.Resume_Active,
+ Resume_Token_Goal => Item.Resume_Token_Goal,
+ Conflict_During_Resume => Item.Conflict_During_Resume,
+ Zombie_Token_Count => 0,
+ Errors => Item.Errors,
+ Label => List.Parser_Label,
+ Verb => Item.Verb);
end;
List.Elements.Prepend (New_Item);
end Prepend_Copy;
- procedure Free (Cursor : in out Parser_Lists.Cursor'Class)
- is
- Temp : Parser_State_Lists.Cursor := Cursor.Ptr;
- begin
- Parser_State_Lists.Next (Cursor.Ptr);
- Parser_State_Lists.Delete (Cursor.Elements.all, Temp);
- end Free;
-
----------
-- stuff for iterators
@@ -369,11 +364,8 @@ package body WisiToken.Parse.LR.Parser_Lists is
return State_Access (Parser_State_Lists.Persistent_Ref (Position.Ptr));
end Persistent_State_Ref;
- type List_Access is access all List;
-
- type Iterator is new Iterator_Interfaces.Forward_Iterator with record
- Container : List_Access;
- end record;
+ type Iterator (Elements : access Parser_State_Lists.List) is new
Iterator_Interfaces.Forward_Iterator
+ with null record;
overriding function First (Object : Iterator) return Parser_Node_Access;
overriding function Next
@@ -383,7 +375,7 @@ package body WisiToken.Parse.LR.Parser_Lists is
overriding function First (Object : Iterator) return Parser_Node_Access
is begin
- return (Elements => Object.Container.Elements'Access, Ptr =>
Object.Container.Elements.First);
+ return (Elements => Object.Elements, Ptr => Object.Elements.First);
end First;
overriding function Next
@@ -398,7 +390,7 @@ package body WisiToken.Parse.LR.Parser_Lists is
function Iterate (Container : aliased in out List) return
Iterator_Interfaces.Forward_Iterator'Class
is begin
- return Iterator'(Container => Container'Access);
+ return Iterator'(Elements => Container.Elements'Access);
end Iterate;
function Has_Element (Iterator : in Parser_Node_Access) return Boolean
diff --git a/wisitoken-parse-lr-parser_lists.ads
b/wisitoken-parse-lr-parser_lists.ads
index 19aa370..6a77e6c 100644
--- a/wisitoken-parse-lr-parser_lists.ads
+++ b/wisitoken-parse-lr-parser_lists.ads
@@ -2,7 +2,7 @@
--
-- Generalized LR parser state.
--
--- Copyright (C) 2014-2015, 2017 - 2019 Free Software Foundation, Inc.
+-- Copyright (C) 2014-2015, 2017 - 2020 Free Software Foundation, Inc.
--
-- This file is part of the WisiToken package.
--
@@ -28,7 +28,7 @@ package WisiToken.Parse.LR.Parser_Lists is
type Parser_Stack_Item is record
State : Unknown_State_Index := Unknown_State;
- Token : Syntax_Trees.Node_Index := Syntax_Trees.Invalid_Node_Index;
+ Token : Node_Index := Invalid_Node_Index;
end record;
package Parser_Stacks is new SAL.Gen_Unbounded_Definite_Stacks
(Parser_Stack_Item);
@@ -58,16 +58,19 @@ package WisiToken.Parse.LR.Parser_Lists is
Shared_Token : Base_Token_Index := Invalid_Token_Index;
-- Last token read from Shared_Parser.Terminals.
- Recover_Insert_Delete : Config_Op_Queues.Queue;
- -- Tokens in that were inserted during error recovery, or should be
- -- deleted/skipped when read. Contains only Insert and Delete ops.
- -- Used/emptied by main parse.
+ Recover_Insert_Delete : aliased Recover_Op_Arrays.Vector;
+ -- Tokens that were inserted or deleted during error recovery.
+ -- Contains only Insert and Delete ops. Filled by error recover, used
+ -- by main parse and Execute_Actions.
+ --
+ -- Not emptied between error recovery sessions, so Execute_Actions
+ -- knows about all insert/delete.
- Prev_Deleted : Recover_Token_Index_Arrays.Vector;
- -- Tokens deleted by previous error recovery; don't process in new
- -- error recovery.
+ Recover_Insert_Delete_Current : Recover_Op_Arrays.Extended_Index :=
Recover_Op_Arrays.No_Index;
+ -- Next item in Recover_Insert_Delete to be processed by main parse;
+ -- No_Index if all done.
- Current_Token : Syntax_Trees.Node_Index :=
Syntax_Trees.Invalid_Node_Index;
+ Current_Token : Node_Index := Invalid_Node_Index;
-- Current terminal, in Tree
Inc_Shared_Token : Boolean := True;
@@ -76,7 +79,7 @@ package WisiToken.Parse.LR.Parser_Lists is
-- There is no need to use a branched stack; max stack length is
-- proportional to source text nesting depth, not source text length.
- Tree : Syntax_Trees.Tree;
+ Tree : aliased Syntax_Trees.Tree;
-- We use a branched tree to avoid copying large trees for each
-- spawned parser; tree size is proportional to source text size. In
-- normal parsing, parallel parsers are short-lived; they each process
@@ -120,15 +123,12 @@ package WisiToken.Parse.LR.Parser_Lists is
function Count (List : in Parser_Lists.List) return SAL.Base_Peek_Type;
- type Cursor is tagged private;
+ type Cursor (<>) is tagged private;
function First (List : aliased in out Parser_Lists.List'Class) return
Cursor;
procedure Next (Cursor : in out Parser_Lists.Cursor);
function Is_Done (Cursor : in Parser_Lists.Cursor) return Boolean;
function Has_Element (Cursor : in Parser_Lists.Cursor) return Boolean is
(not Is_Done (Cursor));
-
- function Active_Parser_Count (Cursor : in Parser_Lists.Cursor) return
SAL.Base_Peek_Type;
-
function Label (Cursor : in Parser_Lists.Cursor) return Natural;
function Total_Recover_Cost (Cursor : in Parser_Lists.Cursor) return
Integer;
function Max_Recover_Ops_Length (Cursor : in Parser_Lists.Cursor) return
Ada.Containers.Count_Type;
@@ -161,16 +161,19 @@ package WisiToken.Parse.LR.Parser_Lists is
type State_Reference (Element : not null access Parser_State) is null record
with Implicit_Dereference => Element;
- function State_Ref (Position : in Cursor) return State_Reference;
+ function State_Ref (Position : in Cursor) return State_Reference
+ with Pre => Has_Element (Position);
-- Direct access to visible components of Parser_State
- function First_State_Ref (List : in Parser_Lists.List'Class) return
State_Reference;
+ function First_State_Ref (List : in Parser_Lists.List'Class) return
State_Reference
+ with Pre => List.Count > 0;
-- Direct access to visible components of first parser's Parser_State
type Constant_State_Reference (Element : not null access constant
Parser_State) is null record
with Implicit_Dereference => Element;
- function First_Constant_State_Ref (List : in Parser_Lists.List'Class)
return Constant_State_Reference;
+ function First_Constant_State_Ref (List : in Parser_Lists.List'Class)
return Constant_State_Reference
+ with Pre => List.Count > 0;
-- Direct access to visible components of first parser's Parser_State
procedure Put_Top_10 (Trace : in out WisiToken.Trace'Class; Cursor : in
Parser_Lists.Cursor);
@@ -182,10 +185,6 @@ package WisiToken.Parse.LR.Parser_Lists is
--
-- Copy.Recover is set to default.
- procedure Free (Cursor : in out Parser_Lists.Cursor'Class);
- -- Delete the Cursor parser. It will not appear in future
- -- iterations. On return, Cursor points to next parser, or none.
-
----------
-- Stuff for iterators, to allow
-- 'for Parser of Parsers loop'
@@ -214,7 +213,7 @@ package WisiToken.Parse.LR.Parser_Lists is
-- ... Current_Parser.<visible parser_state component> ...
-- end loop;
- type Parser_Node_Access is private;
+ type Parser_Node_Access (<>) is private;
function To_Cursor (Ptr : in Parser_Node_Access) return Cursor;
@@ -262,14 +261,14 @@ private
Parser_Label : Natural; -- label of last added parser.
end record;
- type Cursor is tagged record
- Elements : access Parser_State_Lists.List;
- Ptr : Parser_State_Lists.Cursor;
+ type Cursor (Elements : access Parser_State_Lists.List) is tagged
+ record
+ Ptr : Parser_State_Lists.Cursor;
end record;
- type Parser_Node_Access is record
- Elements : access Parser_State_Lists.List;
- Ptr : Parser_State_Lists.Cursor;
+ type Parser_Node_Access (Elements : access Parser_State_Lists.List) is
+ record
+ Ptr : Parser_State_Lists.Cursor;
end record;
end WisiToken.Parse.LR.Parser_Lists;
diff --git a/wisitoken-parse-lr-parser_no_recover.adb
b/wisitoken-parse-lr-parser_no_recover.adb
index 7943aab..5e23b7c 100644
--- a/wisitoken-parse-lr-parser_no_recover.adb
+++ b/wisitoken-parse-lr-parser_no_recover.adb
@@ -2,7 +2,7 @@
--
-- See spec.
--
--- Copyright (C) 2002 - 2005, 2008 - 2015, 2017 - 2019 Free Software
Foundation, Inc.
+-- Copyright (C) 2002 - 2005, 2008 - 2015, 2017 - 2020 Free Software
Foundation, Inc.
--
-- This file is part of the WisiToken package.
--
@@ -33,11 +33,11 @@ package body WisiToken.Parse.LR.Parser_No_Recover is
procedure Reduce_Stack_1
(Current_Parser : in Parser_Lists.Cursor;
Action : in Reduce_Action_Rec;
- Nonterm : out WisiToken.Syntax_Trees.Valid_Node_Index;
+ Nonterm : out Valid_Node_Index;
Trace : in out WisiToken.Trace'Class)
is
Parser_State : Parser_Lists.Parser_State renames
Current_Parser.State_Ref.Element.all;
- Children_Tree : Syntax_Trees.Valid_Node_Index_Array (1 ..
SAL.Base_Peek_Type (Action.Token_Count));
+ Children_Tree : Valid_Node_Index_Array (1 .. SAL.Base_Peek_Type
(Action.Token_Count));
-- for Set_Children.
begin
for I in reverse Children_Tree'Range loop
@@ -60,7 +60,7 @@ package body WisiToken.Parse.LR.Parser_No_Recover is
is
Parser_State : Parser_Lists.Parser_State renames
Current_Parser.State_Ref;
Trace : WisiToken.Trace'Class renames Shared_Parser.Trace.all;
- Nonterm : WisiToken.Syntax_Trees.Valid_Node_Index;
+ Nonterm : Valid_Node_Index;
begin
if Trace_Parse > Detail then
Trace.Put
@@ -233,9 +233,8 @@ package body WisiToken.Parse.LR.Parser_No_Recover is
Trace : WisiToken.Trace'Class renames Shared_Parser.Trace.all;
- Current_Verb : All_Parse_Action_Verbs;
- Current_Parser : Parser_Lists.Cursor;
- Action : Parse_Action_Node_Ptr;
+ Current_Verb : All_Parse_Action_Verbs;
+ Action : Parse_Action_Node_Ptr;
procedure Check_Error (Check_Parser : in out Parser_Lists.Cursor)
is begin
@@ -260,13 +259,13 @@ package body WisiToken.Parse.LR.Parser_No_Recover is
Shared_Parser.User_Data.Reset;
end if;
- Shared_Parser.Lex_All;
-
Shared_Parser.Shared_Tree.Clear;
Shared_Parser.Parsers := Parser_Lists.New_List
(Shared_Tree => Shared_Parser.Shared_Tree'Unchecked_Access);
+ Shared_Parser.Lex_All;
+
Shared_Parser.Parsers.First.State_Ref.Stack.Push
((Shared_Parser.Table.State_First, others => <>));
Main_Loop :
@@ -281,8 +280,8 @@ package body WisiToken.Parse.LR.Parser_No_Recover is
for Parser_State of Shared_Parser.Parsers loop
Parser_State.Shared_Token := Parser_State.Shared_Token + 1;
- Parser_State.Current_Token := Parser_State.Tree.Add_Terminal
- (Parser_State.Shared_Token, Shared_Parser.Terminals);
+ Parser_State.Current_Token := Shared_Parser.Terminals
+ (Parser_State.Shared_Token).Tree_Index;
end loop;
when Accept_It =>
@@ -326,100 +325,104 @@ package body WisiToken.Parse.LR.Parser_No_Recover is
-- We don't use 'for Parser_State of Parsers loop' here,
-- because terminate on error and spawn on conflict require
-- changing the parser list.
- Current_Parser := Shared_Parser.Parsers.First;
- loop
- exit when Current_Parser.Is_Done;
-
- if Shared_Parser.Terminate_Same_State and
- Current_Verb = Shift
- then
- Shared_Parser.Parsers.Duplicate_State
- (Current_Parser, Shared_Parser.Trace.all,
Shared_Parser.Terminals);
- -- If Duplicate_State terminated Current_Parser,
Current_Parser now
- -- points to the next parser. Otherwise it is unchanged.
- end if;
-
- exit when Current_Parser.Is_Done;
-
- if Trace_Parse > Extra then
- Trace.Put_Line
- ("current_verb: " & Parse_Action_Verbs'Image (Current_Verb) &
- "," & Integer'Image (Current_Parser.Label) &
- ".verb: " & Parse_Action_Verbs'Image
(Current_Parser.Verb));
- end if;
+ declare
+ Current_Parser : Parser_Lists.Cursor :=
Shared_Parser.Parsers.First;
+ begin
+ loop
+ exit when Current_Parser.Is_Done;
+
+ if Shared_Parser.Terminate_Same_State and
+ Current_Verb = Shift
+ then
+ Shared_Parser.Parsers.Duplicate_State
+ (Current_Parser, Shared_Parser.Trace.all,
Shared_Parser.Terminals);
+ -- If Duplicate_State terminated Current_Parser,
Current_Parser now
+ -- points to the next parser. Otherwise it is unchanged.
+ end if;
- -- Each branch of the following 'if' calls either
Current_Parser.Free
- -- (which advances to the next parser) or Current_Parser.Next.
+ exit when Current_Parser.Is_Done;
- if Current_Parser.Verb = Current_Verb then
if Trace_Parse > Extra then
- Parser_Lists.Put_Top_10 (Trace, Current_Parser);
+ Trace.Put_Line
+ ("current_verb: " & Parse_Action_Verbs'Image
(Current_Verb) &
+ "," & Integer'Image (Current_Parser.Label) &
+ ".verb: " & Parse_Action_Verbs'Image
(Current_Parser.Verb));
end if;
- declare
- State : Parser_Lists.Parser_State renames
Current_Parser.State_Ref.Element.all;
- begin
- Action := Action_For
- (Table => Shared_Parser.Table.all,
- State => State.Stack.Peek.State,
- ID => State.Tree.ID (State.Current_Token));
- end;
+ -- Each branch of the following 'if' calls either
Current_Parser.Free
+ -- (which advances to the next parser) or Current_Parser.Next.
- declare
- Conflict : Parse_Action_Node_Ptr := Action.Next;
- begin
- loop
- exit when Conflict = null;
- -- Spawn a new parser (before modifying Current_Parser
stack).
-
- if Shared_Parser.Parsers.Count =
Shared_Parser.Max_Parallel then
- declare
- Parser_State : Parser_Lists.Parser_State renames
Current_Parser.State_Ref;
- Token : Base_Token renames Shared_Parser.Terminals
(Parser_State.Shared_Token);
- begin
- raise WisiToken.Parse_Error with Error_Message
- (Shared_Parser.Lexer.File_Name, Token.Line,
Token.Column,
- ": too many parallel parsers required in grammar
state" &
- State_Index'Image
(Parser_State.Stack.Peek.State) &
- "; simplify grammar, or increase max-parallel
(" &
- SAL.Base_Peek_Type'Image
(Shared_Parser.Max_Parallel) & ")");
- end;
- else
- if Trace_Parse > Outline then
+ if Current_Parser.Verb = Current_Verb then
+ if Trace_Parse > Extra then
+ Parser_Lists.Put_Top_10 (Trace, Current_Parser);
+ end if;
+
+ declare
+ State : Parser_Lists.Parser_State renames
Current_Parser.State_Ref.Element.all;
+ begin
+ Action := Action_For
+ (Table => Shared_Parser.Table.all,
+ State => State.Stack.Peek.State,
+ ID => State.Tree.ID (State.Current_Token));
+ end;
+
+ declare
+ Conflict : Parse_Action_Node_Ptr := Action.Next;
+ begin
+ loop
+ exit when Conflict = null;
+ -- Spawn a new parser (before modifying
Current_Parser stack).
+
+ if Shared_Parser.Parsers.Count =
Shared_Parser.Max_Parallel then
declare
Parser_State : Parser_Lists.Parser_State renames
Current_Parser.State_Ref;
+ Token : Base_Token renames
Shared_Parser.Terminals (Parser_State.Shared_Token);
begin
- Trace.Put_Line
- (Integer'Image (Current_Parser.Label) & ": " &
- Trimmed_Image
(Parser_State.Stack.Peek.State) & ": " &
- Parser_State.Tree.Image
(Parser_State.Current_Token, Trace.Descriptor.all) & " : " &
- "spawn" & Integer'Image
(Shared_Parser.Parsers.Last_Label + 1) & ", (" &
- Trimmed_Image (1 + Integer
(Shared_Parser.Parsers.Count)) & " active)");
+ raise WisiToken.Parse_Error with Error_Message
+ (Shared_Parser.Lexer.File_Name, Token.Line,
Token.Column,
+ ": too many parallel parsers required in
grammar state" &
+ State_Index'Image
(Parser_State.Stack.Peek.State) &
+ "; simplify grammar, or increase
max-parallel (" &
+ SAL.Base_Peek_Type'Image
(Shared_Parser.Max_Parallel) & ")");
end;
- end if;
-
- Shared_Parser.Parsers.Prepend_Copy (Current_Parser);
- Do_Action (Conflict.Item, Shared_Parser.Parsers.First,
Shared_Parser);
+ else
+ if Trace_Parse > Outline then
+ declare
+ Parser_State : Parser_Lists.Parser_State
renames Current_Parser.State_Ref;
+ begin
+ Trace.Put_Line
+ (Integer'Image (Current_Parser.Label) & ":
" &
+ Trimmed_Image
(Parser_State.Stack.Peek.State) & ": " &
+ Parser_State.Tree.Image
+ (Parser_State.Current_Token,
Trace.Descriptor.all) & " : " &
+ "spawn" & Integer'Image
(Shared_Parser.Parsers.Last_Label + 1) & ", (" &
+ Trimmed_Image (1 + Integer
(Shared_Parser.Parsers.Count)) & " active)");
+ end;
+ end if;
+
+ Shared_Parser.Parsers.Prepend_Copy (Current_Parser);
+ Do_Action (Conflict.Item,
Shared_Parser.Parsers.First, Shared_Parser);
- declare
- Temp : Parser_Lists.Cursor :=
Shared_Parser.Parsers.First;
- begin
- Check_Error (Temp);
- end;
- end if;
+ declare
+ Temp : Parser_Lists.Cursor :=
Shared_Parser.Parsers.First;
+ begin
+ Check_Error (Temp);
+ end;
+ end if;
- Conflict := Conflict.Next;
- end loop;
- end;
+ Conflict := Conflict.Next;
+ end loop;
+ end;
- Do_Action (Action.Item, Current_Parser, Shared_Parser);
- Check_Error (Current_Parser);
+ Do_Action (Action.Item, Current_Parser, Shared_Parser);
+ Check_Error (Current_Parser);
- else
- -- Current parser is waiting for others to catch up
- Current_Parser.Next;
- end if;
- end loop;
+ else
+ -- Current parser is waiting for others to catch up
+ Current_Parser.Next;
+ end if;
+ end loop;
+ end;
end loop Main_Loop;
-- We don't raise Syntax_Error for lexer errors, since they are all
@@ -427,13 +430,16 @@ package body WisiToken.Parse.LR.Parser_No_Recover is
-- character.
end Parse;
- overriding procedure Execute_Actions (Parser : in out
LR.Parser_No_Recover.Parser)
+ overriding procedure Execute_Actions
+ (Parser : in out LR.Parser_No_Recover.Parser;
+ Image_Augmented : in Syntax_Trees.Image_Augmented := null)
is
+ pragma Unreferenced (Image_Augmented);
use all type Syntax_Trees.User_Data_Access;
procedure Process_Node
(Tree : in out Syntax_Trees.Tree;
- Node : in Syntax_Trees.Valid_Node_Index)
+ Node : in Valid_Node_Index)
is
use all type Syntax_Trees.Node_Label;
begin
@@ -443,7 +449,7 @@ package body WisiToken.Parse.LR.Parser_No_Recover is
declare
use all type Syntax_Trees.Semantic_Action;
- Tree_Children : constant Syntax_Trees.Valid_Node_Index_Array :=
Tree.Children (Node);
+ Tree_Children : constant Valid_Node_Index_Array := Tree.Children
(Node);
begin
Parser.User_Data.Reduce (Tree, Node, Tree_Children);
@@ -453,7 +459,7 @@ package body WisiToken.Parse.LR.Parser_No_Recover is
exception
when E : others =>
declare
- Token : Base_Token renames Parser.Terminals
(Tree.Min_Terminal_Index (Node));
+ Token : Base_Token renames Parser.Terminals
(Tree.First_Shared_Terminal (Node));
begin
raise WisiToken.Parse_Error with Error_Message
(Parser.Lexer.File_Name, Token.Line, Token.Column,
@@ -474,6 +480,7 @@ package body WisiToken.Parse.LR.Parser_No_Recover is
declare
Parser_State : Parser_Lists.Parser_State renames
Parser.Parsers.First_State_Ref.Element.all;
begin
+ Parser_State.Tree.Set_Parents;
Parser.User_Data.Initialize_Actions (Parser_State.Tree);
Parser_State.Tree.Process_Tree (Process_Node'Access);
end;
@@ -489,6 +496,18 @@ package body WisiToken.Parse.LR.Parser_No_Recover is
end if;
end Tree;
+ overriding
+ function Tree_Var_Ref
+ (Parser : aliased in out LR.Parser_No_Recover.Parser)
+ return Syntax_Trees.Tree_Variable_Reference
+ is begin
+ if Parser.Parsers.Count > 1 then
+ raise WisiToken.Parse_Error with "ambigous parse";
+ else
+ return (Element => Parser.Parsers.First_State_Ref.Tree'Access);
+ end if;
+ end Tree_Var_Ref;
+
overriding function Any_Errors (Parser : in LR.Parser_No_Recover.Parser)
return Boolean
is
use all type Ada.Containers.Count_Type;
@@ -515,7 +534,7 @@ package body WisiToken.Parse.LR.Parser_No_Recover is
case Item.Label is
when Action =>
declare
- Token : Base_Token renames Parser.Terminals
(Parser_State.Tree.Min_Terminal_Index (Item.Error_Token));
+ Token : Base_Token renames Parser.Terminals
(Parser_State.Tree.First_Shared_Terminal (Item.Error_Token));
begin
Put_Line
(Current_Error,
diff --git a/wisitoken-parse-lr-parser_no_recover.ads
b/wisitoken-parse-lr-parser_no_recover.ads
index 33665d7..5e630d2 100644
--- a/wisitoken-parse-lr-parser_no_recover.ads
+++ b/wisitoken-parse-lr-parser_no_recover.ads
@@ -6,7 +6,7 @@
-- to not depend on wisitoken-lr-mckenzie_recover, so editing that
-- does not cause everything to be regenerated/compiled.
--
--- Copyright (C) 2002, 2003, 2009, 2010, 2013 - 2015, 2017 - 2019 Free
Software Foundation, Inc.
+-- Copyright (C) 2002, 2003, 2009, 2010, 2013 - 2015, 2017 - 2020 Free
Software Foundation, Inc.
--
-- This file is part of the WisiToken package.
--
@@ -73,13 +73,20 @@ package WisiToken.Parse.LR.Parser_No_Recover is
overriding function Tree (Parser : in LR.Parser_No_Recover.Parser) return
Syntax_Trees.Tree;
+ overriding
+ function Tree_Var_Ref
+ (Parser : aliased in out LR.Parser_No_Recover.Parser)
+ return Syntax_Trees.Tree_Variable_Reference;
+
overriding function Any_Errors (Parser : in LR.Parser_No_Recover.Parser)
return Boolean;
overriding procedure Put_Errors (Parser : in LR.Parser_No_Recover.Parser);
-- Put user-friendly error messages from the parse to
-- Ada.Text_IO.Current_Error.
- overriding procedure Execute_Actions (Parser : in out
LR.Parser_No_Recover.Parser);
+ overriding procedure Execute_Actions
+ (Parser : in out LR.Parser_No_Recover.Parser;
+ Image_Augmented : in Syntax_Trees.Image_Augmented := null);
-- Execute the grammar actions in Parser.
end WisiToken.Parse.LR.Parser_No_Recover;
diff --git a/wisitoken-parse-lr.adb b/wisitoken-parse-lr.adb
index 0ec3aa9..27fe85d 100644
--- a/wisitoken-parse-lr.adb
+++ b/wisitoken-parse-lr.adb
@@ -2,7 +2,7 @@
--
-- See spec.
--
--- Copyright (C) 2013-2015, 2017, 2018, 2019 Free Software Foundation, Inc.
+-- Copyright (C) 2013-2015, 2017 - 2020 Free Software Foundation, Inc.
--
-- This file is part of the WisiToken package.
--
@@ -156,18 +156,22 @@ package body WisiToken.Parse.LR is
function Strict_Image (Item : in Kernel_Info) return String
is begin
- return "(" & Trimmed_Image (Item.LHS) & "," & Token_ID'Image
(Item.Before_Dot) & "," &
- Ada.Containers.Count_Type'Image (Item.Length_After_Dot) & ", " &
- (if Item.Recursive then "True" else "False") & ")";
+ return "(" & Image (Item.Production) & ", " &
+ Item.Before_Dot'Image & ", " &
+ Item.Length_After_Dot'Image & ", " &
+ Image (Item.Reduce_Production) & ", " &
+ Item.Reduce_Count'Image & ")";
end Strict_Image;
function Strict_Image (Item : in Minimal_Action) return String
is begin
case Item.Verb is
when Shift =>
- return "(Shift," & Token_ID'Image (Item.ID) & "," & State_Index'Image
(Item.State) & ")";
+ return "(Shift, " & Image (Item.Production) & ", " &
+ Token_ID'Image (Item.ID) & "," & State_Index'Image (Item.State) &
")";
+
when Reduce =>
- return "(Reduce," & Token_ID'Image (Item.Nonterm) & "," &
+ return "(Reduce, " & Image (Item.Production) & ", " &
Ada.Containers.Count_Type'Image (Item.Token_Count) & ")";
end case;
end Strict_Image;
@@ -178,7 +182,7 @@ package body WisiToken.Parse.LR is
when Shift =>
return "Shift " & Image (Item.ID, Descriptor);
when Reduce =>
- return "Reduce to " & Image (Item.Nonterm, Descriptor);
+ return "Reduce to " & Image (Item.Production.LHS, Descriptor);
end case;
end Image;
@@ -193,11 +197,12 @@ package body WisiToken.Parse.LR is
end To_Vector;
procedure Add_Action
- (State : in out LR.Parse_State;
- Symbol : in Token_ID;
- State_Index : in WisiToken.State_Index)
+ (State : in out LR.Parse_State;
+ Symbol : in Token_ID;
+ Production : in Production_ID;
+ State_Index : in WisiToken.State_Index)
is begin
- Add (State.Action_List, Symbol, (Shift, State_Index));
+ Add (State.Action_List, Symbol, (Shift, Production, State_Index));
end Add_Action;
procedure Add_Action
@@ -227,7 +232,7 @@ package body WisiToken.Parse.LR is
Semantic_Check : in WisiToken.Semantic_Checks.Semantic_Check)
is begin
-- We assume WisiToken.BNF.Output_Ada_Common.Duplicate_Reduce is True
- -- for this state; no conflicts, all the same action.
+ -- for this state; no conflicts, all the same action, Recursive.
for Symbol of Symbols loop
Add_Action
(State, Symbol, Reduce, Production, RHS_Token_Count,
@@ -489,15 +494,16 @@ package body WisiToken.Parse.LR is
when Shift => (Verb => Shift, others => <>),
when Reduce => (Verb => Reduce, others => <>),
when Accept_It => (Verb => Accept_It, others => <>),
- when Error => (Verb => Error));
+ when Error => (Verb => Error, others => <>));
+
+ Node_J.Item.Production.LHS := Next_Token_ID;
+ Node_J.Item.Production.RHS := Next_Integer;
case Verb is
when Shift =>
Node_J.Item.State := Next_State_Index;
when Reduce | Accept_It =>
- Node_J.Item.Production.LHS := Next_Token_ID;
- Node_J.Item.Production.RHS := Next_Integer;
if Next_Boolean then
Node_J.Item.Action := Actions
(Node_J.Item.Production.LHS)(Node_J.Item.Production.RHS).Action;
@@ -569,9 +575,13 @@ package body WisiToken.Parse.LR is
State.Kernel.Set_First_Last (First, Count_Type (Last));
for I in State.Kernel.First_Index .. State.Kernel.Last_Index
loop
- State.Kernel (I).LHS := Next_Token_ID;
- State.Kernel (I).Before_Dot := Next_Token_ID;
- State.Kernel (I).Length_After_Dot := Next_Count_Type;
+ State.Kernel (I).Production.LHS := Next_Token_ID;
+ State.Kernel (I).Production.RHS := Next_Integer;
+ State.Kernel (I).Before_Dot := Next_Token_ID;
+ State.Kernel (I).Length_After_Dot := Next_Count_Type;
+ State.Kernel (I).Reduce_Production.LHS := Next_Token_ID;
+ State.Kernel (I).Reduce_Production.RHS := Next_Integer;
+ State.Kernel (I).Reduce_Count := Next_Count_Type;
end loop;
end if;
end;
@@ -590,19 +600,22 @@ package body WisiToken.Parse.LR is
for I in State.Minimal_Complete_Actions.First_Index ..
State.Minimal_Complete_Actions.Last_Index loop
declare
Verb : constant Minimal_Verbs :=
Next_Parse_Action_Verbs;
+ LHS : Token_ID;
+ RHS : Integer;
ID : Token_ID;
Action_State : State_Index;
Count : Ada.Containers.Count_Type;
begin
+ LHS := Next_Token_ID;
+ RHS := Next_Integer;
case Verb is
when Shift =>
ID := Next_Token_ID;
Action_State := Next_State_Index;
- State.Minimal_Complete_Actions.Replace_Element (I,
(Shift, ID, Action_State));
+ State.Minimal_Complete_Actions.Replace_Element (I,
(Shift, (LHS, RHS), ID, Action_State));
when Reduce =>
- ID := Next_Token_ID;
Count := Next_Count_Type;
- State.Minimal_Complete_Actions.Replace_Element (I,
(Reduce, ID, Count));
+ State.Minimal_Complete_Actions.Replace_Element (I,
(Reduce, (LHS, RHS), Count));
end case;
end;
end loop;
@@ -613,7 +626,7 @@ package body WisiToken.Parse.LR is
exit when Check_EOI;
end loop;
- Table.Error_Action := new Parse_Action_Node'((Verb => Error), null);
+ Table.Error_Action := new Parse_Action_Node'((Verb => Error, others
=> <>), null);
return Table;
end;
@@ -662,7 +675,7 @@ package body WisiToken.Parse.LR is
use Config_Op_Arrays, Config_Op_Array_Refs;
begin
for I in First_Index (Ops) .. Last_Index (Ops) loop
- if Constant_Ref (Ops, I).Op /= Op then
+ if Constant_Ref (Ops, I).Op = Op then
return False;
end if;
end loop;
@@ -725,11 +738,9 @@ package body WisiToken.Parse.LR is
end Any;
function Valid_Tree_Indices (Stack : in Recover_Stacks.Stack; Depth : in
SAL.Base_Peek_Type) return Boolean
- is
- use all type WisiToken.Syntax_Trees.Node_Index;
- begin
+ is begin
for I in 1 .. Depth loop
- if Stack.Peek (I).Tree_Index = Syntax_Trees.Invalid_Node_Index then
+ if Stack.Peek (I).Tree_Index = Invalid_Node_Index then
return False;
end if;
end loop;
diff --git a/wisitoken-parse-lr.ads b/wisitoken-parse-lr.ads
index 36f8889..da30920 100644
--- a/wisitoken-parse-lr.ads
+++ b/wisitoken-parse-lr.ads
@@ -9,7 +9,7 @@
--
-- See wisitoken.ads
--
--- Copyright (C) 2002, 2003, 2009, 2010, 2013 - 2015, 2017 - 2019 Free
Software Foundation, Inc.
+-- Copyright (C) 2002, 2003, 2009, 2010, 2013 - 2015, 2017 - 2020 Free
Software Foundation, Inc.
--
-- This file is part of the WisiToken package.
--
@@ -40,10 +40,7 @@ with SAL.Gen_Array_Image;
with SAL.Gen_Bounded_Definite_Stacks.Gen_Image_Aux;
with SAL.Gen_Bounded_Definite_Vectors.Gen_Image_Aux;
with SAL.Gen_Bounded_Definite_Vectors.Gen_Refs;
-with SAL.Gen_Bounded_Definite_Vectors_Sorted.Gen_Image_Aux;
-with SAL.Gen_Bounded_Definite_Vectors_Sorted.Gen_Refs;
with SAL.Gen_Unbounded_Definite_Min_Heaps_Fibonacci;
-with SAL.Gen_Unbounded_Definite_Queues.Gen_Image_Aux;
with SAL.Gen_Unbounded_Definite_Vectors_Sorted;
with System.Multiprocessors;
with WisiToken.Semantic_Checks;
@@ -60,17 +57,18 @@ package WisiToken.Parse.LR is
subtype Token_ID_Array_1_3 is Token_ID_Array (1 .. 3);
-- For Language_Matching_Begin_Tokens.
- type Parse_Action_Rec (Verb : Parse_Action_Verbs := Shift) is record
+ type Parse_Action_Rec (Verb : Parse_Action_Verbs := Shift) is
+ record
+ Production : Production_ID;
+ -- The production that produced this action. Used to find kernel
+ -- items during error recovery.
+
case Verb is
when Shift =>
State : State_Index := State_Index'Last;
when Reduce | Accept_It =>
- Production : Production_ID;
- -- The result nonterm and production index. Most uses need only
- -- Production.LHS; elisp code generation, and debug output, needs
- -- Production.RHS
-
+ -- Production.LHS is the result nonterm
Action : WisiToken.Syntax_Trees.Semantic_Action := null;
Check : WisiToken.Semantic_Checks.Semantic_Check := null;
Token_Count : Ada.Containers.Count_Type := 0;
@@ -89,7 +87,7 @@ package WisiToken.Parse.LR is
-- Put a line for Item in parse trace format, with no prefix.
function Equal (Left, Right : in Parse_Action_Rec) return Boolean;
- -- Ignore Action, Check.
+ -- Ignore items not used by the canonical shift-reduce algorithm.
type Parse_Action_Node;
type Parse_Action_Node_Ptr is access Parse_Action_Node;
@@ -132,10 +130,19 @@ package WisiToken.Parse.LR is
(Goto_Node, Token_ID, To_Key, Compare);
type Kernel_Info is record
- LHS : Token_ID := Token_ID'First;
+ Production : Production_ID;
Before_Dot : Token_ID := Token_ID'First;
Length_After_Dot : Ada.Containers.Count_Type := 0;
- Recursive : Boolean := False;
+
+ Reduce_Production : Production_ID;
+ Reduce_Count : Ada.Containers.Count_Type := 0;
+ -- The reduction that error recovery should do for this item if
+ -- Length_After_Dot = 0. Reduce_Production /= Production when item
+ -- after dot is nullable.
+ --
+ -- It is tempting to make Length_After_Dot a discriminant to
+ -- eliminate Reduce_* when they are not needed, but we don't have a
+ -- static value of Length_After_Dot when it is non-zero.
end record;
function Strict_Image (Item : in Kernel_Info) return String;
@@ -148,14 +155,16 @@ package WisiToken.Parse.LR is
function Image is new Kernel_Info_Arrays.Gen_Image (Strict_Image);
- type Minimal_Action (Verb : Minimal_Verbs := Shift) is record
+ type Minimal_Action (Verb : Minimal_Verbs := Shift) is
+ record
+ Production : Production_ID := Invalid_Production_ID;
+
case Verb is
when Shift =>
ID : Token_ID := Invalid_Token_ID;
State : State_Index := State_Index'Last;
when Reduce =>
- Nonterm : Token_ID;
Token_Count : Ada.Containers.Count_Type;
end case;
end record;
@@ -180,14 +189,10 @@ package WisiToken.Parse.LR is
Goto_List : Goto_Arrays.Vector;
-- The following are used in error recovery.
- Kernel : Kernel_Info_Arrays.Vector;
-
+ Kernel : Kernel_Info_Arrays.Vector;
Minimal_Complete_Actions : Minimal_Action_Arrays.Vector;
- Minimal_Complete_Actions_Recursive : Boolean := False;
-- Parse actions that will most quickly complete a production in this
- -- state. If more than one, resolved at runtime using Kernels. If
- -- Minimal_Complete_Actions_Recursive, at least one of the minimal
- -- actions is recursive; this changes the algorithm.
+ -- state. Kernel is used to reduce the number of actions.
end record;
type Parse_State_Array is array (State_Index range <>) of Parse_State;
@@ -195,6 +200,7 @@ package WisiToken.Parse.LR is
procedure Add_Action
(State : in out Parse_State;
Symbol : in Token_ID;
+ Production : in Production_ID;
State_Index : in WisiToken.State_Index);
-- Add a Shift action to tail of State action list.
@@ -419,11 +425,6 @@ package WisiToken.Parse.LR is
Ins_Token_Index : WisiToken.Base_Token_Index;
-- Ins_ID is inserted before Token_Index.
- State : Unknown_State_Index;
- Stack_Depth : SAL.Base_Peek_Type;
- -- Used in Minimal_Completion_Actions to detect cycles; only set for
- -- Insert by Minimal_Completion_Actions.
-
when Delete =>
Del_ID : Token_ID;
-- The token ID deleted.
@@ -452,8 +453,6 @@ package WisiToken.Parse.LR is
function Equal (Left : in Config_Op; Right : in Insert_Op) return Boolean;
-- Ignore state, stack_depth
- package Config_Op_Queues is new SAL.Gen_Unbounded_Definite_Queues
(Config_Op);
-
package Config_Op_Arrays is new SAL.Gen_Bounded_Definite_Vectors
(Positive_Index_Type, Config_Op, Capacity => 80);
-- Using a fixed size vector significantly speeds up
@@ -475,10 +474,7 @@ package WisiToken.Parse.LR is
when Push_Back => Image (Item.PB_ID, Descriptor) & "," &
WisiToken.Token_Index'Image (Item.PB_Token_Index),
when Insert => Image (Item.Ins_ID, Descriptor) & "," &
- WisiToken.Token_Index'Image (Item.Ins_Token_Index) &
- (if Item.State = Unknown_State or Trace_McKenzie <= Detail
then ""
- else "," & State_Index'Image (Item.State) &
- SAL.Base_Peek_Type'Image (Item.Stack_Depth)),
+ WisiToken.Token_Index'Image (Item.Ins_Token_Index),
when Delete => Image (Item.Del_ID, Descriptor) & "," &
WisiToken.Token_Index'Image (Item.Del_Token_Index))
& ")");
@@ -486,7 +482,6 @@ package WisiToken.Parse.LR is
function Image (Item : in Config_Op; Descriptor : in WisiToken.Descriptor)
return String
renames Config_Op_Image;
- function Image is new Config_Op_Queues.Gen_Image_Aux (WisiToken.Descriptor,
Image);
function Config_Op_Array_Image is new Config_Op_Arrays.Gen_Image_Aux
(WisiToken.Descriptor, Image);
function Image (Item : in Config_Op_Arrays.Vector; Descriptor : in
WisiToken.Descriptor) return String
renames Config_Op_Array_Image;
@@ -505,17 +500,51 @@ package WisiToken.Parse.LR is
function Any (Ops : aliased in Config_Op_Arrays.Vector; Op : in
Config_Op_Label) return Boolean;
-- True if Ops contains at least one Op.
- package Sorted_Insert_Delete_Arrays is new
SAL.Gen_Bounded_Definite_Vectors_Sorted
- (Insert_Delete_Op, Compare, Capacity => 80);
+ type Recover_Op (Op : Insert_Delete_Op_Label := Insert) is record
+ -- Add Ins_Tree_Node to Config_Op info, set when item is
+ -- parsed; used to create user augmented token.
+
+ case Op is
+ when Insert =>
+ Ins_ID : Token_ID := Invalid_Token_ID;
+ -- The token ID inserted.
+
+ Ins_Token_Index : Base_Token_Index := Invalid_Token_Index;
+ -- Ins_ID is inserted before Token_Index.
+
+ Ins_Tree_Node : Node_Index := Invalid_Node_Index;
+
+ when Delete =>
+ Del_ID : Token_ID;
+ -- The token ID deleted.
+
+ Del_Token_Index : Base_Token_Index;
+ -- Token at Token_Index is deleted.
+
+ end case;
+ end record;
+
+ package Recover_Op_Arrays is new SAL.Gen_Bounded_Definite_Vectors
+ (Positive_Index_Type, Recover_Op, Capacity => 80);
+
+ package Recover_Op_Array_Refs is new Recover_Op_Arrays.Gen_Refs;
- package Insert_Delete_Array_Refs is new
Sorted_Insert_Delete_Arrays.Gen_Refs;
+ function Image (Item : in Recover_Op; Descriptor : in WisiToken.Descriptor)
return String
+ is ("(" & Item.Op'Image & ", " &
+ (case Item.Op is
+ when Insert => Image (Item.Ins_ID, Descriptor) & "," &
+ Item.Ins_Token_Index'Image & "," &
+ Item.Ins_Tree_Node'Image,
+ when Delete => Image (Item.Del_ID, Descriptor) & "," &
+ Item.Del_Token_Index'Image)
+ & ")");
- function Image is new Sorted_Insert_Delete_Arrays.Gen_Image_Aux
(WisiToken.Descriptor, Image);
+ function Image is new Recover_Op_Arrays.Gen_Image_Aux
(WisiToken.Descriptor, Image);
type Recover_Stack_Item is record
- State : Unknown_State_Index;
+ State : Unknown_State_Index := Unknown_State;
- Tree_Index : Syntax_Trees.Node_Index;
+ Tree_Index : Node_Index := Invalid_Node_Index;
-- Valid if copied at recover initialize, Invalid if pushed during
-- recover.
@@ -547,7 +576,8 @@ package WisiToken.Parse.LR is
-- pushed by recover.
type Strategies is
- (Language_Fix, Minimal_Complete, Matching_Begin, Push_Back, Undo_Reduce,
Insert, Delete, String_Quote);
+ (Ignore_Error, Language_Fix, Minimal_Complete, Matching_Begin,
+ Push_Back, Undo_Reduce, Insert, Delete, String_Quote);
type Strategy_Counts is array (Strategies) of Natural;
function Image is new SAL.Gen_Array_Image (Strategies, Natural,
Strategy_Counts, Trimmed_Image);
@@ -577,7 +607,7 @@ package WisiToken.Parse.LR is
String_Quote_Checked : Line_Number_Type := Invalid_Line_Number;
-- Max line checked for missing string quote.
- Insert_Delete : aliased Sorted_Insert_Delete_Arrays.Vector;
+ Insert_Delete : aliased Config_Op_Arrays.Vector;
-- Edits to the input stream that are not yet parsed; contains only
-- Insert and Delete ops, in token_index order.
@@ -652,7 +682,7 @@ package WisiToken.Parse.LR is
case Label is
when Action =>
- Error_Token : Syntax_Trees.Valid_Node_Index; -- index into Parser.Tree
+ Error_Token : Valid_Node_Index; -- index into Parser.Tree
Expecting : Token_ID_Set (First_Terminal .. Last_Terminal);
when Check =>
diff --git a/wisitoken-parse-packrat-generated.adb
b/wisitoken-parse-packrat-generated.adb
index f5f4b16..7d73f34 100644
--- a/wisitoken-parse-packrat-generated.adb
+++ b/wisitoken-parse-packrat-generated.adb
@@ -2,7 +2,7 @@
--
-- See spec.
--
--- Copyright (C) 2018 - 2019 Free Software Foundation, Inc.
+-- Copyright (C) 2018 - 2020 Free Software Foundation, Inc.
--
-- This library is free software; you can redistribute it and/or modify it
-- under terms of the GNU General Public License as published by the Free
@@ -27,7 +27,7 @@ package body WisiToken.Parse.Packrat.Generated is
Descriptor : WisiToken.Descriptor renames Parser.Trace.Descriptor.all;
- Junk : WisiToken.Syntax_Trees.Valid_Node_Index;
+ Junk : WisiToken.Valid_Node_Index;
pragma Unreferenced (Junk);
Result : Memo_Entry;
@@ -66,6 +66,13 @@ package body WisiToken.Parse.Packrat.Generated is
return Parser.Tree;
end Tree;
+ overriding function Tree_Var_Ref
+ (Parser : aliased in out Generated.Parser)
+ return Syntax_Trees.Tree_Variable_Reference
+ is begin
+ return (Element => Parser.Tree'Access);
+ end Tree_Var_Ref;
+
overriding function Any_Errors (Parser : in Generated.Parser) return Boolean
is
use all type Ada.Containers.Count_Type;
diff --git a/wisitoken-parse-packrat-generated.ads
b/wisitoken-parse-packrat-generated.ads
index 2eddd56..4932465 100644
--- a/wisitoken-parse-packrat-generated.ads
+++ b/wisitoken-parse-packrat-generated.ads
@@ -7,7 +7,7 @@
--
-- see parent.
--
--- Copyright (C) 2018 - 2019 Free Software Foundation, Inc.
+-- Copyright (C) 2018 - 2020 Free Software Foundation, Inc.
--
-- This library is free software; you can redistribute it and/or modify it
-- under terms of the GNU General Public License as published by the Free
@@ -39,7 +39,7 @@ package WisiToken.Parse.Packrat.Generated is
null;
when Success =>
- Result : aliased WisiToken.Syntax_Trees.Valid_Node_Index;
+ Result : aliased Valid_Node_Index;
Last_Token : Base_Token_Index; -- FIXME: change to Last_Pos
@@ -67,6 +67,9 @@ package WisiToken.Parse.Packrat.Generated is
overriding procedure Parse (Parser : aliased in out Generated.Parser);
overriding function Tree (Parser : in Generated.Parser) return
Syntax_Trees.Tree;
+ overriding function Tree_Var_Ref
+ (Parser : aliased in out Generated.Parser)
+ return Syntax_Trees.Tree_Variable_Reference;
overriding function Any_Errors (Parser : in Generated.Parser) return
Boolean;
overriding procedure Put_Errors (Parser : in Generated.Parser);
diff --git a/wisitoken-parse-packrat-procedural.adb
b/wisitoken-parse-packrat-procedural.adb
index 97f71ff..44ab122 100644
--- a/wisitoken-parse-packrat-procedural.adb
+++ b/wisitoken-parse-packrat-procedural.adb
@@ -2,7 +2,7 @@
--
-- See spec.
--
--- Copyright (C) 2018 - 2019 Free Software Foundation, Inc.
+-- Copyright (C) 2018 - 2020 Free Software Foundation, Inc.
--
-- This library is free software; you can redistribute it and/or modify it
-- under terms of the GNU General Public License as published by the Free
@@ -60,12 +60,12 @@ package body WisiToken.Parse.Packrat.Procedural is
Result => Parser.Tree.Add_Nonterm
(Production => (R, RHS_Index),
Action => RHS.Action,
- Children => (1 .. 0 =>
Syntax_Trees.Invalid_Node_Index),
+ Children => (1 .. 0 => Invalid_Node_Index),
Default_Virtual => False),
Last_Pos => Pos);
else
declare
- Children : Syntax_Trees.Valid_Node_Index_Array
+ Children : Valid_Node_Index_Array
(SAL.Base_Peek_Type (RHS.Tokens.First_Index) ..
SAL.Base_Peek_Type (RHS.Tokens.Last_Index));
begin
for I in RHS.Tokens.First_Index .. RHS.Tokens.Last_Index loop
@@ -213,7 +213,7 @@ package body WisiToken.Parse.Packrat.Procedural is
is
Descriptor : WisiToken.Descriptor renames Parser.Trace.Descriptor.all;
- Junk : WisiToken.Syntax_Trees.Valid_Node_Index;
+ Junk : Valid_Node_Index;
pragma Unreferenced (Junk);
Result : Memo_Entry;
@@ -250,4 +250,11 @@ package body WisiToken.Parse.Packrat.Procedural is
return Parser.Tree;
end Tree;
+ overriding function Tree_Var_Ref
+ (Parser : aliased in out Procedural.Parser)
+ return Syntax_Trees.Tree_Variable_Reference
+ is begin
+ return (Element => Parser.Tree'Access);
+ end Tree_Var_Ref;
+
end WisiToken.Parse.Packrat.Procedural;
diff --git a/wisitoken-parse-packrat-procedural.ads
b/wisitoken-parse-packrat-procedural.ads
index 107fead..ff04837 100644
--- a/wisitoken-parse-packrat-procedural.ads
+++ b/wisitoken-parse-packrat-procedural.ads
@@ -9,7 +9,7 @@
--
-- See parent.
--
--- Copyright (C) 2018 - 2019 Free Software Foundation, Inc.
+-- Copyright (C) 2018 - 2020 Free Software Foundation, Inc.
--
-- This library is free software; you can redistribute it and/or modify it
-- under terms of the GNU General Public License as published by the Free
@@ -43,7 +43,7 @@ package WisiToken.Parse.Packrat.Procedural is
null;
when Success =>
- Result : WisiToken.Syntax_Trees.Valid_Node_Index;
+ Result : WisiToken.Valid_Node_Index;
Last_Pos : Base_Token_Index;
end case;
@@ -72,6 +72,9 @@ package WisiToken.Parse.Packrat.Procedural is
overriding procedure Parse (Parser : aliased in out Procedural.Parser);
overriding function Tree (Parser : in Procedural.Parser) return
Syntax_Trees.Tree;
+ overriding function Tree_Var_Ref
+ (Parser : aliased in out Procedural.Parser)
+ return Syntax_Trees.Tree_Variable_Reference;
overriding function Any_Errors (Parser : in Procedural.Parser) return
Boolean
is (False);
diff --git a/wisitoken-parse-packrat.adb b/wisitoken-parse-packrat.adb
index 14fd2bb..46ea1e9 100644
--- a/wisitoken-parse-packrat.adb
+++ b/wisitoken-parse-packrat.adb
@@ -2,7 +2,7 @@
--
-- See spec.
--
--- Copyright (C) 2018 Free Software Foundation, Inc.
+-- Copyright (C) 2018, 2020 Free Software Foundation, Inc.
--
-- This library is free software; you can redistribute it and/or modify it
-- under terms of the GNU General Public License as published by the Free
@@ -19,13 +19,16 @@ pragma License (Modified_GPL);
package body WisiToken.Parse.Packrat is
- overriding procedure Execute_Actions (Parser : in out Packrat.Parser)
+ overriding
+ procedure Execute_Actions
+ (Parser : in out Packrat.Parser;
+ Image_Augmented : in Syntax_Trees.Image_Augmented := null)
is
Descriptor : WisiToken.Descriptor renames Parser.Trace.Descriptor.all;
procedure Process_Node
(Tree : in out Syntax_Trees.Tree;
- Node : in Syntax_Trees.Valid_Node_Index)
+ Node : in Valid_Node_Index)
is
use all type Syntax_Trees.Node_Label;
begin
@@ -35,7 +38,7 @@ package body WisiToken.Parse.Packrat is
declare
use all type Syntax_Trees.Semantic_Action;
- Tree_Children : constant Syntax_Trees.Valid_Node_Index_Array :=
Tree.Children (Node);
+ Tree_Children : constant Valid_Node_Index_Array := Tree.Children
(Node);
begin
Parser.User_Data.Reduce (Tree, Node, Tree_Children);
@@ -47,6 +50,10 @@ package body WisiToken.Parse.Packrat is
begin
if Trace_Action > Outline then
+ if Trace_Action > Extra then
+ Parser.Tree.Print_Tree (Descriptor, Parser.Tree.Root,
Image_Augmented);
+ Parser.Trace.New_Line;
+ end if;
Parser.Trace.Put_Line ("root node: " & Parser.Tree.Image
(Parser.Tree.Root, Descriptor));
end if;
diff --git a/wisitoken-parse-packrat.ads b/wisitoken-parse-packrat.ads
index 40eeba0..9c0421f 100644
--- a/wisitoken-parse-packrat.ads
+++ b/wisitoken-parse-packrat.ads
@@ -14,7 +14,7 @@
-- [warth 2008] Warth, A., Douglass, J.R. and Millstein, T.D., 2008. Packrat
-- parsers can support left recursion. PEPM, 8, pp.103-110.
--
--- Copyright (C) 2018 Free Software Foundation, Inc.
+-- Copyright (C) 2018, 2020 Free Software Foundation, Inc.
--
-- This library is free software; you can redistribute it and/or modify it
-- under terms of the GNU General Public License as published by the Free
@@ -47,17 +47,18 @@ pragma License (Modified_GPL);
with WisiToken.Syntax_Trees;
package WisiToken.Parse.Packrat is
- function Tree_Index (Terminal_Index : in Token_Index) return
Syntax_Trees.Valid_Node_Index
- is (Syntax_Trees.Valid_Node_Index (Terminal_Index));
+ function Tree_Index (Terminal_Index : in Token_Index) return
Valid_Node_Index
+ is (Valid_Node_Index (Terminal_Index));
-- All tokens are read and entered into the syntax tree before any
-- nonterms are reduced, so the mapping from Terminals token_index to
-- Tree node_index is identity.
+ -- FIXME: use Terminals (Terminal_Index).Tree_Index
type Parser is abstract new Base_Parser with record
-- Dynamic parsing data
Base_Tree : aliased WisiToken.Syntax_Trees.Base_Tree;
- Tree : WisiToken.Syntax_Trees.Tree;
+ Tree : aliased WisiToken.Syntax_Trees.Tree;
-- FIXME: Current we only need Base_Tree for Execute_Actions, except
-- that Syntax_Trees only declares the needed operations on Tree. But
-- we may need more trees for error recovery; if not, fix
@@ -66,6 +67,9 @@ package WisiToken.Parse.Packrat is
end record;
- overriding procedure Execute_Actions (Parser : in out Packrat.Parser);
+ overriding
+ procedure Execute_Actions
+ (Parser : in out Packrat.Parser;
+ Image_Augmented : in Syntax_Trees.Image_Augmented := null);
end WisiToken.Parse.Packrat;
diff --git a/wisitoken-parse.adb b/wisitoken-parse.adb
index 3685b4e..535c423 100644
--- a/wisitoken-parse.adb
+++ b/wisitoken-parse.adb
@@ -2,7 +2,7 @@
--
-- See spec.
--
--- Copyright (C) 2018 - 2019 Free Software Foundation, Inc.
+-- Copyright (C) 2018 - 2020 Free Software Foundation, Inc.
--
-- This library is free software; you can redistribute it and/or modify it
-- under terms of the GNU General Public License as published by the Free
@@ -19,7 +19,7 @@ pragma License (Modified_GPL);
package body WisiToken.Parse is
- function Next_Grammar_Token (Parser : in out Base_Parser) return Token_ID
+ function Next_Grammar_Token (Parser : in out Base_Parser'Class) return
Token_ID
is
use all type Ada.Containers.Count_Type;
use all type Syntax_Trees.User_Data_Access;
@@ -32,10 +32,6 @@ package body WisiToken.Parse is
-- We don't handle Error until later; we assume it was recovered.
- if Parser.User_Data /= null then
- Parser.User_Data.Lexer_To_Augmented (Token, Parser.Lexer);
- end if;
-
if Token.Line /= Invalid_Line_Number then
-- Some lexers don't support line numbers.
if Parser.Lexer.First then
@@ -57,9 +53,28 @@ package body WisiToken.Parse is
Parser.Trace.Put_Line (Image (Token, Parser.Trace.Descriptor.all));
end if;
- exit when Token.ID >= Parser.Trace.Descriptor.First_Terminal;
+ if Token.ID >= Parser.Trace.Descriptor.First_Terminal then
+
+ Parser.Terminals.Append (Token);
+
+ -- We create the syntax tree node here, so Lexer_To_Augmented can
+ -- store augmented data in it.
+ Parser.Terminals (Parser.Terminals.Last_Index).Tree_Index :=
Parser.Tree_Var_Ref.Add_Terminal
+ (Parser.Terminals.Last_Index, Parser.Terminals);
+
+ if Parser.User_Data /= null then
+ Parser.User_Data.Lexer_To_Augmented
+ (Parser.Tree_Var_Ref, Parser.Terminals
(Parser.Terminals.Last_Index), Parser.Lexer);
+ end if;
+
+ exit;
+ else
+ -- non-grammar; not in syntax tree
+ if Parser.User_Data /= null then
+ Parser.User_Data.Lexer_To_Augmented (Parser.Tree_Var_Ref,
Token, Parser.Lexer);
+ end if;
+ end if;
end loop;
- Parser.Terminals.Append (Token);
if Error then
declare
@@ -74,7 +89,7 @@ package body WisiToken.Parse is
return Token.ID;
end Next_Grammar_Token;
- procedure Lex_All (Parser : in out Base_Parser)
+ procedure Lex_All (Parser : in out Base_Parser'Class)
is
EOF_ID : constant Token_ID := Parser.Trace.Descriptor.EOI_ID;
begin
diff --git a/wisitoken-parse.ads b/wisitoken-parse.ads
index edecb90..1493658 100644
--- a/wisitoken-parse.ads
+++ b/wisitoken-parse.ads
@@ -2,7 +2,7 @@
--
-- Subprograms common to more than one parser, higher-level than in
wisitoken.ads
--
--- Copyright (C) 2018 - 2019 Free Software Foundation, Inc.
+-- Copyright (C) 2018 - 2020 Free Software Foundation, Inc.
--
-- This library is free software; you can redistribute it and/or modify it
-- under terms of the GNU General Public License as published by the Free
@@ -35,19 +35,19 @@ package WisiToken.Parse is
-- if the only token on line I is a non_grammar token (ie a comment,
-- or a newline for a blank line), Line_Begin_Token (I) is the last
-- grammar token on the previous non-blank line. If Line (I) is a
- -- non-first line in a multi-line token, Line_Begin_Token (I) is
- -- Invalid_Token_Index.
+ -- non-first line in a multi-line terminal token, Line_Begin_Token
+ -- (I) is Invalid_Token_Index.
end record;
-- Common to all parsers. Finalize should free any allocated objects.
- function Next_Grammar_Token (Parser : in out Base_Parser) return Token_ID;
+ function Next_Grammar_Token (Parser : in out Base_Parser'Class) return
Token_ID;
-- Get next token from Lexer, call User_Data.Lexer_To_Augmented. If
-- it is a grammar token, store in Terminals and return its id.
-- Otherwise, repeat.
--
-- Propagates Fatal_Error from Lexer.
- procedure Lex_All (Parser : in out Base_Parser);
+ procedure Lex_All (Parser : in out Base_Parser'Class);
-- Clear Terminals, Line_Begin_Token; reset User_Data. Then call
-- Next_Grammar_Token repeatedly until EOF_ID is returned.
--
@@ -67,12 +67,18 @@ package WisiToken.Parse is
function Tree (Parser : in Base_Parser) return Syntax_Trees.Tree is
abstract;
-- Return the syntax tree resulting from the parse.
+ function Tree_Var_Ref (Parser : aliased in out Base_Parser) return
Syntax_Trees.Tree_Variable_Reference is abstract;
+ -- Return a writable reference to the syntax tree resulting from the parse.
+
function Any_Errors (Parser : in Base_Parser) return Boolean is abstract;
procedure Put_Errors (Parser : in Base_Parser) is abstract;
-- Output error messages to Ada.Text_IO.Current_Error.
- procedure Execute_Actions (Parser : in out Base_Parser) is abstract;
+ procedure Execute_Actions
+ (Parser : in out Base_Parser;
+ Image_Augmented : in Syntax_Trees.Image_Augmented := null)
+ is abstract;
-- Execute all actions in Parser.Tree.
end WisiToken.Parse;
diff --git a/wisitoken-parse_table-mode.el b/wisitoken-parse_table-mode.el
index 13a727c..e864ab0 100644
--- a/wisitoken-parse_table-mode.el
+++ b/wisitoken-parse_table-mode.el
@@ -1,6 +1,6 @@
;; wisitoken-parse_table-mode.el --- For navigating in a parse table as output
by wisitoken-bnf-generate. -*- lexical-binding:t -*-
;;
-;; Copyright (C) 2017 - 2019 Free Software Foundation, Inc.
+;; Copyright (C) 2017 - 2020 Free Software Foundation, Inc.
;;
;; Author: Stephen Leake <stephen_leake@stephe-leake.org>
;; Maintainer: Stephen Leake <stephen_leake@stephe-leake.org>
@@ -43,22 +43,20 @@
;;
;; - 'reduce n tokens to <nonterminal> <prod_id>'
;; => return 'prod_id: name'
- (save-excursion
- (cond
- ((save-excursion
- (end-of-line)
- ;; "go to" for bison output
- (or (looking-back "go ?to state \\([0-9]+\\),?"
(line-beginning-position))
- (looking-back "( \\([0-9]+\\))" (line-beginning-position))))
- (match-string 1))
+ (cond
+ ((save-excursion
+ (beginning-of-line)
+ ;; "go to" for bison output
+ (search-forward-regexp "go ?to state \\([0-9]+\\)" (line-end-position)
t))
+ (match-string 1))
- ((save-excursion
- (back-to-indentation)
- (looking-at "[a-zA-Z_]+ + => reduce [0-9]+ tokens to \\([a-z0-9_]+\\)
\\([0-9.]+\\)"))
- (concat (match-string 2) ": " (match-string 1)))
+ ((save-excursion
+ (beginning-of-line)
+ (search-forward-regexp "reduce [0-9]+ tokens to \\([[:alnum:]_]+\\)
\\([0-9.]+\\)" (line-end-position) t))
+ (concat (match-string 2) ": " (match-string 1)))
- (t
- (thing-at-point 'symbol)))))
+ (t
+ (thing-at-point 'symbol))))
(cl-defgeneric xref-backend-definitions ((_backend (eql
wisitoken-parse_table)) identifier)
;; IDENTIFIER is from xref-back-identifier-at-point; a state number or a
nonterminal
diff --git a/wisitoken-productions.adb b/wisitoken-productions.adb
index f95210b..2f1892f 100644
--- a/wisitoken-productions.adb
+++ b/wisitoken-productions.adb
@@ -2,7 +2,7 @@
--
-- See spec.
--
--- Copyright (C) 2018 Free Software Foundation, Inc.
+-- Copyright (C) 2018, 2020 Free Software Foundation, Inc.
--
-- This file is part of the WisiToken package.
--
@@ -23,6 +23,31 @@ pragma License (Modified_GPL);
with Ada.Text_IO;
package body WisiToken.Productions is
+ function Image (Item : in Recursion_Arrays.Vector) return String
+ is
+ use Ada.Strings.Unbounded;
+ Result : Ada.Strings.Unbounded.Unbounded_String := +"(";
+ Need_Comma : Boolean := False;
+ begin
+ -- We assume most are None, so we use named association
+ for I in Item.First_Index .. Item.Last_Index loop
+ if Item (I) /= None then
+ Result := Result & (if Need_Comma then ", " else "") &
Trimmed_Image (I) & " => " & Image (Item (I));
+ Need_Comma := True;
+ end if;
+ end loop;
+ Result := Result & ")";
+ return -Result;
+ end Image;
+
+ function Constant_Ref_RHS
+ (Grammar : in Prod_Arrays.Vector;
+ ID : in Production_ID)
+ return RHS_Arrays.Constant_Reference_Type
+ is begin
+ return RHS_Arrays.Constant_Ref (Grammar (ID.LHS).RHSs, ID.RHS);
+ end Constant_Ref_RHS;
+
function Image
(LHS : in Token_ID;
RHS_Index : in Natural;
@@ -40,10 +65,17 @@ package body WisiToken.Productions is
end Image;
procedure Put (Grammar : Prod_Arrays.Vector; Descriptor : in
WisiToken.Descriptor)
- is begin
+ is
+ use Ada.Text_IO;
+ begin
for P of Grammar loop
for R in P.RHSs.First_Index .. P.RHSs.Last_Index loop
- Ada.Text_IO.Put_Line (Image (P.LHS, R, P.RHSs (R).Tokens,
Descriptor));
+ Put (Image (P.LHS, R, P.RHSs (R).Tokens, Descriptor));
+ if (for all Item of Grammar (P.LHS).RHSs (R).Recursion => Item =
None) then
+ New_Line;
+ else
+ Put_Line (" ; " & Image (Grammar (P.LHS).RHSs (R).Recursion));
+ end if;
end loop;
end loop;
end Put;
diff --git a/wisitoken-productions.ads b/wisitoken-productions.ads
index 854b302..8b8c8f8 100644
--- a/wisitoken-productions.ads
+++ b/wisitoken-productions.ads
@@ -2,7 +2,7 @@
--
-- Type and operations for building grammar productions.
--
--- Copyright (C) 2018 - 2019 Free Software Foundation, Inc.
+-- Copyright (C) 2018 - 2020 Free Software Foundation, Inc.
--
-- This file is part of the WisiToken package.
--
@@ -24,12 +24,27 @@ with SAL.Gen_Unbounded_Definite_Vectors;
with WisiToken.Semantic_Checks;
with WisiToken.Syntax_Trees;
package WisiToken.Productions is
+ use all type Ada.Containers.Count_Type;
+
+ package Recursion_Arrays is new SAL.Gen_Unbounded_Definite_Vectors
+ (Positive, Recursion_Class, Default_Element => None);
+
+ function Image (Item : in Recursion_Arrays.Vector) return String;
+ -- For parse_table
type Right_Hand_Side is record
- Tokens : Token_ID_Arrays.Vector;
+ Tokens : Token_ID_Arrays.Vector;
+ Recursion : Recursion_Arrays.Vector;
+ -- Recursion for each token. There may be more than one recursion cycle
for any token,
+ -- but we don't track that.
+
Action : WisiToken.Syntax_Trees.Semantic_Action;
Check : WisiToken.Semantic_Checks.Semantic_Check;
- end record;
+ end record
+ with Dynamic_Predicate =>
+ (Tokens.Length = 0 or Tokens.First_Index = 1) and
+ (Recursion.Length = 0 or
+ (Recursion.First_Index = Tokens.First_Index and Recursion.Last_Index =
Tokens.Last_Index));
package RHS_Arrays is new SAL.Gen_Unbounded_Definite_Vectors
(Natural, Right_Hand_Side, Default_Element => (others => <>));
@@ -42,6 +57,11 @@ package WisiToken.Productions is
package Prod_Arrays is new SAL.Gen_Unbounded_Definite_Vectors
(Token_ID, Instance, Default_Element => (others => <>));
+ function Constant_Ref_RHS
+ (Grammar : in Prod_Arrays.Vector;
+ ID : in Production_ID)
+ return RHS_Arrays.Constant_Reference_Type;
+
function Image
(LHS : in Token_ID;
RHS_Index : in Natural;
@@ -51,7 +71,7 @@ package WisiToken.Productions is
-- For comments in generated code, diagnostic messages.
procedure Put (Grammar : Prod_Arrays.Vector; Descriptor : in
WisiToken.Descriptor);
- -- Put Image of each production to Ada.Text_IO.Current_Output.
+ -- Put Image of each production to Ada.Text_IO.Current_Output, for
parse_table.
package Line_Number_Arrays is new SAL.Gen_Unbounded_Definite_Vectors
(Natural, Line_Number_Type, Default_Element => Invalid_Line_Number);
diff --git a/wisitoken-syntax_trees-lr_utils.adb
b/wisitoken-syntax_trees-lr_utils.adb
index a456d82..c75ccea 100644
--- a/wisitoken-syntax_trees-lr_utils.adb
+++ b/wisitoken-syntax_trees-lr_utils.adb
@@ -2,7 +2,7 @@
--
-- See spec.
--
--- Copyright (C) 2019 Stephen Leake All Rights Reserved.
+-- Copyright (C) 2019, 2020 Stephen Leake All Rights Reserved.
--
-- This library is free software; you can redistribute it and/or modify it
-- under terms of the GNU General Public License as published by the Free
@@ -24,9 +24,9 @@ package body WisiToken.Syntax_Trees.LR_Utils is
Lexer : in WisiToken.Lexer.Handle;
Tree : in WisiToken.Syntax_Trees.Tree;
Terminals : in WisiToken.Base_Token_Arrays.Vector;
- Node : in WisiToken.Syntax_Trees.Node_Index)
+ Node : in Node_Index)
is
- Terminal_Index : constant Base_Token_Index := Tree.Min_Terminal_Index
(Node);
+ Terminal_Index : constant Base_Token_Index := Tree.First_Shared_Terminal
(Node);
begin
raise SAL.Programmer_Error with Error_Message
(Lexer.File_Name,
diff --git a/wisitoken-syntax_trees-lr_utils.ads
b/wisitoken-syntax_trees-lr_utils.ads
index 9033f49..84292b4 100644
--- a/wisitoken-syntax_trees-lr_utils.ads
+++ b/wisitoken-syntax_trees-lr_utils.ads
@@ -2,7 +2,7 @@
--
-- Utilities for navigating syntax trees produced by an LR parser.
--
--- Copyright (C) 2019 Stephen Leake All Rights Reserved.
+-- Copyright (C) 2019, 2020 Stephen Leake All Rights Reserved.
--
-- This library is free software; you can redistribute it and/or modify it
-- under terms of the GNU General Public License as published by the Free
@@ -26,7 +26,7 @@ package WisiToken.Syntax_Trees.LR_Utils is
Lexer : in WisiToken.Lexer.Handle;
Tree : in WisiToken.Syntax_Trees.Tree;
Terminals : in WisiToken.Base_Token_Arrays.Vector;
- Node : in WisiToken.Syntax_Trees.Node_Index);
+ Node : in WisiToken.Node_Index);
pragma No_Return (Raise_Programmer_Error);
----------
diff --git a/wisitoken-syntax_trees.adb b/wisitoken-syntax_trees.adb
index abcc4d8..7e98947 100644
--- a/wisitoken-syntax_trees.adb
+++ b/wisitoken-syntax_trees.adb
@@ -2,7 +2,7 @@
--
-- See spec.
--
--- Copyright (C) 2018 - 2019 Free Software Foundation, Inc.
+-- Copyright (C) 2018 - 2020 Free Software Foundation, Inc.
--
-- This library is free software; you can redistribute it and/or modify it
-- under terms of the GNU General Public License as published by the Free
@@ -32,8 +32,6 @@ package body WisiToken.Syntax_Trees is
Include_RHS_Index : in Boolean := False)
return String;
- function Min (Item : in Valid_Node_Index_Array) return Valid_Node_Index;
-
procedure Move_Branch_Point (Tree : in out Syntax_Trees.Tree; Required_Node
: in Valid_Node_Index);
type Visit_Parent_Mode is (Before, After);
@@ -52,7 +50,7 @@ package body WisiToken.Syntax_Trees is
-- all nodes have been processed (Process_Tree returns True).
procedure Set_Children
- (Nodes : in out Node_Arrays.Vector;
+ (Tree : in out Syntax_Trees.Tree;
Parent : in Valid_Node_Index;
Children : in Valid_Node_Index_Array);
@@ -133,20 +131,7 @@ package body WisiToken.Syntax_Trees is
return Nonterm_Node;
end if;
- if Tree.Flush then
- Set_Children (Tree.Shared_Tree.Nodes, Nonterm_Node, Children);
-
- else
- declare
- Min_Child_Node : constant Valid_Node_Index := Min (Children);
- begin
- if Min_Child_Node <= Tree.Last_Shared_Node then
- Move_Branch_Point (Tree, Min_Child_Node);
- end if;
- end;
-
- Set_Children (Tree.Branched_Nodes, Nonterm_Node, Children);
- end if;
+ Set_Children (Tree, Nonterm_Node, Children);
return Nonterm_Node;
end Add_Nonterm;
@@ -179,13 +164,15 @@ package body WisiToken.Syntax_Trees is
function Add_Terminal
(Tree : in out Syntax_Trees.Tree;
- Terminal : in Token_ID)
+ Terminal : in Token_ID;
+ Before : in Base_Token_Index := Invalid_Token_Index)
return Valid_Node_Index
is begin
if Tree.Flush then
Tree.Shared_Tree.Nodes.Append
((Label => Virtual_Terminal,
ID => Terminal,
+ Before => Before,
others => <>));
Tree.Last_Shared_Node := Tree.Shared_Tree.Nodes.Last_Index;
return Tree.Last_Shared_Node;
@@ -193,11 +180,24 @@ package body WisiToken.Syntax_Trees is
Tree.Branched_Nodes.Append
((Label => Virtual_Terminal,
ID => Terminal,
+ Before => Before,
others => <>));
return Tree.Branched_Nodes.Last_Index;
end if;
end Add_Terminal;
+ function Before
+ (Tree : in Syntax_Trees.Tree;
+ Virtual_Terminal : in Valid_Node_Index)
+ return Base_Token_Index
+ is begin
+ if Tree.Flush then
+ return Tree.Shared_Tree.Nodes (Virtual_Terminal).Before;
+ else
+ return Tree.Branched_Nodes (Virtual_Terminal).Before;
+ end if;
+ end Before;
+
function Augmented
(Tree : in Syntax_Trees.Tree;
Node : in Valid_Node_Index)
@@ -210,6 +210,18 @@ package body WisiToken.Syntax_Trees is
end if;
end Augmented;
+ function Augmented_Const
+ (Tree : in Syntax_Trees.Tree;
+ Node : in Valid_Node_Index)
+ return Base_Token_Class_Access_Constant
+ is begin
+ if Node <= Tree.Last_Shared_Node then
+ return Base_Token_Class_Access_Constant (Tree.Shared_Tree.Nodes
(Node).Augmented);
+ else
+ return Base_Token_Class_Access_Constant (Tree.Branched_Nodes
(Node).Augmented);
+ end if;
+ end Augmented_Const;
+
function Byte_Region
(Tree : in Syntax_Trees.Tree;
Node : in Valid_Node_Index)
@@ -305,12 +317,13 @@ package body WisiToken.Syntax_Trees is
Node : Syntax_Trees.Node renames Tree.Shared_Tree.Nodes (Index);
begin
Tree.Shared_Tree.Nodes.Append
- ((Label => Shared_Terminal,
- ID => Node.ID,
- Byte_Region => Node.Byte_Region,
- Parent => Parent,
- State => Unknown_State,
- Terminal => Node.Terminal));
+ ((Label => Shared_Terminal,
+ ID => Node.ID,
+ Byte_Region => Node.Byte_Region,
+ Parent => Parent,
+ State => Unknown_State,
+ Augmented => Node.Augmented,
+ Terminal => Node.Terminal));
end;
when Virtual_Terminal =>
@@ -318,11 +331,13 @@ package body WisiToken.Syntax_Trees is
Node : Syntax_Trees.Node renames Tree.Shared_Tree.Nodes (Index);
begin
Tree.Shared_Tree.Nodes.Append
- ((Label => Virtual_Terminal,
- ID => Node.ID,
- Byte_Region => Node.Byte_Region,
- Parent => Parent,
- State => Unknown_State));
+ ((Label => Virtual_Terminal,
+ ID => Node.ID,
+ Byte_Region => Node.Byte_Region,
+ Parent => Parent,
+ State => Unknown_State,
+ Augmented => Node.Augmented,
+ Before => Node.Before));
end;
when Virtual_Identifier =>
@@ -330,12 +345,13 @@ package body WisiToken.Syntax_Trees is
Node : Syntax_Trees.Node renames Tree.Shared_Tree.Nodes (Index);
begin
Tree.Shared_Tree.Nodes.Append
- ((Label => Virtual_Identifier,
- ID => Node.ID,
- Byte_Region => Node.Byte_Region,
- Parent => Parent,
- State => Unknown_State,
- Identifier => Node.Identifier));
+ ((Label => Virtual_Identifier,
+ ID => Node.ID,
+ Byte_Region => Node.Byte_Region,
+ Parent => Parent,
+ State => Unknown_State,
+ Augmented => Node.Augmented,
+ Identifier => Node.Identifier));
end;
when Nonterm =>
@@ -377,14 +393,13 @@ package body WisiToken.Syntax_Trees is
Byte_Region => Node.Byte_Region,
Parent => Parent,
State => Unknown_State,
+ Augmented => Node.Augmented,
Virtual => Node.Virtual,
RHS_Index => Node.RHS_Index,
Action => Node.Action,
Name => Node.Name,
Children => New_Children,
- Min_Terminal_Index => Node.Min_Terminal_Index,
- Max_Terminal_Index => Node.Max_Terminal_Index,
- Augmented => Node.Augmented));
+ Min_Terminal_Index => Node.Min_Terminal_Index));
end;
Tree.Last_Shared_Node := Tree.Shared_Tree.Nodes.Last_Index;
@@ -465,7 +480,8 @@ package body WisiToken.Syntax_Trees is
overriding procedure Finalize (Tree : in out Base_Tree)
is begin
- Tree.Traversing := False;
+ Tree.Traversing := False;
+ Tree.Parents_Set := False;
if Tree.Augmented_Present then
for Node of Tree.Nodes loop
if Node.Label = Nonterm then
@@ -480,19 +496,27 @@ package body WisiToken.Syntax_Trees is
overriding procedure Finalize (Tree : in out Syntax_Trees.Tree)
is begin
if Tree.Last_Shared_Node /= Invalid_Node_Index then
- if Tree.Shared_Tree.Augmented_Present then
- for Node of Tree.Branched_Nodes loop
- Free (Node.Augmented);
- end loop;
- -- We don't clear Tree.Shared_Tree.Augmented_Present here; other
- -- branched trees may need to be finalized.
- end if;
+ -- Tree.Branched_Nodes Augmented are shallow copies of
+ -- Tree.Shared_Tree.Nodes Augmented, so we don't free them there;
+ -- they are freed in Base_Tree.Finalize above.
Tree.Branched_Nodes.Finalize;
Tree.Last_Shared_Node := Invalid_Node_Index;
Tree.Shared_Tree := null;
end if;
end Finalize;
+ function Insert_After
+ (User_Data : in out User_Data_Type;
+ Tree : in Syntax_Trees.Tree'Class;
+ Token : in Valid_Node_Index;
+ Insert_On_Blank_Line : in Boolean)
+ return Boolean
+ is
+ pragma Unreferenced (User_Data, Tree, Token, Insert_On_Blank_Line);
+ begin
+ return False;
+ end Insert_After;
+
function Find_Ancestor
(Tree : in Syntax_Trees.Tree;
Node : in Valid_Node_Index;
@@ -624,72 +648,6 @@ package body WisiToken.Syntax_Trees is
return Found;
end Find_Descendant;
- function Find_Min_Terminal_Index
- (Tree : in Syntax_Trees.Tree;
- Index : in Token_Index)
- return Node_Index
- is
- Found : Node_Index := Invalid_Node_Index;
-
- function Process (Tree : in Syntax_Trees.Tree; Node : in
Valid_Node_Index) return Boolean
- is
- function Compute (N : in Syntax_Trees.Node) return Boolean
- is begin
- if N.Label /= Nonterm then
- return True;
- elsif Index = N.Min_Terminal_Index then
- Found := Node;
- return False;
- else
- return True;
- end if;
- end Compute;
- begin
- return Compute
- ((if Node <= Tree.Last_Shared_Node
- then Tree.Shared_Tree.Nodes (Node)
- else Tree.Branched_Nodes (Node)));
- end Process;
-
- Junk : constant Boolean := Process_Tree (Tree, Tree.Root, Before,
Process'Access);
- pragma Unreferenced (Junk);
- begin
- return Found;
- end Find_Min_Terminal_Index;
-
- function Find_Max_Terminal_Index
- (Tree : in Syntax_Trees.Tree;
- Index : in Token_Index)
- return Node_Index
- is
- Found : Node_Index := Invalid_Node_Index;
-
- function Process (Tree : in Syntax_Trees.Tree; Node : in
Valid_Node_Index) return Boolean
- is
- function Compute (N : in Syntax_Trees.Node) return Boolean
- is begin
- if N.Label /= Nonterm then
- return True;
- elsif Index = N.Max_Terminal_Index then
- Found := Node;
- return False;
- else
- return True;
- end if;
- end Compute;
- begin
- return Compute
- ((if Node <= Tree.Last_Shared_Node
- then Tree.Shared_Tree.Nodes (Node)
- else Tree.Branched_Nodes (Node)));
- end Process;
-
- Junk : constant Boolean := Process_Tree (Tree, Tree.Root, Before,
Process'Access);
- pragma Unreferenced (Junk);
- begin
- return Found;
- end Find_Max_Terminal_Index;
-
function Find_Sibling
(Tree : in Syntax_Trees.Tree;
Node : in Valid_Node_Index;
@@ -838,6 +796,34 @@ package body WisiToken.Syntax_Trees is
end return;
end Get_Terminals;
+ function First_Terminal (Tree : in Syntax_Trees.Tree; Node : in
Valid_Node_Index) return Node_Index
+ is
+ function Compute (Index : in Valid_Node_Index; N : in Syntax_Trees.Node)
return Node_Index
+ is begin
+ case N.Label is
+ when Shared_Terminal | Virtual_Terminal | Virtual_Identifier =>
+ return Index;
+ when Nonterm =>
+ for C of N.Children loop
+ declare
+ Term : constant Node_Index := First_Terminal (Tree, C);
+ begin
+ if Term /= Invalid_Node_Index then
+ return Term;
+ end if;
+ end;
+ end loop;
+ return Invalid_Node_Index;
+ end case;
+ end Compute;
+ begin
+ return Compute
+ (Node,
+ (if Node <= Tree.Last_Shared_Node
+ then Tree.Shared_Tree.Nodes (Node)
+ else Tree.Branched_Nodes (Node)));
+ end First_Terminal;
+
procedure Get_Terminal_IDs
(Tree : in Syntax_Trees.Tree;
Node : in Valid_Node_Index;
@@ -877,6 +863,26 @@ package body WisiToken.Syntax_Trees is
end return;
end Get_Terminal_IDs;
+ function First_Shared_Terminal (Tree : in Syntax_Trees.Tree; Node : in
Valid_Node_Index) return Base_Token_Index
+ is
+ function Compute (N : in Syntax_Trees.Node) return Base_Token_Index
+ is begin
+ return
+ (case N.Label is
+ when Shared_Terminal => N.Terminal,
+ when Virtual_Terminal |
+ Virtual_Identifier => Invalid_Token_Index,
+ when Nonterm => N.Min_Terminal_Index);
+ end Compute;
+
+ begin
+ if Node <= Tree.Last_Shared_Node then
+ return Compute (Tree.Shared_Tree.Nodes (Node));
+ else
+ return Compute (Tree.Branched_Nodes (Node));
+ end if;
+ end First_Shared_Terminal;
+
function First_Terminal_ID (Tree : in Syntax_Trees.Tree; Node : in
Valid_Node_Index) return Token_ID
is
function Compute (N : in Syntax_Trees.Node) return Token_ID
@@ -886,7 +892,16 @@ package body WisiToken.Syntax_Trees is
return N.ID;
when Nonterm =>
- return First_Terminal_ID (Tree, N.Children (1));
+ for C of N.Children loop
+ declare
+ ID : constant Token_ID := First_Terminal_ID (Tree, C);
+ begin
+ if ID /= Invalid_Token_ID then
+ return ID;
+ end if;
+ end;
+ end loop;
+ return Invalid_Token_ID;
end case;
end Compute;
begin
@@ -1083,14 +1098,23 @@ package body WisiToken.Syntax_Trees is
end if;
end Is_Nonterm;
- function Is_Terminal (Tree : in Syntax_Trees.Tree; Node : in
Valid_Node_Index) return Boolean
+ function Is_Shared_Terminal (Tree : in Syntax_Trees.Tree; Node : in
Valid_Node_Index) return Boolean
is begin
if Node <= Tree.Last_Shared_Node then
return Tree.Shared_Tree.Nodes (Node).Label = Shared_Terminal;
else
return Tree.Branched_Nodes (Node).Label = Shared_Terminal;
end if;
- end Is_Terminal;
+ end Is_Shared_Terminal;
+
+ function Is_Virtual_Terminal (Tree : in Syntax_Trees.Tree; Node : in
Valid_Node_Index) return Boolean
+ is begin
+ if Node <= Tree.Last_Shared_Node then
+ return Tree.Shared_Tree.Nodes (Node).Label = Virtual_Terminal;
+ else
+ return Tree.Branched_Nodes (Node).Label = Virtual_Terminal;
+ end if;
+ end Is_Virtual_Terminal;
function Is_Virtual (Tree : in Syntax_Trees.Tree; Node : in
Valid_Node_Index) return Boolean
is
@@ -1131,17 +1155,61 @@ package body WisiToken.Syntax_Trees is
else Tree.Branched_Nodes.Last_Index);
end Last_Index;
- function Min (Item : in Valid_Node_Index_Array) return Valid_Node_Index
+ function Last_Shared_Terminal (Tree : in Syntax_Trees.Tree; Node : in
Valid_Node_Index) return Base_Token_Index
+ is
+ -- Max_Terminal_Index is not cached, because it is not needed in
recover.
+
+ function Compute (N : in Syntax_Trees.Node) return Base_Token_Index
+ is begin
+ case N.Label is
+ when Shared_Terminal =>
+ return N.Terminal;
+
+ when Virtual_Terminal | Virtual_Identifier =>
+ return Invalid_Token_Index;
+
+ when Nonterm =>
+ for C of reverse N.Children loop
+ declare
+ Last_Term : constant Base_Token_Index :=
Tree.Last_Shared_Terminal (C);
+ begin
+ if Last_Term /= Invalid_Token_Index then
+ return Last_Term;
+ end if;
+ end;
+ end loop;
+ return Invalid_Token_Index;
+ end case;
+ end Compute;
+
+ begin
+ if Node <= Tree.Last_Shared_Node then
+ return Compute (Tree.Shared_Tree.Nodes (Node));
+ else
+ return Compute (Tree.Branched_Nodes (Node));
+ end if;
+ end Last_Shared_Terminal;
+
+ function Last_Terminal (Tree : in Syntax_Trees.Tree; Node : in
Valid_Node_Index) return Node_Index
is
- Result : Node_Index := Item (Item'First);
+ N : constant Node_Const_Ref := Tree.Get_Node_Const_Ref (Node);
begin
- for I in Item'Range loop
- if Item (I) < Result then
- Result := Item (I);
- end if;
- end loop;
- return Result;
- end Min;
+ case N.Label is
+ when Shared_Terminal | Virtual_Terminal | Virtual_Identifier =>
+ return Node;
+ when Nonterm =>
+ for C of reverse N.Children loop
+ declare
+ Term : constant Node_Index := Last_Terminal (Tree, C);
+ begin
+ if Term /= Invalid_Node_Index then
+ return Term;
+ end if;
+ end;
+ end loop;
+ return Invalid_Node_Index;
+ end case;
+ end Last_Terminal;
function Min_Descendant (Nodes : in Node_Arrays.Vector; Node : in
Valid_Node_Index) return Valid_Node_Index
is
@@ -1163,44 +1231,6 @@ package body WisiToken.Syntax_Trees is
end case;
end Min_Descendant;
- function Min_Terminal_Index (Tree : in Syntax_Trees.Tree; Node : in
Valid_Node_Index) return Base_Token_Index
- is
- function Compute (N : in Syntax_Trees.Node) return Base_Token_Index
- is begin
- return
- (case N.Label is
- when Shared_Terminal => N.Terminal,
- when Virtual_Terminal | Virtual_Identifier => Invalid_Token_Index,
- when Nonterm =>
N.Min_Terminal_Index);
- end Compute;
-
- begin
- if Node <= Tree.Last_Shared_Node then
- return Compute (Tree.Shared_Tree.Nodes (Node));
- else
- return Compute (Tree.Branched_Nodes (Node));
- end if;
- end Min_Terminal_Index;
-
- function Max_Terminal_Index (Tree : in Syntax_Trees.Tree; Node : in
Valid_Node_Index) return Base_Token_Index
- is
- function Compute (N : in Syntax_Trees.Node) return Base_Token_Index
- is begin
- return
- (case N.Label is
- when Shared_Terminal => N.Terminal,
- when Virtual_Terminal | Virtual_Identifier => Invalid_Token_Index,
- when Nonterm =>
N.Max_Terminal_Index);
- end Compute;
-
- begin
- if Node <= Tree.Last_Shared_Node then
- return Compute (Tree.Shared_Tree.Nodes (Node));
- else
- return Compute (Tree.Branched_Nodes (Node));
- end if;
- end Max_Terminal_Index;
-
procedure Move_Branch_Point (Tree : in out Syntax_Trees.Tree; Required_Node
: in Valid_Node_Index)
is begin
-- Note that this preserves all stored indices in Branched_Nodes.
@@ -1208,6 +1238,70 @@ package body WisiToken.Syntax_Trees is
Tree.Last_Shared_Node := Required_Node - 1;
end Move_Branch_Point;
+ function Next_Terminal (Tree : in Syntax_Trees.Tree; Node : in
Valid_Node_Index) return Node_Index
+ is
+ use Valid_Node_Index_Arrays;
+ use all type SAL.Base_Peek_Type;
+
+ function First_Child (Node : in Valid_Node_Index) return Node_Index
+ is
+ N : Node_Const_Ref renames Tree.Get_Node_Const_Ref (Node);
+ begin
+ case N.Label is
+ when Shared_Terminal | Virtual_Terminal | Virtual_Identifier =>
+ return Node;
+ when Nonterm =>
+ -- Use first non-empty
+ for J in N.Children.First_Index .. N.Children.Last_Index loop
+ declare
+ Result : constant Node_Index := First_Child (N.Children (J));
+ begin
+ if Result /= Invalid_Node_Index then
+ return Result;
+ end if;
+ end;
+ end loop;
+ -- All Children are empty
+ return Invalid_Node_Index;
+ end case;
+ end First_Child;
+
+ function Next_Child (Child : in Valid_Node_Index; Node : in Node_Index)
return Node_Index
+ is begin
+ -- Node is Parent of Child; return node immediately after Child.
+ if Node = Invalid_Node_Index then
+ return Invalid_Node_Index;
+ else
+ declare
+ N : Node_Const_Ref renames Tree.Get_Node_Const_Ref (Node);
+ begin
+ pragma Assert (N.Label = Nonterm);
+ for I in N.Children.First_Index .. N.Children.Last_Index loop
+ if N.Children (I) = Child then
+ -- Use first non-empty next from I + 1.
+ for J in I + 1 .. N.Children.Last_Index loop
+ declare
+ Result : constant Node_Index := First_Child
(N.Children (J));
+ begin
+ if Result /= Invalid_Node_Index then
+ return Result;
+ end if;
+ end;
+ end loop;
+ -- All next Children are empty
+ return Next_Child (Node, N.Parent);
+ end if;
+ end loop;
+ raise SAL.Programmer_Error;
+ end;
+ end if;
+ end Next_Child;
+
+ N : Node_Const_Ref renames Get_Node_Const_Ref (Tree, Node);
+ begin
+ return Next_Child (Node, N.Parent);
+ end Next_Terminal;
+
function Parent
(Tree : in Syntax_Trees.Tree;
Node : in Valid_Node_Index;
@@ -1229,10 +1323,75 @@ package body WisiToken.Syntax_Trees is
return Result;
end Parent;
+ function Prev_Terminal (Tree : in Syntax_Trees.Tree; Node : in
Valid_Node_Index) return Node_Index
+ is
+ use Valid_Node_Index_Arrays;
+ use all type SAL.Base_Peek_Type;
+
+ function Last_Child (Node : in Valid_Node_Index) return Node_Index
+ is
+ N : Node_Const_Ref renames Tree.Get_Node_Const_Ref (Node);
+ begin
+ case N.Label is
+ when Shared_Terminal | Virtual_Terminal | Virtual_Identifier =>
+ return Node;
+ when Nonterm =>
+ -- Use first non-empty from end.
+ for J in reverse N.Children.First_Index .. N.Children.Last_Index
loop
+ declare
+ Result : constant Node_Index := Last_Child (N.Children (J));
+ begin
+ if Result /= Invalid_Node_Index then
+ return Result;
+ end if;
+ end;
+ end loop;
+ -- All Children are empty
+ return Invalid_Node_Index;
+ end case;
+ end Last_Child;
+
+ function Prev_Child (Child : in Valid_Node_Index; Node : in Node_Index)
return Node_Index
+ is begin
+ -- Node is Parent of Child; return node immediately previous to
Child.
+ if Node = Invalid_Node_Index then
+ return Invalid_Node_Index;
+ else
+ declare
+ N : Node_Const_Ref renames Tree.Get_Node_Const_Ref (Node);
+ begin
+ pragma Assert (N.Label = Nonterm);
+ for I in reverse N.Children.First_Index ..
N.Children.Last_Index loop
+ if N.Children (I) = Child then
+ -- Use first non-empty from I - 1.
+ for J in reverse N.Children.First_Index .. I - 1 loop
+ declare
+ Result : constant Node_Index := Last_Child
(N.Children (J));
+ begin
+ if Result /= Invalid_Node_Index then
+ return Result;
+ end if;
+ end;
+ end loop;
+ -- All previous Children are empty
+ return Prev_Child (Node, N.Parent);
+ end if;
+ end loop;
+ raise SAL.Programmer_Error;
+ end;
+ end if;
+ end Prev_Child;
+
+ N : Node_Const_Ref renames Get_Node_Const_Ref (Tree, Node);
+ begin
+ return Prev_Child (Node, N.Parent);
+ end Prev_Terminal;
+
procedure Print_Tree
- (Tree : in Syntax_Trees.Tree;
- Descriptor : in WisiToken.Descriptor;
- Root : in Node_Index := Invalid_Node_Index)
+ (Tree : in Syntax_Trees.Tree;
+ Descriptor : in WisiToken.Descriptor;
+ Root : in Node_Index := Invalid_Node_Index;
+ Image_Augmented : in Syntax_Trees.Image_Augmented := null)
is
use Ada.Text_IO;
@@ -1256,7 +1415,12 @@ package body WisiToken.Syntax_Trees is
for I in 1 .. Level loop
Put ("| ");
end loop;
- Put_Line (Image (Tree, N, Descriptor, Include_Children => False,
Include_RHS_Index => True));
+ Put (Image (Tree, N, Descriptor, Include_Children => False,
Include_RHS_Index => True));
+ if Image_Augmented /= null and N.Augmented /= null then
+ Put_Line (" - " & Image_Augmented (N.Augmented));
+ else
+ New_Line;
+ end if;
if N.Label = Nonterm then
for Child of N.Children loop
@@ -1391,9 +1555,35 @@ package body WisiToken.Syntax_Trees is
Identifier => Identifier,
Byte_Region => Current.Byte_Region,
Parent => Current.Parent,
- State => Unknown_State));
+ State => Unknown_State,
+ Augmented => null));
end Set_Node_Identifier;
+ procedure Set_Parents (Tree : in out Syntax_Trees.Tree)
+ is
+ procedure Set_Parents
+ (Tree : in out Syntax_Trees.Tree;
+ Node : in Valid_Node_Index;
+ Parent : in Node_Index)
+ is
+ N : Node_Var_Ref renames Tree.Get_Node_Var_Ref (Node);
+ begin
+ N.Parent := Parent;
+ case N.Label is
+ when Shared_Terminal | Virtual_Terminal | Virtual_Identifier =>
+ null;
+
+ when Nonterm =>
+ for C of N.Children loop
+ Set_Parents (Tree, C, Node);
+ end loop;
+ end case;
+ end Set_Parents;
+ begin
+ Set_Parents (Tree, Root (Tree), Invalid_Node_Index);
+ Tree.Shared_Tree.Parents_Set := True;
+ end Set_Parents;
+
procedure Set_Root (Tree : in out Syntax_Trees.Tree; Root : in
Valid_Node_Index)
is begin
Tree.Root := Root;
@@ -1449,25 +1639,36 @@ package body WisiToken.Syntax_Trees is
end Set_Augmented;
procedure Set_Children
- (Nodes : in out Node_Arrays.Vector;
+ (Tree : in out Syntax_Trees.Tree;
Parent : in Valid_Node_Index;
Children : in Valid_Node_Index_Array)
is
use all type SAL.Base_Peek_Type;
- N : Nonterm_Node renames Nodes (Parent);
- J : Positive_Index_Type := Positive_Index_Type'First;
+ N : Node_Var_Ref renames Tree.Get_Node_Var_Ref (Parent);
Min_Terminal_Index_Set : Boolean := False;
begin
N.Children.Set_First_Last (Children'First, Children'Last);
for I in Children'Range loop
- N.Children (J) := Children (I);
+ N.Children (I) := Children (I);
+
+ if Tree.Parents_Set then
+ -- Parsing is done; we are editing the tree.
+ declare
+ K : Node_Var_Ref renames Tree.Get_Node_Var_Ref (Children (I));
+ begin
+ K.Parent := Parent;
+ end;
+ else
+ -- We do _not_ set K.Parent here; that is only done after parsing
is
+ -- complete. See Design note in spec.
+ null;
+ end if;
+
declare
- K : Node renames Nodes (Children (I));
+ K : Node_Const_Ref renames Tree.Get_Node_Const_Ref (Children (I));
begin
- K.Parent := Parent;
-
N.Virtual := N.Virtual or
(case K.Label is
when Shared_Terminal => False,
@@ -1499,27 +1700,7 @@ package body WisiToken.Syntax_Trees is
end if;
end case;
end if;
-
- case K.Label is
- when Shared_Terminal =>
- if N.Max_Terminal_Index < K.Terminal then
- N.Max_Terminal_Index := K.Terminal;
- end if;
-
- when Virtual_Terminal | Virtual_Identifier =>
- null;
-
- when Nonterm =>
- if K.Max_Terminal_Index /= Invalid_Token_Index and then
- -- not an empty nonterm
- N.Max_Terminal_Index < K.Max_Terminal_Index
- then
- N.Max_Terminal_Index := K.Max_Terminal_Index;
- end if;
- end case;
end;
-
- J := J + 1;
end loop;
end Set_Children;
diff --git a/wisitoken-syntax_trees.ads b/wisitoken-syntax_trees.ads
index 85fd2c5..5eff265 100644
--- a/wisitoken-syntax_trees.ads
+++ b/wisitoken-syntax_trees.ads
@@ -2,17 +2,34 @@
--
-- Syntax tree type and operations.
--
--- Rationale :
+-- Design :
+--
+-- There is one syntax tree for each parallel parser. There is one
+-- shared Terminals array (provided by the master parser), matching
+-- the actual input text.
+--
+-- Node contains a Parent component, to make it easy to traverse the
+-- tree in any direction. However, we do not set the Parent nodes
+-- while parsing, to simplify branching the syntax tree for parallel
+-- parsing. When a new nonterm is added to a branched tree, if it set
+-- the parent component of its children, it would first have to move
+-- those children, and all intervening nodes, into the branched tree.
+-- Since Shared_Terminals nodes are created before all other nodes
+-- (when the lexer is run, to allow Lexer_To_Augmented to store info
+-- in the node), that would mean every branched tree is a practically
+-- complete copy of the entire tree, significantly slowing down
+-- parsing (by a factor of 250 on ada-mode wisi.adb when we did this
+-- by mistake!).
+--
+-- The parent components are set by Set_Parents, which is called by
+-- Parser.Execute_Actions before the actions are executed.
+-- Fortunately, we don't need the parent components during error
+-- recover.
--
-- We provide Base_Tree and Tree in one package, because only Tree
-- needs an API; the only way Base_Tree is accessed is via Tree.
--
--- Copyright (C) 2018 - 2019 Free Software Foundation, Inc.
-
--- There is one syntax tree for each parser. There is one shared
--- Terminals array, matching the actual input text.
---
--- Copyright (C) 2018 Free Software Foundation, Inc.
+-- Copyright (C) 2018 - 2020 Free Software Foundation, Inc.
--
-- This library is free software; you can redistribute it and/or modify it
-- under terms of the GNU General Public License as published by the Free
@@ -41,6 +58,9 @@ package WisiToken.Syntax_Trees is
type Tree is new Ada.Finalization.Controlled with private;
+ type Tree_Variable_Reference (Element : access Tree) is null record with
+ Implicit_Dereference => Element;
+
procedure Initialize
(Branched_Tree : in out Tree;
Shared_Tree : in Base_Tree_Access;
@@ -50,18 +70,6 @@ package WisiToken.Syntax_Trees is
overriding procedure Finalize (Tree : in out Syntax_Trees.Tree);
-- Free any allocated storage.
- type Node_Index is range 0 .. Integer'Last;
- subtype Valid_Node_Index is Node_Index range 1 .. Node_Index'Last;
-
- Invalid_Node_Index : constant Node_Index := Node_Index'First;
-
- type Valid_Node_Index_Array is array (Positive_Index_Type range <>) of
Valid_Node_Index;
- -- Index matches Base_Token_Array, Augmented_Token_Array
-
- package Valid_Node_Index_Arrays is new SAL.Gen_Unbounded_Definite_Vectors
- (Positive_Index_Type, Valid_Node_Index, Default_Element =>
Valid_Node_Index'First);
- -- Index matches Valid_Node_Index_Array.
-
type Node_Label is
(Shared_Terminal, -- text is user input, accessed via Parser.Terminals
Virtual_Terminal, -- no text; inserted during error recovery
@@ -92,19 +100,45 @@ package WisiToken.Syntax_Trees is
procedure Lexer_To_Augmented
(User_Data : in out User_Data_Type;
+ Tree : in out Syntax_Trees.Tree'Class;
Token : in Base_Token;
Lexer : not null access WisiToken.Lexer.Instance'Class)
is null;
-- Read auxiliary data from Lexer, do something useful with it.
- -- Called before parsing, once for each token in the input stream.
+ -- Called before parsing, once for each token in the input stream. If
+ -- Token is a grammar token, client can use Tree.Set_Augmented
+ -- (Token.Tree_Node).
+
+ function Insert_After
+ (User_Data : in out User_Data_Type;
+ Tree : in Syntax_Trees.Tree'Class;
+ Token : in Valid_Node_Index;
+ Insert_On_Blank_Line : in Boolean)
+ return Boolean;
+ -- Return True if ID should be treated as if inserted after the
+ -- previous shared terminal, rather than before the next (which is
+ -- the default). This can affect which line it appears on, which
+ -- affects indentation. Called from Insert_Token.
+ --
+ -- The default implementation always returns False.
+
+ procedure Insert_Token
+ (User_Data : in out User_Data_Type;
+ Tree : in out Syntax_Trees.Tree'Class;
+ Token : in Valid_Node_Index)
+ is null;
+ -- Token was inserted in error recovery; update other tokens and Tree
+ -- as needed. Called from Execute_Actions for each inserted token,
+ -- before processing the syntax tree.
procedure Delete_Token
(User_Data : in out User_Data_Type;
+ Tree : in out Syntax_Trees.Tree'Class;
Token_Index : in WisiToken.Token_Index)
is null;
-- Token at Token_Index was deleted in error recovery; update
- -- remaining tokens and Tree as needed. Called from Execute_Actions
- -- for each deleted token, before processing the syntax tree.
+ -- remaining tokens as needed. Called from Execute_Actions for each
+ -- deleted token, before processing the syntax tree.
procedure Reduce
(User_Data : in out User_Data_Type;
@@ -145,12 +179,13 @@ package WisiToken.Syntax_Trees is
Root : in Valid_Node_Index;
Last : in Valid_Node_Index)
return Valid_Node_Index
- with Pre => Tree.Flushed;
+ with Pre => Tree.Flushed and Tree.Parents_Set;
-- Deep copy (into Tree) subtree of Tree rooted at Root. Stop copying
-- after children of Last are copied. Return root of new subtree.
--
- -- Node index order is preserved. References to objects external to
- -- tree are shallow copied.
+ -- Parents of new child nodes are set. Node index order is preserved.
+ -- References to objects external to tree are shallow copied
+ -- (Terminals, Augmented).
function Add_Nonterm
(Tree : in out Syntax_Trees.Tree;
@@ -175,11 +210,21 @@ package WisiToken.Syntax_Trees is
function Add_Terminal
(Tree : in out Syntax_Trees.Tree;
- Terminal : in Token_ID)
+ Terminal : in Token_ID;
+ Before : in Base_Token_Index := Invalid_Token_Index)
return Valid_Node_Index
with Pre => not Tree.Traversing;
- -- Add a new Virtual_Terminal node with no parent. Result points to
- -- the added node.
+ -- Add a new Virtual_Terminal node with no parent. Before is the
+ -- index of the terminal in Terminals that this virtual is inserted
+ -- before during error correction; if Invalid_Token_Index, it is
+ -- inserted during EBNF translation, and there is no such terminal in
+ -- Terminals. Result points to the added node.
+
+ function Before
+ (Tree : in Syntax_Trees.Tree;
+ Virtual_Terminal : in Valid_Node_Index)
+ return Base_Token_Index
+ with Pre => Tree.Is_Virtual_Terminal (Virtual_Terminal);
function Add_Identifier
(Tree : in out Syntax_Trees.Tree;
@@ -209,6 +254,7 @@ package WisiToken.Syntax_Trees is
Children : in Valid_Node_Index_Array)
with
Pre => Tree.Flushed and
+ Tree.Parents_Set and
(not Tree.Traversing) and
Tree.Is_Nonterm (Node);
-- Set ID of Node to New_ID, and children to Children; set parent of
@@ -251,16 +297,25 @@ package WisiToken.Syntax_Trees is
function Has_Parent (Tree : in Syntax_Trees.Tree; Children : in
Valid_Node_Index_Array) return Boolean;
function Is_Empty (Tree : in Syntax_Trees.Tree; Node : in Valid_Node_Index)
return Boolean;
function Is_Nonterm (Tree : in Syntax_Trees.Tree; Node : in
Valid_Node_Index) return Boolean;
- function Is_Terminal (Tree : in Syntax_Trees.Tree; Node : in
Valid_Node_Index) return Boolean;
+ function Is_Shared_Terminal (Tree : in Syntax_Trees.Tree; Node : in
Valid_Node_Index) return Boolean;
+ function Is_Virtual_Terminal (Tree : in Syntax_Trees.Tree; Node : in
Valid_Node_Index) return Boolean;
+
function Is_Virtual (Tree : in Syntax_Trees.Tree; Node : in
Valid_Node_Index) return Boolean;
+ -- Virtual_Terminal, Virtual_Identifier, or Nonterm that contains some
Virtual tokens.
+
function Is_Virtual_Identifier (Tree : in Syntax_Trees.Tree; Node : in
Valid_Node_Index) return Boolean;
function Traversing (Tree : in Syntax_Trees.Tree) return Boolean;
+ function Parents_Set (Tree : in Syntax_Trees.Tree) return Boolean;
+ procedure Set_Parents (Tree : in out Syntax_Trees.Tree)
+ with Pre => Tree.Flushed;
+
function Parent
(Tree : in Syntax_Trees.Tree;
Node : in Valid_Node_Index;
Count : in Positive := 1)
- return Node_Index;
+ return Node_Index
+ with Pre => Tree.Parents_Set;
-- Return Count parent of Node.
procedure Set_Name_Region
@@ -308,23 +363,24 @@ package WisiToken.Syntax_Trees is
(Tree : in Syntax_Trees.Tree;
Nodes : in Valid_Node_Index_Array)
return WisiToken.Recover_Token_Array;
- -- For non-virtual terminals, copied from Tree.Terminals. For others,
- -- constructed from Tree data.
procedure Set_Augmented
(Tree : in out Syntax_Trees.Tree;
Node : in Valid_Node_Index;
- Value : in Base_Token_Class_Access)
- with Pre => Tree.Is_Nonterm (Node);
+ Value : in Base_Token_Class_Access);
-- Value will be deallocated when Tree is finalized.
function Augmented
(Tree : in Syntax_Trees.Tree;
Node : in Valid_Node_Index)
- return Base_Token_Class_Access
- with Pre => Tree.Is_Nonterm (Node);
+ return Base_Token_Class_Access;
-- Returns result of Set_Augmented.
+ function Augmented_Const
+ (Tree : in Syntax_Trees.Tree;
+ Node : in Valid_Node_Index)
+ return Base_Token_Class_Access_Constant;
+
function Action
(Tree : in Syntax_Trees.Tree;
Node : in Valid_Node_Index)
@@ -335,12 +391,14 @@ package WisiToken.Syntax_Trees is
(Tree : in Syntax_Trees.Tree;
Node : in Valid_Node_Index;
ID : in Token_ID)
- return Node_Index;
+ return Node_Index
+ with Pre => Tree.Parents_Set;
function Find_Ancestor
(Tree : in Syntax_Trees.Tree;
Node : in Valid_Node_Index;
IDs : in Token_ID_Array)
- return Node_Index;
+ return Node_Index
+ with Pre => Tree.Parents_Set;
-- Return the ancestor of Node that contains ID, or Invalid_Node_Index if
-- none match.
@@ -349,7 +407,7 @@ package WisiToken.Syntax_Trees is
Node : in Valid_Node_Index;
ID : in Token_ID)
return Node_Index
- with Pre => Tree.Has_Parent (Node);
+ with Pre => Tree.Parents_Set and then Tree.Has_Parent (Node);
-- Return the sibling of Node that contains ID, or Invalid_Node_Index if
-- none match.
@@ -378,24 +436,6 @@ package WisiToken.Syntax_Trees is
-- Return the descendant of Node (may be Node) for which Predicate
-- returns True, or Invalid_Node_Index if none do.
- function Find_Min_Terminal_Index
- (Tree : in Syntax_Trees.Tree;
- Index : in Token_Index)
- return Node_Index
- with Post => Find_Min_Terminal_Index'Result = Invalid_Node_Index or else
- Tree.Is_Nonterm (Find_Min_Terminal_Index'Result);
- -- Return the first node whose Min_Terminal_Index is Index, or
- -- Invalid_Node_Index if none match.
-
- function Find_Max_Terminal_Index
- (Tree : in Syntax_Trees.Tree;
- Index : in Token_Index)
- return Node_Index
- with Post => Find_Max_Terminal_Index'Result = Invalid_Node_Index or else
- Tree.Is_Nonterm (Find_Max_Terminal_Index'Result);
- -- Return the first node whose Max_Terminal_Index is Index, or
- -- Invalid_Node_Index if none match.
-
procedure Set_Root (Tree : in out Syntax_Trees.Tree; Root : in
Valid_Node_Index);
function Root (Tree : in Syntax_Trees.Tree) return Node_Index;
@@ -415,13 +455,17 @@ package WisiToken.Syntax_Trees is
with Pre => Tree.Is_Virtual_Identifier (Node);
function Terminal (Tree : in Syntax_Trees.Tree; Node : in Valid_Node_Index)
return Base_Token_Index
- with Pre => Tree.Is_Terminal (Node);
+ with Pre => Tree.Is_Shared_Terminal (Node);
- function Min_Terminal_Index (Tree : in Syntax_Trees.Tree; Node : in
Valid_Node_Index) return Base_Token_Index;
- function Max_Terminal_Index (Tree : in Syntax_Trees.Tree; Node : in
Valid_Node_Index) return Base_Token_Index;
- -- Returns lowest/highest index of shared terminal in subtree under
- -- Node. If result is Invalid_Token_Index, all terminals are virtual,
- -- or a nonterm is empty.
+ function First_Shared_Terminal (Tree : in Syntax_Trees.Tree; Node : in
Valid_Node_Index) return Base_Token_Index;
+ -- Returns first shared terminal in subtree under Node
+ -- (ignoring virtual terminals). If result is Invalid_Token_Index,
+ -- all terminals are virtual, or a nonterm is empty.
+
+ function Last_Shared_Terminal (Tree : in Syntax_Trees.Tree; Node : in
Valid_Node_Index) return Base_Token_Index;
+ -- Returns last shared terminal in subtree under Node (ignoring
+ -- virtual terminals). If result is Invalid_Token_Index, all
+ -- terminals are virtual, or a nonterm is empty.
function Get_Terminals (Tree : in Syntax_Trees.Tree; Node : in
Valid_Node_Index) return Valid_Node_Index_Array;
-- Return sequence of terminals in Node.
@@ -429,11 +473,27 @@ package WisiToken.Syntax_Trees is
-- "Terminals" can be Shared_Terminal, Virtual_Terminal,
-- Virtual_Identifier.
+ function First_Terminal (Tree : in Syntax_Trees.Tree; Node : in
Valid_Node_Index) return Node_Index;
+ -- First of Get_Terminals. Invalid_Node_Index if Node is an empty
nonterminal.
+
+ function Last_Terminal (Tree : in Syntax_Trees.Tree; Node : in
Valid_Node_Index) return Node_Index;
+ -- Last of Get_Terminals. Invalid_Node_Index if Node is an empty
nonterminal.
+
+ function Prev_Terminal (Tree : in Syntax_Trees.Tree; Node : in
Valid_Node_Index) return Node_Index
+ with Pre => Tree.Parents_Set and Tree.Label (Node) in Shared_Terminal |
Virtual_Terminal | Virtual_Identifier;
+ -- Return the terminal that is immediately before Node in Tree;
+ -- Invalid_Node_Index if Node is the first terminal in Tree.
+
+ function Next_Terminal (Tree : in Syntax_Trees.Tree; Node : in
Valid_Node_Index) return Node_Index
+ with Pre => Tree.Parents_Set and Tree.Label (Node) in Shared_Terminal |
Virtual_Terminal | Virtual_Identifier;
+ -- Return the terminal that is immediately after Node in Tree;
+ -- Invalid_Node_Index if Node is the last terminal in Tree.
+
function Get_Terminal_IDs (Tree : in Syntax_Trees.Tree; Node : in
Valid_Node_Index) return Token_ID_Array;
-- Same as Get_Terminals, but return the IDs.
function First_Terminal_ID (Tree : in Syntax_Trees.Tree; Node : in
Valid_Node_Index) return Token_ID;
- -- First of Get_Terminal_IDs
+ -- First of Get_Terminal_IDs; Invalid_Token_ID if Node is empty.
function Get_IDs
(Tree : in Syntax_Trees.Tree;
@@ -466,13 +526,18 @@ package WisiToken.Syntax_Trees is
return String;
-- Simple list of numbers, for debugging
+ type Image_Augmented is access function (Aug : in Base_Token_Class_Access)
return String;
+
procedure Print_Tree
- (Tree : in Syntax_Trees.Tree;
- Descriptor : in WisiToken.Descriptor;
- Root : in Node_Index := Invalid_Node_Index)
+ (Tree : in Syntax_Trees.Tree;
+ Descriptor : in WisiToken.Descriptor;
+ Root : in Node_Index := Invalid_Node_Index;
+ Image_Augmented : in Syntax_Trees.Image_Augmented := null)
with Pre => Tree.Flushed;
-- Print tree rooted at Root (default Tree.Root) to
- -- Text_IO.Current_Output, for debugging.
+ -- Text_IO.Current_Output, for debugging. For each node,
+ -- Image_Augmented is called if it is not null and node.augmented is
+ -- not null.
private
use all type Ada.Containers.Count_Type;
@@ -492,12 +557,14 @@ private
-- Parse state that was on stack with this token, to allow undoing a
-- reduce.
+ Augmented : Base_Token_Class_Access := null;
+
case Label is
when Shared_Terminal =>
Terminal : Token_Index; -- into Parser.Terminals
when Virtual_Terminal =>
- null;
+ Before : Base_Token_Index := Invalid_Token_Index; -- into
Parser.Terminals
when Virtual_Identifier =>
Identifier : Identifier_Index; -- into user data
@@ -520,11 +587,6 @@ private
Min_Terminal_Index : Base_Token_Index := Invalid_Token_Index;
-- Cached for push_back of nonterminals during recovery
-
- Max_Terminal_Index : Base_Token_Index := Invalid_Token_Index;
- -- Cached for building a WisiToken tree from a libadalang tree.
-
- Augmented : Base_Token_Class_Access := null;
end case;
end record;
@@ -552,6 +614,9 @@ private
-- True while traversing tree in Process_Tree.
-- Declared in Base_Tree so it is cleared by Finalize.
+ Parents_Set : Boolean := False;
+ -- We don't set Node.Parent until after parse is done; see Design
+ -- note above.
end record;
type Tree is new Ada.Finalization.Controlled with record
@@ -579,4 +644,26 @@ private
else Last_Shared_Node <= Shared_Tree.Nodes.Last_Index and
Last_Shared_Node < Branched_Nodes.First_Index));
+ subtype Node_Const_Ref is Node_Arrays.Constant_Reference_Type;
+ subtype Node_Var_Ref is Node_Arrays.Variable_Reference_Type;
+
+ function Get_Node_Const_Ref
+ (Tree : in Syntax_Trees.Tree;
+ Node : in Valid_Node_Index)
+ return Node_Const_Ref
+ is (if Node <= Tree.Last_Shared_Node
+ then Tree.Shared_Tree.Nodes.Constant_Ref (Node)
+ else Tree.Branched_Nodes.Constant_Ref (Node));
+
+ function Get_Node_Var_Ref
+ (Tree : in Syntax_Trees.Tree;
+ Node : in Valid_Node_Index)
+ return Node_Var_Ref
+ is (if Node <= Tree.Last_Shared_Node
+ then Tree.Shared_Tree.Nodes.Variable_Ref (Node)
+ else Tree.Branched_Nodes.Variable_Ref (Node));
+
+ function Parents_Set (Tree : in Syntax_Trees.Tree) return Boolean
+ is (Tree.Shared_Tree.Parents_Set);
+
end WisiToken.Syntax_Trees;
diff --git a/wisitoken-text_io_trace.ads b/wisitoken-text_io_trace.ads
index c6892c8..b400c23 100644
--- a/wisitoken-text_io_trace.ads
+++ b/wisitoken-text_io_trace.ads
@@ -2,7 +2,7 @@
--
-- Trace output to Ada.Text_IO
--
--- Copyright (C) 2017, 2019 Free Software Foundation, Inc.
+-- Copyright (C) 2017, 2019, 2020 Free Software Foundation, Inc.
--
-- This library is free software; you can redistribute it and/or modify it
-- under terms of the GNU General Public License as published by the Free
@@ -31,6 +31,7 @@ package WisiToken.Text_IO_Trace is
overriding
procedure Put_Line (Trace : in out Text_IO_Trace.Trace; Item : in String);
+ -- If Item contains ASCII.LF, Prefix is output after each one.
overriding
procedure New_Line (Trace : in out Text_IO_Trace.Trace);
diff --git a/wisitoken-user_guide.info b/wisitoken-user_guide.info
index 6d04498..982869c 100644
--- a/wisitoken-user_guide.info
+++ b/wisitoken-user_guide.info
@@ -1,7 +1,7 @@
-This is wisitoken-user_guide.info, produced by makeinfo version 6.3 from
+This is wisitoken-user_guide.info, produced by makeinfo version 6.7 from
wisitoken-user_guide.texinfo.
-Copyright (C) 2014-2015, 2017, 2018 Stephen Leake.
+Copyright (C) 2014-2015, 2017, 2018, 2020 Stephen Leake.
Permission is granted to copy, distribute and/or modify this
document under the terms of the GNU Free Documentation License,
@@ -20,7 +20,7 @@ File: wisitoken-user_guide.info, Node: Top, Next: Overview,
Up: (dir)
WisiToken User Guide
********************
-Copyright (C) 2014-2015, 2017, 2018 Stephen Leake.
+Copyright (C) 2014-2015, 2017, 2018, 2020 Stephen Leake.
Permission is granted to copy, distribute and/or modify this
document under the terms of the GNU Free Documentation License,
@@ -42,16 +42,15 @@ File: wisitoken-user_guide.info, Node: Overview, Next:
Common grammar problems
**********
WisiToken is a parser and parser generator toolkit, supporting
-generalized LR (both LALR and LR1) and packrat parsers. The grammar can
-be expressed as either Ada source code statements, or in an EBNF file.
-The parser generator generates either Ada or elisp source (the elisp
-source assumes the Emacs wisi Gnu ELPA package).
+generalized LR (both LALR and LR1) and packrat parsers; the LR parser
+provides robust error recovery. The grammar can be expressed as either
+Ada source code statements, or in an EBNF file. The parser generator
+generates Ada, either plain or assuming the Emacs wisi package.
At one point, "wisi" was short for "Wisent Indentation engine"; the
Emacs 'wisi' package implements an indentation engine that used to be
based on the Emacs wisent parser. However, that parser has now been
-replaced by a generalized LALR parser with error recovery, so "wisi" is
-just a name.
+replaced by the WisiToken parser, so "wisi" is just a name.
* Menu:
@@ -63,13 +62,15 @@ File: wisitoken-user_guide.info, Node: Install, Up:
Overview
1.1 Install
===========
-WisiToken is available as source code only.
+WisiToken is available as source code only, although a subset is
+available in the GNU ELPA package 'wisi'.
- To use the Ada runtime, you will also need to install a lexer
-generator. WisiToken supports re2c, and other lexers can be added.
+ You will also need to install a lexer generator. WisiToken supports
+re2c, and other lexers can be added.
- re2c is available from <http://re2c.org/>. WisiToken uses the
-environment variable RE2C_HOME to locate re2c.
+ re2c is available from <http://re2c.org/>; it is also packaged in
+Mingw64 and Debian. WisiToken requires at least version 1.3. WisiToken
+assumes the executable 're2c' is in '$PATH'.
File: wisitoken-user_guide.info, Node: Common grammar problems, Next:
Grammar File Syntax, Prev: Overview, Up: Top
@@ -200,7 +201,7 @@ and deletions (*note Bison: (bison)Top.).
The top level file structure is a list of declarations and
nonterminals.
- Comments are started by ";;" and terminated by end of line.
+ Comments are started by ';;' and terminated by end of line.
* Menu:
@@ -214,8 +215,8 @@ File: wisitoken-user_guide.info, Node: Declarations,
Next: Nonterminals, Up:
3.1 Declarations
================
-The Declarations sections declares terminal tokens, conflicts, and other
-parser parameters.
+Declarations declare terminal tokens, conflicts, and other parser
+parameters.
* Menu:
@@ -231,17 +232,11 @@ File: wisitoken-user_guide.info, Node: Raw Code, Next:
Keywords, Up: Declarat
3.1.1 Raw code
--------------
-%code { actions | copyright_license } [spec | body | context | pre | post]...
%{ <output language code> }%
+%code { actions | copyright_license } [spec | body | context | pre | post]...
%{ <output language code> }%
Raw code declarations contain arbitrary code, copied verbatim into
-the output.
-
- For Elisp output, the generator adds the necessary 'require' forms
-for the elisp lexer, parser, and wisi actions; you only need to add add
-additional code if you use other actions.
-
- For Ada output, the keywords following '%code' determine where the
-section is output.
+the output. The keywords following '%code' determine where the section
+is output.
File: wisitoken-user_guide.info, Node: Keywords, Next: Tokens, Prev: Raw
Code, Up: Declarations
@@ -249,10 +244,10 @@ File: wisitoken-user_guide.info, Node: Keywords, Next:
Tokens, Prev: Raw Code
3.1.2 Keywords
--------------
-%keyword <name> <string>
+%keyword <name> <string>
-example:
-%keyword SEMICOLON ";"
+ example:
+%keyword SEMICOLON ";"
"Keywords" are reserved words or symbols in the target language; the
lexers recognize them by the given string.
@@ -263,62 +258,49 @@ File: wisitoken-user_guide.info, Node: Tokens, Next:
Error recovery, Prev: Ke
3.1.3 Tokens
------------
-%token < kind > name regexp
-
-example:
-%token <symbol> IDENTIFIER
-%token <punctuation> TICK "'"
-
- The meaning of 'kind' is determined by the lexer and parser runtime.
-The syntax of the regular expression is determined by the lexer
-generator.
+%token < kind > name regexp
- In the Emacs wisi lexer, the token kinds are recognized by Emacs
-syntax properties:
+ example:
+%token <symbol> IDENTIFIER %[ ... ]%
+%token <punctuation> TICK "'"
-'<punctuation>'
- %token <punctuation> TICK "'"
- A string of characters that have punctuation syntax, and match the
- token string.
-
-'<symbol>'
- %token <symbol> IDENTIFIER
- A string of characters that have word syntax, that match no other
- token.
+ The syntax of the regular expression is determined by the lexer
+generator. The meaning of 'kind' is determined by the lexer ('re2c'
+ignores this), with the following defined by the WisiToken generator.
+Other token kinds have no effect; they may be used for documentation.
'<string-double>'
- %token <string-double> STRING_LITERAL
+ %token <string-double> STRING_LITERAL %[ ... ]%
A string of characters that have string syntax, with double quote
delimiters.
'<string-single>'
- %token <string-single> CHARACTER_LITERAL
+ %token <string-single> CHARACTER_LITERAL %[ ... ]%
A string of characters that have string syntax, with single quote
delimiters.
-'<number>'
- %token <number> NUMERIC_LITERAL ada-wisi-number-p ada-wisi
- A string of characters that have word syntax, recognized by the
- function given in the third parameter. The fourth parameter is the
- source file for the recognizer (included via 'require').
-
-'<whitespace>'
- %token <whitespace> WHITESPACE [ \t\n]
- Not used by the wisi lexer; required by the Ada lexer.
-
-'<comment>'
- %token <line_comment> COMMENT "--"[^\n]*[\n]
+'<new-line>'
+ %token <new-line> [\n] %[ ... ]%
Not used by the wisi lexer; required by the Ada lexer. The third
argument is the regular expression to recognize the entire comment.
+'<non-reporting>'
+ %token <non-reporting> WHITESPACE %[ [ \t] ]%
+ A token that is recognized by the lexer, but not returned to the
+ parser.
+
+'<delimited-text>'
+ %token <delimited-text> RAW_CODE "%{" "}%"
+ A token that contains arbitrary text, delimited by the two strings.
+
File: wisitoken-user_guide.info, Node: Error recovery, Next: Other
declarations, Prev: Tokens, Up: Declarations
3.1.4 Error recovery
--------------------
-The parser can use error recovery algorithms when it encounters syntax
-errors; if a solution is found, the parse continues.
+The parser uses an error recovery algorithm when it encounters a syntax
+error; if a solution is found, the parse continues.
Error recovery uses multiple tasks to take advantage of multiple CPU
cores. Unfortunately, this means there is a race condition; the
@@ -327,15 +309,20 @@ This matters because each solution results in a
successful parse,
possibly with different actions (different indentation computed, for
example). Which solution finally succeeds depends on which are
terminated due to identical parser stacks, which in turn depends on the
-order they were delivered. See
-'ada-mode/tests/ada_mode-interactive_2.adb' for an example.
+order they were delivered.
- Once the syntax errors are fixed, only the ambiguities in the grammar
+ Once the syntax errors are fixed, only ambiguities in the grammar
itself can cause a similar problem.
- Several declarations set parameters for the error recovery. If none
-of these parameters are present in the grammar file, the generated
-parser does not do error recovery.
+ Several grammar file declarations set parameters for the error
+recovery. If none of these parameters are present in the grammar file,
+the generated parser does not do error recovery.
+
+ The error recovery algorithm generates possible solutions based on
+the parse state preceding the error point, by inserting, deleting, or
+pushing back tokens. Each possible solution is given a cost, and
+enqueued to be checked later. Solutions are checked in cost order
+(lowest first).
'%mckenzie_check_limit <limit>'
The number of tokens past the error point that must be parsed
@@ -357,7 +344,8 @@ parser does not do error recovery.
"Push back" means undo parsing; remove tokens from the parse stack
and put them back into the input stream. This moves the
- insert/delete point, allowing better solutions.
+ insert/delete point, allowing better solutions. The push back
+ default cost is also the undo reduce default cost.
If not specified, costs are zero. Costs can be negative; they all
add linearly.
@@ -365,25 +353,31 @@ parser does not do error recovery.
'%mckenzie_cost_delete <token> <cost>'
McKenzie error recovery delete cost for a specific token.
+'%mckenzie_cost_fast_forward <cost>'
+ McKenzie error recovery cost for parsing ahead after fixing one
+ error, moving to the next error location.
+
'%mckenzie_cost_insert <token> <cost>'
McKenzie error recovery insert cost for a specific token.
-'%mckenzie_cost_limit <integer>'
- McKenzie error recovery limit on cost of solutions; default max
- integer.
+'%mckenzie_cost_fast_forward <cost>'
+ McKenzie error recovery cost for using the 'matching_begin'
+ strategy.
'%mckenzie_cost_push_back <token> <cost>'
McKenzie error recovery push back cost for a specific token.
+'%mckenzie_cost_undo_reduce <token> <cost>'
+ McKenzie error recovery undo reduce cost for a specific token.
+
'%mckenzie_enqueue_limit <integer>'
McKenzie error recovery limit on possible solutions enqueued (to be
checked); default max integer.
- The error recovery algorithm generates possible solutions based on
- the grammar preceding the error point, by inserting, deleting, or
- pushing back tokens. Each possible solution is given a cost, and
- enqueued to be checked later. Solutions are checked in cost order
- (lowest first).
+'%mckenzie_minimal_complete_cost_delta <cost>'
+ McKenzie error recovery cost added to the cost of an inserted token
+ when the insert is done by the minimal complete strategy; this cost
+ is normally negative.
File: wisitoken-user_guide.info, Node: Other declarations, Prev: Error
recovery, Up: Declarations
@@ -398,7 +392,7 @@ File: wisitoken-user_guide.info, Node: Other declarations,
Prev: Error recover
Declare a known conflict.
Example conflict declaration:
- %conflict REDUCE/REDUCE in state abstract_limited_opt,
abstract_limited_synchronized_opt on token NEW
+ %conflict REDUCE/REDUCE in state abstract_limited_opt,
abstract_limited_synchronized_opt on token NEW
The conflict description is output by 'wisitoken-bnf-generate' when
an undeclared conflict is detected. If the user decides to not fix
@@ -422,10 +416,12 @@ File: wisitoken-user_guide.info, Node: Other
declarations, Prev: Error recover
in 'wisi-indent' actions must be declared, so the elisp and Ada
code aggree on what they mean.
-'embedded_quote_escape_doubled'
- If present, quote characters embedded in strings are escaped by
- doubling (as in Ada); otherwise they are escaped by preceding with
- backslash (as in C). Default is backslash.
+'%elisp_action <elisp name> <Ada name>'
+ Declare elisp and Ada names for a custom action subprogram written
+ in Ada.
+
+ The term "elisp" here is historical; the name is not actually used
+ by elisp in the current implementation.
'end_names_optional_option <name>'
When generating Ada code for Emacs, the name of the Ada variable
@@ -434,31 +430,24 @@ File: wisitoken-user_guide.info, Node: Other
declarations, Prev: Error recover
In the Ada language, block names can be repeated at the end; for
example:
- Get_Inputs :
- loop
- ...
- end loop Get_Inputs;
+ Get_Inputs :
+ loop
+ ...
+ end loop Get_Inputs;
These names are optional in the Ada standard. Making them required
improves error recovery; the recovery algorithm can use matching
names to isolate the error.
-'generate <generate_algorithm> <output_language> [text_rep |'
- elisp | re2c | process | module]
+'generate <generate_algorithm> <output_language> [text_rep]'
'<generate_algorithm>' is one of 'LALR | LR1 | Packrat_Gen |
Packrat_Proc | External'
- '<output_language>' is one of 'Ada | Ada_Emacs | elisp'
-
- Declare one output source set. Multiple sets can be declared; they
- are all generated together.
+ '<output_language>' is one of 'Ada | Ada_Emacs'
- 'elisp | re2c' determine the lexer used by the generated code.
-
- 'process | module' determine the style of code generated by
- 'Ada_Emacs'; an external process executable, or an Emacs loadable
- module.
+ The algorithm/output_language pair declares one output source set.
+ Multiple sets can be declared; they are all generated together.
'text_rep' determines how the parse table is represented; if
present, it is in a text file that is loaded at parser run time.
@@ -469,11 +458,14 @@ File: wisitoken-user_guide.info, Node: Other
declarations, Prev: Error recover
in the code. The text file can take a long time to read at parser
startup (a few seconds for the Ada language).
-'%no_language_runtime'
- When generating Ada code for Emacs, '%no_language_runtime' causes
- the generated code to not include the runtime. Some grammars may
- need no runtime, particularly if they are small grammars intendend
- to test some generator feature.
+'%language_runtime'
+ Specify an alternate name for the language runtime package; the
+ default is 'Wisi.<language_name>'.
+
+'%meta_syntax [BNF | EBNF]'
+ Declares the syntax used by the grammar file. BNF is a minor
+ extension of standard Backus Naur Form; EBNF is a large extension.
+ The default is BNF.
'%no_enum'
By default, the generated Ada code includes an enumeration type
@@ -484,6 +476,19 @@ File: wisitoken-user_guide.info, Node: Other
declarations, Prev: Error recover
'%no_enum' causes the generated code to not include the token
enumeration type.
+'%no_language_runtime'
+ When generating Ada code for Emacs, '%no_language_runtime' causes
+ the generated code to not include the runtime. Some grammars may
+ need no runtime, particularly if they are small grammars intendend
+ to test some generator feature.
+
+'%partial_recursion'
+ The error recovery algorithm requires computing the recursion
+ present in the language grammar. For some grammars (such as Java),
+ this is too hard; '%partial_recursion' tells WisiToken to use a
+ simpler approximate calculation. This will affect the quality of
+ the error recovery, but it will still be robust.
+
'%start'
The start token for the grammar.
@@ -497,19 +502,23 @@ File: wisitoken-user_guide.info, Node: Nonterminals,
Next: Conditional code,
3.2 Nonterminals
================
-The nonterminals section declares the nonterminal tokens, and the
-associated production rules and actions.
+A nonterminal statement declares a nonterminal token, and the associated
+production rules and actions.
- The syntax of nonterminals is:
+ The syntax of a nonterminal statement is:
-{nonterminal} : {token} ... [ %( action code )% [| {token} ... [ %(
-action code )% ] ]... ;
+{nonterminal} : {token} ... [ %( post-parse action )% [ %( in-parse action )%
]] [| {token} ... [ %(
+action code )% ] ... ;
Each nonterminal gives the expansion of a nonterminal token into a
list of tokens (both terminal and nonterminal); optional productions are
-separated by "|". Each list of tokens is followed by an "action", which
-is output-language code (enclosed in '%( )%'), that will be executed
-when the production is reduced.
+separated by "|". Each list of tokens is followed by zero to two
+actions, one executed after the parse is complete, one during the parse
+when the production is reduced. in-parse actions can add semantic
+checks that help during error recovery. post-parse actions typically
+build an abstract syntax tree. The actions are written in
+output-language code; for 'Ada_Emacs' output, this is elisp (a hold-over
+from when WisiToken only output elisp code).
File: wisitoken-user_guide.info, Node: Conditional code, Prev: Nonterminals,
Up: Grammar File Syntax
@@ -517,16 +526,13 @@ File: wisitoken-user_guide.info, Node: Conditional code,
Prev: Nonterminals,
3.3 Conditional code
====================
-The elisp and elisp lexers support different regular expression syntax,
-so it is sometimes necessary to include or exclude some declarations and
-portions of rules based on the lexer.
+It is sometimes necessary to include or exclude some declarations and
+portions of rules based on the choice of lexer or parser.
- In addition, LALR parsers can have more conflicts than LR1 parsers.
-
- Therefore the EBNF supports '%if ... %end if':
-%if {lexer | parser} = {<lexer> | <generate_algorithm>}
-...
-%end if
+ Therefore WisiToken supports '%if ... %end if' in the grammar file:
+%if {lexer | parser} = {<lexer> | <generate_algorithm>}
+...
+%end if
The lines between '%if' and '%end if' are ignored if the current
lexer or parser is not the one specified in the '%if' condition.
@@ -536,19 +542,24 @@ lexer or parser is not the one specified in the '%if'
condition.
Tag Table:
-Node: Top721
-Node: Overview1366
-Node: Install2139
-Node: Common grammar problems2523
-Node: Empty choice in list2816
-Node: Grammar File Syntax5798
-Node: Declarations6355
-Node: Raw Code6675
-Node: Keywords7260
-Node: Tokens7569
-Node: Error recovery9217
-Node: Other declarations12453
-Node: Nonterminals16475
-Node: Conditional code17192
+Node: Top727
+Node: Overview1378
+Node: Install2140
+Node: Common grammar problems2637
+Node: Empty choice in list2930
+Node: Grammar File Syntax5912
+Node: Declarations6469
+Node: Raw Code6775
+Node: Keywords7157
+Node: Tokens7471
+Node: Error recovery8814
+Node: Other declarations12536
+Node: Nonterminals17033
+Node: Conditional code18069
End Tag Table
+
+
+Local Variables:
+coding: utf-8
+End:
diff --git a/wisitoken-wisi_ada.adb b/wisitoken-wisi_ada.adb
index 34dad7c..dd5e072 100644
--- a/wisitoken-wisi_ada.adb
+++ b/wisitoken-wisi_ada.adb
@@ -2,7 +2,7 @@
--
-- see spec
--
--- Copyright (C) 2013, 2014, 2015, 2017 - 2019 Free Software Foundation, Inc.
+-- Copyright (C) 2013, 2014, 2015, 2017 - 2020 Free Software Foundation, Inc.
--
-- This file is part of the WisiToken package.
--
@@ -47,17 +47,17 @@ package body WisiToken.Wisi_Ada is
function "+" (Tokens : in Token_ID_Arrays.Vector; Action : in
Syntax_Trees.Semantic_Action) return Right_Hand_Side
is begin
- return (Tokens, Action, null);
+ return (Tokens, Recursion => <>, Action => Action, Check => null);
end "+";
function "+" (Tokens : in Token_ID; Action : in
Syntax_Trees.Semantic_Action) return Right_Hand_Side
is begin
- return (Only (Tokens), Action, null);
+ return (Only (Tokens), Recursion => <>, Action => Action, Check => null);
end "+";
function "+" (Action : in Syntax_Trees.Semantic_Action) return
Right_Hand_Side
is begin
- return (Token_ID_Arrays.Empty_Vector, Action, null);
+ return (Tokens => <>, Recursion => <>, Action => Action, Check => null);
end "+";
function Only (Item : in WisiToken.Productions.Right_Hand_Side) return
WisiToken.Productions.RHS_Arrays.Vector
diff --git a/wisitoken.adb b/wisitoken.adb
index 16d9249..9efeb18 100644
--- a/wisitoken.adb
+++ b/wisitoken.adb
@@ -2,7 +2,7 @@
--
-- See spec
--
--- Copyright (C) 2009, 2014-2015, 2017 - 2019 Free Software Foundation, Inc.
+-- Copyright (C) 2009, 2014-2015, 2017 - 2020 Free Software Foundation, Inc.
--
-- This file is part of the WisiToken package.
--
@@ -224,26 +224,6 @@ package body WisiToken is
end return;
end To_Vector;
- function Net_Recursion (A, B : in Recursion) return Recursion
- is begin
- return
- (case A is
- when None => B,
- when Single =>
- (case B is
- when None => Single,
- when others => B),
- when Right =>
- (case B is
- when None | Single => Right,
- when others => B),
- when Left =>
- (case B is
- when None | Single | Left => Left,
- when others => B),
- when Middle => Middle);
- end Net_Recursion;
-
function Slice (Item : in Token_Array_Token_Set; I : in Token_ID) return
Token_ID_Set
is
Result : Token_ID_Set := (Item'First (2) .. Item'Last (2) => False);
@@ -376,7 +356,11 @@ package body WisiToken is
Descriptor : in WisiToken.Descriptor)
return String
is begin
- return "(" & Image (Item.ID, Descriptor) &
+ return
+ (if Item.Min_Terminal_Index = Invalid_Token_Index
+ then ""
+ else Trimmed_Image (Item.Min_Terminal_Index) & ":") &
+ "(" & Image (Item.ID, Descriptor) &
(if Item.Byte_Region = Null_Buffer_Region then "" else ", " & Image
(Item.Byte_Region)) & ")";
end Image;
diff --git a/wisitoken.ads b/wisitoken.ads
index 891fb26..0230d55 100644
--- a/wisitoken.ads
+++ b/wisitoken.ads
@@ -16,7 +16,7 @@
-- Sethi, and Ullman (aka: "The [Red] Dragon Book" due to the dragon
-- on the cover).
--
--- Copyright (C) 2009, 2010, 2013 - 2015, 2017 - 2019 Free Software
Foundation, Inc.
+-- Copyright (C) 2009, 2010, 2013 - 2015, 2017 - 2020 Free Software
Foundation, Inc.
--
-- This file is part of the WisiToken package.
--
@@ -142,7 +142,7 @@ package WisiToken is
-- is a terminal) or to Image_Width.
function Image (Item : in Token_ID; Desc : in Descriptor) return String;
- -- Return Desc.Image (Item), or empty string for Invalid_Token_ID.
+ -- Return Desc.Image (Item), or "-" for Invalid_Token_ID.
function Trimmed_Image is new SAL.Gen_Trimmed_Image (Token_ID);
@@ -160,6 +160,9 @@ package WisiToken is
(Positive, Token_ID, Default_Element => Invalid_Token_ID);
function Image is new Token_ID_Arrays.Gen_Image_Aux (Descriptor,
Trimmed_Image, Image);
+ function Image_No_Assoc (Item : in Token_ID_Arrays.Vector; Aux : in
Descriptor) return String
+ is (Image (Item, Aux, Association => False));
+
function Trimmed_Image is new Token_ID_Arrays.Gen_Image (Trimmed_Image);
procedure To_Vector (Item : in Token_ID_Array; Vector : in out
Token_ID_Arrays.Vector);
@@ -247,21 +250,17 @@ package WisiToken is
function "+" (Item : in Production_ID_Array) return
Production_ID_Arrays.Vector renames To_Vector;
function "+" (Item : in Production_ID) return Production_ID_Arrays.Vector
is (To_Vector ((1 => Item)));
- type Recursion is
- (None,
- Single, -- Single token in right hand side is recursive.
- Middle, -- Multiple tokens in right hand side, recursive token not at
either end.
- Right, -- Multiple tokens in right hand side, recursive token not at
right end.
- Left -- Multiple tokens in right hand side, recursive token not at
left end.
- );
- -- In worst-case order; Left recursion causes the most
- -- problems in LR error recovery, and in Packrat.
-
- function Worst_Recursion (A, B : in Recursion) return Recursion
- is (Recursion'Max (A, B));
+ type Token_Array_Production_ID is array (Token_ID range <>) of
Production_ID;
- function Net_Recursion (A, B : in Recursion) return Recursion;
- -- For finding the net recursion of a chain; Middle dominates.
+ type Recursion_Class is (None, Direct_Left, Other_Left, Other, Other_Right,
Direct_Right);
+ function Image (Item : in Recursion_Class) return String
+ is (case Item is
+ when None => "None",
+ when Direct_Left => "Direct_Left",
+ when Other_Left => "Other_Left",
+ when Other => "Other",
+ when Other_Right => "Other_Right",
+ when Direct_Right => "Direct_Right");
----------
-- Tokens
@@ -291,11 +290,26 @@ package WisiToken is
Invalid_Line_Number : constant Line_Number_Type := Line_Number_Type'Last;
+ -- Syntax tree nodes.
+ type Node_Index is range 0 .. Integer'Last;
+ subtype Valid_Node_Index is Node_Index range 1 .. Node_Index'Last;
+
+ Invalid_Node_Index : constant Node_Index := Node_Index'First;
+
+ type Valid_Node_Index_Array is array (Positive_Index_Type range <>) of
Valid_Node_Index;
+ -- Index matches Base_Token_Array, Augmented_Token_Array
+
+ package Valid_Node_Index_Arrays is new SAL.Gen_Unbounded_Definite_Vectors
+ (Positive_Index_Type, Valid_Node_Index, Default_Element =>
Valid_Node_Index'First);
+ -- Index matches Valid_Node_Index_Array.
+
type Base_Token is tagged record
- -- Base_Token is used in the core parser. The parser only needs ID;
+ -- Base_Token is used in the core parser. The parser only needs ID and
Tree_Node;
-- semantic checks need Byte_Region to compare names. Line, Col, and
-- Char_Region are included for error messages.
- ID : Token_ID := Invalid_Token_ID;
+
+ ID : Token_ID := Invalid_Token_ID;
+ Tree_Index : Node_Index := Invalid_Node_Index;
Byte_Region : Buffer_Region := Null_Buffer_Region;
-- Index into the Lexer buffer for the token text.
@@ -352,8 +366,8 @@ package WisiToken is
(Line_Number_Type, Base_Token_Index, Default_Element =>
Invalid_Token_Index);
type Recover_Token is record
- -- Maintaining a syntax tree during recover is too slow, so we store
- -- enough information in the recover stack to perform
+ -- Maintaining a syntax tree during error recovery is too slow, so we
+ -- store enough information in the recover stack to perform
-- Semantic_Checks, Language_Fixes, and Push_Back operations. and to
-- apply the solution to the main parser state. We make thousands of
-- copies of the parse stack during recover, so minimizing size and
@@ -419,7 +433,9 @@ package WisiToken is
Trace_Action : Integer := 0;
-- Output during Execute_Action, and unit tests.
- Trace_Generate : Integer := 0;
+ Trace_Generate_EBNF : Integer := 0;
+ Trace_Generate_Table : Integer := 0;
+ Trace_Generate_Minimal_Complete : Integer := 0;
-- Output during grammar generation.
Debug_Mode : Boolean := False;
diff --git a/wisitoken_grammar_actions.adb b/wisitoken_grammar_actions.adb
index 8f4faf7..8819828 100644
--- a/wisitoken_grammar_actions.adb
+++ b/wisitoken_grammar_actions.adb
@@ -28,8 +28,8 @@ package body Wisitoken_Grammar_Actions is
procedure declaration_0
(User_Data : in out WisiToken.Syntax_Trees.User_Data_Type'Class;
Tree : in out WisiToken.Syntax_Trees.Tree;
- Nonterm : in WisiToken.Syntax_Trees.Valid_Node_Index;
- Tokens : in WisiToken.Syntax_Trees.Valid_Node_Index_Array)
+ Nonterm : in WisiToken.Valid_Node_Index;
+ Tokens : in WisiToken.Valid_Node_Index_Array)
is
pragma Unreferenced (Nonterm);
begin
@@ -39,8 +39,8 @@ package body Wisitoken_Grammar_Actions is
procedure declaration_1
(User_Data : in out WisiToken.Syntax_Trees.User_Data_Type'Class;
Tree : in out WisiToken.Syntax_Trees.Tree;
- Nonterm : in WisiToken.Syntax_Trees.Valid_Node_Index;
- Tokens : in WisiToken.Syntax_Trees.Valid_Node_Index_Array)
+ Nonterm : in WisiToken.Valid_Node_Index;
+ Tokens : in WisiToken.Valid_Node_Index_Array)
is
pragma Unreferenced (Nonterm);
begin
@@ -50,8 +50,8 @@ package body Wisitoken_Grammar_Actions is
procedure declaration_2
(User_Data : in out WisiToken.Syntax_Trees.User_Data_Type'Class;
Tree : in out WisiToken.Syntax_Trees.Tree;
- Nonterm : in WisiToken.Syntax_Trees.Valid_Node_Index;
- Tokens : in WisiToken.Syntax_Trees.Valid_Node_Index_Array)
+ Nonterm : in WisiToken.Valid_Node_Index;
+ Tokens : in WisiToken.Valid_Node_Index_Array)
is
pragma Unreferenced (Nonterm);
begin
@@ -61,8 +61,8 @@ package body Wisitoken_Grammar_Actions is
procedure declaration_3
(User_Data : in out WisiToken.Syntax_Trees.User_Data_Type'Class;
Tree : in out WisiToken.Syntax_Trees.Tree;
- Nonterm : in WisiToken.Syntax_Trees.Valid_Node_Index;
- Tokens : in WisiToken.Syntax_Trees.Valid_Node_Index_Array)
+ Nonterm : in WisiToken.Valid_Node_Index;
+ Tokens : in WisiToken.Valid_Node_Index_Array)
is
pragma Unreferenced (Nonterm);
begin
@@ -72,8 +72,8 @@ package body Wisitoken_Grammar_Actions is
procedure declaration_4
(User_Data : in out WisiToken.Syntax_Trees.User_Data_Type'Class;
Tree : in out WisiToken.Syntax_Trees.Tree;
- Nonterm : in WisiToken.Syntax_Trees.Valid_Node_Index;
- Tokens : in WisiToken.Syntax_Trees.Valid_Node_Index_Array)
+ Nonterm : in WisiToken.Valid_Node_Index;
+ Tokens : in WisiToken.Valid_Node_Index_Array)
is
pragma Unreferenced (Nonterm);
begin
@@ -83,8 +83,8 @@ package body Wisitoken_Grammar_Actions is
procedure declaration_5
(User_Data : in out WisiToken.Syntax_Trees.User_Data_Type'Class;
Tree : in out WisiToken.Syntax_Trees.Tree;
- Nonterm : in WisiToken.Syntax_Trees.Valid_Node_Index;
- Tokens : in WisiToken.Syntax_Trees.Valid_Node_Index_Array)
+ Nonterm : in WisiToken.Valid_Node_Index;
+ Tokens : in WisiToken.Valid_Node_Index_Array)
is
pragma Unreferenced (Tree, Nonterm, Tokens);
begin
@@ -94,8 +94,8 @@ package body Wisitoken_Grammar_Actions is
procedure nonterminal_0
(User_Data : in out WisiToken.Syntax_Trees.User_Data_Type'Class;
Tree : in out WisiToken.Syntax_Trees.Tree;
- Nonterm : in WisiToken.Syntax_Trees.Valid_Node_Index;
- Tokens : in WisiToken.Syntax_Trees.Valid_Node_Index_Array)
+ Nonterm : in WisiToken.Valid_Node_Index;
+ Tokens : in WisiToken.Valid_Node_Index_Array)
is
pragma Unreferenced (Nonterm);
begin
@@ -105,8 +105,8 @@ package body Wisitoken_Grammar_Actions is
procedure nonterminal_1
(User_Data : in out WisiToken.Syntax_Trees.User_Data_Type'Class;
Tree : in out WisiToken.Syntax_Trees.Tree;
- Nonterm : in WisiToken.Syntax_Trees.Valid_Node_Index;
- Tokens : in WisiToken.Syntax_Trees.Valid_Node_Index_Array)
+ Nonterm : in WisiToken.Valid_Node_Index;
+ Tokens : in WisiToken.Valid_Node_Index_Array)
is
pragma Unreferenced (Nonterm);
begin
@@ -116,8 +116,8 @@ package body Wisitoken_Grammar_Actions is
procedure rhs_item_1
(User_Data : in out WisiToken.Syntax_Trees.User_Data_Type'Class;
Tree : in out WisiToken.Syntax_Trees.Tree;
- Nonterm : in WisiToken.Syntax_Trees.Valid_Node_Index;
- Tokens : in WisiToken.Syntax_Trees.Valid_Node_Index_Array)
+ Nonterm : in WisiToken.Valid_Node_Index;
+ Tokens : in WisiToken.Valid_Node_Index_Array)
is
pragma Unreferenced (Nonterm);
begin
@@ -127,8 +127,8 @@ package body Wisitoken_Grammar_Actions is
procedure rhs_item_2
(User_Data : in out WisiToken.Syntax_Trees.User_Data_Type'Class;
Tree : in out WisiToken.Syntax_Trees.Tree;
- Nonterm : in WisiToken.Syntax_Trees.Valid_Node_Index;
- Tokens : in WisiToken.Syntax_Trees.Valid_Node_Index_Array)
+ Nonterm : in WisiToken.Valid_Node_Index;
+ Tokens : in WisiToken.Valid_Node_Index_Array)
is
pragma Unreferenced (Nonterm);
begin
@@ -138,8 +138,8 @@ package body Wisitoken_Grammar_Actions is
procedure rhs_item_3
(User_Data : in out WisiToken.Syntax_Trees.User_Data_Type'Class;
Tree : in out WisiToken.Syntax_Trees.Tree;
- Nonterm : in WisiToken.Syntax_Trees.Valid_Node_Index;
- Tokens : in WisiToken.Syntax_Trees.Valid_Node_Index_Array)
+ Nonterm : in WisiToken.Valid_Node_Index;
+ Tokens : in WisiToken.Valid_Node_Index_Array)
is
pragma Unreferenced (Nonterm);
begin
@@ -149,8 +149,8 @@ package body Wisitoken_Grammar_Actions is
procedure rhs_item_4
(User_Data : in out WisiToken.Syntax_Trees.User_Data_Type'Class;
Tree : in out WisiToken.Syntax_Trees.Tree;
- Nonterm : in WisiToken.Syntax_Trees.Valid_Node_Index;
- Tokens : in WisiToken.Syntax_Trees.Valid_Node_Index_Array)
+ Nonterm : in WisiToken.Valid_Node_Index;
+ Tokens : in WisiToken.Valid_Node_Index_Array)
is
pragma Unreferenced (Nonterm);
begin
@@ -160,8 +160,8 @@ package body Wisitoken_Grammar_Actions is
procedure rhs_item_5
(User_Data : in out WisiToken.Syntax_Trees.User_Data_Type'Class;
Tree : in out WisiToken.Syntax_Trees.Tree;
- Nonterm : in WisiToken.Syntax_Trees.Valid_Node_Index;
- Tokens : in WisiToken.Syntax_Trees.Valid_Node_Index_Array)
+ Nonterm : in WisiToken.Valid_Node_Index;
+ Tokens : in WisiToken.Valid_Node_Index_Array)
is
pragma Unreferenced (Nonterm);
begin
@@ -171,8 +171,8 @@ package body Wisitoken_Grammar_Actions is
procedure rhs_optional_item_3
(User_Data : in out WisiToken.Syntax_Trees.User_Data_Type'Class;
Tree : in out WisiToken.Syntax_Trees.Tree;
- Nonterm : in WisiToken.Syntax_Trees.Valid_Node_Index;
- Tokens : in WisiToken.Syntax_Trees.Valid_Node_Index_Array)
+ Nonterm : in WisiToken.Valid_Node_Index;
+ Tokens : in WisiToken.Valid_Node_Index_Array)
is
pragma Unreferenced (Nonterm);
begin
diff --git a/wisitoken_grammar_actions.ads b/wisitoken_grammar_actions.ads
index 5e346e8..1308267 100644
--- a/wisitoken_grammar_actions.ads
+++ b/wisitoken_grammar_actions.ads
@@ -167,71 +167,71 @@ package Wisitoken_Grammar_Actions is
procedure declaration_0
(User_Data : in out WisiToken.Syntax_Trees.User_Data_Type'Class;
Tree : in out WisiToken.Syntax_Trees.Tree;
- Nonterm : in WisiToken.Syntax_Trees.Valid_Node_Index;
- Tokens : in WisiToken.Syntax_Trees.Valid_Node_Index_Array);
+ Nonterm : in WisiToken.Valid_Node_Index;
+ Tokens : in WisiToken.Valid_Node_Index_Array);
procedure declaration_1
(User_Data : in out WisiToken.Syntax_Trees.User_Data_Type'Class;
Tree : in out WisiToken.Syntax_Trees.Tree;
- Nonterm : in WisiToken.Syntax_Trees.Valid_Node_Index;
- Tokens : in WisiToken.Syntax_Trees.Valid_Node_Index_Array);
+ Nonterm : in WisiToken.Valid_Node_Index;
+ Tokens : in WisiToken.Valid_Node_Index_Array);
procedure declaration_2
(User_Data : in out WisiToken.Syntax_Trees.User_Data_Type'Class;
Tree : in out WisiToken.Syntax_Trees.Tree;
- Nonterm : in WisiToken.Syntax_Trees.Valid_Node_Index;
- Tokens : in WisiToken.Syntax_Trees.Valid_Node_Index_Array);
+ Nonterm : in WisiToken.Valid_Node_Index;
+ Tokens : in WisiToken.Valid_Node_Index_Array);
procedure declaration_3
(User_Data : in out WisiToken.Syntax_Trees.User_Data_Type'Class;
Tree : in out WisiToken.Syntax_Trees.Tree;
- Nonterm : in WisiToken.Syntax_Trees.Valid_Node_Index;
- Tokens : in WisiToken.Syntax_Trees.Valid_Node_Index_Array);
+ Nonterm : in WisiToken.Valid_Node_Index;
+ Tokens : in WisiToken.Valid_Node_Index_Array);
procedure declaration_4
(User_Data : in out WisiToken.Syntax_Trees.User_Data_Type'Class;
Tree : in out WisiToken.Syntax_Trees.Tree;
- Nonterm : in WisiToken.Syntax_Trees.Valid_Node_Index;
- Tokens : in WisiToken.Syntax_Trees.Valid_Node_Index_Array);
+ Nonterm : in WisiToken.Valid_Node_Index;
+ Tokens : in WisiToken.Valid_Node_Index_Array);
procedure declaration_5
(User_Data : in out WisiToken.Syntax_Trees.User_Data_Type'Class;
Tree : in out WisiToken.Syntax_Trees.Tree;
- Nonterm : in WisiToken.Syntax_Trees.Valid_Node_Index;
- Tokens : in WisiToken.Syntax_Trees.Valid_Node_Index_Array);
+ Nonterm : in WisiToken.Valid_Node_Index;
+ Tokens : in WisiToken.Valid_Node_Index_Array);
procedure nonterminal_0
(User_Data : in out WisiToken.Syntax_Trees.User_Data_Type'Class;
Tree : in out WisiToken.Syntax_Trees.Tree;
- Nonterm : in WisiToken.Syntax_Trees.Valid_Node_Index;
- Tokens : in WisiToken.Syntax_Trees.Valid_Node_Index_Array);
+ Nonterm : in WisiToken.Valid_Node_Index;
+ Tokens : in WisiToken.Valid_Node_Index_Array);
procedure nonterminal_1
(User_Data : in out WisiToken.Syntax_Trees.User_Data_Type'Class;
Tree : in out WisiToken.Syntax_Trees.Tree;
- Nonterm : in WisiToken.Syntax_Trees.Valid_Node_Index;
- Tokens : in WisiToken.Syntax_Trees.Valid_Node_Index_Array);
+ Nonterm : in WisiToken.Valid_Node_Index;
+ Tokens : in WisiToken.Valid_Node_Index_Array);
procedure rhs_item_1
(User_Data : in out WisiToken.Syntax_Trees.User_Data_Type'Class;
Tree : in out WisiToken.Syntax_Trees.Tree;
- Nonterm : in WisiToken.Syntax_Trees.Valid_Node_Index;
- Tokens : in WisiToken.Syntax_Trees.Valid_Node_Index_Array);
+ Nonterm : in WisiToken.Valid_Node_Index;
+ Tokens : in WisiToken.Valid_Node_Index_Array);
procedure rhs_item_2
(User_Data : in out WisiToken.Syntax_Trees.User_Data_Type'Class;
Tree : in out WisiToken.Syntax_Trees.Tree;
- Nonterm : in WisiToken.Syntax_Trees.Valid_Node_Index;
- Tokens : in WisiToken.Syntax_Trees.Valid_Node_Index_Array);
+ Nonterm : in WisiToken.Valid_Node_Index;
+ Tokens : in WisiToken.Valid_Node_Index_Array);
procedure rhs_item_3
(User_Data : in out WisiToken.Syntax_Trees.User_Data_Type'Class;
Tree : in out WisiToken.Syntax_Trees.Tree;
- Nonterm : in WisiToken.Syntax_Trees.Valid_Node_Index;
- Tokens : in WisiToken.Syntax_Trees.Valid_Node_Index_Array);
+ Nonterm : in WisiToken.Valid_Node_Index;
+ Tokens : in WisiToken.Valid_Node_Index_Array);
procedure rhs_item_4
(User_Data : in out WisiToken.Syntax_Trees.User_Data_Type'Class;
Tree : in out WisiToken.Syntax_Trees.Tree;
- Nonterm : in WisiToken.Syntax_Trees.Valid_Node_Index;
- Tokens : in WisiToken.Syntax_Trees.Valid_Node_Index_Array);
+ Nonterm : in WisiToken.Valid_Node_Index;
+ Tokens : in WisiToken.Valid_Node_Index_Array);
procedure rhs_item_5
(User_Data : in out WisiToken.Syntax_Trees.User_Data_Type'Class;
Tree : in out WisiToken.Syntax_Trees.Tree;
- Nonterm : in WisiToken.Syntax_Trees.Valid_Node_Index;
- Tokens : in WisiToken.Syntax_Trees.Valid_Node_Index_Array);
+ Nonterm : in WisiToken.Valid_Node_Index;
+ Tokens : in WisiToken.Valid_Node_Index_Array);
procedure rhs_optional_item_3
(User_Data : in out WisiToken.Syntax_Trees.User_Data_Type'Class;
Tree : in out WisiToken.Syntax_Trees.Tree;
- Nonterm : in WisiToken.Syntax_Trees.Valid_Node_Index;
- Tokens : in WisiToken.Syntax_Trees.Valid_Node_Index_Array);
+ Nonterm : in WisiToken.Valid_Node_Index;
+ Tokens : in WisiToken.Valid_Node_Index_Array);
end Wisitoken_Grammar_Actions;
diff --git a/wisitoken_grammar_main.adb b/wisitoken_grammar_main.adb
index 981e60c..cb91adf 100644
--- a/wisitoken_grammar_main.adb
+++ b/wisitoken_grammar_main.adb
@@ -50,86 +50,86 @@ package body Wisitoken_Grammar_Main is
procedure Subr_1
is begin
Table.States (0).Action_List.Set_Capacity (2);
- Add_Action (Table.States (0), 23, 1);
- Add_Action (Table.States (0), 33, 2);
+ Add_Action (Table.States (0), 23, (38, 0), 1);
+ Add_Action (Table.States (0), 33, (43, 0), 2);
Table.States (0).Goto_List.Set_Capacity (4);
Add_Goto (Table.States (0), 38, 3);
Add_Goto (Table.States (0), 43, 4);
Add_Goto (Table.States (0), 55, 5);
Add_Goto (Table.States (0), 56, 6);
Table.States (1).Action_List.Set_Capacity (7);
- Add_Action (Table.States (1), 3, 7);
- Add_Action (Table.States (1), 4, 8);
- Add_Action (Table.States (1), 5, 9);
- Add_Action (Table.States (1), 6, 10);
- Add_Action (Table.States (1), 7, 11);
- Add_Action (Table.States (1), 8, 12);
- Add_Action (Table.States (1), 33, 13);
+ Add_Action (Table.States (1), 3, (38, 1), 7);
+ Add_Action (Table.States (1), 4, (38, 5), 8);
+ Add_Action (Table.States (1), 5, (38, 4), 9);
+ Add_Action (Table.States (1), 6, (39, 0), 10);
+ Add_Action (Table.States (1), 7, (39, 1), 11);
+ Add_Action (Table.States (1), 8, (39, 2), 12);
+ Add_Action (Table.States (1), 33, (38, 2), 13);
Table.States (1).Goto_List.Set_Capacity (1);
Add_Goto (Table.States (1), 39, 14);
Table.States (2).Action_List.Set_Capacity (2);
- Add_Action (Table.States (2), 13, 15);
- Add_Action (Table.States (2), 14, 16);
+ Add_Action (Table.States (2), 13, (43, 0), 15);
+ Add_Action (Table.States (2), 14, (43, 1), 16);
Table.States (3).Action_List.Set_Capacity (3);
- Add_Action (Table.States (3), (23, 33, 36), (55, 0), 1, null,
null);
+ Add_Action (Table.States (3), (23, 33, 36), (55, 0), 1, null,
null);
Table.States (4).Action_List.Set_Capacity (3);
- Add_Action (Table.States (4), (23, 33, 36), (55, 1), 1, null,
null);
+ Add_Action (Table.States (4), (23, 33, 36), (55, 1), 1, null,
null);
Table.States (5).Action_List.Set_Capacity (3);
- Add_Action (Table.States (5), (23, 33, 36), (56, 0), 1, null,
null);
+ Add_Action (Table.States (5), (23, 33, 36), (56, 0), 1, null,
null);
Table.States (6).Action_List.Set_Capacity (3);
- Add_Action (Table.States (6), 23, 1);
- Add_Action (Table.States (6), 33, 2);
- Add_Action (Table.States (6), 36, Accept_It, (37, 0), 1, null,
null);
+ Add_Action (Table.States (6), 23, (38, 0), 1);
+ Add_Action (Table.States (6), 33, (43, 0), 2);
+ Add_Action (Table.States (6), 36, Accept_It, (37, 0), 1, null,
null);
Table.States (6).Goto_List.Set_Capacity (3);
Add_Goto (Table.States (6), 38, 3);
Add_Goto (Table.States (6), 43, 4);
Add_Goto (Table.States (6), 55, 17);
Table.States (7).Action_List.Set_Capacity (1);
- Add_Action (Table.States (7), 33, 18);
+ Add_Action (Table.States (7), 33, (40, 0), 18);
Table.States (7).Goto_List.Set_Capacity (1);
Add_Goto (Table.States (7), 40, 19);
Table.States (8).Action_List.Set_Capacity (1);
- Add_Action (Table.States (8), 5, 20);
+ Add_Action (Table.States (8), 5, (38, 5), 20);
Table.States (9).Action_List.Set_Capacity (1);
- Add_Action (Table.States (9), 33, 21);
+ Add_Action (Table.States (9), 33, (38, 4), 21);
Table.States (10).Action_List.Set_Capacity (1);
- Add_Action (Table.States (10), (1 => 33), (39, 0), 1, null, null);
+ Add_Action (Table.States (10), (1 => 33), (39, 0), 1, null,
null);
Table.States (11).Action_List.Set_Capacity (1);
- Add_Action (Table.States (11), 21, 22);
+ Add_Action (Table.States (11), 21, (39, 1), 22);
Table.States (12).Action_List.Set_Capacity (1);
- Add_Action (Table.States (12), 21, 23);
+ Add_Action (Table.States (12), 21, (39, 2), 23);
Table.States (13).Action_List.Set_Capacity (13);
- Add_Action (Table.States (13), 8, 24);
- Add_Action (Table.States (13), 10, 25);
- Add_Action (Table.States (13), 15, 26);
- Add_Action (Table.States (13), 16, 27);
- Add_Action (Table.States (13), 20, 28);
- Add_Action (Table.States (13), 23, Reduce, (38, 3), 2,
declaration_3'Access, null);
- Add_Action (Table.States (13), 28, 29);
- Add_Action (Table.States (13), 30, 30);
- Add_Action (Table.States (13), 32, 31);
- Add_Action (Table.States (13), 33, 32);
- Add_Conflict (Table.States (13), 33, (38, 3), 2,
declaration_3'Access, null);
- Add_Action (Table.States (13), 34, 33);
- Add_Action (Table.States (13), 35, 34);
- Add_Action (Table.States (13), 36, Reduce, (38, 3), 2,
declaration_3'Access, null);
+ Add_Action (Table.States (13), 8, (42, 10), 24);
+ Add_Action (Table.States (13), 10, (42, 5), 25);
+ Add_Action (Table.States (13), 15, (42, 0), 26);
+ Add_Action (Table.States (13), 16, (42, 2), 27);
+ Add_Action (Table.States (13), 20, (42, 3), 28);
+ Add_Action (Table.States (13), 23, Reduce, (38, 3), 2,
declaration_3'Access, null);
+ Add_Action (Table.States (13), 28, (42, 6), 29);
+ Add_Action (Table.States (13), 30, (42, 7), 30);
+ Add_Action (Table.States (13), 32, (42, 4), 31);
+ Add_Action (Table.States (13), 33, (42, 1), 32);
+ Add_Conflict (Table.States (13), 33, (38, 3), 2,
declaration_3'Access, null);
+ Add_Action (Table.States (13), 34, (42, 8), 33);
+ Add_Action (Table.States (13), 35, (42, 9), 34);
+ Add_Action (Table.States (13), 36, Reduce, (38, 3), 2,
declaration_3'Access, null);
Table.States (13).Goto_List.Set_Capacity (2);
Add_Goto (Table.States (13), 41, 35);
Add_Goto (Table.States (13), 42, 36);
Table.States (14).Action_List.Set_Capacity (1);
- Add_Action (Table.States (14), 33, 37);
+ Add_Action (Table.States (14), 33, (38, 0), 37);
Table.States (15).Action_List.Set_Capacity (10);
- Add_Action (Table.States (15), 12, Reduce, (46, 0), 0, null, null);
- Add_Action (Table.States (15), 18, 38);
- Add_Action (Table.States (15), 19, 39);
- Add_Action (Table.States (15), 20, 40);
- Add_Action (Table.States (15), 21, 41);
- Add_Action (Table.States (15), 23, Reduce, (46, 0), 0, null, null);
- Add_Action (Table.States (15), 29, Reduce, (46, 0), 0, null, null);
- Add_Action (Table.States (15), 33, 42);
- Add_Conflict (Table.States (15), 33, (46, 0), 0, null, null);
- Add_Action (Table.States (15), 35, 43);
- Add_Action (Table.States (15), 36, Reduce, (46, 0), 0, null, null);
+ Add_Action (Table.States (15), 12, Reduce, (46, 0), 0, null,
null);
+ Add_Action (Table.States (15), 18, (53, 0), 38);
+ Add_Action (Table.States (15), 19, (52, 0), 39);
+ Add_Action (Table.States (15), 20, (51, 0), 40);
+ Add_Action (Table.States (15), 21, (47, 0), 41);
+ Add_Action (Table.States (15), 23, Reduce, (46, 0), 0, null,
null);
+ Add_Action (Table.States (15), 29, Reduce, (46, 0), 0, null,
null);
+ Add_Action (Table.States (15), 33, (48, 1), 42);
+ Add_Conflict (Table.States (15), 33, (46, 0), 0, null, null);
+ Add_Action (Table.States (15), 35, (50, 1), 43);
+ Add_Action (Table.States (15), 36, Reduce, (46, 0), 0, null,
null);
Table.States (15).Goto_List.Set_Capacity (9);
Add_Goto (Table.States (15), 45, 44);
Add_Goto (Table.States (15), 46, 45);
@@ -141,17 +141,17 @@ package body Wisitoken_Grammar_Main is
Add_Goto (Table.States (15), 52, 51);
Add_Goto (Table.States (15), 53, 52);
Table.States (16).Action_List.Set_Capacity (10);
- Add_Action (Table.States (16), 12, Reduce, (46, 0), 0, null, null);
- Add_Action (Table.States (16), 18, 38);
- Add_Action (Table.States (16), 19, 39);
- Add_Action (Table.States (16), 20, 40);
- Add_Action (Table.States (16), 21, 41);
- Add_Action (Table.States (16), 23, Reduce, (46, 0), 0, null, null);
- Add_Action (Table.States (16), 29, Reduce, (46, 0), 0, null, null);
- Add_Action (Table.States (16), 33, 42);
- Add_Conflict (Table.States (16), 33, (46, 0), 0, null, null);
- Add_Action (Table.States (16), 35, 43);
- Add_Action (Table.States (16), 36, Reduce, (46, 0), 0, null, null);
+ Add_Action (Table.States (16), 12, Reduce, (46, 0), 0, null,
null);
+ Add_Action (Table.States (16), 18, (53, 0), 38);
+ Add_Action (Table.States (16), 19, (52, 0), 39);
+ Add_Action (Table.States (16), 20, (51, 0), 40);
+ Add_Action (Table.States (16), 21, (47, 0), 41);
+ Add_Action (Table.States (16), 23, Reduce, (46, 0), 0, null,
null);
+ Add_Action (Table.States (16), 29, Reduce, (46, 0), 0, null,
null);
+ Add_Action (Table.States (16), 33, (48, 1), 42);
+ Add_Conflict (Table.States (16), 33, (46, 0), 0, null, null);
+ Add_Action (Table.States (16), 35, (50, 1), 43);
+ Add_Action (Table.States (16), 36, Reduce, (46, 0), 0, null,
null);
Table.States (16).Goto_List.Set_Capacity (9);
Add_Goto (Table.States (16), 45, 53);
Add_Goto (Table.States (16), 46, 45);
@@ -163,95 +163,95 @@ package body Wisitoken_Grammar_Main is
Add_Goto (Table.States (16), 52, 51);
Add_Goto (Table.States (16), 53, 52);
Table.States (17).Action_List.Set_Capacity (3);
- Add_Action (Table.States (17), (23, 33, 36), (56, 1), 2, null,
null);
+ Add_Action (Table.States (17), (23, 33, 36), (56, 1), 2, null,
null);
Table.States (18).Action_List.Set_Capacity (2);
- Add_Action (Table.States (18), (9, 33), (40, 0), 1, null, null);
+ Add_Action (Table.States (18), (9, 33), (40, 0), 1, null, null);
Table.States (19).Action_List.Set_Capacity (2);
- Add_Action (Table.States (19), 9, 54);
- Add_Action (Table.States (19), 33, 55);
+ Add_Action (Table.States (19), 9, (38, 1), 54);
+ Add_Action (Table.States (19), 33, (40, 1), 55);
Table.States (20).Action_List.Set_Capacity (3);
- Add_Action (Table.States (20), (23, 33, 36), (38, 5), 3,
declaration_5'Access, null);
+ Add_Action (Table.States (20), (23, 33, 36), (38, 5), 3,
declaration_5'Access, null);
Table.States (21).Action_List.Set_Capacity (1);
- Add_Action (Table.States (21), 16, 56);
+ Add_Action (Table.States (21), 16, (38, 4), 56);
Table.States (22).Action_List.Set_Capacity (1);
- Add_Action (Table.States (22), 33, 57);
+ Add_Action (Table.States (22), 33, (39, 1), 57);
Table.States (23).Action_List.Set_Capacity (1);
- Add_Action (Table.States (23), 33, 58);
+ Add_Action (Table.States (23), 33, (39, 2), 58);
Table.States (24).Action_List.Set_Capacity (13);
- Add_Action (Table.States (24), (8, 10, 15, 16, 20, 23, 28, 30, 32,
33, 34, 35, 36), (42, 10), 1, null,
+ Add_Action (Table.States (24), (8, 10, 15, 16, 20, 23, 28, 30, 32,
33, 34, 35, 36), (42, 10), 1, null,
null);
Table.States (25).Action_List.Set_Capacity (13);
- Add_Action (Table.States (25), (8, 10, 15, 16, 20, 23, 28, 30, 32,
33, 34, 35, 36), (42, 5), 1, null,
+ Add_Action (Table.States (25), (8, 10, 15, 16, 20, 23, 28, 30, 32,
33, 34, 35, 36), (42, 5), 1, null,
null);
Table.States (26).Action_List.Set_Capacity (13);
- Add_Action (Table.States (26), (8, 10, 15, 16, 20, 23, 28, 30, 32,
33, 34, 35, 36), (42, 0), 1, null,
+ Add_Action (Table.States (26), (8, 10, 15, 16, 20, 23, 28, 30, 32,
33, 34, 35, 36), (42, 0), 1, null,
null);
Table.States (27).Action_List.Set_Capacity (13);
- Add_Action (Table.States (27), (8, 10, 15, 16, 20, 23, 28, 30, 32,
33, 34, 35, 36), (42, 2), 1, null,
+ Add_Action (Table.States (27), (8, 10, 15, 16, 20, 23, 28, 30, 32,
33, 34, 35, 36), (42, 2), 1, null,
null);
Table.States (28).Action_List.Set_Capacity (13);
- Add_Action (Table.States (28), (8, 10, 15, 16, 20, 23, 28, 30, 32,
33, 34, 35, 36), (42, 3), 1, null,
+ Add_Action (Table.States (28), (8, 10, 15, 16, 20, 23, 28, 30, 32,
33, 34, 35, 36), (42, 3), 1, null,
null);
Table.States (29).Action_List.Set_Capacity (13);
- Add_Action (Table.States (29), (8, 10, 15, 16, 20, 23, 28, 30, 32,
33, 34, 35, 36), (42, 6), 1, null,
+ Add_Action (Table.States (29), (8, 10, 15, 16, 20, 23, 28, 30, 32,
33, 34, 35, 36), (42, 6), 1, null,
null);
Table.States (30).Action_List.Set_Capacity (13);
- Add_Action (Table.States (30), (8, 10, 15, 16, 20, 23, 28, 30, 32,
33, 34, 35, 36), (42, 7), 1, null,
+ Add_Action (Table.States (30), (8, 10, 15, 16, 20, 23, 28, 30, 32,
33, 34, 35, 36), (42, 7), 1, null,
null);
Table.States (31).Action_List.Set_Capacity (13);
- Add_Action (Table.States (31), (8, 10, 15, 16, 20, 23, 28, 30, 32,
33, 34, 35, 36), (42, 4), 1, null,
+ Add_Action (Table.States (31), (8, 10, 15, 16, 20, 23, 28, 30, 32,
33, 34, 35, 36), (42, 4), 1, null,
null);
Table.States (32).Action_List.Set_Capacity (13);
- Add_Action (Table.States (32), (8, 10, 15, 16, 20, 23, 28, 30, 32,
33, 34, 35, 36), (42, 1), 1, null,
+ Add_Action (Table.States (32), (8, 10, 15, 16, 20, 23, 28, 30, 32,
33, 34, 35, 36), (42, 1), 1, null,
null);
Table.States (33).Action_List.Set_Capacity (13);
- Add_Action (Table.States (33), (8, 10, 15, 16, 20, 23, 28, 30, 32,
33, 34, 35, 36), (42, 8), 1, null,
+ Add_Action (Table.States (33), (8, 10, 15, 16, 20, 23, 28, 30, 32,
33, 34, 35, 36), (42, 8), 1, null,
null);
Table.States (34).Action_List.Set_Capacity (13);
- Add_Action (Table.States (34), (8, 10, 15, 16, 20, 23, 28, 30, 32,
33, 34, 35, 36), (42, 9), 1, null,
+ Add_Action (Table.States (34), (8, 10, 15, 16, 20, 23, 28, 30, 32,
33, 34, 35, 36), (42, 9), 1, null,
null);
Table.States (35).Action_List.Set_Capacity (13);
- Add_Action (Table.States (35), 8, 24);
- Add_Action (Table.States (35), 10, 25);
- Add_Action (Table.States (35), 15, 26);
- Add_Action (Table.States (35), 16, 27);
- Add_Action (Table.States (35), 20, 28);
- Add_Action (Table.States (35), 23, Reduce, (38, 2), 3,
declaration_2'Access, null);
- Add_Action (Table.States (35), 28, 29);
- Add_Action (Table.States (35), 30, 30);
- Add_Action (Table.States (35), 32, 31);
- Add_Action (Table.States (35), 33, 32);
- Add_Conflict (Table.States (35), 33, (38, 2), 3,
declaration_2'Access, null);
- Add_Action (Table.States (35), 34, 33);
- Add_Action (Table.States (35), 35, 34);
- Add_Action (Table.States (35), 36, Reduce, (38, 2), 3,
declaration_2'Access, null);
+ Add_Action (Table.States (35), 8, (42, 10), 24);
+ Add_Action (Table.States (35), 10, (42, 5), 25);
+ Add_Action (Table.States (35), 15, (42, 0), 26);
+ Add_Action (Table.States (35), 16, (42, 2), 27);
+ Add_Action (Table.States (35), 20, (42, 3), 28);
+ Add_Action (Table.States (35), 23, Reduce, (38, 2), 3,
declaration_2'Access, null);
+ Add_Action (Table.States (35), 28, (42, 6), 29);
+ Add_Action (Table.States (35), 30, (42, 7), 30);
+ Add_Action (Table.States (35), 32, (42, 4), 31);
+ Add_Action (Table.States (35), 33, (42, 1), 32);
+ Add_Conflict (Table.States (35), 33, (38, 2), 3,
declaration_2'Access, null);
+ Add_Action (Table.States (35), 34, (42, 8), 33);
+ Add_Action (Table.States (35), 35, (42, 9), 34);
+ Add_Action (Table.States (35), 36, Reduce, (38, 2), 3,
declaration_2'Access, null);
Table.States (35).Goto_List.Set_Capacity (1);
Add_Goto (Table.States (35), 42, 59);
Table.States (36).Action_List.Set_Capacity (13);
- Add_Action (Table.States (36), (8, 10, 15, 16, 20, 23, 28, 30, 32,
33, 34, 35, 36), (41, 0), 1, null,
+ Add_Action (Table.States (36), (8, 10, 15, 16, 20, 23, 28, 30, 32,
33, 34, 35, 36), (41, 0), 1, null,
null);
Table.States (37).Action_List.Set_Capacity (11);
- Add_Action (Table.States (37), 8, 24);
- Add_Action (Table.States (37), 10, 25);
- Add_Action (Table.States (37), 15, 26);
- Add_Action (Table.States (37), 16, 27);
- Add_Action (Table.States (37), 20, 28);
- Add_Action (Table.States (37), 28, 29);
- Add_Action (Table.States (37), 30, 30);
- Add_Action (Table.States (37), 32, 31);
- Add_Action (Table.States (37), 33, 32);
- Add_Action (Table.States (37), 34, 33);
- Add_Action (Table.States (37), 35, 34);
+ Add_Action (Table.States (37), 8, (42, 10), 24);
+ Add_Action (Table.States (37), 10, (42, 5), 25);
+ Add_Action (Table.States (37), 15, (42, 0), 26);
+ Add_Action (Table.States (37), 16, (42, 2), 27);
+ Add_Action (Table.States (37), 20, (42, 3), 28);
+ Add_Action (Table.States (37), 28, (42, 6), 29);
+ Add_Action (Table.States (37), 30, (42, 7), 30);
+ Add_Action (Table.States (37), 32, (42, 4), 31);
+ Add_Action (Table.States (37), 33, (42, 1), 32);
+ Add_Action (Table.States (37), 34, (42, 8), 33);
+ Add_Action (Table.States (37), 35, (42, 9), 34);
Table.States (37).Goto_List.Set_Capacity (2);
Add_Goto (Table.States (37), 41, 60);
Add_Goto (Table.States (37), 42, 36);
Table.States (38).Action_List.Set_Capacity (6);
- Add_Action (Table.States (38), 18, 38);
- Add_Action (Table.States (38), 19, 39);
- Add_Action (Table.States (38), 20, 40);
- Add_Action (Table.States (38), 21, 41);
- Add_Action (Table.States (38), 33, 42);
- Add_Action (Table.States (38), 35, 43);
+ Add_Action (Table.States (38), 18, (53, 0), 38);
+ Add_Action (Table.States (38), 19, (52, 0), 39);
+ Add_Action (Table.States (38), 20, (51, 0), 40);
+ Add_Action (Table.States (38), 21, (47, 0), 41);
+ Add_Action (Table.States (38), 33, (48, 1), 42);
+ Add_Action (Table.States (38), 35, (50, 1), 43);
Table.States (38).Goto_List.Set_Capacity (8);
Add_Goto (Table.States (38), 47, 46);
Add_Goto (Table.States (38), 48, 47);
@@ -262,12 +262,12 @@ package body Wisitoken_Grammar_Main is
Add_Goto (Table.States (38), 53, 52);
Add_Goto (Table.States (38), 54, 62);
Table.States (39).Action_List.Set_Capacity (6);
- Add_Action (Table.States (39), 18, 38);
- Add_Action (Table.States (39), 19, 39);
- Add_Action (Table.States (39), 20, 40);
- Add_Action (Table.States (39), 21, 41);
- Add_Action (Table.States (39), 33, 42);
- Add_Action (Table.States (39), 35, 43);
+ Add_Action (Table.States (39), 18, (53, 0), 38);
+ Add_Action (Table.States (39), 19, (52, 0), 39);
+ Add_Action (Table.States (39), 20, (51, 0), 40);
+ Add_Action (Table.States (39), 21, (47, 0), 41);
+ Add_Action (Table.States (39), 33, (48, 1), 42);
+ Add_Action (Table.States (39), 35, (50, 1), 43);
Table.States (39).Goto_List.Set_Capacity (8);
Add_Goto (Table.States (39), 47, 46);
Add_Goto (Table.States (39), 48, 47);
@@ -278,12 +278,12 @@ package body Wisitoken_Grammar_Main is
Add_Goto (Table.States (39), 53, 52);
Add_Goto (Table.States (39), 54, 63);
Table.States (40).Action_List.Set_Capacity (6);
- Add_Action (Table.States (40), 18, 38);
- Add_Action (Table.States (40), 19, 39);
- Add_Action (Table.States (40), 20, 40);
- Add_Action (Table.States (40), 21, 41);
- Add_Action (Table.States (40), 33, 42);
- Add_Action (Table.States (40), 35, 43);
+ Add_Action (Table.States (40), 18, (53, 0), 38);
+ Add_Action (Table.States (40), 19, (52, 0), 39);
+ Add_Action (Table.States (40), 20, (51, 0), 40);
+ Add_Action (Table.States (40), 21, (47, 0), 41);
+ Add_Action (Table.States (40), 33, (48, 1), 42);
+ Add_Action (Table.States (40), 35, (50, 1), 43);
Table.States (40).Goto_List.Set_Capacity (8);
Add_Goto (Table.States (40), 47, 46);
Add_Goto (Table.States (40), 48, 47);
@@ -294,72 +294,72 @@ package body Wisitoken_Grammar_Main is
Add_Goto (Table.States (40), 53, 52);
Add_Goto (Table.States (40), 54, 64);
Table.States (41).Action_List.Set_Capacity (1);
- Add_Action (Table.States (41), 33, 65);
+ Add_Action (Table.States (41), 33, (47, 0), 65);
Table.States (42).Action_List.Set_Capacity (18);
- Add_Action (Table.States (42), 11, Reduce, (50, 0), 1, null, null);
- Add_Action (Table.States (42), 12, Reduce, (50, 0), 1, null, null);
- Add_Action (Table.States (42), 16, 66);
- Add_Action (Table.States (42), 18, Reduce, (50, 0), 1, null, null);
- Add_Action (Table.States (42), 19, Reduce, (50, 0), 1, null, null);
- Add_Action (Table.States (42), 20, Reduce, (50, 0), 1, null, null);
- Add_Action (Table.States (42), 21, Reduce, (50, 0), 1, null, null);
- Add_Action (Table.States (42), 23, Reduce, (50, 0), 1, null, null);
- Add_Action (Table.States (42), 24, 67);
- Add_Action (Table.States (42), 25, 68);
- Add_Action (Table.States (42), 26, Reduce, (50, 0), 1, null, null);
- Add_Action (Table.States (42), 27, Reduce, (50, 0), 1, null, null);
- Add_Action (Table.States (42), 28, Reduce, (50, 0), 1, null, null);
- Add_Action (Table.States (42), 29, Reduce, (50, 0), 1, null, null);
- Add_Action (Table.States (42), 31, 69);
- Add_Action (Table.States (42), 33, Reduce, (50, 0), 1, null, null);
- Add_Action (Table.States (42), 35, Reduce, (50, 0), 1, null, null);
- Add_Action (Table.States (42), 36, Reduce, (50, 0), 1, null, null);
+ Add_Action (Table.States (42), 11, Reduce, (50, 0), 1, null,
null);
+ Add_Action (Table.States (42), 12, Reduce, (50, 0), 1, null,
null);
+ Add_Action (Table.States (42), 16, (48, 1), 66);
+ Add_Action (Table.States (42), 18, Reduce, (50, 0), 1, null,
null);
+ Add_Action (Table.States (42), 19, Reduce, (50, 0), 1, null,
null);
+ Add_Action (Table.States (42), 20, Reduce, (50, 0), 1, null,
null);
+ Add_Action (Table.States (42), 21, Reduce, (50, 0), 1, null,
null);
+ Add_Action (Table.States (42), 23, Reduce, (50, 0), 1, null,
null);
+ Add_Action (Table.States (42), 24, (53, 4), 67);
+ Add_Action (Table.States (42), 25, (52, 2), 68);
+ Add_Action (Table.States (42), 26, Reduce, (50, 0), 1, null,
null);
+ Add_Action (Table.States (42), 27, Reduce, (50, 0), 1, null,
null);
+ Add_Action (Table.States (42), 28, Reduce, (50, 0), 1, null,
null);
+ Add_Action (Table.States (42), 29, Reduce, (50, 0), 1, null,
null);
+ Add_Action (Table.States (42), 31, (53, 5), 69);
+ Add_Action (Table.States (42), 33, Reduce, (50, 0), 1, null,
null);
+ Add_Action (Table.States (42), 35, Reduce, (50, 0), 1, null,
null);
+ Add_Action (Table.States (42), 36, Reduce, (50, 0), 1, null,
null);
Table.States (43).Action_List.Set_Capacity (15);
- Add_Action (Table.States (43), 11, Reduce, (50, 1), 1,
rhs_item_1'Access, null);
- Add_Action (Table.States (43), 12, Reduce, (50, 1), 1,
rhs_item_1'Access, null);
- Add_Action (Table.States (43), 18, Reduce, (50, 1), 1,
rhs_item_1'Access, null);
- Add_Action (Table.States (43), 19, Reduce, (50, 1), 1,
rhs_item_1'Access, null);
- Add_Action (Table.States (43), 20, Reduce, (50, 1), 1,
rhs_item_1'Access, null);
- Add_Action (Table.States (43), 21, Reduce, (50, 1), 1,
rhs_item_1'Access, null);
- Add_Action (Table.States (43), 23, Reduce, (50, 1), 1,
rhs_item_1'Access, null);
- Add_Action (Table.States (43), 25, 70);
- Add_Action (Table.States (43), 26, Reduce, (50, 1), 1,
rhs_item_1'Access, null);
- Add_Action (Table.States (43), 27, Reduce, (50, 1), 1,
rhs_item_1'Access, null);
- Add_Action (Table.States (43), 28, Reduce, (50, 1), 1,
rhs_item_1'Access, null);
- Add_Action (Table.States (43), 29, Reduce, (50, 1), 1,
rhs_item_1'Access, null);
- Add_Action (Table.States (43), 33, Reduce, (50, 1), 1,
rhs_item_1'Access, null);
- Add_Action (Table.States (43), 35, Reduce, (50, 1), 1,
rhs_item_1'Access, null);
- Add_Action (Table.States (43), 36, Reduce, (50, 1), 1,
rhs_item_1'Access, null);
+ Add_Action (Table.States (43), 11, Reduce, (50, 1), 1,
rhs_item_1'Access, null);
+ Add_Action (Table.States (43), 12, Reduce, (50, 1), 1,
rhs_item_1'Access, null);
+ Add_Action (Table.States (43), 18, Reduce, (50, 1), 1,
rhs_item_1'Access, null);
+ Add_Action (Table.States (43), 19, Reduce, (50, 1), 1,
rhs_item_1'Access, null);
+ Add_Action (Table.States (43), 20, Reduce, (50, 1), 1,
rhs_item_1'Access, null);
+ Add_Action (Table.States (43), 21, Reduce, (50, 1), 1,
rhs_item_1'Access, null);
+ Add_Action (Table.States (43), 23, Reduce, (50, 1), 1,
rhs_item_1'Access, null);
+ Add_Action (Table.States (43), 25, (52, 3), 70);
+ Add_Action (Table.States (43), 26, Reduce, (50, 1), 1,
rhs_item_1'Access, null);
+ Add_Action (Table.States (43), 27, Reduce, (50, 1), 1,
rhs_item_1'Access, null);
+ Add_Action (Table.States (43), 28, Reduce, (50, 1), 1,
rhs_item_1'Access, null);
+ Add_Action (Table.States (43), 29, Reduce, (50, 1), 1,
rhs_item_1'Access, null);
+ Add_Action (Table.States (43), 33, Reduce, (50, 1), 1,
rhs_item_1'Access, null);
+ Add_Action (Table.States (43), 35, Reduce, (50, 1), 1,
rhs_item_1'Access, null);
+ Add_Action (Table.States (43), 36, Reduce, (50, 1), 1,
rhs_item_1'Access, null);
Table.States (44).Action_List.Set_Capacity (5);
- Add_Action (Table.States (44), 12, 71);
- Add_Action (Table.States (44), 23, 72);
- Add_Conflict (Table.States (44), 23, (44, 1), 0, null, null);
- Add_Action (Table.States (44), 29, 73);
- Add_Action (Table.States (44), 33, Reduce, (44, 1), 0, null, null);
- Add_Action (Table.States (44), 36, Reduce, (44, 1), 0, null, null);
+ Add_Action (Table.States (44), 12, (45, 1), 71);
+ Add_Action (Table.States (44), 23, (45, 2), 72);
+ Add_Conflict (Table.States (44), 23, (44, 1), 0, null, null);
+ Add_Action (Table.States (44), 29, (44, 0), 73);
+ Add_Action (Table.States (44), 33, Reduce, (44, 1), 0, null,
null);
+ Add_Action (Table.States (44), 36, Reduce, (44, 1), 0, null,
null);
Table.States (44).Goto_List.Set_Capacity (1);
Add_Goto (Table.States (44), 44, 74);
Table.States (45).Action_List.Set_Capacity (5);
- Add_Action (Table.States (45), (12, 23, 29, 33, 36), (45, 0), 1,
null, null);
+ Add_Action (Table.States (45), (12, 23, 29, 33, 36), (45, 0), 1,
null, null);
Table.States (46).Action_List.Set_Capacity (14);
- Add_Action (Table.States (46), (11, 12, 18, 19, 20, 21, 23, 26,
27, 28, 29, 33, 35, 36), (50, 2), 1,
+ Add_Action (Table.States (46), (11, 12, 18, 19, 20, 21, 23, 26,
27, 28, 29, 33, 35, 36), (50, 2), 1,
rhs_item_2'Access, null);
Table.States (47).Action_List.Set_Capacity (14);
- Add_Action (Table.States (47), (11, 12, 18, 19, 20, 21, 23, 26,
27, 28, 29, 33, 35, 36), (49, 0), 1, null,
+ Add_Action (Table.States (47), (11, 12, 18, 19, 20, 21, 23, 26,
27, 28, 29, 33, 35, 36), (49, 0), 1, null,
null);
Table.States (48).Action_List.Set_Capacity (11);
- Add_Action (Table.States (48), 11, 75);
- Add_Action (Table.States (48), 12, Reduce, (46, 1), 1, null, null);
- Add_Action (Table.States (48), 18, 38);
- Add_Action (Table.States (48), 19, 39);
- Add_Action (Table.States (48), 20, 40);
- Add_Action (Table.States (48), 21, 41);
- Add_Action (Table.States (48), 23, Reduce, (46, 1), 1, null, null);
- Add_Action (Table.States (48), 29, Reduce, (46, 1), 1, null, null);
- Add_Action (Table.States (48), 33, 42);
- Add_Conflict (Table.States (48), 33, (46, 1), 1, null, null);
- Add_Action (Table.States (48), 35, 43);
- Add_Action (Table.States (48), 36, Reduce, (46, 1), 1, null, null);
+ Add_Action (Table.States (48), 11, (46, 2), 75);
+ Add_Action (Table.States (48), 12, Reduce, (46, 1), 1, null,
null);
+ Add_Action (Table.States (48), 18, (53, 0), 38);
+ Add_Action (Table.States (48), 19, (52, 0), 39);
+ Add_Action (Table.States (48), 20, (51, 0), 40);
+ Add_Action (Table.States (48), 21, (47, 0), 41);
+ Add_Action (Table.States (48), 23, Reduce, (46, 1), 1, null,
null);
+ Add_Action (Table.States (48), 29, Reduce, (46, 1), 1, null,
null);
+ Add_Action (Table.States (48), 33, (48, 1), 42);
+ Add_Conflict (Table.States (48), 33, (46, 1), 1, null, null);
+ Add_Action (Table.States (48), 35, (50, 1), 43);
+ Add_Action (Table.States (48), 36, Reduce, (46, 1), 1, null,
null);
Table.States (48).Goto_List.Set_Capacity (6);
Add_Goto (Table.States (48), 47, 46);
Add_Goto (Table.States (48), 48, 76);
@@ -368,67 +368,67 @@ package body Wisitoken_Grammar_Main is
Add_Goto (Table.States (48), 52, 51);
Add_Goto (Table.States (48), 53, 52);
Table.States (49).Action_List.Set_Capacity (14);
- Add_Action (Table.States (49), (11, 12, 18, 19, 20, 21, 23, 26,
27, 28, 29, 33, 35, 36), (48, 0), 1, null,
+ Add_Action (Table.States (49), (11, 12, 18, 19, 20, 21, 23, 26,
27, 28, 29, 33, 35, 36), (48, 0), 1, null,
null);
Table.States (50).Action_List.Set_Capacity (14);
- Add_Action (Table.States (50), (11, 12, 18, 19, 20, 21, 23, 26,
27, 28, 29, 33, 35, 36), (50, 5), 1,
+ Add_Action (Table.States (50), (11, 12, 18, 19, 20, 21, 23, 26,
27, 28, 29, 33, 35, 36), (50, 5), 1,
rhs_item_5'Access, null);
Table.States (51).Action_List.Set_Capacity (14);
- Add_Action (Table.States (51), (11, 12, 18, 19, 20, 21, 23, 26,
27, 28, 29, 33, 35, 36), (50, 3), 1,
+ Add_Action (Table.States (51), (11, 12, 18, 19, 20, 21, 23, 26,
27, 28, 29, 33, 35, 36), (50, 3), 1,
rhs_item_3'Access, null);
Table.States (52).Action_List.Set_Capacity (14);
- Add_Action (Table.States (52), (11, 12, 18, 19, 20, 21, 23, 26,
27, 28, 29, 33, 35, 36), (50, 4), 1,
+ Add_Action (Table.States (52), (11, 12, 18, 19, 20, 21, 23, 26,
27, 28, 29, 33, 35, 36), (50, 4), 1,
rhs_item_4'Access, null);
Table.States (53).Action_List.Set_Capacity (5);
- Add_Action (Table.States (53), 12, 71);
- Add_Action (Table.States (53), 23, 72);
- Add_Conflict (Table.States (53), 23, (44, 1), 0, null, null);
- Add_Action (Table.States (53), 29, 73);
- Add_Action (Table.States (53), 33, Reduce, (44, 1), 0, null, null);
- Add_Action (Table.States (53), 36, Reduce, (44, 1), 0, null, null);
+ Add_Action (Table.States (53), 12, (45, 1), 71);
+ Add_Action (Table.States (53), 23, (45, 2), 72);
+ Add_Conflict (Table.States (53), 23, (44, 1), 0, null, null);
+ Add_Action (Table.States (53), 29, (44, 0), 73);
+ Add_Action (Table.States (53), 33, Reduce, (44, 1), 0, null,
null);
+ Add_Action (Table.States (53), 36, Reduce, (44, 1), 0, null,
null);
Table.States (53).Goto_List.Set_Capacity (1);
Add_Goto (Table.States (53), 44, 77);
Table.States (54).Action_List.Set_Capacity (3);
- Add_Action (Table.States (54), (23, 33, 36), (38, 1), 4,
declaration_1'Access, null);
+ Add_Action (Table.States (54), (23, 33, 36), (38, 1), 4,
declaration_1'Access, null);
Table.States (55).Action_List.Set_Capacity (2);
- Add_Action (Table.States (55), (9, 33), (40, 1), 2, null, null);
+ Add_Action (Table.States (55), (9, 33), (40, 1), 2, null, null);
Table.States (56).Action_List.Set_Capacity (1);
- Add_Action (Table.States (56), 33, 78);
+ Add_Action (Table.States (56), 33, (38, 4), 78);
Table.States (57).Action_List.Set_Capacity (1);
- Add_Action (Table.States (57), 17, 79);
+ Add_Action (Table.States (57), 17, (39, 1), 79);
Table.States (58).Action_List.Set_Capacity (1);
- Add_Action (Table.States (58), 17, 80);
+ Add_Action (Table.States (58), 17, (39, 2), 80);
Table.States (59).Action_List.Set_Capacity (13);
- Add_Action (Table.States (59), (8, 10, 15, 16, 20, 23, 28, 30, 32,
33, 34, 35, 36), (41, 1), 2, null,
+ Add_Action (Table.States (59), (8, 10, 15, 16, 20, 23, 28, 30, 32,
33, 34, 35, 36), (41, 1), 2, null,
null);
Table.States (60).Action_List.Set_Capacity (13);
- Add_Action (Table.States (60), 8, 24);
- Add_Action (Table.States (60), 10, 25);
- Add_Action (Table.States (60), 15, 26);
- Add_Action (Table.States (60), 16, 27);
- Add_Action (Table.States (60), 20, 28);
- Add_Action (Table.States (60), 23, Reduce, (38, 0), 4,
declaration_0'Access, null);
- Add_Action (Table.States (60), 28, 29);
- Add_Action (Table.States (60), 30, 30);
- Add_Action (Table.States (60), 32, 31);
- Add_Action (Table.States (60), 33, 32);
- Add_Conflict (Table.States (60), 33, (38, 0), 4,
declaration_0'Access, null);
- Add_Action (Table.States (60), 34, 33);
- Add_Action (Table.States (60), 35, 34);
- Add_Action (Table.States (60), 36, Reduce, (38, 0), 4,
declaration_0'Access, null);
+ Add_Action (Table.States (60), 8, (42, 10), 24);
+ Add_Action (Table.States (60), 10, (42, 5), 25);
+ Add_Action (Table.States (60), 15, (42, 0), 26);
+ Add_Action (Table.States (60), 16, (42, 2), 27);
+ Add_Action (Table.States (60), 20, (42, 3), 28);
+ Add_Action (Table.States (60), 23, Reduce, (38, 0), 4,
declaration_0'Access, null);
+ Add_Action (Table.States (60), 28, (42, 6), 29);
+ Add_Action (Table.States (60), 30, (42, 7), 30);
+ Add_Action (Table.States (60), 32, (42, 4), 31);
+ Add_Action (Table.States (60), 33, (42, 1), 32);
+ Add_Conflict (Table.States (60), 33, (38, 0), 4,
declaration_0'Access, null);
+ Add_Action (Table.States (60), 34, (42, 8), 33);
+ Add_Action (Table.States (60), 35, (42, 9), 34);
+ Add_Action (Table.States (60), 36, Reduce, (38, 0), 4,
declaration_0'Access, null);
Table.States (60).Goto_List.Set_Capacity (1);
Add_Goto (Table.States (60), 42, 59);
Table.States (61).Action_List.Set_Capacity (10);
- Add_Action (Table.States (61), 12, Reduce, (54, 0), 1, null, null);
- Add_Action (Table.States (61), 18, 38);
- Add_Action (Table.States (61), 19, 39);
- Add_Action (Table.States (61), 20, 40);
- Add_Action (Table.States (61), 21, 41);
- Add_Action (Table.States (61), 26, Reduce, (54, 0), 1, null, null);
- Add_Action (Table.States (61), 27, Reduce, (54, 0), 1, null, null);
- Add_Action (Table.States (61), 28, Reduce, (54, 0), 1, null, null);
- Add_Action (Table.States (61), 33, 42);
- Add_Action (Table.States (61), 35, 43);
+ Add_Action (Table.States (61), 12, Reduce, (54, 0), 1, null,
null);
+ Add_Action (Table.States (61), 18, (53, 0), 38);
+ Add_Action (Table.States (61), 19, (52, 0), 39);
+ Add_Action (Table.States (61), 20, (51, 0), 40);
+ Add_Action (Table.States (61), 21, (47, 0), 41);
+ Add_Action (Table.States (61), 26, Reduce, (54, 0), 1, null,
null);
+ Add_Action (Table.States (61), 27, Reduce, (54, 0), 1, null,
null);
+ Add_Action (Table.States (61), 28, Reduce, (54, 0), 1, null,
null);
+ Add_Action (Table.States (61), 33, (48, 1), 42);
+ Add_Action (Table.States (61), 35, (50, 1), 43);
Table.States (61).Goto_List.Set_Capacity (6);
Add_Goto (Table.States (61), 47, 46);
Add_Goto (Table.States (61), 48, 76);
@@ -437,23 +437,23 @@ package body Wisitoken_Grammar_Main is
Add_Goto (Table.States (61), 52, 51);
Add_Goto (Table.States (61), 53, 52);
Table.States (62).Action_List.Set_Capacity (2);
- Add_Action (Table.States (62), 12, 81);
- Add_Action (Table.States (62), 26, 82);
+ Add_Action (Table.States (62), 12, (54, 1), 81);
+ Add_Action (Table.States (62), 26, (53, 0), 82);
Table.States (63).Action_List.Set_Capacity (2);
- Add_Action (Table.States (63), 12, 81);
- Add_Action (Table.States (63), 27, 83);
+ Add_Action (Table.States (63), 12, (54, 1), 81);
+ Add_Action (Table.States (63), 27, (52, 0), 83);
Table.States (64).Action_List.Set_Capacity (2);
- Add_Action (Table.States (64), 12, 81);
- Add_Action (Table.States (64), 28, 84);
+ Add_Action (Table.States (64), 12, (54, 1), 81);
+ Add_Action (Table.States (64), 28, (51, 0), 84);
Table.States (65).Action_List.Set_Capacity (1);
- Add_Action (Table.States (65), 16, 85);
+ Add_Action (Table.States (65), 16, (47, 0), 85);
Table.States (66).Action_List.Set_Capacity (6);
- Add_Action (Table.States (66), 18, 38);
- Add_Action (Table.States (66), 19, 39);
- Add_Action (Table.States (66), 20, 40);
- Add_Action (Table.States (66), 21, 41);
- Add_Action (Table.States (66), 33, 86);
- Add_Action (Table.States (66), 35, 43);
+ Add_Action (Table.States (66), 18, (53, 0), 38);
+ Add_Action (Table.States (66), 19, (52, 0), 39);
+ Add_Action (Table.States (66), 20, (51, 0), 40);
+ Add_Action (Table.States (66), 21, (47, 0), 41);
+ Add_Action (Table.States (66), 33, (50, 0), 86);
+ Add_Action (Table.States (66), 35, (50, 1), 43);
Table.States (66).Goto_List.Set_Capacity (5);
Add_Goto (Table.States (66), 47, 46);
Add_Goto (Table.States (66), 50, 87);
@@ -461,29 +461,29 @@ package body Wisitoken_Grammar_Main is
Add_Goto (Table.States (66), 52, 51);
Add_Goto (Table.States (66), 53, 52);
Table.States (67).Action_List.Set_Capacity (14);
- Add_Action (Table.States (67), (11, 12, 18, 19, 20, 21, 23, 26,
27, 28, 29, 33, 35, 36), (53, 4), 2, null,
+ Add_Action (Table.States (67), (11, 12, 18, 19, 20, 21, 23, 26,
27, 28, 29, 33, 35, 36), (53, 4), 2, null,
null);
Table.States (68).Action_List.Set_Capacity (14);
- Add_Action (Table.States (68), (11, 12, 18, 19, 20, 21, 23, 26,
27, 28, 29, 33, 35, 36), (52, 2), 2, null,
+ Add_Action (Table.States (68), (11, 12, 18, 19, 20, 21, 23, 26,
27, 28, 29, 33, 35, 36), (52, 2), 2, null,
null);
Table.States (69).Action_List.Set_Capacity (14);
- Add_Action (Table.States (69), (11, 12, 18, 19, 20, 21, 23, 26,
27, 28, 29, 33, 35, 36), (53, 5), 2, null,
+ Add_Action (Table.States (69), (11, 12, 18, 19, 20, 21, 23, 26,
27, 28, 29, 33, 35, 36), (53, 5), 2, null,
null);
Table.States (70).Action_List.Set_Capacity (14);
- Add_Action (Table.States (70), (11, 12, 18, 19, 20, 21, 23, 26,
27, 28, 29, 33, 35, 36), (52, 3), 2,
+ Add_Action (Table.States (70), (11, 12, 18, 19, 20, 21, 23, 26,
27, 28, 29, 33, 35, 36), (52, 3), 2,
rhs_optional_item_3'Access, null);
Table.States (71).Action_List.Set_Capacity (10);
- Add_Action (Table.States (71), 12, Reduce, (46, 0), 0, null, null);
- Add_Action (Table.States (71), 18, 38);
- Add_Action (Table.States (71), 19, 39);
- Add_Action (Table.States (71), 20, 40);
- Add_Action (Table.States (71), 21, 41);
- Add_Action (Table.States (71), 23, Reduce, (46, 0), 0, null, null);
- Add_Action (Table.States (71), 29, Reduce, (46, 0), 0, null, null);
- Add_Action (Table.States (71), 33, 42);
- Add_Conflict (Table.States (71), 33, (46, 0), 0, null, null);
- Add_Action (Table.States (71), 35, 43);
- Add_Action (Table.States (71), 36, Reduce, (46, 0), 0, null, null);
+ Add_Action (Table.States (71), 12, Reduce, (46, 0), 0, null,
null);
+ Add_Action (Table.States (71), 18, (53, 0), 38);
+ Add_Action (Table.States (71), 19, (52, 0), 39);
+ Add_Action (Table.States (71), 20, (51, 0), 40);
+ Add_Action (Table.States (71), 21, (47, 0), 41);
+ Add_Action (Table.States (71), 23, Reduce, (46, 0), 0, null,
null);
+ Add_Action (Table.States (71), 29, Reduce, (46, 0), 0, null,
null);
+ Add_Action (Table.States (71), 33, (48, 1), 42);
+ Add_Conflict (Table.States (71), 33, (46, 0), 0, null, null);
+ Add_Action (Table.States (71), 35, (50, 1), 43);
+ Add_Action (Table.States (71), 36, Reduce, (46, 0), 0, null,
null);
Table.States (71).Goto_List.Set_Capacity (8);
Add_Goto (Table.States (71), 46, 88);
Add_Goto (Table.States (71), 47, 46);
@@ -494,37 +494,37 @@ package body Wisitoken_Grammar_Main is
Add_Goto (Table.States (71), 52, 51);
Add_Goto (Table.States (71), 53, 52);
Table.States (72).Action_List.Set_Capacity (2);
- Add_Action (Table.States (72), 4, 89);
- Add_Action (Table.States (72), 5, 90);
+ Add_Action (Table.States (72), 4, (45, 3), 89);
+ Add_Action (Table.States (72), 5, (45, 2), 90);
Table.States (73).Action_List.Set_Capacity (3);
- Add_Action (Table.States (73), (23, 33, 36), (44, 0), 1, null,
null);
+ Add_Action (Table.States (73), (23, 33, 36), (44, 0), 1, null,
null);
Table.States (74).Action_List.Set_Capacity (3);
- Add_Action (Table.States (74), (23, 33, 36), (43, 0), 4,
nonterminal_0'Access, null);
+ Add_Action (Table.States (74), (23, 33, 36), (43, 0), 4,
nonterminal_0'Access, null);
Table.States (75).Action_List.Set_Capacity (6);
- Add_Action (Table.States (75), 11, 91);
- Add_Action (Table.States (75), 12, Reduce, (46, 2), 2, null, null);
- Add_Action (Table.States (75), 23, Reduce, (46, 2), 2, null, null);
- Add_Action (Table.States (75), 29, Reduce, (46, 2), 2, null, null);
- Add_Action (Table.States (75), 33, Reduce, (46, 2), 2, null, null);
- Add_Action (Table.States (75), 36, Reduce, (46, 2), 2, null, null);
+ Add_Action (Table.States (75), 11, (46, 3), 91);
+ Add_Action (Table.States (75), 12, Reduce, (46, 2), 2, null,
null);
+ Add_Action (Table.States (75), 23, Reduce, (46, 2), 2, null,
null);
+ Add_Action (Table.States (75), 29, Reduce, (46, 2), 2, null,
null);
+ Add_Action (Table.States (75), 33, Reduce, (46, 2), 2, null,
null);
+ Add_Action (Table.States (75), 36, Reduce, (46, 2), 2, null,
null);
Table.States (76).Action_List.Set_Capacity (14);
- Add_Action (Table.States (76), (11, 12, 18, 19, 20, 21, 23, 26,
27, 28, 29, 33, 35, 36), (49, 1), 2, null,
+ Add_Action (Table.States (76), (11, 12, 18, 19, 20, 21, 23, 26,
27, 28, 29, 33, 35, 36), (49, 1), 2, null,
null);
Table.States (77).Action_List.Set_Capacity (3);
- Add_Action (Table.States (77), (23, 33, 36), (43, 1), 4,
nonterminal_1'Access, null);
+ Add_Action (Table.States (77), (23, 33, 36), (43, 1), 4,
nonterminal_1'Access, null);
Table.States (78).Action_List.Set_Capacity (3);
- Add_Action (Table.States (78), (23, 33, 36), (38, 4), 5,
declaration_4'Access, null);
+ Add_Action (Table.States (78), (23, 33, 36), (38, 4), 5,
declaration_4'Access, null);
Table.States (79).Action_List.Set_Capacity (1);
- Add_Action (Table.States (79), (1 => 33), (39, 1), 4, null, null);
+ Add_Action (Table.States (79), (1 => 33), (39, 1), 4, null,
null);
Table.States (80).Action_List.Set_Capacity (1);
- Add_Action (Table.States (80), (1 => 33), (39, 2), 4, null, null);
+ Add_Action (Table.States (80), (1 => 33), (39, 2), 4, null,
null);
Table.States (81).Action_List.Set_Capacity (6);
- Add_Action (Table.States (81), 18, 38);
- Add_Action (Table.States (81), 19, 39);
- Add_Action (Table.States (81), 20, 40);
- Add_Action (Table.States (81), 21, 41);
- Add_Action (Table.States (81), 33, 42);
- Add_Action (Table.States (81), 35, 43);
+ Add_Action (Table.States (81), 18, (53, 0), 38);
+ Add_Action (Table.States (81), 19, (52, 0), 39);
+ Add_Action (Table.States (81), 20, (51, 0), 40);
+ Add_Action (Table.States (81), 21, (47, 0), 41);
+ Add_Action (Table.States (81), 33, (48, 1), 42);
+ Add_Action (Table.States (81), 35, (50, 1), 43);
Table.States (81).Goto_List.Set_Capacity (7);
Add_Goto (Table.States (81), 47, 46);
Add_Goto (Table.States (81), 48, 47);
@@ -534,84 +534,84 @@ package body Wisitoken_Grammar_Main is
Add_Goto (Table.States (81), 52, 51);
Add_Goto (Table.States (81), 53, 52);
Table.States (82).Action_List.Set_Capacity (15);
- Add_Action (Table.States (82), 11, Reduce, (53, 0), 3, null, null);
- Add_Action (Table.States (82), 12, Reduce, (53, 0), 3, null, null);
- Add_Action (Table.States (82), 18, Reduce, (53, 0), 3, null, null);
- Add_Action (Table.States (82), 19, Reduce, (53, 0), 3, null, null);
- Add_Action (Table.States (82), 20, Reduce, (53, 0), 3, null, null);
- Add_Action (Table.States (82), 21, Reduce, (53, 0), 3, null, null);
- Add_Action (Table.States (82), 22, 93);
- Add_Action (Table.States (82), 23, Reduce, (53, 0), 3, null, null);
- Add_Action (Table.States (82), 26, Reduce, (53, 0), 3, null, null);
- Add_Action (Table.States (82), 27, Reduce, (53, 0), 3, null, null);
- Add_Action (Table.States (82), 28, Reduce, (53, 0), 3, null, null);
- Add_Action (Table.States (82), 29, Reduce, (53, 0), 3, null, null);
- Add_Action (Table.States (82), 33, Reduce, (53, 0), 3, null, null);
- Add_Action (Table.States (82), 35, Reduce, (53, 0), 3, null, null);
- Add_Action (Table.States (82), 36, Reduce, (53, 0), 3, null, null);
+ Add_Action (Table.States (82), 11, Reduce, (53, 0), 3, null,
null);
+ Add_Action (Table.States (82), 12, Reduce, (53, 0), 3, null,
null);
+ Add_Action (Table.States (82), 18, Reduce, (53, 0), 3, null,
null);
+ Add_Action (Table.States (82), 19, Reduce, (53, 0), 3, null,
null);
+ Add_Action (Table.States (82), 20, Reduce, (53, 0), 3, null,
null);
+ Add_Action (Table.States (82), 21, Reduce, (53, 0), 3, null,
null);
+ Add_Action (Table.States (82), 22, (53, 1), 93);
+ Add_Action (Table.States (82), 23, Reduce, (53, 0), 3, null,
null);
+ Add_Action (Table.States (82), 26, Reduce, (53, 0), 3, null,
null);
+ Add_Action (Table.States (82), 27, Reduce, (53, 0), 3, null,
null);
+ Add_Action (Table.States (82), 28, Reduce, (53, 0), 3, null,
null);
+ Add_Action (Table.States (82), 29, Reduce, (53, 0), 3, null,
null);
+ Add_Action (Table.States (82), 33, Reduce, (53, 0), 3, null,
null);
+ Add_Action (Table.States (82), 35, Reduce, (53, 0), 3, null,
null);
+ Add_Action (Table.States (82), 36, Reduce, (53, 0), 3, null,
null);
Table.States (83).Action_List.Set_Capacity (14);
- Add_Action (Table.States (83), (11, 12, 18, 19, 20, 21, 23, 26,
27, 28, 29, 33, 35, 36), (52, 0), 3, null,
+ Add_Action (Table.States (83), (11, 12, 18, 19, 20, 21, 23, 26,
27, 28, 29, 33, 35, 36), (52, 0), 3, null,
null);
Table.States (84).Action_List.Set_Capacity (17);
- Add_Action (Table.States (84), 11, Reduce, (51, 0), 3, null, null);
- Add_Action (Table.States (84), 12, Reduce, (51, 0), 3, null, null);
- Add_Action (Table.States (84), 18, Reduce, (51, 0), 3, null, null);
- Add_Action (Table.States (84), 19, Reduce, (51, 0), 3, null, null);
- Add_Action (Table.States (84), 20, Reduce, (51, 0), 3, null, null);
- Add_Action (Table.States (84), 21, Reduce, (51, 0), 3, null, null);
- Add_Action (Table.States (84), 23, Reduce, (51, 0), 3, null, null);
- Add_Action (Table.States (84), 24, 94);
- Add_Action (Table.States (84), 25, 95);
- Add_Action (Table.States (84), 26, Reduce, (51, 0), 3, null, null);
- Add_Action (Table.States (84), 27, Reduce, (51, 0), 3, null, null);
- Add_Action (Table.States (84), 28, Reduce, (51, 0), 3, null, null);
- Add_Action (Table.States (84), 29, Reduce, (51, 0), 3, null, null);
- Add_Action (Table.States (84), 31, 96);
- Add_Action (Table.States (84), 33, Reduce, (51, 0), 3, null, null);
- Add_Action (Table.States (84), 35, Reduce, (51, 0), 3, null, null);
- Add_Action (Table.States (84), 36, Reduce, (51, 0), 3, null, null);
+ Add_Action (Table.States (84), 11, Reduce, (51, 0), 3, null,
null);
+ Add_Action (Table.States (84), 12, Reduce, (51, 0), 3, null,
null);
+ Add_Action (Table.States (84), 18, Reduce, (51, 0), 3, null,
null);
+ Add_Action (Table.States (84), 19, Reduce, (51, 0), 3, null,
null);
+ Add_Action (Table.States (84), 20, Reduce, (51, 0), 3, null,
null);
+ Add_Action (Table.States (84), 21, Reduce, (51, 0), 3, null,
null);
+ Add_Action (Table.States (84), 23, Reduce, (51, 0), 3, null,
null);
+ Add_Action (Table.States (84), 24, (53, 2), 94);
+ Add_Action (Table.States (84), 25, (52, 1), 95);
+ Add_Action (Table.States (84), 26, Reduce, (51, 0), 3, null,
null);
+ Add_Action (Table.States (84), 27, Reduce, (51, 0), 3, null,
null);
+ Add_Action (Table.States (84), 28, Reduce, (51, 0), 3, null,
null);
+ Add_Action (Table.States (84), 29, Reduce, (51, 0), 3, null,
null);
+ Add_Action (Table.States (84), 31, (53, 3), 96);
+ Add_Action (Table.States (84), 33, Reduce, (51, 0), 3, null,
null);
+ Add_Action (Table.States (84), 35, Reduce, (51, 0), 3, null,
null);
+ Add_Action (Table.States (84), 36, Reduce, (51, 0), 3, null,
null);
Table.States (85).Action_List.Set_Capacity (1);
- Add_Action (Table.States (85), 33, 97);
+ Add_Action (Table.States (85), 33, (47, 0), 97);
Table.States (86).Action_List.Set_Capacity (17);
- Add_Action (Table.States (86), 11, Reduce, (50, 0), 1, null, null);
- Add_Action (Table.States (86), 12, Reduce, (50, 0), 1, null, null);
- Add_Action (Table.States (86), 18, Reduce, (50, 0), 1, null, null);
- Add_Action (Table.States (86), 19, Reduce, (50, 0), 1, null, null);
- Add_Action (Table.States (86), 20, Reduce, (50, 0), 1, null, null);
- Add_Action (Table.States (86), 21, Reduce, (50, 0), 1, null, null);
- Add_Action (Table.States (86), 23, Reduce, (50, 0), 1, null, null);
- Add_Action (Table.States (86), 24, 67);
- Add_Action (Table.States (86), 25, 68);
- Add_Action (Table.States (86), 26, Reduce, (50, 0), 1, null, null);
- Add_Action (Table.States (86), 27, Reduce, (50, 0), 1, null, null);
- Add_Action (Table.States (86), 28, Reduce, (50, 0), 1, null, null);
- Add_Action (Table.States (86), 29, Reduce, (50, 0), 1, null, null);
- Add_Action (Table.States (86), 31, 69);
- Add_Action (Table.States (86), 33, Reduce, (50, 0), 1, null, null);
- Add_Action (Table.States (86), 35, Reduce, (50, 0), 1, null, null);
- Add_Action (Table.States (86), 36, Reduce, (50, 0), 1, null, null);
+ Add_Action (Table.States (86), 11, Reduce, (50, 0), 1, null,
null);
+ Add_Action (Table.States (86), 12, Reduce, (50, 0), 1, null,
null);
+ Add_Action (Table.States (86), 18, Reduce, (50, 0), 1, null,
null);
+ Add_Action (Table.States (86), 19, Reduce, (50, 0), 1, null,
null);
+ Add_Action (Table.States (86), 20, Reduce, (50, 0), 1, null,
null);
+ Add_Action (Table.States (86), 21, Reduce, (50, 0), 1, null,
null);
+ Add_Action (Table.States (86), 23, Reduce, (50, 0), 1, null,
null);
+ Add_Action (Table.States (86), 24, (53, 4), 67);
+ Add_Action (Table.States (86), 25, (52, 2), 68);
+ Add_Action (Table.States (86), 26, Reduce, (50, 0), 1, null,
null);
+ Add_Action (Table.States (86), 27, Reduce, (50, 0), 1, null,
null);
+ Add_Action (Table.States (86), 28, Reduce, (50, 0), 1, null,
null);
+ Add_Action (Table.States (86), 29, Reduce, (50, 0), 1, null,
null);
+ Add_Action (Table.States (86), 31, (53, 5), 69);
+ Add_Action (Table.States (86), 33, Reduce, (50, 0), 1, null,
null);
+ Add_Action (Table.States (86), 35, Reduce, (50, 0), 1, null,
null);
+ Add_Action (Table.States (86), 36, Reduce, (50, 0), 1, null,
null);
Table.States (87).Action_List.Set_Capacity (14);
- Add_Action (Table.States (87), (11, 12, 18, 19, 20, 21, 23, 26,
27, 28, 29, 33, 35, 36), (48, 1), 3, null,
+ Add_Action (Table.States (87), (11, 12, 18, 19, 20, 21, 23, 26,
27, 28, 29, 33, 35, 36), (48, 1), 3, null,
null);
Table.States (88).Action_List.Set_Capacity (5);
- Add_Action (Table.States (88), (12, 23, 29, 33, 36), (45, 1), 3,
null, null);
+ Add_Action (Table.States (88), (12, 23, 29, 33, 36), (45, 1), 3,
null, null);
Table.States (89).Action_List.Set_Capacity (1);
- Add_Action (Table.States (89), 5, 98);
+ Add_Action (Table.States (89), 5, (45, 3), 98);
Table.States (90).Action_List.Set_Capacity (1);
- Add_Action (Table.States (90), 33, 99);
+ Add_Action (Table.States (90), 33, (45, 2), 99);
Table.States (91).Action_List.Set_Capacity (5);
- Add_Action (Table.States (91), (12, 23, 29, 33, 36), (46, 3), 3,
null, null);
+ Add_Action (Table.States (91), (12, 23, 29, 33, 36), (46, 3), 3,
null, null);
Table.States (92).Action_List.Set_Capacity (10);
- Add_Action (Table.States (92), 12, Reduce, (54, 1), 3, null, null);
- Add_Action (Table.States (92), 18, 38);
- Add_Action (Table.States (92), 19, 39);
- Add_Action (Table.States (92), 20, 40);
- Add_Action (Table.States (92), 21, 41);
- Add_Action (Table.States (92), 26, Reduce, (54, 1), 3, null, null);
- Add_Action (Table.States (92), 27, Reduce, (54, 1), 3, null, null);
- Add_Action (Table.States (92), 28, Reduce, (54, 1), 3, null, null);
- Add_Action (Table.States (92), 33, 42);
- Add_Action (Table.States (92), 35, 43);
+ Add_Action (Table.States (92), 12, Reduce, (54, 1), 3, null,
null);
+ Add_Action (Table.States (92), 18, (53, 0), 38);
+ Add_Action (Table.States (92), 19, (52, 0), 39);
+ Add_Action (Table.States (92), 20, (51, 0), 40);
+ Add_Action (Table.States (92), 21, (47, 0), 41);
+ Add_Action (Table.States (92), 26, Reduce, (54, 1), 3, null,
null);
+ Add_Action (Table.States (92), 27, Reduce, (54, 1), 3, null,
null);
+ Add_Action (Table.States (92), 28, Reduce, (54, 1), 3, null,
null);
+ Add_Action (Table.States (92), 33, (48, 1), 42);
+ Add_Action (Table.States (92), 35, (50, 1), 43);
Table.States (92).Goto_List.Set_Capacity (6);
Add_Goto (Table.States (92), 47, 46);
Add_Goto (Table.States (92), 48, 76);
@@ -620,34 +620,34 @@ package body Wisitoken_Grammar_Main is
Add_Goto (Table.States (92), 52, 51);
Add_Goto (Table.States (92), 53, 52);
Table.States (93).Action_List.Set_Capacity (14);
- Add_Action (Table.States (93), (11, 12, 18, 19, 20, 21, 23, 26,
27, 28, 29, 33, 35, 36), (53, 1), 4, null,
+ Add_Action (Table.States (93), (11, 12, 18, 19, 20, 21, 23, 26,
27, 28, 29, 33, 35, 36), (53, 1), 4, null,
null);
Table.States (94).Action_List.Set_Capacity (14);
- Add_Action (Table.States (94), (11, 12, 18, 19, 20, 21, 23, 26,
27, 28, 29, 33, 35, 36), (53, 2), 4, null,
+ Add_Action (Table.States (94), (11, 12, 18, 19, 20, 21, 23, 26,
27, 28, 29, 33, 35, 36), (53, 2), 4, null,
null);
Table.States (95).Action_List.Set_Capacity (14);
- Add_Action (Table.States (95), (11, 12, 18, 19, 20, 21, 23, 26,
27, 28, 29, 33, 35, 36), (52, 1), 4, null,
+ Add_Action (Table.States (95), (11, 12, 18, 19, 20, 21, 23, 26,
27, 28, 29, 33, 35, 36), (52, 1), 4, null,
null);
Table.States (96).Action_List.Set_Capacity (14);
- Add_Action (Table.States (96), (11, 12, 18, 19, 20, 21, 23, 26,
27, 28, 29, 33, 35, 36), (53, 3), 4, null,
+ Add_Action (Table.States (96), (11, 12, 18, 19, 20, 21, 23, 26,
27, 28, 29, 33, 35, 36), (53, 3), 4, null,
null);
Table.States (97).Action_List.Set_Capacity (1);
- Add_Action (Table.States (97), 17, 100);
+ Add_Action (Table.States (97), 17, (47, 0), 100);
Table.States (98).Action_List.Set_Capacity (5);
- Add_Action (Table.States (98), (12, 23, 29, 33, 36), (45, 3), 4,
null, null);
+ Add_Action (Table.States (98), (12, 23, 29, 33, 36), (45, 3), 4,
null, null);
Table.States (99).Action_List.Set_Capacity (1);
- Add_Action (Table.States (99), 16, 101);
+ Add_Action (Table.States (99), 16, (45, 2), 101);
Table.States (100).Action_List.Set_Capacity (14);
- Add_Action (Table.States (100), (11, 12, 18, 19, 20, 21, 23, 26,
27, 28, 29, 33, 35, 36), (47, 0), 5, null,
- null);
+ Add_Action (Table.States (100), (11, 12, 18, 19, 20, 21, 23, 26,
27, 28, 29, 33, 35, 36), (47, 0), 5,
+ null, null);
Table.States (101).Action_List.Set_Capacity (1);
- Add_Action (Table.States (101), 33, 102);
+ Add_Action (Table.States (101), 33, (45, 2), 102);
Table.States (102).Action_List.Set_Capacity (5);
- Add_Action (Table.States (102), (12, 23, 29, 33, 36), (45, 2), 6,
null, null);
+ Add_Action (Table.States (102), (12, 23, 29, 33, 36), (45, 2), 6,
null, null);
end Subr_1;
begin
Subr_1;
- Table.Error_Action := new Parse_Action_Node'((Verb => Error), null);
+ Table.Error_Action := new Parse_Action_Node'((Verb => Error, others
=> <>), null);
end;
WisiToken.Parse.LR.Parser_No_Recover.New_Parser
diff --git a/wisitoken_grammar_re2c.c b/wisitoken_grammar_re2c.c
index ef82744..b58f1d0 100644
--- a/wisitoken_grammar_re2c.c
+++ b/wisitoken_grammar_re2c.c
@@ -1,4 +1,4 @@
-/* Generated by re2c 1.0.3 */
+/* Generated by re2c 1.3 */
#line 1 "../wisitoken_grammar.re2c"
// generated parser support file. -*- mode: C -*-
// command line: wisitoken-bnf-generate.exe --generate LALR Ada re2c
wisitoken_grammar.wy
@@ -332,21 +332,21 @@ yy2:
YYSKIP ();
yy3:
YYDEBUG(3, YYPEEK ());
-#line 261 "../wisitoken_grammar.re2c"
+#line 262 "../wisitoken_grammar.re2c"
{status = ERROR_unrecognized_character; continue;}
#line 338 "../wisitoken_grammar_re2c.c"
yy4:
YYDEBUG(4, YYPEEK ());
YYSKIP ();
YYDEBUG(5, YYPEEK ());
-#line 259 "../wisitoken_grammar.re2c"
+#line 260 "../wisitoken_grammar.re2c"
{*id = 36; continue;}
#line 345 "../wisitoken_grammar_re2c.c"
yy6:
YYDEBUG(6, YYPEEK ());
YYSKIP ();
YYDEBUG(7, YYPEEK ());
-#line 217 "../wisitoken_grammar.re2c"
+#line 218 "../wisitoken_grammar.re2c"
{ lexer->byte_token_start = lexer->cursor;
lexer->char_token_start = lexer->char_pos;
if (*lexer->cursor == 0x0A)
@@ -359,7 +359,7 @@ yy8:
YYDEBUG(8, YYPEEK ());
YYSKIP ();
YYDEBUG(9, YYPEEK ());
-#line 224 "../wisitoken_grammar.re2c"
+#line 225 "../wisitoken_grammar.re2c"
{*id = 1; continue;}
#line 365 "../wisitoken_grammar_re2c.c"
yy10:
@@ -538,7 +538,7 @@ yy12:
}
yy13:
YYDEBUG(13, YYPEEK ());
-#line 246 "../wisitoken_grammar.re2c"
+#line 247 "../wisitoken_grammar.re2c"
{*id = 23; continue;}
#line 544 "../wisitoken_grammar_re2c.c"
yy14:
@@ -701,35 +701,35 @@ yy15:
YYDEBUG(15, YYPEEK ());
YYSKIP ();
YYDEBUG(16, YYPEEK ());
-#line 243 "../wisitoken_grammar.re2c"
+#line 244 "../wisitoken_grammar.re2c"
{*id = 20; continue;}
#line 707 "../wisitoken_grammar_re2c.c"
yy17:
YYDEBUG(17, YYPEEK ());
YYSKIP ();
YYDEBUG(18, YYPEEK ());
-#line 251 "../wisitoken_grammar.re2c"
+#line 252 "../wisitoken_grammar.re2c"
{*id = 28; continue;}
#line 714 "../wisitoken_grammar_re2c.c"
yy19:
YYDEBUG(19, YYPEEK ());
YYSKIP ();
YYDEBUG(20, YYPEEK ());
-#line 254 "../wisitoken_grammar.re2c"
+#line 255 "../wisitoken_grammar.re2c"
{*id = 31; continue;}
#line 721 "../wisitoken_grammar_re2c.c"
yy21:
YYDEBUG(21, YYPEEK ());
YYSKIP ();
YYDEBUG(22, YYPEEK ());
-#line 247 "../wisitoken_grammar.re2c"
+#line 248 "../wisitoken_grammar.re2c"
{*id = 24; continue;}
#line 728 "../wisitoken_grammar_re2c.c"
yy23:
YYDEBUG(23, YYPEEK ());
YYSKIP ();
YYDEBUG(24, YYPEEK ());
-#line 238 "../wisitoken_grammar.re2c"
+#line 239 "../wisitoken_grammar.re2c"
{*id = 15; continue;}
#line 735 "../wisitoken_grammar_re2c.c"
yy25:
@@ -752,14 +752,14 @@ yy25:
}
yy26:
YYDEBUG(26, YYPEEK ());
-#line 245 "../wisitoken_grammar.re2c"
+#line 246 "../wisitoken_grammar.re2c"
{*id = 22; continue;}
#line 758 "../wisitoken_grammar_re2c.c"
yy27:
YYDEBUG(27, YYPEEK ());
YYSKIP ();
YYDEBUG(28, YYPEEK ());
-#line 253 "../wisitoken_grammar.re2c"
+#line 254 "../wisitoken_grammar.re2c"
{*id = 30; continue;}
#line 765 "../wisitoken_grammar_re2c.c"
yy29:
@@ -783,7 +783,7 @@ yy29:
}
yy31:
YYDEBUG(31, YYPEEK ());
-#line 255 "../wisitoken_grammar.re2c"
+#line 256 "../wisitoken_grammar.re2c"
{*id = 32; continue;}
#line 789 "../wisitoken_grammar_re2c.c"
yy32:
@@ -798,7 +798,7 @@ yy32:
}
yy33:
YYDEBUG(33, YYPEEK ());
-#line 236 "../wisitoken_grammar.re2c"
+#line 237 "../wisitoken_grammar.re2c"
{*id = 13; continue;}
#line 804 "../wisitoken_grammar_re2c.c"
yy34:
@@ -811,35 +811,35 @@ yy34:
}
yy35:
YYDEBUG(35, YYPEEK ());
-#line 252 "../wisitoken_grammar.re2c"
+#line 253 "../wisitoken_grammar.re2c"
{*id = 29; continue;}
#line 817 "../wisitoken_grammar_re2c.c"
yy36:
YYDEBUG(36, YYPEEK ());
YYSKIP ();
YYDEBUG(37, YYPEEK ());
-#line 244 "../wisitoken_grammar.re2c"
+#line 245 "../wisitoken_grammar.re2c"
{*id = 21; continue;}
#line 824 "../wisitoken_grammar_re2c.c"
yy38:
YYDEBUG(38, YYPEEK ());
YYSKIP ();
YYDEBUG(39, YYPEEK ());
-#line 239 "../wisitoken_grammar.re2c"
+#line 240 "../wisitoken_grammar.re2c"
{*id = 16; continue;}
#line 831 "../wisitoken_grammar_re2c.c"
yy40:
YYDEBUG(40, YYPEEK ());
YYSKIP ();
YYDEBUG(41, YYPEEK ());
-#line 240 "../wisitoken_grammar.re2c"
+#line 241 "../wisitoken_grammar.re2c"
{*id = 17; continue;}
#line 838 "../wisitoken_grammar_re2c.c"
yy42:
YYDEBUG(42, YYPEEK ());
YYSKIP ();
YYDEBUG(43, YYPEEK ());
-#line 248 "../wisitoken_grammar.re2c"
+#line 249 "../wisitoken_grammar.re2c"
{*id = 25; continue;}
#line 845 "../wisitoken_grammar_re2c.c"
yy44:
@@ -970,21 +970,21 @@ yy45:
}
yy46:
YYDEBUG(46, YYPEEK ());
-#line 256 "../wisitoken_grammar.re2c"
+#line 257 "../wisitoken_grammar.re2c"
{*id = 33; continue;}
#line 976 "../wisitoken_grammar_re2c.c"
yy47:
YYDEBUG(47, YYPEEK ());
YYSKIP ();
YYDEBUG(48, YYPEEK ());
-#line 242 "../wisitoken_grammar.re2c"
+#line 243 "../wisitoken_grammar.re2c"
{*id = 19; continue;}
#line 983 "../wisitoken_grammar_re2c.c"
yy49:
YYDEBUG(49, YYPEEK ());
YYSKIP ();
YYDEBUG(50, YYPEEK ());
-#line 250 "../wisitoken_grammar.re2c"
+#line 251 "../wisitoken_grammar.re2c"
{*id = 27; continue;}
#line 990 "../wisitoken_grammar_re2c.c"
yy51:
@@ -1051,21 +1051,21 @@ yy57:
YYDEBUG(57, YYPEEK ());
YYSKIP ();
YYDEBUG(58, YYPEEK ());
-#line 241 "../wisitoken_grammar.re2c"
+#line 242 "../wisitoken_grammar.re2c"
{*id = 18; continue;}
#line 1057 "../wisitoken_grammar_re2c.c"
yy59:
YYDEBUG(59, YYPEEK ());
YYSKIP ();
YYDEBUG(60, YYPEEK ());
-#line 235 "../wisitoken_grammar.re2c"
+#line 236 "../wisitoken_grammar.re2c"
{*id = 12; continue;}
#line 1064 "../wisitoken_grammar_re2c.c"
yy61:
YYDEBUG(61, YYPEEK ());
YYSKIP ();
YYDEBUG(62, YYPEEK ());
-#line 249 "../wisitoken_grammar.re2c"
+#line 250 "../wisitoken_grammar.re2c"
{*id = 26; continue;}
#line 1071 "../wisitoken_grammar_re2c.c"
yy63:
@@ -1593,7 +1593,7 @@ yy72:
}
yy73:
YYDEBUG(73, YYPEEK ());
-#line 257 "../wisitoken_grammar.re2c"
+#line 258 "../wisitoken_grammar.re2c"
{*id = 34; continue;}
#line 1599 "../wisitoken_grammar_re2c.c"
yy74:
@@ -1930,21 +1930,21 @@ yy80:
YYDEBUG(80, YYPEEK ());
YYSKIP ();
YYDEBUG(81, YYPEEK ());
-#line 234 "../wisitoken_grammar.re2c"
+#line 235 "../wisitoken_grammar.re2c"
{*id = 11; skip_to(lexer, ")%"); continue;}
#line 1936 "../wisitoken_grammar_re2c.c"
yy82:
YYDEBUG(82, YYPEEK ());
YYSKIP ();
YYDEBUG(83, YYPEEK ());
-#line 233 "../wisitoken_grammar.re2c"
+#line 234 "../wisitoken_grammar.re2c"
{*id = 10; skip_to(lexer, "]%"); continue;}
#line 1943 "../wisitoken_grammar_re2c.c"
yy84:
YYDEBUG(84, YYPEEK ());
YYSKIP ();
YYDEBUG(85, YYPEEK ());
-#line 232 "../wisitoken_grammar.re2c"
+#line 233 "../wisitoken_grammar.re2c"
{*id = 9; skip_to(lexer, "}%"); continue;}
#line 1950 "../wisitoken_grammar_re2c.c"
yy86:
@@ -2115,7 +2115,7 @@ yy88:
}
yy89:
YYDEBUG(89, YYPEEK ());
-#line 258 "../wisitoken_grammar.re2c"
+#line 259 "../wisitoken_grammar.re2c"
{*id = 35; continue;}
#line 2121 "../wisitoken_grammar_re2c.c"
yy90:
@@ -2645,7 +2645,7 @@ yy97:
}
yy99:
YYDEBUG(99, YYPEEK ());
-#line 225 "../wisitoken_grammar.re2c"
+#line 226 "../wisitoken_grammar.re2c"
{*id = 2; continue;}
#line 2651 "../wisitoken_grammar_re2c.c"
yy100:
@@ -3124,7 +3124,7 @@ yy108:
}
yy109:
YYDEBUG(109, YYPEEK ());
-#line 228 "../wisitoken_grammar.re2c"
+#line 229 "../wisitoken_grammar.re2c"
{*id = 5; continue;}
#line 3130 "../wisitoken_grammar_re2c.c"
yy110:
@@ -3161,7 +3161,7 @@ yy113:
YYDEBUG(113, YYPEEK ());
YYSKIP ();
YYDEBUG(114, YYPEEK ());
-#line 237 "../wisitoken_grammar.re2c"
+#line 238 "../wisitoken_grammar.re2c"
{*id = 14; continue;}
#line 3167 "../wisitoken_grammar_re2c.c"
yy115:
@@ -3630,7 +3630,7 @@ yy122:
}
yy123:
YYDEBUG(123, YYPEEK ());
-#line 227 "../wisitoken_grammar.re2c"
+#line 228 "../wisitoken_grammar.re2c"
{*id = 4; continue;}
#line 3636 "../wisitoken_grammar_re2c.c"
yy124:
@@ -3789,7 +3789,7 @@ yy127:
}
yy128:
YYDEBUG(128, YYPEEK ());
-#line 226 "../wisitoken_grammar.re2c"
+#line 227 "../wisitoken_grammar.re2c"
{*id = 3; continue;}
#line 3795 "../wisitoken_grammar_re2c.c"
yy129:
@@ -3968,7 +3968,7 @@ yy134:
}
yy135:
YYDEBUG(135, YYPEEK ());
-#line 231 "../wisitoken_grammar.re2c"
+#line 232 "../wisitoken_grammar.re2c"
{*id = 8; continue;}
#line 3974 "../wisitoken_grammar_re2c.c"
yy136:
@@ -4117,7 +4117,7 @@ yy138:
}
yy139:
YYDEBUG(139, YYPEEK ());
-#line 229 "../wisitoken_grammar.re2c"
+#line 230 "../wisitoken_grammar.re2c"
{*id = 6; continue;}
#line 4123 "../wisitoken_grammar_re2c.c"
yy140:
@@ -4286,11 +4286,11 @@ yy144:
}
yy145:
YYDEBUG(145, YYPEEK ());
-#line 230 "../wisitoken_grammar.re2c"
+#line 231 "../wisitoken_grammar.re2c"
{*id = 7; continue;}
#line 4292 "../wisitoken_grammar_re2c.c"
}
-#line 262 "../wisitoken_grammar.re2c"
+#line 263 "../wisitoken_grammar.re2c"
}
/* lexer->cursor and lexer ->char_pos are one char past end of token */
diff --git a/wisitoken_grammar_runtime.adb b/wisitoken_grammar_runtime.adb
index 346eadb..42d61fe 100644
--- a/wisitoken_grammar_runtime.adb
+++ b/wisitoken_grammar_runtime.adb
@@ -2,7 +2,7 @@
--
-- See spec.
--
--- Copyright (C) 2018 - 2019 Free Software Foundation, Inc.
+-- Copyright (C) 2018 - 2020 Free Software Foundation, Inc.
--
-- This library is free software; you can redistribute it and/or modify it
-- under terms of the GNU General Public License as published by the Free
@@ -25,11 +25,11 @@ with GNAT.Regexp;
with SAL.Generic_Decimal_Image;
with System.Assertions;
with WisiToken.Generate; use WisiToken.Generate;
-with Wisitoken_Grammar_Actions; use Wisitoken_Grammar_Actions;
with WisiToken.Syntax_Trees.LR_Utils;
package body WisiToken_Grammar_Runtime is
use WisiToken;
+ use Wisitoken_Grammar_Actions;
----------
-- Body subprograms, misc order
@@ -38,14 +38,14 @@ package body WisiToken_Grammar_Runtime is
(Label : in String;
Data : in User_Data_Type;
Tree : in WisiToken.Syntax_Trees.Tree;
- Node : in WisiToken.Syntax_Trees.Node_Index);
+ Node : in WisiToken.Node_Index);
pragma No_Return (Raise_Programmer_Error);
procedure Raise_Programmer_Error
(Label : in String;
Data : in User_Data_Type;
Tree : in WisiToken.Syntax_Trees.Tree;
- Node : in WisiToken.Syntax_Trees.Node_Index)
+ Node : in WisiToken.Node_Index)
is begin
WisiToken.Syntax_Trees.LR_Utils.Raise_Programmer_Error
(Label, Wisitoken_Grammar_Actions.Descriptor, Data.Grammar_Lexer,
Tree, Data.Terminals.all, Node);
@@ -54,7 +54,7 @@ package body WisiToken_Grammar_Runtime is
function Get_Line
(Data : in User_Data_Type;
Tree : in Syntax_Trees.Tree;
- Node : in WisiToken.Syntax_Trees.Valid_Node_Index)
+ Node : in WisiToken.Valid_Node_Index)
return WisiToken.Line_Number_Type
is
-- Find a source line for Node.
@@ -64,12 +64,12 @@ package body WisiToken_Grammar_Runtime is
Temp : Node_Index := Node;
begin
loop
- if Tree.Min_Terminal_Index (Temp) = Invalid_Token_Index then
+ if Tree.First_Shared_Terminal (Temp) = Invalid_Token_Index then
-- Node is empty or all virtual_identifiers; try parents.
Temp := Tree.Parent (Temp);
exit when Temp = Invalid_Node_Index;
else
- return Data.Terminals.all (Tree.Min_Terminal_Index (Temp)).Line;
+ return Data.Terminals.all (Tree.First_Shared_Terminal (Temp)).Line;
end if;
end loop;
return Invalid_Line_Number;
@@ -78,13 +78,13 @@ package body WisiToken_Grammar_Runtime is
function Get_Text
(Data : in User_Data_Type;
Tree : in Syntax_Trees.Tree;
- Tree_Index : in Syntax_Trees.Valid_Node_Index;
+ Tree_Index : in Valid_Node_Index;
Strip_Quotes : in Boolean := False)
return String
is
use all type Syntax_Trees.Node_Label;
- function Strip_Delimiters (Tree_Index : in
Syntax_Trees.Valid_Node_Index) return String
+ function Strip_Delimiters (Tree_Index : in Valid_Node_Index) return
String
is
Region : Buffer_Region renames Data.Terminals.all (Tree.Terminal
(Tree_Index)).Byte_Region;
begin
@@ -124,7 +124,7 @@ package body WisiToken_Grammar_Runtime is
declare
use all type Ada.Strings.Unbounded.Unbounded_String;
Result : Ada.Strings.Unbounded.Unbounded_String;
- Tree_Indices : constant Syntax_Trees.Valid_Node_Index_Array :=
Tree.Get_Terminals (Tree_Index);
+ Tree_Indices : constant Valid_Node_Index_Array :=
Tree.Get_Terminals (Tree_Index);
Need_Space : Boolean :=
False;
begin
for Tree_Index of Tree_Indices loop
@@ -140,12 +140,12 @@ package body WisiToken_Grammar_Runtime is
function Get_Child_Text
(Data : in User_Data_Type;
Tree : in Syntax_Trees.Tree;
- Parent : in Syntax_Trees.Valid_Node_Index;
+ Parent : in Valid_Node_Index;
Child : in SAL.Peek_Type;
Strip_Quotes : in Boolean := False)
return String
is
- Tree_Indices : constant Syntax_Trees.Valid_Node_Index_Array :=
Tree.Get_Terminals (Parent);
+ Tree_Indices : constant Valid_Node_Index_Array := Tree.Get_Terminals
(Parent);
begin
return Get_Text (Data, Tree, Tree_Indices (Child), Strip_Quotes);
end Get_Child_Text;
@@ -153,8 +153,8 @@ package body WisiToken_Grammar_Runtime is
procedure Start_If_1
(Data : in out User_Data_Type;
Tree : in Syntax_Trees.Tree;
- A_Index : in Syntax_Trees.Valid_Node_Index;
- B_Index : in Syntax_Trees.Valid_Node_Index)
+ A_Index : in Valid_Node_Index;
+ B_Index : in Valid_Node_Index)
is
use all type WisiToken.BNF.Generate_Algorithm;
use all type WisiToken.BNF.Lexer_Type;
@@ -171,7 +171,7 @@ package body WisiToken_Grammar_Runtime is
else
raise Grammar_Error with
Error_Message
- (Data.Grammar_Lexer.File_Name, Data.Terminals.all
(Tree.Min_Terminal_Index (A_Index)).Line,
+ (Data.Grammar_Lexer.File_Name, Data.Terminals.all
(Tree.First_Shared_Terminal (A_Index)).Line,
"invalid '%if'; must be one of {lexer | parser}");
end if;
end Start_If_1;
@@ -180,12 +180,11 @@ package body WisiToken_Grammar_Runtime is
(Data : in out User_Data_Type;
Tree : in Syntax_Trees.Tree;
Labels : in out WisiToken.BNF.String_Arrays.Vector;
- Token : in Syntax_Trees.Valid_Node_Index)
+ Token : in Valid_Node_Index)
return WisiToken.BNF.RHS_Type
is
- use all type WisiToken.Syntax_Trees.Node_Index;
use all type SAL.Base_Peek_Type;
- Children : constant Syntax_Trees.Valid_Node_Index_Array := Tree.Children
(Token);
+ Children : constant Valid_Node_Index_Array := Tree.Children (Token);
begin
pragma Assert (-Tree.ID (Token) = rhs_ID);
@@ -253,9 +252,9 @@ package body WisiToken_Grammar_Runtime is
Tree : in WisiToken.Syntax_Trees.Tree;
Right_Hand_Sides : in out WisiToken.BNF.RHS_Lists.List;
Labels : in out WisiToken.BNF.String_Arrays.Vector;
- Token : in WisiToken.Syntax_Trees.Valid_Node_Index)
+ Token : in WisiToken.Valid_Node_Index)
is
- Tokens : constant Syntax_Trees.Valid_Node_Index_Array := Tree.Children
(Token);
+ Tokens : constant Valid_Node_Index_Array := Tree.Children (Token);
begin
pragma Assert (-Tree.ID (Token) = rhs_list_ID);
@@ -345,6 +344,7 @@ package body WisiToken_Grammar_Runtime is
overriding
procedure Lexer_To_Augmented
(Data : in out User_Data_Type;
+ Tree : in out WisiToken.Syntax_Trees.Tree'Class;
Token : in WisiToken.Base_Token;
Lexer : not null access WisiToken.Lexer.Instance'Class)
is
@@ -353,23 +353,31 @@ package body WisiToken_Grammar_Runtime is
begin
if Token.ID < Wisitoken_Grammar_Actions.Descriptor.First_Terminal then
-- Non-grammar token
- if Data.Non_Grammar.Length = 0 then
- Data.Non_Grammar.Set_First_Last (0, 0);
- end if;
-
if Data.Terminals.Length = 0 then
- Data.Non_Grammar (0).Append (Token);
+ Data.Leading_Non_Grammar.Append (Token);
else
- Data.Non_Grammar.Set_First_Last (0, Data.Terminals.Last_Index);
- Data.Non_Grammar (Data.Terminals.Last_Index).Append (Token);
+ declare
+ Containing_Aug : Augmented_Token_Access :=
Augmented_Token_Access
+ (Tree.Augmented (Data.Last_Terminal_Node));
+ begin
+ if Containing_Aug = null then
+ Containing_Aug := new Augmented_Token'
+ (Data.Terminals.all (Tree.First_Shared_Terminal
(Data.Last_Terminal_Node)) with Non_Grammar => <>);
+ Tree.Set_Augmented (Data.Last_Terminal_Node,
WisiToken.Base_Token_Class_Access (Containing_Aug));
+ end if;
+
+ Containing_Aug.Non_Grammar.Append (Token);
+ end;
end if;
+ else
+ Data.Last_Terminal_Node := Token.Tree_Index;
end if;
end Lexer_To_Augmented;
procedure Start_If
(User_Data : in out WisiToken.Syntax_Trees.User_Data_Type'Class;
Tree : in WisiToken.Syntax_Trees.Tree;
- Tokens : in WisiToken.Syntax_Trees.Valid_Node_Index_Array)
+ Tokens : in WisiToken.Valid_Node_Index_Array)
is begin
-- all phases
Start_If_1 (User_Data_Type (User_Data), Tree, Tokens (3), Tokens (5));
@@ -386,7 +394,7 @@ package body WisiToken_Grammar_Runtime is
procedure Add_Declaration
(User_Data : in out WisiToken.Syntax_Trees.User_Data_Type'Class;
Tree : in WisiToken.Syntax_Trees.Tree;
- Tokens : in WisiToken.Syntax_Trees.Valid_Node_Index_Array)
+ Tokens : in WisiToken.Valid_Node_Index_Array)
is
use all type WisiToken.Syntax_Trees.Node_Label;
use all type Ada.Strings.Unbounded.Unbounded_String;
@@ -425,7 +433,7 @@ package body WisiToken_Grammar_Runtime is
elsif Kind = "generate" then
declare
use all type SAL.Base_Peek_Type;
- Children : constant
Syntax_Trees.Valid_Node_Index_Array := Tree.Get_Terminals (Tokens (3));
+ Children : constant Valid_Node_Index_Array :=
Tree.Get_Terminals (Tokens (3));
Tuple : WisiToken.BNF.Generate_Tuple;
begin
Tuple.Gen_Alg := WisiToken.BNF.To_Generate_Algorithm
(Get_Text (Data, Tree, Children (1)));
@@ -498,13 +506,13 @@ package body WisiToken_Grammar_Runtime is
when Syntax_Trees.Nonterm =>
-- must be token_keyword_non_grammar
declare
- Children_2 : constant Syntax_Trees.Valid_Node_Index_Array :=
Tree.Children (Tokens (2));
+ Children_2 : constant Valid_Node_Index_Array := Tree.Children
(Tokens (2));
Child_1_ID : constant Token_Enum_ID := To_Token_Enum (Tree.ID
(Children_2 (1)));
begin
case Child_1_ID is
when Wisitoken_Grammar_Actions.TOKEN_ID =>
declare
- Children_4 : constant Syntax_Trees.Valid_Node_Index_Array :=
Tree.Children (Tokens (4));
+ Children_4 : constant Valid_Node_Index_Array :=
Tree.Children (Tokens (4));
begin
WisiToken.BNF.Add_Token
(Data.Tokens.Tokens,
@@ -639,7 +647,7 @@ package body WisiToken_Grammar_Runtime is
elsif Kind = "conflict" then
declare
- Tree_Indices : constant
Syntax_Trees.Valid_Node_Index_Array := Tree.Get_Terminals
+ Tree_Indices : constant Valid_Node_Index_Array :=
Tree.Get_Terminals
(Tokens (3));
-- %conflict <action_a>/<action_b> in state <LHS_A>,
<LHS_B> on token <on>
-- 1 2 3 4 5 6 7 8
9 10 11
@@ -695,13 +703,15 @@ package body WisiToken_Grammar_Runtime is
if Tree.Get_Terminals (Tokens (3))'Length /= 4 then
raise Grammar_Error with
Error_Message
- (Data.Grammar_Lexer.File_Name, Data.Terminals.all
(Tree.Min_Terminal_Index (Tokens (3))).Line,
+ (Data.Grammar_Lexer.File_Name,
+ Data.Terminals.all (Tree.First_Shared_Terminal
(Tokens (3))).Line,
"too " & (if Tree.Get_Terminals (Tokens (3))'Length
> 4 then "many" else "few") &
" default costs; should be 'insert, delete, push
back, ignore check fail'.");
end if;
Data.Language_Params.Error_Recover := True;
- Data.McKenzie_Recover.Source_Line := Data.Terminals.all
(Tree.Min_Terminal_Index (Tokens (1))).Line;
+ Data.McKenzie_Recover.Source_Line := Data.Terminals.all
+ (Tree.First_Shared_Terminal (Tokens (1))).Line;
Data.McKenzie_Recover.Default_Insert :=
Natural'Value
(Get_Child_Text (Data, Tree, Tokens (3), 1));
@@ -796,7 +806,7 @@ package body WisiToken_Grammar_Runtime is
procedure Add_Nonterminal
(User_Data : in out WisiToken.Syntax_Trees.User_Data_Type'Class;
Tree : in WisiToken.Syntax_Trees.Tree;
- Tokens : in WisiToken.Syntax_Trees.Valid_Node_Index_Array)
+ Tokens : in WisiToken.Valid_Node_Index_Array)
is
use all type Ada.Containers.Count_Type;
use WisiToken.Syntax_Trees;
@@ -841,7 +851,7 @@ package body WisiToken_Grammar_Runtime is
((+LHS_String, Right_Hand_Sides, Labels,
Source_Line =>
(case Tree.Label (LHS_Node) is
- when Shared_Terminal => Data.Terminals.all
(Tree.Min_Terminal_Index (LHS_Node)).Line,
+ when Shared_Terminal => Data.Terminals.all
(Tree.First_Shared_Terminal (LHS_Node)).Line,
when Virtual_Identifier => Invalid_Line_Number, -- IMPROVEME:
get line from Right_Hand_Sides
when others => raise SAL.Programmer_Error)));
end if;
@@ -850,7 +860,7 @@ package body WisiToken_Grammar_Runtime is
procedure Check_EBNF
(User_Data : in out WisiToken.Syntax_Trees.User_Data_Type'Class;
Tree : in WisiToken.Syntax_Trees.Tree;
- Tokens : in WisiToken.Syntax_Trees.Valid_Node_Index_Array;
+ Tokens : in WisiToken.Valid_Node_Index_Array;
Token : in WisiToken.Positive_Index_Type)
is
Data : User_Data_Type renames User_Data_Type (User_Data);
@@ -861,7 +871,7 @@ package body WisiToken_Grammar_Runtime is
if Data.Meta_Syntax /= EBNF_Syntax then
declare
- Tok : Base_Token renames Data.Terminals.all
(Tree.Min_Terminal_Index (Tokens (Token)));
+ Tok : Base_Token renames Data.Terminals.all
(Tree.First_Shared_Terminal (Tokens (Token)));
begin
raise Grammar_Error with Error_Message
(Data.Grammar_Lexer.File_Name, Tok.Line, Tok.Column,
@@ -879,7 +889,7 @@ package body WisiToken_Grammar_Runtime is
is
use WisiToken.Syntax_Trees;
- Copied_EBNF_Nodes :
WisiToken.Syntax_Trees.Valid_Node_Index_Arrays.Vector;
+ Copied_EBNF_Nodes : WisiToken.Valid_Node_Index_Arrays.Vector;
Symbol_Regexp : constant GNAT.Regexp.Regexp := GNAT.Regexp.Compile
((if Data.Language_Params.Case_Insensitive
@@ -1201,7 +1211,7 @@ package body WisiToken_Grammar_Runtime is
((+rhs_ID, 2),
(1 => RHS_Item_List,
2 => Tree.Add_Terminal
- (Tree.Min_Terminal_Index (Orig_RHS_Children (2)),
+ (Tree.First_Shared_Terminal (Orig_RHS_Children (2)),
Data.Terminals.all)));
when 3 =>
@@ -1209,10 +1219,10 @@ package body WisiToken_Grammar_Runtime is
((+rhs_ID, 3),
(1 => RHS_Item_List,
2 => Tree.Add_Terminal
- (Tree.Min_Terminal_Index (Orig_RHS_Children (2)),
+ (Tree.First_Shared_Terminal (Orig_RHS_Children (2)),
Data.Terminals.all),
3 => Tree.Add_Terminal
- (Tree.Min_Terminal_Index (Orig_RHS_Children (3)),
+ (Tree.First_Shared_Terminal (Orig_RHS_Children (3)),
Data.Terminals.all)));
when others =>
@@ -1227,7 +1237,7 @@ package body WisiToken_Grammar_Runtime is
(Last => Orig_RHS_Element_A_Head,
Root => Orig_RHS_Item_List_A_Root);
- if Trace_Generate > Extra then
+ if Trace_Generate_EBNF > Extra then
Ada.Text_IO.New_Line;
Ada.Text_IO.Put_Line ("new a:");
Tree.Print_Tree (Wisitoken_Grammar_Actions.Descriptor,
New_RHS_Item_List_A);
@@ -1240,7 +1250,7 @@ package body WisiToken_Grammar_Runtime is
(Last => Orig_RHS_Element_C_Head,
Root => Orig_RHS_Item_List_C_Root);
- if Trace_Generate > Extra then
+ if Trace_Generate_EBNF > Extra then
Ada.Text_IO.New_Line;
Ada.Text_IO.Put_Line ("new c:");
Tree.Print_Tree (Wisitoken_Grammar_Actions.Descriptor,
New_RHS_Item_List_C);
@@ -1293,7 +1303,7 @@ package body WisiToken_Grammar_Runtime is
end if;
end if;
- if Trace_Generate > Extra then
+ if Trace_Generate_EBNF > Extra then
Ada.Text_IO.New_Line;
Ada.Text_IO.Put_Line ("new ac:");
Tree.Print_Tree (Wisitoken_Grammar_Actions.Descriptor, New_RHS_AC);
@@ -1303,7 +1313,7 @@ package body WisiToken_Grammar_Runtime is
declare
procedure Record_Copied_Node
(Tree : in out WisiToken.Syntax_Trees.Tree;
- Node : in WisiToken.Syntax_Trees.Valid_Node_Index)
+ Node : in WisiToken.Valid_Node_Index)
is begin
if To_Token_Enum (Tree.ID (Node)) in
rhs_optional_item_ID |
@@ -1338,7 +1348,7 @@ package body WisiToken_Grammar_Runtime is
Append_Element (Compilation_Unit_List_Tail, Comp_Unit);
end if;
- if Trace_Generate > Extra then
+ if Trace_Generate_EBNF > Extra then
Ada.Text_IO.New_Line;
Ada.Text_IO.Put_Line ("new comp_unit:");
Tree.Print_Tree (Wisitoken_Grammar_Actions.Descriptor, Unit);
@@ -1540,9 +1550,28 @@ package body WisiToken_Grammar_Runtime is
New_Nonterminal_List_1 (List_Nonterm, RHS_Element_1, RHS_Element_3,
Byte_Region);
end New_Nonterminal_List;
+ procedure Copy_Non_Grammar
+ (From : in Valid_Node_Index;
+ To : in Valid_Node_Index)
+ is
+ From_Aug : constant Base_Token_Class_Access := Tree.Augmented (From);
+ begin
+ if From_Aug /= null then
+ declare
+ New_Aug : constant Augmented_Token_Access := new
Augmented_Token'
+ (ID => Tree.ID (From),
+ Tree_Index => To,
+ Non_Grammar => Augmented_Token_Access (From_Aug).Non_Grammar,
+ others => <>);
+ begin
+ Tree.Set_Augmented (To, Base_Token_Class_Access (New_Aug));
+ end;
+ end if;
+ end Copy_Non_Grammar;
+
procedure Process_Node (Node : in Valid_Node_Index)
is begin
- if Trace_Generate > Detail then
+ if Trace_Generate_EBNF > Detail then
Ada.Text_IO.New_Line;
Ada.Text_IO.Put_Line ("translate node" & Node_Index'Image (Node));
end if;
@@ -1552,13 +1581,15 @@ package body WisiToken_Grammar_Runtime is
when declaration_ID =>
-- Must be "%meta_syntax EBNF"; change to BNF
declare
- Decl_Item : constant Valid_Node_Index := Tree.Find_Descendant
+ Decl_Item : constant Valid_Node_Index :=
Tree.Find_Descendant
(Tree.Child (Node, 3), +declaration_item_ID);
- Children : Valid_Node_Index_Array := Tree.Children (Decl_Item);
+ Old_Children : constant Valid_Node_Index_Array := Tree.Children
(Decl_Item);
+ New_Children : constant Valid_Node_Index_Array :=
+ (1 => Tree.Add_Identifier
+ (+IDENTIFIER_ID, New_Identifier ("BNF"), Tree.Byte_Region
(Decl_Item)));
begin
- Children (1) := Tree.Add_Identifier
- (+IDENTIFIER_ID, New_Identifier ("BNF"), Tree.Byte_Region
(Decl_Item));
- Tree.Set_Children (Decl_Item, (+declaration_item_ID, 1),
Children);
+ Copy_Non_Grammar (Old_Children (1), New_Children (1));
+ Tree.Set_Children (Decl_Item, (+declaration_item_ID, 1),
New_Children);
end;
when rhs_alternative_list_ID =>
@@ -1613,14 +1644,15 @@ package body WisiToken_Grammar_Runtime is
-- | | | rhs_alternative_list: Child (Node, 2)
-- | | | RIGHT_PAREN
- -- See if there's an existing nonterminal for this content.
declare
- Element_Content : constant String := Get_Text (Data,
Tree, Tree.Child (Node, 2));
- Temp : Node_Index := First_List_Element
+ Element_Content : constant String := Get_Text (Data,
Tree, Tree.Child (Node, 2));
+ Right_Paren_Node : constant Valid_Node_Index := Tree.Child
(Node, 3);
+ Temp : Node_Index :=
First_List_Element
(Tree.Child (Tree.Root, 1), +compilation_unit_ID);
- Name_Node : Node_Index;
- New_Ident : Base_Identifier_Index :=
Invalid_Identifier_Index;
+ Name_Node : Node_Index;
+ New_Ident : Base_Identifier_Index :=
Invalid_Identifier_Index;
begin
+ -- See if there's an existing nonterminal for this content.
loop
pragma Assert (Tree.ID (Temp) = +compilation_unit_ID);
@@ -1664,6 +1696,7 @@ package body WisiToken_Grammar_Runtime is
end if;
Tree.Set_Node_Identifier (Node, +IDENTIFIER_ID, New_Ident);
+ Copy_Non_Grammar (Right_Paren_Node, Node);
Tree.Set_Children (Tree.Parent (Node), (+rhs_item_ID, 0), (1 =>
Node));
Clear_EBNF_Node (Node);
end;
@@ -1810,7 +1843,7 @@ package body WisiToken_Grammar_Runtime is
declare
List_Name_Node : constant Valid_Node_Index :=
Tree.Find_Ancestor (RHS_2, +nonterminal_ID);
- List_Name_Tok : constant Token_Index :=
Tree.Min_Terminal_Index (List_Name_Node);
+ List_Name_Tok : constant Token_Index :=
Tree.First_Shared_Terminal (List_Name_Node);
List_Name_Region : constant Buffer_Region :=
Data.Terminals.all (List_Name_Tok).Byte_Region;
List_Name : constant String :=
Data.Grammar_Lexer.Buffer_Text (List_Name_Region);
@@ -1823,13 +1856,13 @@ package body WisiToken_Grammar_Runtime is
RHS_1_Action : constant Node_Index :=
(case RHS_2_Index is
when 2 | 3 => Tree.Add_Terminal
- (Tree.Min_Terminal_Index (RHS_2_Children (2)),
Data.Terminals.all),
+ (Tree.First_Shared_Terminal (RHS_2_Children (2)),
Data.Terminals.all),
when others => Invalid_Node_Index);
RHS_1_Check : constant Node_Index :=
(case RHS_2_Index is
when 3 => Tree.Add_Terminal
- (Tree.Min_Terminal_Index (RHS_2_Children (3)),
Data.Terminals.all),
+ (Tree.First_Shared_Terminal (RHS_2_Children (3)),
Data.Terminals.all),
when others => Invalid_Node_Index);
RHS_1 : constant Valid_Node_Index :=
@@ -1902,7 +1935,7 @@ package body WisiToken_Grammar_Runtime is
Clear_EBNF_Node (Node);
- if Trace_Generate > Extra then
+ if Trace_Generate_EBNF > Extra then
Ada.Text_IO.New_Line;
Ada.Text_IO.Put_Line ("edited rhs_list:");
Tree.Print_Tree (Wisitoken_Grammar_Actions.Descriptor,
Tree.Parent (RHS_2));
@@ -2000,7 +2033,7 @@ package body WisiToken_Grammar_Runtime is
if Element_Content = RHS_1 and RHS_2 =
Expected_RHS_2 then
case Tree.Label (Name_Node) is
when Shared_Terminal =>
- List_Nonterm_Terminal_Name :=
Tree.Min_Terminal_Index (Name_Node);
+ List_Nonterm_Terminal_Name :=
Tree.First_Shared_Terminal (Name_Node);
when Virtual_Identifier =>
List_Nonterm_Virtual_Name :=
Tree.Identifier (Name_Node);
when others =>
@@ -2042,7 +2075,7 @@ package body WisiToken_Grammar_Runtime is
then
List_Nonterm_Virtual_Name := Next_Nonterm_Name
("_list");
New_Nonterminal_List
- (List_Nonterm_Virtual_Name, Tree.Min_Terminal_Index
(Tree.Child (Node, 2)),
+ (List_Nonterm_Virtual_Name,
Tree.First_Shared_Terminal (Tree.Child (Node, 2)),
Data.Terminals.all, Tree.Byte_Region (Node));
end if;
else
@@ -2063,7 +2096,8 @@ package body WisiToken_Grammar_Runtime is
if List_Nonterm_Virtual_Name = Invalid_Identifier_Index then
List_Nonterm_Virtual_Name := Next_Nonterm_Name ("_list");
New_Nonterminal_List
- (List_Nonterm_Virtual_Name, Tree.Min_Terminal_Index
(Tree.Child (Node, 1)), Data.Terminals.all,
+ (List_Nonterm_Virtual_Name,
+ Tree.First_Shared_Terminal (Tree.Child (Node, 1)),
Data.Terminals.all,
Tree.Byte_Region (Node));
end if;
@@ -2089,7 +2123,7 @@ package body WisiToken_Grammar_Runtime is
Clear_EBNF_Node (Node);
- if Trace_Generate > Extra then
+ if Trace_Generate_EBNF > Extra then
Ada.Text_IO.New_Line;
Ada.Text_IO.Put_Line ("edited rhs_item:");
Tree.Print_Tree (Wisitoken_Grammar_Actions.Descriptor,
Parent_RHS_Item);
@@ -2165,7 +2199,7 @@ package body WisiToken_Grammar_Runtime is
Name_Identifier_Node := Tree.Child (Tree.Child
(Name_Element_Node, 1), 1);
else
-- Name has a label
- Name_Label := Tree.Min_Terminal_Index
(Tree.Child (Name_Element_Node, 1));
+ Name_Label :=
Tree.First_Shared_Terminal (Tree.Child (Name_Element_Node, 1));
Name_Identifier_Node := Tree.Child (Tree.Child
(Name_Element_Node, 3), 1);
end if;
@@ -2173,7 +2207,7 @@ package body WisiToken_Grammar_Runtime is
when Virtual_Identifier =>
Name_Ident := Tree.Identifier
(Name_Identifier_Node);
when Shared_Terminal =>
- Name_Terminal := Tree.Min_Terminal_Index
(Name_Identifier_Node);
+ Name_Terminal := Tree.First_Shared_Terminal
(Name_Identifier_Node);
when others =>
Raise_Programmer_Error ("unhandled rhs_optional
case ", Data, Tree, Name_Identifier_Node);
end case;
@@ -2308,7 +2342,7 @@ package body WisiToken_Grammar_Runtime is
end;
end if;
- if Trace_Generate > Extra then
+ if Trace_Generate_EBNF > Extra then
Ada.Text_IO.New_Line;
Ada.Text_IO.Put_Line ("edited rhs:");
Tree.Print_Tree
(Wisitoken_Grammar_Actions.Descriptor, RHS);
@@ -2484,7 +2518,7 @@ package body WisiToken_Grammar_Runtime is
Data.Meta_Syntax := BNF_Syntax;
- if Trace_Generate > Detail then
+ if Trace_Generate_EBNF > Detail then
Ada.Text_IO.New_Line;
Ada.Text_IO.Put_Line ("Identifiers:");
for I in Data.Tokens.Virtual_Identifiers.First_Index ..
Data.Tokens.Virtual_Identifiers.Last_Index loop
@@ -2500,29 +2534,39 @@ package body WisiToken_Grammar_Runtime is
is
use Ada.Text_IO;
use WisiToken.Syntax_Trees;
- File : File_Type;
- Comments_Include_Newline : Boolean;
- procedure Put_Comments (Node : in Valid_Node_Index)
+ File : File_Type;
+
+ procedure Put_Comments
+ (Node : in Valid_Node_Index;
+ Force_New_Line : in Boolean := False;
+ Force_Comment : in String := "")
is
- Token : constant Base_Token_Index := Tree.Max_Terminal_Index (Node);
+ Last_Term : constant Node_Index := Tree.Last_Terminal
(Node);
+ Aug : constant Base_Token_Class_Access :=
+ (if Last_Term = Invalid_Node_Index
+ then null
+ else Tree.Augmented (Last_Term));
+
+ Comments_Include_Newline : Boolean := False;
begin
- -- Not all tokens have trailing non_grammar, so Data.Non_Grammar may
- -- not have entries for every token.
- Comments_Include_Newline := False;
- if Token /= Invalid_Token_Index and then
- Token in Data.Non_Grammar.First_Index .. Data.Non_Grammar.Last_Index
- then
- declare
- Tokens : Base_Token_Arrays.Vector renames Data.Non_Grammar
(Token);
- begin
- for Token of Tokens loop
- if Token.ID = +NEW_LINE_ID then
- Comments_Include_Newline := True;
- end if;
- Put (File, Data.Grammar_Lexer.Buffer_Text
(Token.Byte_Region));
- end loop;
- end;
+ if Aug = null then
+ if Force_Comment /= "" then
+ Put_Line (File, Force_Comment);
+
+ elsif Force_New_Line then
+ New_Line (File);
+ end if;
+ else
+ for Token of Augmented_Token_Access (Aug).Non_Grammar loop
+ if Token.ID = +NEW_LINE_ID then
+ Comments_Include_Newline := True;
+ end if;
+ Put (File, Data.Grammar_Lexer.Buffer_Text (Token.Byte_Region));
+ end loop;
+ if Force_New_Line and not Comments_Include_Newline then
+ New_Line (File);
+ end if;
end if;
end Put_Comments;
@@ -2627,9 +2671,8 @@ package body WisiToken_Grammar_Runtime is
end Put_RHS_Item_List;
procedure Put_RHS
- (Node : in Valid_Node_Index;
- First : in Boolean;
- Virtual : in Boolean)
+ (Node : in Valid_Node_Index;
+ First : in Boolean)
with Pre => Tree.ID (Node) = +rhs_ID
is
Children : constant Valid_Node_Index_Array := Tree.Children (Node);
@@ -2637,34 +2680,19 @@ package body WisiToken_Grammar_Runtime is
Put (File, (if First then " : " else " | "));
case Tree.RHS_Index (Node) is
when 0 =>
- if Virtual then
- Put_Line (File, ";; empty");
- else
- Put_Comments (Tree.Parent (Node));
- end if;
+ Put_Comments (Tree.Parent (Node), Force_Comment => ";; empty");
when 1 .. 3 =>
Put_RHS_Item_List (Children (1));
- if Virtual then
- New_Line (File);
- else
- Put_Comments (Children (1));
- end if;
+ Put_Comments (Children (1), Force_New_Line => True);
if Tree.RHS_Index (Node) > 1 then
Put (File, " %(" & Get_Text (Data, Tree, Children (2)) &
")%"); -- action
- if Virtual then
- New_Line (File);
- else
- Put_Comments (Children (2));
- end if;
+ Put_Comments (Children (2), Force_New_Line => True);
+
if Tree.RHS_Index (Node) > 2 then
Put (File, " %(" & Get_Text (Data, Tree, Children (3)) &
")%"); -- check
- if Virtual then
- New_Line (File);
- else
- Put_Comments (Children (3));
- end if;
+ Put_Comments (Children (3), Force_New_Line => True);
end if;
end if;
@@ -2693,11 +2721,11 @@ package body WisiToken_Grammar_Runtime is
begin
case Tree.RHS_Index (Node) is
when 0 =>
- Put_RHS (Children (1), First, Virtual or Children (1) >
Data.EBNF_Nodes.Last_Index);
+ Put_RHS (Children (1), First);
First := False;
when 1 =>
Put_RHS_List (Children (1), First, Virtual);
- Put_RHS (Children (3), First => False, Virtual => Virtual or
Children (3) > Data.EBNF_Nodes.Last_Index);
+ Put_RHS (Children (3), First => False);
when 2 =>
Put
(File, "%if " & Get_Text (Data, Tree, Children (3)) & " = " &
Get_Text (Data, Tree, Children (4)));
@@ -2764,11 +2792,7 @@ package body WisiToken_Grammar_Runtime is
Put (File, " " & Get_Text (Data, Tree, Children (3)));
Put_Declaration_Item_List (Children (4));
- if Tree.Is_Virtual (Children (4)) then
- New_Line (File);
- else
- Put_Comments (Children (4));
- end if;
+ Put_Comments (Children (4), Force_New_Line => True);
when 1 =>
Put (File, "%code ");
@@ -2814,14 +2838,7 @@ package body WisiToken_Grammar_Runtime is
First : Boolean := True;
begin
Put (File, Get_Text (Data, Tree, Children (1)));
- if Virtual then
- New_Line (File);
- else
- Put_Comments (Children (1));
- if not Comments_Include_Newline then
- New_Line (File);
- end if;
- end if;
+ Put_Comments (Children (1), Force_New_Line => True);
Put_RHS_List (Children (3), First, Virtual);
@@ -2847,13 +2864,9 @@ package body WisiToken_Grammar_Runtime is
Put_Line (File, ";;; generated from " & Data.Grammar_Lexer.File_Name & "
-*- buffer-read-only:t -*-");
Put_Line (File, ";;;");
- declare
- Tokens : Base_Token_Arrays.Vector renames Data.Non_Grammar (0);
- begin
- for Token of Tokens loop
- Put (File, Data.Grammar_Lexer.Buffer_Text (Token.Byte_Region));
- end loop;
- end;
+ for Token of Data.Leading_Non_Grammar loop
+ Put (File, Data.Grammar_Lexer.Buffer_Text (Token.Byte_Region));
+ end loop;
Process_Node (Tree.Root);
diff --git a/wisitoken_grammar_runtime.ads b/wisitoken_grammar_runtime.ads
index df848a9..082e26e 100644
--- a/wisitoken_grammar_runtime.ads
+++ b/wisitoken_grammar_runtime.ads
@@ -2,7 +2,7 @@
--
-- Runtime utils for wisi_grammar.wy actions.
--
--- Copyright (C) 2018 - 2019 Free Software Foundation, Inc.
+-- Copyright (C) 2018 - 2020 Free Software Foundation, Inc.
--
-- This library is free software; you can redistribute it and/or modify it
-- under terms of the GNU General Public License as published by the Free
@@ -18,10 +18,10 @@
pragma License (Modified_GPL);
with Ada.Containers;
-with SAL.Gen_Unbounded_Definite_Vectors;
with WisiToken.BNF;
with WisiToken.Lexer;
with WisiToken.Syntax_Trees;
+with Wisitoken_Grammar_Actions;
package WisiToken_Grammar_Runtime is
type Meta_Syntax is (Unknown, BNF_Syntax, EBNF_Syntax);
@@ -29,10 +29,6 @@ package WisiToken_Grammar_Runtime is
type Action_Phase is (Meta, Other);
- package Base_Token_Array_Arrays is new SAL.Gen_Unbounded_Definite_Vectors
- (WisiToken.Base_Token_Index, WisiToken.Base_Token_Arrays.Vector,
- Default_Element => WisiToken.Base_Token_Arrays.Empty_Vector);
-
type User_Data_Type is new WisiToken.Syntax_Trees.User_Data_Type with
record
Grammar_Lexer : WisiToken.Lexer.Handle; -- used to read the .wy file now.
@@ -61,10 +57,10 @@ package WisiToken_Grammar_Runtime is
Conflicts : WisiToken.BNF.Conflict_Lists.List;
McKenzie_Recover : WisiToken.BNF.McKenzie_Recover_Param_Type;
- Non_Grammar : Base_Token_Array_Arrays.Vector;
- -- Non_Grammar (0) contains leading blank lines and comments;
- -- Non_Grammar (I) contains blank lines and comments following
- -- Terminals (I). Only used in Print_Source.
+ Leading_Non_Grammar : WisiToken.Base_Token_Arrays.Vector;
+ -- leading blank lines and comments
+
+ Last_Terminal_Node : WisiToken.Node_Index :=
WisiToken.Invalid_Node_Index;
Rule_Count : Integer := 0;
Action_Count : Integer := 0;
@@ -81,6 +77,15 @@ package WisiToken_Grammar_Runtime is
-- An '%if' specified a different lexer, during Execute_Actions
end record;
+ type Augmented_Token is new WisiToken.Base_Token with
+ record
+ Non_Grammar : WisiToken.Base_Token_Arrays.Vector;
+ end record;
+ type Augmented_Token_Access is access all Augmented_Token;
+
+ function Image (Item : in WisiToken.Base_Token_Class_Access) return String
+ is (WisiToken.Image (Augmented_Token_Access (Item).Non_Grammar,
Wisitoken_Grammar_Actions.Descriptor));
+
overriding
procedure Set_Lexer_Terminals
(User_Data : in out User_Data_Type;
@@ -97,37 +102,38 @@ package WisiToken_Grammar_Runtime is
overriding
procedure Lexer_To_Augmented
(Data : in out User_Data_Type;
+ Tree : in out WisiToken.Syntax_Trees.Tree'Class;
Token : in WisiToken.Base_Token;
Lexer : not null access WisiToken.Lexer.Instance'Class);
procedure Start_If
(User_Data : in out WisiToken.Syntax_Trees.User_Data_Type'Class;
Tree : in WisiToken.Syntax_Trees.Tree;
- Tokens : in WisiToken.Syntax_Trees.Valid_Node_Index_Array);
+ Tokens : in WisiToken.Valid_Node_Index_Array);
procedure End_If (User_Data : in out
WisiToken.Syntax_Trees.User_Data_Type'Class);
procedure Add_Declaration
(User_Data : in out WisiToken.Syntax_Trees.User_Data_Type'Class;
Tree : in WisiToken.Syntax_Trees.Tree;
- Tokens : in WisiToken.Syntax_Trees.Valid_Node_Index_Array);
+ Tokens : in WisiToken.Valid_Node_Index_Array);
procedure Add_Nonterminal
(User_Data : in out WisiToken.Syntax_Trees.User_Data_Type'Class;
Tree : in WisiToken.Syntax_Trees.Tree;
- Tokens : in WisiToken.Syntax_Trees.Valid_Node_Index_Array);
+ Tokens : in WisiToken.Valid_Node_Index_Array);
procedure Check_EBNF
(User_Data : in out WisiToken.Syntax_Trees.User_Data_Type'Class;
Tree : in WisiToken.Syntax_Trees.Tree;
- Tokens : in WisiToken.Syntax_Trees.Valid_Node_Index_Array;
+ Tokens : in WisiToken.Valid_Node_Index_Array;
Token : in WisiToken.Positive_Index_Type);
procedure Translate_EBNF_To_BNF
(Tree : in out WisiToken.Syntax_Trees.Tree;
Data : in out User_Data_Type);
-- Process EBNF nonterms, adding new nonterms as needed, resulting in
- -- a BNF tree. Descriptor is used for error messages.
+ -- a BNF tree.
--
-- Generator.LR.*_Generate requires a BNF grammar.
- [elpa] externals/wisi 5becb56 29/35: Release ada-mode 7.0.1, wisi 3.0.1, (continued)
- [elpa] externals/wisi 5becb56 29/35: Release ada-mode 7.0.1, wisi 3.0.1, Stefan Monnier, 2020/11/28
- [elpa] externals/wisi 2114f5a 28/35: In ada-mode and wisi, release ada-mode 6.2.1, wisi 2.2.1; fix packaging bugs, Stefan Monnier, 2020/11/28
- [elpa] externals/wisi 2636b79 25/35: Release ada-mode 6.1.0, wisi 2.1.0, Stefan Monnier, 2020/11/28
- [elpa] externals/wisi dd09dcf 35/35: * .gitignore: New file, Stefan Monnier, 2020/11/28
- [elpa] externals/wisi 232d669 18/35: Release: ada-mode: version 5.2.0. wisi: version 1.1.3, Stefan Monnier, 2020/11/28
- [elpa] externals/wisi c7f61e5 26/35: In ada-mode, wisi; release ada-mode 6.1.1, wisi 2.1.1, Stefan Monnier, 2020/11/28
- [elpa] externals/wisi 66d7e59 27/35: In ada-mode, wisi: release Ada mode 6.2.0, wisi 1.2.0., Stefan Monnier, 2020/11/28
- [elpa] externals/wisi 1dc8c19 12/35: release ada-mode 5.1.7, wisi 1.1.0; minor format changes in ada-ref-man (take 2), Stefan Monnier, 2020/11/28
- [elpa] externals/wisi 5934bfc 06/35: release ada-mode 5.1.0, wisi 1.0.1, Stefan Monnier, 2020/11/28
- [elpa] externals/wisi d9cd208 32/35: In ada-mode, release 7.1.3; in wisi, release 3.1.2, Stefan Monnier, 2020/11/28
- [elpa] externals/wisi c80e75d 30/35: Release ada-mode 7.1.0, wisi 3.1.0,
Stefan Monnier <=
- [elpa] externals/wisi 4d8af96 05/35: update to Ada mode version 5.0.1, Stefan Monnier, 2020/11/28
- [elpa] externals/wisi 8a5302b 09/35: ada-mode 5.1.3, wisi 1.0.4, Stefan Monnier, 2020/11/28
- [elpa] externals/wisi 01c34d0 33/35: In wisi, missed a few files in 3.1.2 release, Stefan Monnier, 2020/11/28
- [elpa] externals/wisi 0e04e18 08/35: ada-mode, wisi: bump versions again; forgot to add some files to git, Stefan Monnier, 2020/11/28