summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--misc/count_tables.adb139
-rw-r--r--misc/count_tables.ads124
2 files changed, 263 insertions, 0 deletions
diff --git a/misc/count_tables.adb b/misc/count_tables.adb
new file mode 100644
index 0000000..68cb9ad
--- /dev/null
+++ b/misc/count_tables.adb
@@ -0,0 +1,139 @@
+
+package body Count_Tables is
+
+
+ function Has_Element
+ (Position : Cursor)
+ return Boolean is
+ begin
+ return Position.My_Map /= null and then
+ Position.Index >= Position.My_Map.My_Vec.First_Index and then
+ Position.Index <= Position.My_Map.My_Vec.Last_Index;
+ end Has_Element;
+
+
+ function Key
+ (Position : Cursor)
+ return Key_Type is
+ begin
+ return Internal_Maps.Key
+ (Position.My_Map.My_Vec.Element (Position.Index));
+ end Key;
+
+
+ function Element
+ (Position : Cursor)
+ return Natural is
+ begin
+ return Internal_Maps.Element
+ (Position.My_Map.My_Vec.Element (Position.Index));
+ end Element;
+
+
+ function Reference
+ (Container : aliased in out Map;
+ Position : Cursor)
+ return Reference_Type is
+ begin
+ return (Element => Container.My_Map.Reference
+ (Container.My_Vec (Position.Index)).Element);
+ end Reference;
+
+
+ procedure Increment
+ (Container : in out Map;
+ Key : in Key_Type;
+ Value : in Natural := 1)
+ is
+ Place : Internal_Maps.Cursor;
+ Success : Boolean;
+ begin
+ Container.My_Map.Insert (Key, Value, Place, Success);
+ if not Success then
+ Container.My_Map.Reference (Key) := Container.My_Map.Reference (Key) + Value;
+ else
+ Container.My_Vec.Append (Place);
+ end if;
+ end Increment;
+
+
+ function Less
+ (Left, Right : in Internal_Maps.Cursor)
+ return Boolean is
+ begin
+ return Internal_Maps.Element (Right) < Internal_Maps.Element (Left);
+ end Less;
+
+
+ procedure Sort
+ (Container : in out Map) is
+ begin
+ Cursor_Sorting.Sort (Container.My_Vec);
+ end Sort;
+
+
+ function Iterate
+ (Container : in Map)
+ return Map_Iterator_Interfaces.Reversible_Iterator'Class is
+ begin
+ return It : Iterator := (Ada.Finalization.Limited_Controlled
+ with Container => Container'Unrestricted_Access);
+ end Iterate;
+
+
+ function First
+ (Object : in Iterator) return Cursor is
+ begin
+ if Object.Container /= null and then
+ not Object.Container.My_Map.Is_Empty
+ then
+ return (My_Map => Object.Container, Index => 1);
+ else
+ return No_Element;
+ end if;
+ end First;
+
+
+ function Last
+ (Object : in Iterator) return Cursor is
+ begin
+ if Object.Container /= null and then
+ not Object.Container.My_Map.Is_Empty
+ then
+ return (My_Map => Object.Container, Index => Object.Container.My_Vec.Last_Index);
+ else
+ return No_Element;
+ end if;
+ end Last;
+
+
+ function Next
+ (Object : in Iterator;
+ Position : in Cursor) return Cursor is
+ begin
+ if Has_Element (Position) and then
+ Position.Index < Position.My_Map.My_Vec.Last_Index
+ then
+ return (My_Map => Position.My_Map, Index => Position.Index + 1);
+ else
+ return No_Element;
+ end if;
+ end Next;
+
+
+ function Previous
+ (Object : in Iterator;
+ Position : in Cursor) return Cursor is
+ begin
+ if Has_Element (Position) and then
+ Position.Index > Position.My_Map.My_Vec.First_Index
+ then
+ return (My_Map => Position.My_Map, Index => Position.Index - 1);
+ else
+ return No_Element;
+ end if;
+ end Previous;
+
+
+end Count_Tables;
+
diff --git a/misc/count_tables.ads b/misc/count_tables.ads
new file mode 100644
index 0000000..9f3055c
--- /dev/null
+++ b/misc/count_tables.ads
@@ -0,0 +1,124 @@
+
+
+with
+ Ada.Iterator_Interfaces;
+
+private with
+ Ada.Containers.Indefinite_Ordered_Maps,
+ Ada.Containers.Vectors,
+ Ada.Finalization;
+
+generic
+ type Key_Type (<>) is private;
+ with function "<" (Left, Right : Key_Type) return Boolean is <>;
+package Count_Tables is
+
+ -- This package imitates the basics of
+ -- the Nim CountTable table variant.
+
+ -- Functionality is incomplete and likely inefficient,
+ -- as this was only put together for demonstrative purposes.
+
+ type Map is tagged private
+ with Variable_Indexing => Reference,
+ Default_Iterator => Iterate,
+ Iterator_Element => Natural;
+
+ type Cursor is private;
+
+ Empty_Map : constant Map;
+ No_Element : constant Cursor;
+
+ function Has_Element
+ (Position : Cursor)
+ return Boolean;
+
+ function Key
+ (Position : Cursor)
+ return Key_Type;
+
+ function Element
+ (Position : Cursor)
+ return Natural;
+
+ package Map_Iterator_Interfaces is new
+ Ada.Iterator_Interfaces (Cursor, Has_Element);
+
+ type Reference_Type (Element : not null access Natural) is private
+ with Implicit_Dereference => Element;
+
+ function Reference
+ (Container : aliased in out Map;
+ Position : Cursor)
+ return Reference_Type;
+
+ procedure Increment
+ (Container : in out Map;
+ Key : in Key_Type;
+ Value : in Natural := 1);
+
+ procedure Sort
+ (Container : in out Map);
+
+ function Iterate
+ (Container : in Map)
+ return Map_Iterator_Interfaces.Reversible_Iterator'Class;
+
+private
+
+ type Map_Access is access all Map;
+
+ type Cursor is record
+ My_Map : Map_Access;
+ Index : Positive;
+ end record;
+
+ package Internal_Maps is new Ada.Containers.Indefinite_Ordered_Maps (Key_Type, Natural);
+ package Cursor_Vectors is new Ada.Containers.Vectors (Positive, Internal_Maps.Cursor, Internal_Maps."=");
+
+ type Map is tagged record
+ My_Map : Internal_Maps.Map;
+ My_Vec : Cursor_Vectors.Vector;
+ end record;
+
+ Empty_Map : constant Map :=
+ (My_Map => Internal_Maps.Empty_Map,
+ My_Vec => Cursor_Vectors.Empty_Vector);
+ No_Element : constant Cursor :=
+ (My_Map => null,
+ Index => 1);
+
+ function Less
+ (Left, Right : in Internal_Maps.Cursor)
+ return Boolean;
+
+ package Cursor_Sorting is new Cursor_Vectors.Generic_Sorting (Less);
+
+ type Reference_Type (Element : not null access Natural) is null record;
+
+ type Iterator is new Ada.Finalization.Limited_Controlled and
+ Map_Iterator_Interfaces.Reversible_Iterator with
+ record
+ Container : Map_Access;
+ end record;
+
+ overriding function First
+ (Object : in Iterator)
+ return Cursor;
+
+ overriding function Last
+ (Object : in Iterator)
+ return Cursor;
+
+ overriding function Next
+ (Object : in Iterator;
+ Position : in Cursor)
+ return Cursor;
+
+ overriding function Previous
+ (Object : in Iterator;
+ Position : in Cursor)
+ return Cursor;
+
+end Count_Tables;
+