[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/wisi da79b0f 1/4: * sal-*: Update to be compatible with
|
From: |
Stephen Leake |
|
Subject: |
[elpa] externals/wisi da79b0f 1/4: * sal-*: Update to be compatible with gnat FSF 11, Pro 22, Community 2021 |
|
Date: |
Fri, 30 Jul 2021 19:33:07 -0400 (EDT) |
branch: externals/wisi
commit da79b0ffca235fc09c442e7eb03f2f4cde5e1a42
Author: Stephen Leake <stephen_leake@stephe-leake.org>
Commit: Stephen Leake <stephen_leake@stephe-leake.org>
* sal-*: Update to be compatible with gnat FSF 11, Pro 22, Community 2021
* NEWS: Doc 3.1.4, 3.1.5.
* wisi-parse-common.el: Fix byte compiler style warnings.
* wisi.el:
* wisitoken-parse_table-mode.el:
---
NEWS | 10 +-
sal-gen_bounded_definite_stacks-gen_image_aux.ads | 4 +-
sal-gen_bounded_definite_vectors-gen_image_aux.ads | 4 +-
sal-gen_bounded_definite_vectors.adb | 20 +-
sal-gen_bounded_definite_vectors.ads | 31 +-
sal-gen_definite_doubly_linked_lists.adb | 117 ++++---
sal-gen_definite_doubly_linked_lists.ads | 13 +-
sal-gen_definite_doubly_linked_lists_sorted.adb | 29 +-
sal-gen_definite_doubly_linked_lists_sorted.ads | 14 +-
sal-gen_graphs.adb | 4 +-
sal-gen_indefinite_doubly_linked_lists.adb | 5 +-
sal-gen_unbounded_definite_min_heaps_fibonacci.ads | 5 +-
sal-gen_unbounded_definite_red_black_trees.adb | 378 ++++++++++++++-------
sal-gen_unbounded_definite_red_black_trees.ads | 161 ++++++---
sal-gen_unbounded_definite_stacks.adb | 20 +-
sal-gen_unbounded_definite_stacks.ads | 29 +-
...n_unbounded_definite_vectors-gen_comparable.ads | 4 +-
sal-gen_unbounded_definite_vectors-gen_image.adb | 16 +-
sal-gen_unbounded_definite_vectors-gen_image.ads | 16 +-
...en_unbounded_definite_vectors-gen_image_aux.adb | 96 +++---
...en_unbounded_definite_vectors-gen_image_aux.ads | 58 ++--
sal-gen_unbounded_definite_vectors.adb | 212 ++++++++----
sal-gen_unbounded_definite_vectors.ads | 78 +++--
sal-gen_unbounded_definite_vectors_sorted.adb | 6 +-
sal-gen_unbounded_definite_vectors_sorted.ads | 3 +-
sal.adb | 40 ++-
sal.ads | 6 +-
wisi-parse-common.el | 8 +-
wisi-prj.el | 7 +-
wisi.el | 3 +-
wisitoken-parse_table-mode.el | 4 +-
31 files changed, 926 insertions(+), 475 deletions(-)
diff --git a/NEWS b/NEWS
index 304ae9b..078a5c4 100644
--- a/NEWS
+++ b/NEWS
@@ -6,11 +6,13 @@ 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.3
-22 Jul 2021
+* wisi 3.1.5
+29 Jul 2021
-** Update several SAL files for compatibility with FSF gnat 11, Pro
- gnat 21.
+** Update several SAL files for compatibility with gnat FSF 11, Pro
+ 22, Community 2021.
+
+* wisi 3.1.4 packaging error
* wisi 3.1.2
4 Jun 2020
diff --git a/sal-gen_bounded_definite_stacks-gen_image_aux.ads
b/sal-gen_bounded_definite_stacks-gen_image_aux.ads
index e960398..2270c2a 100644
--- a/sal-gen_bounded_definite_stacks-gen_image_aux.ads
+++ b/sal-gen_bounded_definite_stacks-gen_image_aux.ads
@@ -2,7 +2,7 @@
--
-- Image with auxiliary data for instantiations of parent.
--
--- 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
@@ -18,7 +18,7 @@
pragma License (Modified_GPL);
generic
- type Aux_Data (<>) is private;
+ type Aux_Data (<>) is limited private;
with function Element_Image (Item : in Element_Type; Aux : in Aux_Data)
return String;
function SAL.Gen_Bounded_Definite_Stacks.Gen_Image_Aux
(Item : in Stack;
diff --git a/sal-gen_bounded_definite_vectors-gen_image_aux.ads
b/sal-gen_bounded_definite_vectors-gen_image_aux.ads
index 241e67b..a740212 100644
--- a/sal-gen_bounded_definite_vectors-gen_image_aux.ads
+++ b/sal-gen_bounded_definite_vectors-gen_image_aux.ads
@@ -2,7 +2,7 @@
--
-- Image with auxiliary data for instantiations of parent.
--
--- 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
@@ -18,6 +18,6 @@
pragma License (Modified_GPL);
generic
- type Aux_Data (<>) is private;
+ type Aux_Data (<>) is limited private;
with function Element_Image (Item : in Element_Type; Aux : in Aux_Data)
return String;
function SAL.Gen_Bounded_Definite_Vectors.Gen_Image_Aux (Item : in Vector; Aux
: in Aux_Data) return String;
diff --git a/sal-gen_bounded_definite_vectors.adb
b/sal-gen_bounded_definite_vectors.adb
index 17aac08..b6163a6 100644
--- a/sal-gen_bounded_definite_vectors.adb
+++ b/sal-gen_bounded_definite_vectors.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
@@ -49,6 +49,13 @@ is
function Last_Index (Container : Vector) return Extended_Index
is (Container.Last);
+ function To_Vector (Element : in Element_Type) return Vector
+ is begin
+ return Result : Vector do
+ Append (Result, Element);
+ end return;
+ end To_Vector;
+
procedure Append (Container : in out Vector; New_Item : in Element_Type)
is
J : constant Peek_Type := To_Peek_Index (Container.Last + 1);
@@ -117,4 +124,15 @@ is
end;
end Delete_First;
+ procedure Delete_Last (Container : in out Vector; Count : in
Ada.Containers.Count_Type := 1)
+ is
+ use Ada.Containers;
+ begin
+ if Count = 0 then
+ return;
+ end if;
+
+ Container.Last := Extended_Index (Integer (Container.Last) - Integer
(Count));
+ end Delete_Last;
+
end SAL.Gen_Bounded_Definite_Vectors;
diff --git a/sal-gen_bounded_definite_vectors.ads
b/sal-gen_bounded_definite_vectors.ads
index 9e698e2..3b8069b 100644
--- a/sal-gen_bounded_definite_vectors.ads
+++ b/sal-gen_bounded_definite_vectors.ads
@@ -2,7 +2,7 @@
--
-- A simple bounded vector of definite items, in Spark.
--
--- 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
@@ -20,6 +20,9 @@ pragma License (Modified_GPL);
generic
type Index_Type is range <>;
type Element_Type is private;
+ Default_Element : in Element_Type;
+ -- Only used in Empty_Vector
+
Capacity : in Ada.Containers.Count_Type;
package SAL.Gen_Bounded_Definite_Vectors
with Spark_Mode
@@ -36,6 +39,10 @@ is
type Vector is private with
Default_Initial_Condition => Length (Vector) = 0;
+ -- Not 'tagged' because SPARK in Gnat Community 2019 does not support
+ -- type invariant on tagged type.
+
+ Empty_Vector : constant Vector;
function Length (Container : in Vector) return Ada.Containers.Count_Type
with
Post => Length'Result in 0 .. Capacity;
@@ -69,6 +76,9 @@ is
Post => Element (Container, Index) = New_Item;
-- Index of first element in Vector is Index_Type'First.
+ function To_Vector (Element : in Element_Type) return Vector with
+ Post => Length (To_Vector'Result) = 1;
+
procedure Append (Container : in out Vector; New_Item : in Element_Type)
with
Pre => Length (Container) < Capacity,
Post => Length (Container) = Length (Container'Old) + 1 and
@@ -123,10 +133,19 @@ is
Element (Container'Old, Index_Type (Integer (I) + Integer
(Count))) = Element (Container, I));
-- Remaining elements slide down.
+ procedure Delete_Last (Container : in out Vector; Count : in
Ada.Containers.Count_Type := 1) with
+ Pre => Length (Container) >= Count,
+ Post => Length (Container) = Length (Container)'Old - Count and then
+ (for all I in Index_Type'First .. Last_Index (Container) =>
+ Element (Container'Old, I) = Element (Container, I));
+
private
type Array_Type is array (Peek_Type range 1 .. Peek_Type (Capacity)) of
aliased Element_Type;
+ function To_Peek_Index (Index : in Extended_Index) return Base_Peek_Type is
+ (Base_Peek_Type (Index - Index_Type'First + 1));
+
type Vector is
record
Elements : Array_Type;
@@ -136,10 +155,10 @@ private
pragma Annotate (GNATprove, Intentional, "type ""Vector"" is not fully
initialized",
"Only items in Elements with index < Last are accessed");
- ----------
- -- For child units
-
- function To_Peek_Index (Index : in Extended_Index) return Base_Peek_Type is
- (Base_Peek_Type (Index - Index_Type'First + 1));
+ -- We require Default_Element for this because SPARK in GNAT Community
2019 doesn't
+ -- support <> here.
+ Empty_Vector : constant Vector :=
+ (Last => No_Index,
+ Elements => (others => Default_Element));
end SAL.Gen_Bounded_Definite_Vectors;
diff --git a/sal-gen_definite_doubly_linked_lists.adb
b/sal-gen_definite_doubly_linked_lists.adb
index d86441a..a189399 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 - 2020 Free Software Foundation, Inc.
+-- Copyright (C) 2017 - 2021 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
@@ -82,7 +82,8 @@ package body SAL.Gen_Definite_Doubly_Linked_Lists is
Free (Container.Head);
Container.Head := Next;
end loop;
- Container.Tail := null;
+ Container.Tail := null;
+ Container.Count := 0;
end Finalize;
function Length (Container : in List) return Ada.Containers.Count_Type
@@ -158,39 +159,22 @@ package body SAL.Gen_Definite_Doubly_Linked_Lists is
procedure Next (Position : in out Cursor)
is begin
- if Position.Ptr /= null then
- if Position.Ptr.Next = null then
- Position.Ptr := null;
- else
- Position.Ptr := Position.Ptr.Next;
- end if;
- end if;
+ Position.Ptr := Position.Ptr.Next;
end Next;
function Next (Position : in Cursor) return Cursor
is begin
- if Position.Ptr = null then
- return Position;
- else
- if Position.Ptr.Next = null then
- return (Ptr => null);
- else
- return (Ptr => Position.Ptr.Next);
- end if;
- end if;
+ return (Ptr => Position.Ptr.Next);
end Next;
+ procedure Previous (Position : in out Cursor)
+ is begin
+ Position.Ptr := Position.Ptr.Prev;
+ end Previous;
+
function Previous (Position : in Cursor) return Cursor
is begin
- if Position.Ptr = null then
- return Position;
- else
- if Position.Ptr.Prev = null then
- return (Ptr => null);
- else
- return (Ptr => Position.Ptr.Prev);
- end if;
- end if;
+ return (Ptr => Position.Ptr.Prev);
end Previous;
function Element (Position : in Cursor) return Element_Type
@@ -216,46 +200,67 @@ package body SAL.Gen_Definite_Doubly_Linked_Lists is
Container.Count := Container.Count - 1;
end Delete_First;
- procedure Insert
+ function Append (Container : in out List; Element : in Element_Type) return
Cursor
+ is begin
+ Append (Container, Element);
+ return (Ptr => Container.Tail);
+ end Append;
+
+ function Insert
(Container : in out List;
Before : in Cursor;
Element : in Element_Type)
+ return Cursor
is
use all type Ada.Containers.Count_Type;
begin
if Before = (Ptr => null) then
- Container.Append (Element);
+ return Container.Append (Element);
else
- if Before.Ptr = Container.Head then
- declare
- -- old list: before ...
- -- newlist: new before ...
- New_Node : constant Node_Access := new Node_Type'
- (Element => Element,
- Prev => null,
- Next => Before.Ptr);
- begin
- Before.Ptr.Prev := New_Node;
- Container.Head := New_Node;
- end;
- else
- declare
- -- old list: ... prev before ...
- -- newlist: ... prev new before ...
- New_Node : constant Node_Access := new Node_Type'
- (Element => Element,
- Prev => Before.Ptr.Prev,
- Next => Before.Ptr);
- begin
- Before.Ptr.Prev.Next := New_Node;
- Before.Ptr.Prev := New_Node;
-
- end;
- end if;
- Container.Count := Container.Count + 1;
+ return Result : Cursor do
+ if Before.Ptr = Container.Head then
+ declare
+ -- old list: before ...
+ -- newlist: new before ...
+ New_Node : constant Node_Access := new Node_Type'
+ (Element => Element,
+ Prev => null,
+ Next => Before.Ptr);
+ begin
+ Before.Ptr.Prev := New_Node;
+ Container.Head := New_Node;
+ Result.Ptr := New_Node;
+ end;
+ else
+ declare
+ -- old list: ... prev before ...
+ -- newlist: ... prev new before ...
+ New_Node : constant Node_Access := new Node_Type'
+ (Element => Element,
+ Prev => Before.Ptr.Prev,
+ Next => Before.Ptr);
+ begin
+ Before.Ptr.Prev.Next := New_Node;
+ Before.Ptr.Prev := New_Node;
+ Result.Ptr := New_Node;
+ end;
+ end if;
+ Container.Count := Container.Count + 1;
+ end return;
end if;
end Insert;
+ procedure Insert
+ (Container : in out List;
+ Before : in Cursor;
+ Element : in Element_Type)
+ is
+ Junk : Cursor := Insert (Container, Before, Element);
+ pragma Unreferenced (Junk);
+ begin
+ null;
+ end Insert;
+
function Persistent_Ref (Position : in Cursor) return access Element_Type
is begin
return Position.Ptr.Element'Access;
diff --git a/sal-gen_definite_doubly_linked_lists.ads
b/sal-gen_definite_doubly_linked_lists.ads
index 8470daf..4d68707 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 - 2020 Free Software Foundation, Inc.
+-- Copyright (C) 2017 - 2021 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
@@ -75,6 +75,10 @@ package SAL.Gen_Definite_Doubly_Linked_Lists is
function Next (Position : in Cursor) return Cursor
with Pre => Has_Element (Position);
+
+ procedure Previous (Position : in out Cursor)
+ with Pre => Has_Element (Position);
+
function Previous (Position : in Cursor) return Cursor
with Pre => Has_Element (Position);
@@ -86,10 +90,17 @@ package SAL.Gen_Definite_Doubly_Linked_Lists is
procedure Delete_First (Container : in out List);
+ function Append (Container : in out List; Element : in Element_Type) return
Cursor;
+
procedure Insert
(Container : in out List;
Before : in Cursor;
Element : in Element_Type);
+ function Insert
+ (Container : in out List;
+ Before : in Cursor;
+ Element : in Element_Type)
+ return Cursor;
-- If Before is No_Element, insert after Last.
function Persistent_Ref (Position : in Cursor) return access Element_Type
diff --git a/sal-gen_definite_doubly_linked_lists_sorted.adb
b/sal-gen_definite_doubly_linked_lists_sorted.adb
index 702914d..b8f6ac6 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 - 2020 Free Software Foundation, Inc.
+-- Copyright (C) 2018 - 2021 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
@@ -185,7 +185,8 @@ package body SAL.Gen_Definite_Doubly_Linked_Lists_Sorted is
Free (Container.Head);
Container.Head := Next;
end loop;
- Container.Tail := null;
+ Container.Tail := null;
+ Container.Count := 0;
end Finalize;
overriding function "=" (Left, Right : in List) return Boolean
@@ -378,18 +379,18 @@ package body SAL.Gen_Definite_Doubly_Linked_Lists_Sorted
is
function First (Container : aliased in List) return Cursor
is begin
if Container.Head = null then
- return (Container'Access, null);
+ return (Ptr => null);
else
- return (Container'Access, Container.Head);
+ return (Ptr => Container.Head);
end if;
end First;
function Last (Container : aliased in List) return Cursor
is begin
if Container.Tail = null then
- return (Container'Access, null);
+ return (Ptr => null);
else
- return (Container'Access, Container.Tail);
+ return (Ptr => Container.Tail);
end if;
end Last;
@@ -401,11 +402,11 @@ package body SAL.Gen_Definite_Doubly_Linked_Lists_Sorted
is
Find (Container, Element, Node, Compare);
if Node = null then
- return (Container'Access, null);
+ return (Ptr => null);
elsif Compare = Equal then
- return (Container'Access, Node);
+ return (Ptr => Node);
else
- return (Container'Access, null);
+ return (Ptr => null);
end if;
end Find;
@@ -426,9 +427,9 @@ package body SAL.Gen_Definite_Doubly_Linked_Lists_Sorted is
return Position;
else
if Position.Ptr.Next = null then
- return (Position.Container, null);
+ return (Ptr => null);
else
- return (Position.Container, Position.Ptr.Next);
+ return (Ptr => Position.Ptr.Next);
end if;
end if;
end Next;
@@ -439,9 +440,9 @@ package body SAL.Gen_Definite_Doubly_Linked_Lists_Sorted is
return Position;
else
if Position.Ptr.Prev = null then
- return (Position.Container, null);
+ return (Ptr => null);
else
- return (Position.Container, Position.Ptr.Prev);
+ return (Ptr => Position.Ptr.Prev);
end if;
end if;
end Previous;
@@ -466,7 +467,7 @@ package body SAL.Gen_Definite_Doubly_Linked_Lists_Sorted is
Node.Prev.Next := Node.Next;
end if;
Free (Node);
- Position := (Container'Access, null);
+ Position := (Ptr => null);
Container.Count := Container.Count - 1;
end Delete;
diff --git a/sal-gen_definite_doubly_linked_lists_sorted.ads
b/sal-gen_definite_doubly_linked_lists_sorted.ads
index 91ffeda..d15adda 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 - 2020 Free Software Foundation, Inc.
+-- Copyright (C) 2018 - 2021 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 +41,8 @@ package SAL.Gen_Definite_Doubly_Linked_Lists_Sorted is
Empty_List : constant List;
+ function Is_Empty (Container : in List) return Boolean;
+
overriding procedure Adjust (Container : in out List);
-- Deep copy.
@@ -81,7 +83,7 @@ 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;
function No_Element (Container : aliased in List) return Cursor;
@@ -153,8 +155,10 @@ private
Count : Ada.Containers.Count_Type := 0;
end record;
- type Cursor (Container : not null access constant List) is
- record
+ function Is_Empty (Container : in List) return Boolean
+ is (Container.Head = null);
+
+ type Cursor is record
Ptr : Node_Access;
end record;
@@ -171,7 +175,7 @@ private
Empty_List : constant List := (Ada.Finalization.Controlled with null, null,
0);
function No_Element (Container : aliased in List) return Cursor
- is (Container'Access, null);
+ is (Ptr => null);
type Iterator (Container : not null access constant List) is new
Iterator_Interfaces.Reversible_Iterator with
null record;
diff --git a/sal-gen_graphs.adb b/sal-gen_graphs.adb
index ef0fcc3..c389281 100644
--- a/sal-gen_graphs.adb
+++ b/sal-gen_graphs.adb
@@ -2,7 +2,7 @@
--
-- See spec.
--
--- 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
@@ -562,7 +562,7 @@ package body SAL.Gen_Graphs is
Next (Cur);
end loop;
- A_K.Clear;
+ A_K.Clear (Free_Memory => True);
if Has_Element (Least_Vertex_Cur) then
declare
Component : Vertex_Lists.List renames Components
(Least_Vertex_Cur);
diff --git a/sal-gen_indefinite_doubly_linked_lists.adb
b/sal-gen_indefinite_doubly_linked_lists.adb
index 71d3f61..0ff3764 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 - 2020 Free Software Foundation, Inc.
+-- Copyright (C) 2018 - 2021 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
@@ -68,7 +68,8 @@ package body SAL.Gen_Indefinite_Doubly_Linked_Lists is
Free (Container.Head);
Container.Head := Next;
end loop;
- Container.Tail := null;
+ Container.Tail := null;
+ Container.Count := 0;
end Finalize;
function Length (Container : in List) return SAL.Base_Peek_Type
diff --git a/sal-gen_unbounded_definite_min_heaps_fibonacci.ads
b/sal-gen_unbounded_definite_min_heaps_fibonacci.ads
index aab9fcf..44174b5 100644
--- a/sal-gen_unbounded_definite_min_heaps_fibonacci.ads
+++ b/sal-gen_unbounded_definite_min_heaps_fibonacci.ads
@@ -7,7 +7,7 @@
-- [1] Introduction to Algorithms, Third Edition. Thomas H. Cormen,
-- Charles E. Leiserson, Ronald L. Rivest, Clifford Stein. Chapter 19.
--
--- 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
@@ -70,7 +70,8 @@ package SAL.Gen_Unbounded_Definite_Min_Heaps_Fibonacci is
type Constant_Reference_Type (Element : not null access constant
Element_Type) is private with
Implicit_Dereference => Element;
- function Peek (Heap : in Heap_Type) return Constant_Reference_Type;
+ function Peek (Heap : in Heap_Type) return Constant_Reference_Type
+ with Pre => Heap.Count > 0;
-- Return a constant reference to the min element.
pragma Inline (Peek);
diff --git a/sal-gen_unbounded_definite_red_black_trees.adb
b/sal-gen_unbounded_definite_red_black_trees.adb
index c039056..533b23c 100644
--- a/sal-gen_unbounded_definite_red_black_trees.adb
+++ b/sal-gen_unbounded_definite_red_black_trees.adb
@@ -21,11 +21,11 @@ package body SAL.Gen_Unbounded_Definite_Red_Black_Trees is
-- Local declarations (alphabetical order)
- function Count_Tree (Item : in Node_Access; Nil : in Node_Access) return
Ada.Containers.Count_Type
- with Pre => Nil /= null;
-
procedure Delete_Fixup (T : in out Tree; X : in out Node_Access);
+ procedure Insert_Fixup (Tree : in out Pkg.Tree; Z : in out Node_Access)
+ with Pre => Z /= null;
+
function Find (Root : in Node_Access; Key : in Key_Type; Nil : in
Node_Access) return Node_Access
with Pre => Nil /= null;
@@ -41,20 +41,30 @@ package body SAL.Gen_Unbounded_Definite_Red_Black_Trees is
----------
-- local bodies (alphabetical order)
- function Count_Tree (Item : in Node_Access; Nil : in Node_Access) return
Ada.Containers.Count_Type
+ procedure Count_Tree
+ (Item : in not null Node_Access;
+ Nil : in not null Node_Access;
+ Count : in out Ada.Containers.Count_Type;
+ Max_Depth : in out Ada.Containers.Count_Type;
+ Sub_Tree_Depth : in Ada.Containers.Count_Type)
+ with Pre => Item /= Nil
is
use all type Ada.Containers.Count_Type;
- Result : Ada.Containers.Count_Type := 0;
+ Local_Sub_Tree_Depth : constant Ada.Containers.Count_Type :=
Sub_Tree_Depth + 1;
begin
+ Count := @ + 1;
+
+ if Local_Sub_Tree_Depth > Max_Depth then
+ Max_Depth := Local_Sub_Tree_Depth;
+ end if;
+
if Item.Left /= Nil then
- Result := Result + Count_Tree (Item.Left, Nil);
+ Count_Tree (Item.Left, Nil, Count, Max_Depth, Local_Sub_Tree_Depth);
end if;
if Item.Right /= Nil then
- Result := Result + Count_Tree (Item.Right, Nil);
+ Count_Tree (Item.Right, Nil, Count, Max_Depth, Local_Sub_Tree_Depth);
end if;
-
- return Result + 1;
end Count_Tree;
procedure Delete_Fixup (T : in out Tree; X : in out Node_Access)
@@ -139,6 +149,95 @@ package body SAL.Gen_Unbounded_Definite_Red_Black_Trees is
return null;
end Find;
+ function Find_Or_Insert
+ (Tree : in out Pkg.Tree;
+ Element : in Element_Type;
+ Found : out Boolean;
+ Duplicate : in Duplicate_Action_Type := Error;
+ No_Find : in Boolean)
+ return Cursor
+ is
+ -- [1] 13.3 RB-Insert (T, z), with extra return if found
+ Nil : Node_Access renames Tree.Nil;
+ Key_Z : constant Key_Type := Key (Element);
+ Y : Node_Access := Nil;
+ X : Node_Access := Tree.Root;
+
+ Compare_Z_Y : Compare_Result;
+ begin
+ Nil.Parent := null;
+ Nil.Left := null;
+ Nil.Right := null;
+
+ while X /= Nil loop
+ Y := X;
+ Compare_Z_Y := Key_Compare (Key_Z, Key (X.Element));
+ case Compare_Z_Y is
+ when Less =>
+ X := X.Left;
+ when Equal =>
+ Found := True;
+
+ if No_Find then
+ case Duplicate is
+ when Allow =>
+ X := X.Right;
+ when Ignore =>
+ return
+ (Node => X,
+ Direction => Unknown,
+ Left_Done => True,
+ Right_Done => True);
+ when Error =>
+ raise Duplicate_Key;
+ end case;
+ else
+ return
+ (Node => X,
+ Direction => Unknown,
+ Left_Done => True,
+ Right_Done => True);
+ end if;
+ when Greater =>
+ X := X.Right;
+ end case;
+ end loop;
+
+ Found := False;
+
+ -- Not found, or No_Find; insert.
+ declare
+ Z : Node_Access := new Node'(Element, Nil, Nil, Nil, Red);
+ Result : Node_Access;
+ begin
+
+ Z.Parent := Y;
+ if Y = Nil then
+ Tree.Root := Z;
+ else
+ case Compare_Z_Y is
+ when Less =>
+ Y.Left := Z;
+ when Equal | Greater =>
+ Y.Right := Z;
+ end case;
+ end if;
+
+ Result := Z;
+ if Z = Tree.Root then
+ Z.Color := Black;
+ else
+ Insert_Fixup (Tree, Z);
+ end if;
+
+ return
+ (Node => Result,
+ Direction => Unknown,
+ Left_Done => True,
+ Right_Done => True);
+ end;
+ end Find_Or_Insert;
+
procedure Free_Tree (Item : in out Node_Access; Nil : in Node_Access)
is begin
if Item = Nil or Item = null then
@@ -293,24 +392,57 @@ package body SAL.Gen_Unbounded_Definite_Red_Black_Trees is
Object.Root := Object.Nil;
end Initialize;
- function Has_Element (Cursor : in Pkg.Cursor) return Boolean
+ overriding procedure Adjust (Object : in out Tree)
+ is
+ Old_Nil : constant Node_Access := Object.Nil;
+ New_Nil : constant Node_Access := new Node;
+
+ function Copy_Subtree
+ (Node : in Node_Access;
+ Parent : in Node_Access)
+ return Node_Access
+ is
+ New_Node : constant Node_Access := new Pkg.Node'(Node.Element,
Parent, New_Nil, New_Nil, Node.Color);
+ begin
+ if Node.Left /= Old_Nil then
+ New_Node.Left := Copy_Subtree (Node.Left, New_Node);
+ end if;
+
+ if Node.Right /= Old_Nil then
+ New_Node.Right := Copy_Subtree (Node.Right, New_Node);
+ end if;
+
+ return New_Node;
+ end Copy_Subtree;
+ begin
+ Object.Nil := New_Nil;
+ Object.Nil.Color := Black;
+ if Object.Root = Old_Nil then
+ Object.Root := New_Nil;
+ else
+ Object.Root := Copy_Subtree (Object.Root, New_Nil);
+ end if;
+ end Adjust;
+
+ procedure Clear (Tree : in out Pkg.Tree)
is begin
- return Cursor.Node /= null;
- end Has_Element;
+ Finalize (Tree);
+ Initialize (Tree);
+ end Clear;
- function Constant_Reference
- (Container : aliased in Tree;
- Position : in Cursor)
+ function Constant_Ref
+ (Container : in Tree;
+ Position : in Cursor)
return Constant_Reference_Type
is
pragma Unreferenced (Container);
begin
return (Element => Position.Node.all.Element'Access, Dummy => 1);
- end Constant_Reference;
+ end Constant_Ref;
- function Constant_Reference
- (Container : aliased in Tree;
- Key : in Key_Type)
+ function Constant_Ref
+ (Container : in Tree;
+ Key : in Key_Type)
return Constant_Reference_Type
is
Node : constant Node_Access := Find (Container.Root, Key, Container.Nil);
@@ -318,28 +450,28 @@ package body SAL.Gen_Unbounded_Definite_Red_Black_Trees is
if Node = null then
raise Not_Found;
else
- -- WORKAROUND: GNAT Community 2019 requires Node.all.Element'Access
- -- here, Community 2020 and GNAT Pro 21.0w 20200426 requires
- -- Node.Element'Access (no .all). The code is technically legal
- -- either way, so both compilers have a bug. This code is compatible
- -- with 2020. AdaCore ticket T503-001 on Eurocontrol support
- -- contract.
+ -- WORKAROUND: GNAT Community 2019 requires Node.all.Element here,
+ -- GNAT Community 2020 and GNAT Pro 21.0w 20200426 require .all _not_
+ -- be here. The code is technically legal either way, so both
+ -- compilers have a bug. Matching 2020 for now. GNAT Pro 22, GNAT
+ -- Community 2021 fix the bug. AdaCore ticket T503-001 on Eurocontrol
+ -- support contract.
return (Element => Node.Element'Access, Dummy => 1);
end if;
- end Constant_Reference;
+ end Constant_Ref;
- function Variable_Reference
+ function Variable_Ref
(Container : aliased in Tree;
Position : in Cursor)
return Variable_Reference_Type
is
pragma Unreferenced (Container);
begin
- -- WORKAROUND: see note in Constant_Reference
+ -- WORKAROUND: see note in Constant_Ref
return (Element => Position.Node.Element'Access, Dummy => 1);
- end Variable_Reference;
+ end Variable_Ref;
- function Variable_Reference
+ function Variable_Ref
(Container : aliased in Tree;
Key : in Key_Type)
return Variable_Reference_Type
@@ -349,20 +481,37 @@ package body SAL.Gen_Unbounded_Definite_Red_Black_Trees is
if Node = null then
raise Not_Found;
else
- -- WORKAROUND: see note in Constant_Reference
+ -- WORKAROUND: see note in Constant_Ref
return (Element => Node.Element'Access, Dummy => 1);
end if;
- end Variable_Reference;
+ end Variable_Ref;
+
+ function Unchecked_Const_Ref
+ (Container : in Tree;
+ Position : in Cursor)
+ return access constant Element_Type
+ is
+ pragma Unreferenced (Container);
+ begin
+ return Position.Node.all.Element'Access;
+ end Unchecked_Const_Ref;
- function Iterate (Tree : in Pkg.Tree'Class) return Iterator
+ function Unchecked_Var_Ref (Container : in Tree; Position : in Cursor)
return access Element_Type
+ is
+ pragma Unreferenced (Container);
+ begin
+ return Position.Node.all.Element'Access;
+ end Unchecked_Var_Ref;
+
+ function Iterate (Tree : aliased in Pkg.Tree'Class) return Iterator
is begin
- return (Tree.Root, Tree.Nil);
+ return (Container => Tree'Access);
end Iterate;
overriding function First (Iterator : in Pkg.Iterator) return Cursor
is
- Nil : Node_Access renames Iterator.Nil;
- Node : Node_Access := Iterator.Root;
+ Nil : Node_Access renames Iterator.Container.Nil;
+ Node : Node_Access := Iterator.Container.Root;
begin
if Node = Nil then
return
@@ -382,12 +531,11 @@ package body SAL.Gen_Unbounded_Definite_Red_Black_Trees is
Left_Done => True,
Right_Done => False);
end if;
-
end First;
overriding function Next (Iterator : in Pkg.Iterator; Position : in Cursor)
return Cursor
is
- Nil : Node_Access renames Iterator.Nil;
+ Nil : Node_Access renames Iterator.Container.Nil;
begin
if Position.Direction /= Ascending then
raise Programmer_Error;
@@ -460,8 +608,8 @@ package body SAL.Gen_Unbounded_Definite_Red_Black_Trees is
overriding function Last (Iterator : in Pkg.Iterator) return Cursor
is
- Nil : Node_Access renames Iterator.Nil;
- Node : Node_Access := Iterator.Root;
+ Nil : Node_Access renames Iterator.Container.Nil;
+ Node : Node_Access := Iterator.Container.Root;
begin
if Node = Nil then
return
@@ -484,7 +632,7 @@ package body SAL.Gen_Unbounded_Definite_Red_Black_Trees is
overriding function Previous (Iterator : in Pkg.Iterator; Position : in
Cursor) return Cursor
is
- Nil : Node_Access renames Iterator.Nil;
+ Nil : Node_Access renames Iterator.Container.Nil;
begin
if Position.Direction /= Descending then
raise Programmer_Error;
@@ -557,8 +705,8 @@ package body SAL.Gen_Unbounded_Definite_Red_Black_Trees is
function Previous (Iterator : in Pkg.Iterator; Key : in Key_Type) return
Cursor
is
- Nil : Node_Access renames Iterator.Nil;
- Node : Node_Access := Iterator.Root;
+ Nil : Node_Access renames Iterator.Container.Nil;
+ Node : Node_Access := Iterator.Container.Root;
begin
while Node /= Nil loop
declare
@@ -598,8 +746,8 @@ package body SAL.Gen_Unbounded_Definite_Red_Black_Trees is
Direction : in Direction_Type := Ascending)
return Cursor
is
- Nil : Node_Access renames Iterator.Nil;
- Node : constant Node_Access := Find (Iterator.Root, Key, Nil);
+ Nil : Node_Access renames Iterator.Container.Nil;
+ Node : constant Node_Access := Find (Iterator.Container.Root, Key, Nil);
begin
if Node = null then
return
@@ -622,14 +770,25 @@ package body SAL.Gen_Unbounded_Definite_Red_Black_Trees is
end if;
end Find;
+ function Find
+ (Container : in Tree;
+ Key : in Key_Type;
+ Direction : in Direction_Type := Ascending)
+ return Cursor
+ is
+ Iter : constant Iterator := Container.Iterate;
+ begin
+ return Find (Iter, Key, Direction);
+ end Find;
+
function Find_In_Range
(Iterator : in Pkg.Iterator;
Direction : in Known_Direction_Type;
First, Last : in Key_Type)
return Cursor
is
- Nil : Node_Access renames Iterator.Nil;
- Node : Node_Access := Iterator.Root;
+ Nil : Node_Access renames Iterator.Container.Nil;
+ Node : Node_Access := Iterator.Container.Root;
Candidate : Node_Access := null; -- best result found so far
begin
while Node /= Nil loop
@@ -723,104 +882,85 @@ package body SAL.Gen_Unbounded_Definite_Red_Black_Trees
is
end Find_In_Range;
function Count (Tree : in Pkg.Tree) return Ada.Containers.Count_Type
- is begin
+ is
+ Count : Ada.Containers.Count_Type := 0;
+ Max_Depth : Ada.Containers.Count_Type := 0;
+ begin
if Tree.Root = Tree.Nil then
return 0;
else
- return Count_Tree (Tree.Root, Tree.Nil);
+ Count_Tree (Tree.Root, Tree.Nil, Count, Max_Depth, 1);
+ return Count;
end if;
end Count;
+ procedure Count_Depth
+ (Tree : in Pkg.Tree;
+ Count : out Ada.Containers.Count_Type;
+ Depth : out Ada.Containers.Count_Type)
+ is begin
+ Count := 0;
+ Depth := 0;
+
+ if Tree.Root = Tree.Nil then
+ null;
+ else
+ Count_Tree (Tree.Root, Tree.Nil, Count, Depth, 1);
+ end if;
+ end Count_Depth;
+
function Present (Container : in Tree; Key : in Key_Type) return Boolean
is
- Nil : Node_Access renames Container.Nil;
- Node : Node_Access := Container.Root;
+ Node : constant Node_Access := Find (Container.Root, Key, Container.Nil);
begin
- while Node /= Nil loop
- case Key_Compare (Key, Pkg.Key (Node.Element)) is
- when Equal =>
- return True;
- when Less =>
- Node := Node.Left;
- when Greater =>
- Node := Node.Right;
- end case;
- end loop;
- return False;
+ return Node /= null;
end Present;
- function Insert (Tree : in out Pkg.Tree; Element : in Element_Type) return
Cursor
+ function Insert
+ (Tree : in out Pkg.Tree;
+ Element : in Element_Type;
+ Duplicate : in Duplicate_Action_Type := Error)
+ return Cursor
is
- -- [1] 13.3 RB-Insert (T, z)
- Nil : Node_Access renames Tree.Nil;
- Z : Node_Access := new Node'(Element, Nil, Nil, Nil, Red);
- Key_Z : constant Key_Type := Key (Z.Element);
- Y : Node_Access := Nil;
- X : Node_Access := Tree.Root;
-
- Result : Node_Access;
- Compare_Z_Y : Compare_Result;
+ Found : Boolean;
begin
- Nil.Parent := null;
- Nil.Left := null;
- Nil.Right := null;
-
- while X /= Nil loop
- Y := X;
- Compare_Z_Y := Key_Compare (Key_Z, Key (X.Element));
- case Compare_Z_Y is
- when Less =>
- X := X.Left;
- when Equal | Greater =>
- X := X.Right;
- end case;
- end loop;
-
- Z.Parent := Y;
- if Y = Nil then
- Tree.Root := Z;
- else
- case Compare_Z_Y is
- when Less =>
- Y.Left := Z;
- when Equal | Greater =>
- Y.Right := Z;
- end case;
- end if;
-
- Result := Z;
- if Z = Tree.Root then
- Z.Color := Black;
- else
- Insert_Fixup (Tree, Z);
- end if;
-
- return
- (Node => Result,
- Direction => Unknown,
- Left_Done => True,
- Right_Done => True);
+ return Find_Or_Insert (Tree, Element, Found, Duplicate, No_Find => True);
end Insert;
- procedure Insert (Tree : in out Pkg.Tree; Element : in Element_Type)
+ procedure Insert
+ (Tree : in out Pkg.Tree;
+ Element : in Element_Type;
+ Duplicate : in Duplicate_Action_Type := Error)
is
- Temp : Cursor := Insert (Tree, Element);
+ Temp : Cursor := Insert (Tree, Element, Duplicate);
pragma Unreferenced (Temp);
begin
null;
end Insert;
- procedure Delete (Tree : in out Pkg.Tree; Position : in out Cursor)
+ function Find_Or_Insert
+ (Tree : in out Pkg.Tree;
+ Element : in Element_Type;
+ Found : out Boolean)
+ return Cursor
+ is begin
+ return Find_Or_Insert (Tree, Element, Found, Duplicate => Ignore,
No_Find => False);
+ end Find_Or_Insert;
+
+ procedure Delete (Tree : in out Pkg.Tree; Key : in Key_Type)
is
Nil : Node_Access renames Tree.Nil;
T : Pkg.Tree renames Tree;
- Z : constant Node_Access :=
- (if Position.Node = null then raise Parameter_Error else
Position.Node);
+ Z : constant Node_Access := Find (Tree.Root, Key, Tree.Nil);
Y : Node_Access := Z;
- Y_Orig_Color : Color := Y.Color;
+ Y_Orig_Color : Color := (if Y = null then Color'First else Y.Color);
X : Node_Access;
begin
- -- Catch logic errors in use of Nil
+ if Z = null then
+ raise SAL.Not_Found;
+ end if;
+
+ -- Catch logic errors in use of Nil; these should never be referenced.
Nil.Parent := null;
Nil.Left := null;
Nil.Right := null;
@@ -864,8 +1004,6 @@ package body SAL.Gen_Unbounded_Definite_Red_Black_Trees is
if Y_Orig_Color = Black then
Delete_Fixup (T, X);
end if;
-
- Free (Position.Node);
end Delete;
end SAL.Gen_Unbounded_Definite_Red_Black_Trees;
diff --git a/sal-gen_unbounded_definite_red_black_trees.ads
b/sal-gen_unbounded_definite_red_black_trees.ads
index f886ed9..05b6d60 100644
--- a/sal-gen_unbounded_definite_red_black_trees.ads
+++ b/sal-gen_unbounded_definite_red_black_trees.ads
@@ -3,12 +3,19 @@
-- Generic unbounded red-black tree with definite elements, definite
-- or indefinite key.
--
+-- Design:
+--
+-- We don't enforce any control of references active on a tree; that
+-- proved buggy, slow, and not helpful in finding higher-level bugs.
+-- The only real problem is references to a deleted node, which is
+-- easy to keep track of.
+--
-- References :
--
-- [1] Introduction to Algorithms, Thomas H. Cormen, Charles E.
-- Leiserson, Ronald L. Rivest, Clifford Stein.
--
--- Copyright (C) 2017 - 2020 Free Software Foundation, Inc.
+-- Copyright (C) 2017 - 2021 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,15 +42,21 @@ package SAL.Gen_Unbounded_Definite_Red_Black_Trees is
package Pkg renames Gen_Unbounded_Definite_Red_Black_Trees;
- type Tree is new Ada.Finalization.Limited_Controlled with private
+ type Tree is new Ada.Finalization.Controlled with private
with
- Constant_Indexing => Constant_Reference,
- Variable_Indexing => Variable_Reference,
+ Constant_Indexing => Constant_Ref,
+ Variable_Indexing => Variable_Ref,
Default_Iterator => Iterate,
Iterator_Element => Element_Type;
overriding procedure Finalize (Object : in out Tree);
overriding procedure Initialize (Object : in out Tree);
+ overriding procedure Adjust (Object : in out Tree);
+
+ Empty_Tree : constant Tree;
+
+ procedure Clear (Tree : in out Pkg.Tree);
+ -- Set Tree to empty.
type Direction_Type is (Ascending, Descending, Unknown);
subtype Known_Direction_Type is Direction_Type range Ascending ..
Descending;
@@ -57,49 +70,60 @@ package SAL.Gen_Unbounded_Definite_Red_Black_Trees is
No_Element : constant Cursor;
function Has_Element (Cursor : in Pkg.Cursor) return Boolean;
+ function Direction (Cursor : in Pkg.Cursor) return Direction_Type;
+ function Key (Cursor : in Pkg.Cursor) return Key_Type;
+ function Element (Cursor : in Pkg.Cursor) return Element_Type;
type Constant_Reference_Type (Element : not null access constant
Element_Type) is private with
Implicit_Dereference => Element;
- function Constant_Reference
- (Container : aliased in Tree;
- Position : in Cursor)
- return Constant_Reference_Type with
- Inline, Pre => Has_Element (Position);
-
- function Constant_Reference
- (Container : aliased in Tree;
- Key : in Key_Type)
- return Constant_Reference_Type with
- Inline;
+ function Constant_Ref
+ (Container : in Tree;
+ Position : in Cursor)
+ return Constant_Reference_Type
+ with Inline, Pre => Has_Element (Position);
+
+ function Constant_Ref
+ (Container : 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;
+ -- User must not change value of Key thru this reference; if Key is
+ -- changed, use Delete, Insert.
- function Variable_Reference
+ function Variable_Ref
(Container : aliased in Tree;
Position : in Cursor)
- return Variable_Reference_Type with
- Inline, Pre => Has_Element (Position);
+ return Variable_Reference_Type
+ with Inline, Pre => Has_Element (Position);
- function Variable_Reference
+ function Variable_Ref
(Container : aliased in Tree;
Key : in Key_Type)
- return Variable_Reference_Type with
- Inline;
+ return Variable_Reference_Type
+ with Inline;
-- Raises Not_Found if Key not found in Container.
+ function Unchecked_Const_Ref (Container : in Tree; Position : in Cursor)
return access constant Element_Type;
+ function Unchecked_Var_Ref (Container : in Tree; Position : in Cursor)
return access Element_Type;
+ -- For higher level containers.
+
package Iterators is new Ada.Iterator_Interfaces (Cursor, Has_Element);
- type Iterator is new Iterators.Reversible_Iterator with private;
+ type Iterator (Container : not null access constant Tree) is new
Iterators.Reversible_Iterator with private;
- function Iterate (Tree : in Pkg.Tree'Class) return Iterator;
+ function Iterate (Tree : aliased in Pkg.Tree'Class) return Iterator;
overriding function First (Iterator : in Pkg.Iterator) return Cursor;
- overriding function Next (Iterator : in Pkg.Iterator; Position : in Cursor)
return Cursor;
+ overriding function Next (Iterator : in Pkg.Iterator; Position : in Cursor)
return Cursor
+ with Pre => Has_Element (Position) and Direction (Position) /= Unknown;
overriding function Last (Iterator : in Pkg.Iterator) return Cursor;
- overriding function Previous (Iterator : in Pkg.Iterator; Position : in
Cursor) return Cursor;
+ overriding function Previous (Iterator : in Pkg.Iterator; Position : in
Cursor) return Cursor
+ with Pre => Has_Element (Position) and Direction (Position) /= Unknown;
function Previous (Iterator : in Pkg.Iterator; Key : in Key_Type) return
Cursor;
-- Initialise Iterator to descending, starting at element with
@@ -113,6 +137,13 @@ package SAL.Gen_Unbounded_Definite_Red_Black_Trees is
return Cursor;
-- Has_Element is False if Key is not in Container.
+ function Find
+ (Container : in Tree;
+ Key : in Key_Type;
+ Direction : in Direction_Type := Ascending)
+ return Cursor;
+ -- Creates an Iterator internally.
+
function Find_In_Range
(Iterator : in Pkg.Iterator;
Direction : in Known_Direction_Type;
@@ -127,15 +158,52 @@ package SAL.Gen_Unbounded_Definite_Red_Black_Trees is
-- those for any element that Next or Previous returns.
function Count (Tree : in Pkg.Tree) return Ada.Containers.Count_Type;
+ function Length (Tree : in Pkg.Tree) return Ada.Containers.Count_Type
+ renames Count;
+ procedure Count_Depth
+ (Tree : in Pkg.Tree;
+ Count : out Ada.Containers.Count_Type;
+ Depth : out Ada.Containers.Count_Type);
+ -- Count and Count_Depth traverse the entire tree.
function Present (Container : in Tree; Key : in Key_Type) return Boolean;
- procedure Insert (Tree : in out Pkg.Tree; Element : in Element_Type);
- function Insert (Tree : in out Pkg.Tree; Element : in Element_Type) return
Cursor;
- -- Result points to newly inserted element.
+ procedure Insert
+ (Tree : in out Pkg.Tree;
+ Element : in Element_Type;
+ Duplicate : in Duplicate_Action_Type := Error);
+ function Insert
+ (Tree : in out Pkg.Tree;
+ Element : in Element_Type;
+ Duplicate : in Duplicate_Action_Type := Error)
+ return Cursor;
+ -- Result points to newly inserted element, with Direction Unknown.
+ --
+ -- If Key (Element) is found, and Duplicate is:
+ --
+ -- - Allow, Element is inserted; it can only by retrieved using
+ -- Iterate.
+ --
+ -- - Ignore, Element is not inserted.
+ --
+ -- - Error, raises Duplicate_Key.
+
+ function Find_Or_Insert
+ (Tree : in out Pkg.Tree;
+ Element : in Element_Type;
+ Found : out Boolean)
+ return Cursor;
+ -- Search for Element; if found, Found is True. If not found, insert
+ -- it. Return a Cursor to the found or inserted element. , and return
+ -- a cursor for it.
+
+ procedure Delete (Tree : in out Pkg.Tree; Key : in Key_Type);
+ -- Delete element with Key.
+ --
+ -- Raises SAL.Not_Found if Key is not found.
+ --
+ -- Invalidates any active iterators; not enforced.
- procedure Delete (Tree : in out Pkg.Tree; Position : in out Cursor);
- -- Delete element at Position, set Position to No_Element.
private
type Node;
@@ -153,11 +221,11 @@ private
procedure Free is new Ada.Unchecked_Deallocation (Node, Node_Access);
- type Tree is new Ada.Finalization.Limited_Controlled with record
+ type Tree is new Ada.Finalization.Controlled with record
Root : Node_Access;
Nil : Node_Access;
-- Nil is the node pointed to by all links that would otherwise be
- -- 'null'. This simplifies several algorithm (for example,
+ -- 'null'. This simplifies several algorithms (for example,
-- Node.Left.Color is always valid). Its parent, left, right links
-- are used as temp storage for some algorithms (especially Delete).
-- Nil.Color is Black.
@@ -173,26 +241,37 @@ private
Right_Done : Boolean := True;
end record;
- type Constant_Reference_Type (Element : not null access constant
Element_Type) is
- record
+ function Has_Element (Cursor : in Pkg.Cursor) return Boolean
+ is (Cursor.Node /= null);
+
+ function Direction (Cursor : in Pkg.Cursor) return Direction_Type
+ is (Cursor.Direction);
+
+ function Key (Cursor : in Pkg.Cursor) return Key_Type
+ is (Key (Cursor.Node.Element));
+
+ function Element (Cursor : in Pkg.Cursor) return Element_Type
+ is (Cursor.Node.Element);
+
+ type Constant_Reference_Type (Element : not null access constant
Element_Type)
+ is record
Dummy : Integer := raise Program_Error with "uninitialized reference";
end record;
- type Variable_Reference_Type (Element : not null access Element_Type) is
- record
+ type Variable_Reference_Type (Element : not null access Element_Type)
+ is record
Dummy : Integer := raise Program_Error with "uninitialized reference";
end record;
+ Empty_Tree : constant Tree := (Ada.Finalization.Controlled with null, null);
+
No_Element : constant Cursor :=
(Node => null,
Direction => Unknown,
Left_Done => True,
Right_Done => True);
- type Iterator is new Iterators.Reversible_Iterator with
- record
- Root : Node_Access;
- Nil : Node_Access;
- end record;
+ type Iterator (Container : not null access constant Tree) is new
Iterators.Reversible_Iterator
+ with null record;
end SAL.Gen_Unbounded_Definite_Red_Black_Trees;
diff --git a/sal-gen_unbounded_definite_stacks.adb
b/sal-gen_unbounded_definite_stacks.adb
index 072c104..e13bc2c 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 - 2020 Free Software
Foundation, Inc.
+-- Copyright (C) 1998, 2003, 2009, 2015, 2017 - 2021 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
@@ -187,7 +187,7 @@ package body SAL.Gen_Unbounded_Definite_Stacks is
function Has_Element (Position : in Cursor) return Boolean
is begin
- return Position.Container.Depth >= Position.Ptr;
+ return Position.Ptr /= Invalid_Peek_Index;
end Has_Element;
type Iterator (Container : not null access constant Stack) is new
Iterator_Interfaces.Forward_Iterator with
@@ -205,15 +205,19 @@ package body SAL.Gen_Unbounded_Definite_Stacks is
end Iterate;
overriding function First (Object : Iterator) return Cursor
- is begin
- return (Object.Container, 1);
- end First;
-
- overriding function Next (Object : in Iterator; Position : in Cursor)
return Cursor
is
pragma Unreferenced (Object);
begin
- return (Position.Container, Position.Ptr + 1);
+ return (Ptr => 1);
+ end First;
+
+ overriding function Next (Object : in Iterator; Position : in Cursor)
return Cursor
+ is begin
+ if Object.Container.Depth > Position.Ptr then
+ return (Ptr => Position.Ptr + 1);
+ else
+ return (Ptr => Invalid_Peek_Index);
+ end if;
end Next;
end SAL.Gen_Unbounded_Definite_Stacks;
diff --git a/sal-gen_unbounded_definite_stacks.ads
b/sal-gen_unbounded_definite_stacks.ads
index 3d1e1e7..d2b6902 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 - 2020 Free Software
Foundation, Inc.
+-- Copyright (C) 1998-2000, 2002-2003, 2009, 2015, 2017 - 2021 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
@@ -44,19 +44,22 @@ package SAL.Gen_Unbounded_Definite_Stacks is
overriding function "=" (Left, Right : in Sguds.Stack) return Boolean;
- procedure Clear (Stack : in out Sguds.Stack);
- -- Empty Stack of all items.
-
function Depth (Stack : in Sguds.Stack) return Base_Peek_Type;
-- Returns current count of items in the Stack
+ procedure Clear (Stack : in out Sguds.Stack)
+ with Post => Stack.Depth = 0;
+ -- Empty Stack of all items.
+
function Is_Empty (Stack : in Sguds.Stack) return Boolean;
-- Returns true iff no items are in Stack.
function Peek
(Stack : in Sguds.Stack;
Index : in Peek_Type := 1)
- return Element_Type with Inline;
+ return Element_Type
+ with Inline,
+ Pre => Stack.Depth >= Index;
-- Return the Index'th item from the top of Stack; the Item is _not_
removed.
-- Top item has index 1.
--
@@ -64,13 +67,15 @@ package SAL.Gen_Unbounded_Definite_Stacks is
--
-- See also Constant_Ref, implicit indexing
- procedure Pop (Stack : in out Sguds.Stack; Count : in Base_Peek_Type := 1);
+ procedure Pop (Stack : in out Sguds.Stack; Count : in Base_Peek_Type := 1)
+ with Pre => Stack.Depth >= Count;
-- Remove Count Items from the top of Stack, discard them.
--
-- Raises Container_Empty if there are fewer than Count items on
-- Stack.
- function Pop (Stack : in out Sguds.Stack) return Element_Type;
+ function Pop (Stack : in out Sguds.Stack) return Element_Type
+ with Pre => Stack.Depth >= 1;
-- Remove Item from the top of Stack, and return it.
--
-- Raises Container_Empty if Is_Empty.
@@ -80,7 +85,8 @@ package SAL.Gen_Unbounded_Definite_Stacks is
--
-- May raise Container_Full.
- function Top (Stack : in Sguds.Stack) return Element_Type;
+ function Top (Stack : in Sguds.Stack) return Element_Type
+ with Pre => Stack.Depth >= 1;
-- Return the item at the top of Stack; the Item is _not_ removed.
-- Same as Peek (Stack, 1).
--
@@ -115,7 +121,7 @@ package SAL.Gen_Unbounded_Definite_Stacks is
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;
@@ -150,9 +156,8 @@ private
Empty_Stack : constant Stack := (Ada.Finalization.Controlled with
Invalid_Peek_Index, null);
- type Cursor (Container : not null access constant Stack) is
- record
- Ptr : Peek_Type;
+ type Cursor is record
+ Ptr : Base_Peek_Type := Invalid_Peek_Index;
end record;
end SAL.Gen_Unbounded_Definite_Stacks;
diff --git a/sal-gen_unbounded_definite_vectors-gen_comparable.ads
b/sal-gen_unbounded_definite_vectors-gen_comparable.ads
index 56d84c0..1742d36 100644
--- a/sal-gen_unbounded_definite_vectors-gen_comparable.ads
+++ b/sal-gen_unbounded_definite_vectors-gen_comparable.ads
@@ -2,7 +2,7 @@
--
-- Add "<" to parent
--
--- 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
@@ -27,4 +27,6 @@ package SAL.Gen_Unbounded_Definite_Vectors.Gen_Comparable is
-- Similar to Ada "<" for arrays; Ada Reference Manual
-- section 4.5.2 para 26/3.
+ Empty_Vector : constant Vector :=
(SAL.Gen_Unbounded_Definite_Vectors.Empty_Vector with null record);
+
end SAL.Gen_Unbounded_Definite_Vectors.Gen_Comparable;
diff --git a/sal-gen_unbounded_definite_vectors-gen_image.adb
b/sal-gen_unbounded_definite_vectors-gen_image.adb
index 929994a..57497ae 100644
--- a/sal-gen_unbounded_definite_vectors-gen_image.adb
+++ b/sal-gen_unbounded_definite_vectors-gen_image.adb
@@ -2,7 +2,7 @@
--
-- See spec.
--
--- Copyright (C) 2018 Free Software Foundation, Inc.
+-- Copyright (C) 2018, 2021 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,11 @@ pragma License (Modified_GPL);
with Ada.Strings.Fixed;
with Ada.Strings.Unbounded;
-function SAL.Gen_Unbounded_Definite_Vectors.Gen_Image (Item : in Vector;
Strict : in Boolean := False) return String
+function SAL.Gen_Unbounded_Definite_Vectors.Gen_Image
+ (Item : in Vector;
+ Strict : in Boolean := False;
+ Association : in Boolean := False)
+ return String
is
use all type Ada.Containers.Count_Type;
use Ada.Strings;
@@ -29,19 +33,19 @@ is
First : constant Base_Peek_Type := To_Peek_Type (Item.First_Index);
Last : constant Base_Peek_Type := To_Peek_Type (Item.Last_Index);
begin
- if Strict and Item.Length = 0 then
+ if (Strict or Association) and Item.Length = 0 then
return "(" & Trim (Index_Type'Image (Index_Type'First), Left) & " .. " &
Trim (Index_Type'Image (Extended_Index'First), Left) & " => <>)";
- elsif Strict and Item.Length = 1 then
+ elsif (Strict or Association) and Item.Length = 1 then
return "(" & Trim (Index_Type'Image (Index_Type'First), Left) & " => " &
Element_Image (Item.Elements (First)) & ")";
else
for I in First .. Last loop
- Result := Result & Element_Image (Item.Elements (I));
+ Result := @ & (if Association then Trim (I'Image, Left) & " => " else
"") & Element_Image (Item.Elements (I));
if I /= Last then
- Result := Result & ", ";
+ Result := @ & ", ";
end if;
end loop;
Result := Result & ")";
diff --git a/sal-gen_unbounded_definite_vectors-gen_image.ads
b/sal-gen_unbounded_definite_vectors-gen_image.ads
index 274e1f1..a1bb31f 100644
--- a/sal-gen_unbounded_definite_vectors-gen_image.ads
+++ b/sal-gen_unbounded_definite_vectors-gen_image.ads
@@ -2,7 +2,7 @@
--
-- Image of parent.
--
--- Copyright (C) 2018 Free Software Foundation, Inc.
+-- Copyright (C) 2018, 2021 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,6 +19,14 @@ pragma License (Modified_GPL);
generic
with function Element_Image (Item : in Element_Type) return String;
-function SAL.Gen_Unbounded_Definite_Vectors.Gen_Image (Item : in Vector;
Strict : in Boolean := False) return String;
--- Image of Item, in Ada aggregate syntax. If Strict, use correct
--- syntax for 0 and 1 item; otherwise, use () and (item).
+function SAL.Gen_Unbounded_Definite_Vectors.Gen_Image
+ (Item : in Vector;
+ Strict : in Boolean := False;
+ Association : in Boolean := False)
+ return String;
+-- Image of Item, in Ada aggregate syntax.
+--
+-- If Strict, use correct syntax for 0 and 1 item; otherwise, use ()
+-- and (item).
+--
+-- If Association, use associative syntax, otherwise use positional.
diff --git a/sal-gen_unbounded_definite_vectors-gen_image_aux.adb
b/sal-gen_unbounded_definite_vectors-gen_image_aux.adb
index e0d90a6..ca2f197 100644
--- a/sal-gen_unbounded_definite_vectors-gen_image_aux.adb
+++ b/sal-gen_unbounded_definite_vectors-gen_image_aux.adb
@@ -1,43 +1,53 @@
--- Abstract :
---
--- See spec.
---
--- Copyright (C) 2018 - 2019 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
--- 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);
-
-with Ada.Strings.Unbounded;
-function SAL.Gen_Unbounded_Definite_Vectors.Gen_Image_Aux
- (Item : in Vector;
- Aux : in Aux_Data;
- Association : in Boolean := False)
- return String
-is
- use Ada.Strings.Unbounded;
- Result : Unbounded_String := To_Unbounded_String ("(");
- First : constant Base_Peek_Type := To_Peek_Type (Item.First_Index);
- Last : constant Base_Peek_Type := To_Peek_Type (Item.Last_Index);
-begin
- for I in First .. Last loop
- if Association then
- Result := Result & Index_Trimmed_Image (To_Index_Type (I)) & " => ";
- end if;
- Result := Result & Element_Image (Item.Elements (I), Aux);
- if I /= Last then
- Result := Result & ", ";
- end if;
- end loop;
- Result := Result & ")";
- return To_String (Result);
-end SAL.Gen_Unbounded_Definite_Vectors.Gen_Image_Aux;
+-- Abstract :
+--
+-- See spec.
+--
+-- Copyright (C) 2018 - 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
+-- 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);
+
+with Ada.Strings.Unbounded;
+function SAL.Gen_Unbounded_Definite_Vectors.Gen_Image_Aux
+ (Item : in Vector;
+ Aux : in Aux_Data;
+ First : in Extended_Index := Index_Type'First;
+ Last : in Extended_Index := Index_Type'Last;
+ Association : in Boolean := False)
+ return String
+is
+ use Ada.Strings.Unbounded;
+ Result : Unbounded_String := To_Unbounded_String ("(");
+ Actual_First : constant Base_Peek_Type := To_Peek_Type
+ (if First = Index_Type'First
+ then Item.First_Index
+ else First);
+ Actual_Last : constant Base_Peek_Type := To_Peek_Type
+ (if Last = Index_Type'Last
+ then Item.Last_Index
+ else Last);
+begin
+ if First /= No_Index then
+ for I in Actual_First .. Actual_Last loop
+ if Association then
+ Result := Result & Index_Trimmed_Image (To_Index_Type (I)) & " =>
";
+ end if;
+ Result := Result & Element_Image (Item.Elements (I), Aux);
+ if I /= Actual_Last then
+ Result := Result & ", ";
+ end if;
+ end loop;
+ end if;
+ Result := Result & ")";
+ return To_String (Result);
+end SAL.Gen_Unbounded_Definite_Vectors.Gen_Image_Aux;
diff --git a/sal-gen_unbounded_definite_vectors-gen_image_aux.ads
b/sal-gen_unbounded_definite_vectors-gen_image_aux.ads
index eb8a89a..b8873c5 100644
--- a/sal-gen_unbounded_definite_vectors-gen_image_aux.ads
+++ b/sal-gen_unbounded_definite_vectors-gen_image_aux.ads
@@ -1,28 +1,30 @@
--- Abstract :
---
--- Image with auxiliary data for instantiations of parent.
---
--- Copyright (C) 2018 - 2019 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
--- 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);
-
-generic
- type Aux_Data (<>) is private;
- with function Index_Trimmed_Image (Item : in Index_Type) return String;
- with function Element_Image (Item : in Element_Type; Aux : in Aux_Data)
return String;
-function SAL.Gen_Unbounded_Definite_Vectors.Gen_Image_Aux
- (Item : in Vector;
- Aux : in Aux_Data;
- Association : in Boolean := False)
- return String;
+-- Abstract :
+--
+-- Image with auxiliary data for instantiations of parent.
+--
+-- Copyright (C) 2018 - 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
+-- 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);
+
+generic
+ type Aux_Data (<>) is limited private;
+ with function Index_Trimmed_Image (Item : in Index_Type) return String;
+ with function Element_Image (Item : in Element_Type; Aux : in Aux_Data)
return String;
+function SAL.Gen_Unbounded_Definite_Vectors.Gen_Image_Aux
+ (Item : in Vector;
+ Aux : in Aux_Data;
+ First : in Extended_Index := Index_Type'First;
+ Last : in Extended_Index := Index_Type'Last;
+ Association : in Boolean := False)
+ return String;
diff --git a/sal-gen_unbounded_definite_vectors.adb
b/sal-gen_unbounded_definite_vectors.adb
index 9e1c189..be86525 100644
--- a/sal-gen_unbounded_definite_vectors.adb
+++ b/sal-gen_unbounded_definite_vectors.adb
@@ -2,7 +2,7 @@
--
-- See spec.
--
--- Copyright (C) 2018 - 2020 Free Software Foundation, Inc.
+-- Copyright (C) 2018 - 2021 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,6 +19,13 @@ pragma License (Modified_GPL);
package body SAL.Gen_Unbounded_Definite_Vectors is
+ -- Body specs, as needed.
+
+ procedure Set_First (Container : in out Vector; First : in Index_Type);
+ procedure Set_Last (Container : in out Vector; Last : in Extended_Index);
+
+ -- Body subprograms, no order
+
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;
@@ -54,23 +61,8 @@ package body SAL.Gen_Unbounded_Definite_Vectors is
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;
@@ -92,14 +84,25 @@ package body SAL.Gen_Unbounded_Definite_Vectors is
end if;
end Adjust;
+ function Is_Empty (Container : in Vector) return Boolean
+ is
+ use all type Ada.Containers.Count_Type;
+ begin
+ return Container.Length = 0;
+ end Is_Empty;
+
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;
+ elsif Container.Last = No_Index and Container.First = No_Index then
+ return 0;
+ elsif Container.Last < Container.First then
+ return 0;
else
- return Ada.Containers.Count_Type (To_Peek_Type (Container.Last) -
Container.Elements'First + 1);
+ return Ada.Containers.Count_Type (To_Peek_Type (Container.Last) -
To_Peek_Type (Container.First) + 1);
end if;
end Length;
@@ -132,6 +135,15 @@ package body SAL.Gen_Unbounded_Definite_Vectors is
end if;
end Set_Capacity;
+ procedure Clear (Container : in out Vector; Free_Memory : in Boolean :=
False)
+ is begin
+ if Free_Memory then
+ Free (Container.Elements);
+ end if;
+ Container.First := No_Index;
+ Container.Last := No_Index;
+ end Clear;
+
function Element (Container : Vector; Index : Index_Type) return
Element_Type
is begin
return Container.Elements (To_Peek_Type (Index));
@@ -142,9 +154,11 @@ package body SAL.Gen_Unbounded_Definite_Vectors is
Container.Elements (To_Peek_Type (Index)) := New_Item;
end Replace_Element;
- function First_Index (Container : Vector) return Extended_Index
+ function First_Index (Container : Vector; No_Index_If_Empty : in Boolean :=
False) return Extended_Index
is begin
- if Container.First = No_Index then
+ if No_Index_If_Empty then
+ return Container.First;
+ elsif Container.First = No_Index then
return No_Index + 1;
else
return Container.First;
@@ -171,7 +185,7 @@ package body SAL.Gen_Unbounded_Definite_Vectors is
if Container.Elements = null then
Container.Elements := new Array_Type (J .. J);
- elsif J > Container.Elements'Last then
+ elsif J not in Container.Elements'First .. Container.Elements'Last
then
Grow (Container.Elements, J);
end if;
@@ -179,6 +193,12 @@ package body SAL.Gen_Unbounded_Definite_Vectors is
end;
end Append;
+ function Append (Container : in out Vector; New_Item : in Element_Type)
return Index_Type
+ is begin
+ Append (Container, New_Item);
+ return Container.Last_Index;
+ end Append;
+
procedure Append (Container : in out Vector; New_Items : in Vector)
is
use all type Ada.Containers.Count_Type;
@@ -202,7 +222,7 @@ package body SAL.Gen_Unbounded_Definite_Vectors is
begin
if Container.Elements = null then
Container.Elements := new Array_Type (I .. J);
- elsif J > Container.Elements'Last then
+ elsif J not in Container.Elements'First .. Container.Elements'Last
then
Grow (Container.Elements, J);
end if;
@@ -226,7 +246,7 @@ package body SAL.Gen_Unbounded_Definite_Vectors is
if Container.Elements = null then
Container.Elements := new Array_Type (J .. J);
- elsif J < Container.Elements'First then
+ elsif J not in Container.Elements'First .. Container.Elements'Last
then
Grow (Container.Elements, J);
end if;
@@ -253,9 +273,12 @@ package body SAL.Gen_Unbounded_Definite_Vectors is
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
+ if I not in Target.Elements'First .. Target.Elements'Last then
Grow (Target.Elements, I);
end if;
+ if J not in Target.Elements'First .. Target.Elements'Last then
+ Grow (Target.Elements, J);
+ end if;
Target.Elements (I .. J) := Source.Elements (Source_I .. Source_J);
Target.First := New_First;
end;
@@ -275,10 +298,10 @@ package body SAL.Gen_Unbounded_Definite_Vectors is
Container.Last := Container.Last + 1;
declare
- J : constant Peek_Type := To_Peek_Type (Before);
+ 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
+ if K not in Container.Elements'First .. Container.Elements'Last
then
Grow (Container.Elements, K);
end if;
@@ -288,6 +311,19 @@ package body SAL.Gen_Unbounded_Definite_Vectors is
end if;
end Insert;
+ procedure Add
+ (Container : in out Vector;
+ Element : in Element_Type;
+ Index : in Index_Type)
+ is begin
+ if Index < Container.First then
+ Set_First (Container, Index);
+ elsif Index > Container.Last then
+ Set_Last (Container, Index);
+ end if;
+ Container.Elements (To_Peek_Type (Index)) := Element;
+ end Add;
+
procedure Merge
(Target : in out Vector;
Source : in out Vector)
@@ -295,7 +331,7 @@ package body SAL.Gen_Unbounded_Definite_Vectors is
use all type Ada.Containers.Count_Type;
begin
if Source.Length = 0 then
- Source.Clear;
+ null;
elsif Target.Length = 0 then
Target := Source;
@@ -359,39 +395,70 @@ package body SAL.Gen_Unbounded_Definite_Vectors is
procedure Set_First (Container : in out Vector; First : in Index_Type)
is
- J : constant Peek_Type := To_Peek_Type (First);
+ J : constant Peek_Type := To_Peek_Type (First);
+ Old_First : constant Extended_Index := Container.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);
+ if Container.Elements = null then
+ if Container.Last >= First then
+ -- We can't fill the aggregate with Default_Element here; it is
+ -- allocated on the stack.
+ Container.Elements := new Array_Type (J .. To_Peek_Type
(Container.Last));
+ for I in Container.Elements'Range loop
+ Container.Elements (I) := Default_Element;
+ end loop;
+ end if;
- elsif Container.Elements'First > J then
+ else
+ if Container.Elements'First > J then
+ -- We have to ensure Elements contains Container.First even if
Last <
+ -- First, in case we are reusing Elements after Clear
Grow (Container.Elements, J);
end if;
+
+ if Container.First <= Container.Last then
+ for I in To_Peek_Type (First) .. To_Peek_Type (Old_First - 1) loop
+ Container.Elements (I) := Default_Element;
+ end loop;
+ 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);
+ J : constant Base_Peek_Type := To_Peek_Type (Last);
+ Old_Last : constant Extended_Index := Container.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
+ if Container.Elements = null then
+ if Last >= Container.First then
+ -- We can't fill the aggregate with Default_Element here; it is
+ -- allocated on the stack.
+ Container.Elements := new Array_Type (To_Peek_Type
(Container.First) .. J);
+ for I in Container.Elements'Range loop
+ Container.Elements (I) := Default_Element;
+ end loop;
+ end if;
+ else
+ if Container.Elements'Last < J then
+ -- We have to ensure Elements contains Container.Last even if
Last <
+ -- First, in case we are reusing Elements after Clear
Grow (Container.Elements, J);
end if;
+
+ if Container.First <= Container.Last then
+ for I in To_Peek_Type (Old_Last + 1) .. To_Peek_Type (Last) loop
+ Container.Elements (I) := Default_Element;
+ end loop;
+ end if;
end if;
end Set_Last;
@@ -408,7 +475,7 @@ package body SAL.Gen_Unbounded_Definite_Vectors is
is
J : constant Peek_Type := To_Peek_Type (Index);
begin
- Container.Elements (J .. J) := (J => <>);
+ Container.Elements (J) := Default_Element;
if Index = Container.Last then
Container.Last := Container.Last - 1;
end if;
@@ -430,72 +497,77 @@ package body SAL.Gen_Unbounded_Definite_Vectors is
end if;
end Contains;
- function Element (Position : Cursor) return Element_Type
+ function Element (Container : in Vector; Position : Cursor) return
Element_Type
is begin
- return Position.Container.Elements (Position.Index);
+ return Container.Elements (Position.Index);
end Element;
- function First (Container : aliased in Vector) return Cursor
+ function First (Container : in Vector) return Cursor
is
use all type Ada.Containers.Count_Type;
begin
if Container.Length = 0 then
- return (Container'Access, Invalid_Peek_Index);
+ return (Index => Invalid_Peek_Index);
else
- return (Container'Access, To_Peek_Type (Container.First));
+ return (Index => To_Peek_Type (Container.First));
end if;
end First;
- function Next (Position : in Cursor) return Cursor
+ function Next (Container : in Vector; 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);
+ return (Index => Invalid_Peek_Index);
+ elsif Position.Index < To_Peek_Type (Container.Last) then
+ return (Index => Position.Index + 1);
else
- return (Position.Container, Invalid_Peek_Index);
+ return (Index => Invalid_Peek_Index);
end if;
end Next;
- procedure Next (Position : in out Cursor)
+ procedure Next (Container : in Vector; Position : in out Cursor)
is begin
if Position.Index = Invalid_Peek_Index then
null;
- elsif Position.Index < To_Peek_Type (Position.Container.Last) then
+ elsif Position.Index < To_Peek_Type (Container.Last) then
Position.Index := Position.Index + 1;
else
- Position := (Position.Container, Invalid_Peek_Index);
+ Position := (Index => Invalid_Peek_Index);
end if;
end Next;
- function Prev (Position : in Cursor) return Cursor
+ function Prev (Container : in Vector; 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);
+ return (Index => Invalid_Peek_Index);
+ elsif Position.Index > To_Peek_Type (Container.First) then
+ return (Index => Position.Index - 1);
else
- return (Position.Container, Invalid_Peek_Index);
+ return (Index => Invalid_Peek_Index);
end if;
end Prev;
- procedure Prev (Position : in out Cursor)
+ procedure Prev (Container : in Vector; Position : in out Cursor)
is begin
if Position.Index = Invalid_Peek_Index then
null;
- elsif Position.Index > To_Peek_Type (Position.Container.First) then
+ elsif Position.Index > To_Peek_Type (Container.First) then
Position.Index := Position.Index - 1;
else
- Position := (Position.Container, Invalid_Peek_Index);
+ Position := (Index => Invalid_Peek_Index);
end if;
end Prev;
+ function No_Element (Container : in Vector) return Cursor
+ is begin
+ return (Index => Invalid_Peek_Index);
+ end No_Element;
+
function To_Cursor
- (Container : aliased in Vector;
- Index : in Extended_Index)
+ (Container : in Vector;
+ Index : in Extended_Index)
return Cursor
is begin
- return (Container'Access, To_Peek_Type (Index));
+ return (Index => To_Peek_Type (Index));
end To_Cursor;
function To_Index (Position : in Cursor) return Extended_Index
@@ -529,9 +601,9 @@ package body SAL.Gen_Unbounded_Definite_Vectors is
use all type Ada.Containers.Count_Type;
begin
if Object.Container.Length = 0 then
- return (Object.Container, Invalid_Peek_Index);
+ return (Index => Invalid_Peek_Index);
else
- return (Object.Container, To_Peek_Type (Object.Container.First));
+ return (Index => To_Peek_Type (Object.Container.First));
end if;
end First;
@@ -540,27 +612,27 @@ package body SAL.Gen_Unbounded_Definite_Vectors is
use all type Ada.Containers.Count_Type;
begin
if Object.Container.Length = 0 then
- return (Object.Container, Invalid_Peek_Index);
+ return (Index => Invalid_Peek_Index);
else
- return (Object.Container, To_Peek_Type (Object.Container.Last));
+ return (Index => 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);
+ 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
if Position.Index = To_Peek_Type (Index_Type'First) then
- return (Object.Container, Invalid_Peek_Index);
+ return (Index => Invalid_Peek_Index);
else
- return (Object.Container, Position.Index - 1);
+ return (Index => Position.Index - 1);
end if;
end Previous;
diff --git a/sal-gen_unbounded_definite_vectors.ads
b/sal-gen_unbounded_definite_vectors.ads
index 29ecae0..67c071a 100644
--- a/sal-gen_unbounded_definite_vectors.ads
+++ b/sal-gen_unbounded_definite_vectors.ads
@@ -5,16 +5,26 @@
--
-- Prepend is as fast (in amortized time) as Append.
--
--- It provides no checking of cursor tampering; higher level code
--- must ensure that.
---
-- Design:
--
+-- We provide no control of references to Vector held by various
+-- types; adding that proved buggy and very slow (Wisitoken generate
+-- time for Ada went from 200 seconds to 640 seconds). So the user
+-- must be aware of potential problems:
+--
+-- declare
+-- Object : Element_Type renames Vector.Constant_Ref (Position);
+-- begin
+-- Vector.Insert (A); -- reallocates underlying array to grow it
+--
+-- B := Object.B; -- Invalid reference
+-- end;
+--
-- 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.
+-- Copyright (C) 2018 - 2021 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
@@ -55,10 +65,11 @@ package SAL.Gen_Unbounded_Definite_Vectors is
overriding procedure Finalize (Container : in out Vector);
overriding procedure Adjust (Container : in out Vector);
- overriding function "=" (Left, Right : in Vector) return Boolean is
- (raise Programmer_Error);
+ overriding function "=" (Left, Right : in Vector) return Boolean
+ is (raise Programmer_Error);
-- Use Gen_Comparable child.
+ function Is_Empty (Container : in Vector) return Boolean;
function Length (Container : in Vector) return Ada.Containers.Count_Type;
function Capacity (Container : in Vector) return Ada.Containers.Count_Type;
@@ -68,14 +79,15 @@ package SAL.Gen_Unbounded_Definite_Vectors is
Last : in Extended_Index);
-- Allocates memory, but does not change Container.First, Container.Last.
- procedure Clear (Container : in out Vector)
- renames Finalize;
+ procedure Clear (Container : in out Vector; Free_Memory : in Boolean :=
False);
+ -- Set Container to Empty. If Free_Memory, free all memory, .
- 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.
+ function First_Index (Container : Vector; No_Index_If_Empty : in Boolean :=
False) return Extended_Index;
+ -- By default, 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).
+ -- If you need No_Index for an empty Container, use No_Index_If_Empty
+ -- => True.
function Last_Index (Container : Vector) return Extended_Index;
-- No_Index when Container is empty.
@@ -91,6 +103,9 @@ package SAL.Gen_Unbounded_Definite_Vectors is
-- Raises Constraint_Error if index of new item would be greater than
-- Index_Type'Last.
+ function Append (Container : in out Vector; New_Item : in Element_Type)
return Index_Type;
+ -- Same as Append, return index of new element.
+
procedure Append (Container : in out Vector; New_Items : in Vector);
-- Insert all elements of New_Items at end of Container.
@@ -114,6 +129,13 @@ package SAL.Gen_Unbounded_Definite_Vectors is
Before : in Index_Type);
-- Existing elements at Before and after are slid to higher indices.
+ procedure Add
+ (Container : in out Vector;
+ Element : in Element_Type;
+ Index : in Index_Type);
+ -- If Index is not in Container.First_Index .. Container.Last_Index,
+ -- grow Container to include Index. Then store Element at Index.
+
procedure Merge
(Target : in out Vector;
Source : in out Vector);
@@ -131,11 +153,11 @@ package SAL.Gen_Unbounded_Definite_Vectors is
(Container : in out Vector;
First : in Index_Type;
Last : in Extended_Index);
- -- Elements in First .. Last that have not been set have
- -- Default_Element value.
+ -- Elements in the expansion from previous First .. Last are set to
+ -- Default_Element.
procedure Delete (Container : in out Vector; Index : in Index_Type);
- -- Replace Index element contents with default. If Index =
+ -- Replace Index element contents with Default_Element. If Index =
-- Container.Last_Index, Container.Last_Index is decremented.
function Contains (Container : in Vector; Element : in Element_Type) return
Boolean;
@@ -153,20 +175,22 @@ 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;
+ type Cursor is private;
function Has_Element (Position : Cursor) return Boolean;
- function Element (Position : Cursor) return Element_Type
+ function Element (Container : in Vector; Position : Cursor) return
Element_Type
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);
- function Prev (Position : in Cursor) return Cursor;
- procedure Prev (Position : in out Cursor);
+ function First (Container : in Vector) return Cursor;
+ function Next (Container : in Vector; Position : in Cursor) return Cursor;
+ procedure Next (Container : in Vector; Position : in out Cursor);
+ function Prev (Container : in Vector; Position : in Cursor) return Cursor;
+ procedure Prev (Container : in Vector; Position : in out Cursor);
+
+ function No_Element (Container : in Vector) return Cursor;
function To_Cursor
- (Container : aliased in Vector;
- Index : in Extended_Index)
+ (Container : in Vector;
+ Index : in Extended_Index)
return Cursor
with Pre => Index = No_Index or Index in Container.First_Index ..
Container.Last_Index;
@@ -201,11 +225,7 @@ private
Last : Extended_Index := No_Index;
end record;
- type Vector_Access is access constant Vector;
- for Vector_Access'Storage_Size use 0;
-
- type Cursor (Container : not null access constant Vector) is
- record
+ type Cursor is record
Index : Base_Peek_Type := Invalid_Peek_Index;
end record;
diff --git a/sal-gen_unbounded_definite_vectors_sorted.adb
b/sal-gen_unbounded_definite_vectors_sorted.adb
index 8e40695..3890acb 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 - 2020 Free Software Foundation, Inc.
+-- Copyright (C) 2019 - 2021 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
@@ -55,13 +55,13 @@ package body SAL.Gen_Unbounded_Definite_Vectors_Sorted is
-- on the stack.
for I in New_First .. Old_First - 1 loop
- New_Array (I .. I) := (others => <>);
+ New_Array (I) := Default_Element;
end loop;
New_Array (Old_First .. Old_Last) := Elements.all;
for I in Old_Last + 1 .. New_Last loop
- New_Array (I .. I) := (others => <>);
+ New_Array (I) := Default_Element;
end loop;
Free (Elements);
diff --git a/sal-gen_unbounded_definite_vectors_sorted.ads
b/sal-gen_unbounded_definite_vectors_sorted.ads
index 2a52c74..f8ef919 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 - 2020 Free Software Foundation, Inc.
+-- Copyright (C) 2019 - 2021 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,6 +25,7 @@ generic
type Key_Type is private;
with function To_Key (Item : in Element_Type) return Key_Type;
with function Key_Compare (Left, Right : in Key_Type) return Compare_Result;
+ Default_Element : in Element_Type;
package SAL.Gen_Unbounded_Definite_Vectors_Sorted is
use all type Ada.Containers.Count_Type;
diff --git a/sal.adb b/sal.adb
index 6265651..d889f4f 100644
--- a/sal.adb
+++ b/sal.adb
@@ -21,7 +21,9 @@
-- executable to be covered by the GNU General Public License. This
-- exception does not however invalidate any other reasons why the
-- executable file might be covered by the GNU Public License.
---
+
+pragma License (Modified_GPL);
+
package body SAL is
function Version return String is
@@ -29,4 +31,40 @@ package body SAL is
return "SAL 3.5";
end Version;
+ function String_Compare (Left, Right : in String) return Compare_Result
+ is
+ J : Integer := Right'First;
+ begin
+ if Left'Length = 0 then
+ if Right'Length = 0 then
+ return Equal;
+ else
+ return Less;
+ end if;
+ else
+ if Right'Length = 0 then
+ return Greater;
+ end if;
+
+ for I in Left'Range loop
+ if Left (I) > Right (J) then
+ return Greater;
+ elsif Left (I) < Right (J) then
+ return Less;
+ end if;
+
+ J := J + 1;
+ if I < Left'Last and J > Right'Last then
+ return Greater;
+ end if;
+ end loop;
+
+ if J < Right'Last then
+ return Less;
+ else
+ return Equal;
+ end if;
+ end if;
+ end String_Compare;
+
end SAL;
diff --git a/sal.ads b/sal.ads
index 1e63dbc..843ba59 100644
--- a/sal.ads
+++ b/sal.ads
@@ -9,7 +9,7 @@
--
-- Contact Stephe at stephen_leake@stephe-leake.org.
--
--- Copyright (C) 1997 - 2004, 2008, 2009, 2015, 2017, 2018 Free Software
Foundation, Inc.
+-- Copyright (C) 1997 - 2004, 2008, 2009, 2015, 2017, 2018, 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
@@ -62,6 +62,7 @@ package SAL is
type Direction_Type is (Forward, Backward);
type Duplicate_Action_Type is (Allow, Ignore, Error);
+ subtype Ignore_Error_Type is Duplicate_Action_Type range Ignore .. Error;
type Overflow_Action_Type is (Overwrite, Error);
@@ -72,4 +73,7 @@ package SAL is
Invalid_Peek_Index : constant Base_Peek_Type := 0;
type Compare_Result is (Less, Equal, Greater);
+
+ function String_Compare (Left, Right : in String) return Compare_Result;
+
end SAL;
diff --git a/wisi-parse-common.el b/wisi-parse-common.el
index 2140b50..01a417b 100644
--- a/wisi-parse-common.el
+++ b/wisi-parse-common.el
@@ -1,6 +1,6 @@
;;; wisi-parse-common.el --- declarations used by wisi-parse.el,
wisi-ada-parse.el, and wisi.el -*- lexical-binding:t -*-
;;
-;; Copyright (C) 2014, 2015, 2017 - 2019 Free Software Foundation, Inc.
+;; Copyright (C) 2014, 2015, 2017 - 2019, 2021 Free Software Foundation, Inc.
;;
;; Author: Stephen Leake <stephen_leake@member.fsf.org>
;;
@@ -127,9 +127,9 @@ Return nil if no match found before eob."
If using an external parser, send it BEGIN thru SEND-END.")
(cl-defgeneric wisi-refactor ((parser wisi-parser) refactor-action parse-begin
parse-end edit-begin)
- "Send parser command to perform REFACTOR-ACTION on region PARSE-BEGIN
PARSE-END at point EDIT_BEGIN.
-The parse region is not expanded first; it must be the statement
-or declaration containing EDIT_BEGIN.")
+ "Perform REFACTOR-ACTION at point EDIT_BEGIN.
+STMT-START, STMT-END are the start and end positions of the
+statement containing EDIT_BEGIN.")
(cl-defgeneric wisi-parse-kill ((parser wisi-parser))
"Kill any external process associated with parser.")
diff --git a/wisi-prj.el b/wisi-prj.el
index 501c09f..8bbb5ca 100644
--- a/wisi-prj.el
+++ b/wisi-prj.el
@@ -1,6 +1,6 @@
;;; wisi-prj.el --- project integration -*- lexical-binding:t -*-
;;
-;; Copyright (C) 2019 - 2020 Free Software Foundation, Inc.
+;; Copyright (C) 2019 - 2021 Free Software Foundation, Inc.
;;
;; Author: Stephen Leake <stephen_leake@member.fsf.org>
;;
@@ -185,8 +185,9 @@ slow refresh operations may be skipped."
nil)
(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:
+ "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,
diff --git a/wisi.el b/wisi.el
index 3c095c7..bbeb001 100644
--- a/wisi.el
+++ b/wisi.el
@@ -212,7 +212,8 @@ If PARSE-RESULT is non-nil, use it instead of calling
`syntax-ppss'."
(cons 'face t)
(cons 'navigate t)
(cons 'indent t))
- "Non-nil when parse is needed because text has changed - cleared when parse
succeeds.")
+ "Non-nil when parse is needed due to text change.
+Cleared when parse succeeds.")
(defun wisi-parse-try (&optional parse-action)
(cdr (assoc (or parse-action wisi--parse-action) wisi--parse-try)))
diff --git a/wisitoken-parse_table-mode.el b/wisitoken-parse_table-mode.el
index e864ab0..7cd12a9 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 - 2020 Free Software Foundation, Inc.
+;; Copyright (C) 2017 - 2021 Free Software Foundation, Inc.
;;
;; Author: Stephen Leake <stephen_leake@stephe-leake.org>
;; Maintainer: Stephen Leake <stephen_leake@stephe-leake.org>
@@ -80,7 +80,7 @@
;;;###autoload
(define-minor-mode wisitoken-parse_table-mode
"Provides navigation in wisi-generate parse table output."
- nil ":parse_table" nil
+ :lighter ":parse_table"
(add-hook 'xref-backend-functions #'wisitoken-parse_table--xref-backend nil
t)
(if wisitoken-parse_table-mode