Packrat.Tokens added, tested, and functional

7 files changed, 297 insertions, 1 deletions

diff --git a/packrat_parser_lib_notes.txt b/packrat_parser_lib_notes.txt
index 8bcac69..8e98d56 100644
--- a/packrat_parser_lib_notes.txt
+++ b/packrat_parser_lib_notes.txt
@@ -214,6 +214,10 @@ Pretty_Print
 To_String
 Pretty_Print
 
+(for tokens)
+To_String
+Pretty_Print
+
 
 
 
@@ -244,6 +248,36 @@ Decode
 
 
 
+Packrat.Tokens
+ - nested package, defines a datatype important throughout lexing/parsing
+ - generic over the array type of whatever is being lexed/parsed and the enum of valid token labels
+ - contains an enum identifier, the start position, the finish position plus one, and the token value
+
+List of datatypes:
+Token (tagged, controlled, but not limited)
+
+List of funcs:
+Create
+Initialized
+
+Label
+Value
+Start
+Finish
+
+
+
+
+Packrat.Graphs
+
+List_of_datatypes:
+Parse_Graph
+
+List of funcs:
+
+
+
+
 
 
 Ratnest
@@ -257,6 +291,18 @@ Run_Tests
 Ratnest.Tests
 
 List of funcs:
+Valid_Message_Check
+Valid_Identifier_Check
+Join_Check
+Encode_1_Check
+Encode_2_Check
+Encode_3_Check
+Encode_4_Check
+Decode_Check
+
+Token_Adjust_Check
+Token_Store_Check
+
 In_Set_Check
 Not_In_Set_Check
 
diff --git a/src/packrat-tokens.adb b/src/packrat-tokens.adb
new file mode 100644
index 0000000..4cb10bf
--- /dev/null
+++ b/src/packrat-tokens.adb
@@ -0,0 +1,116 @@
+
+
+with
+
+    Ada.Unchecked_Deallocation;
+
+
+separate (Packrat)
+package body Tokens is
+
+
+    procedure Free_Array is new Ada.Unchecked_Deallocation
+        (Object => Element_Array, Name => Element_Array_Access);
+
+
+
+
+
+    procedure Initialize
+           (This : in out Token) is
+    begin
+        This.Start_At := 1;
+        This.Finish_At := 0;
+    end Initialize;
+
+
+    procedure Adjust
+           (This : in out Token)
+    is
+        New_Array : Element_Array_Access :=
+            new Element_Array (This.Token_Value'Range);
+    begin
+        New_Array.all := This.Token_Value.all;
+        This.Token_Value := New_Array;
+    end Adjust;
+
+
+    procedure Finalize
+           (This : in out Token) is
+    begin
+        if This.Token_Value /= null then
+            Free_Array (This.Token_Value);
+        end if;
+    end Finalize;
+
+
+
+
+
+    function Create
+           (Ident  : in Label_Enum;
+            Start  : in Positive;
+            Finish : in Natural;
+            Value  : in Element_Array)
+        return Token
+    is
+        This : Token;
+    begin
+        This.Identifier := Ident;
+        This.Start_At := Start;
+        This.Finish_At := Finish;
+        This.Token_Value := new Element_Array (Value'Range);
+        This.Token_Value.all := Value;
+        return This;
+    end Create;
+
+
+
+
+
+    function Initialized
+           (This : in Token)
+        return Boolean is
+    begin
+        return This.Token_Value /= null;
+    end Initialized;
+
+
+
+
+
+    function Label
+           (This : in Token)
+        return Label_Enum is
+    begin
+        return This.Identifier;
+    end Label;
+
+
+    function Start
+           (This : in Token)
+        return Positive is
+    begin
+        return This.Start_At;
+    end Start;
+
+
+    function Finish
+           (This : in Token)
+        return Natural is
+    begin
+        return This.Finish_At;
+    end Finish;
+
+
+    function Value
+           (This : in Token)
+        return Element_Array is
+    begin
+        return This.Token_Value.all;
+    end Value;
+
+
+end Tokens;
+
+
diff --git a/src/packrat.adb b/src/packrat.adb
index e78d0ae..de623e2 100644
--- a/src/packrat.adb
+++ b/src/packrat.adb
@@ -4,6 +4,7 @@ package body Packrat is
 
 
     package body Errors is separate;
+    package body Tokens is separate;
 
 
 end Packrat;
diff --git a/src/packrat.ads b/src/packrat.ads
index 1c81958..c60b798 100644
--- a/src/packrat.ads
+++ b/src/packrat.ads
@@ -2,7 +2,8 @@
 
 with
 
-    Ada.Strings.Unbounded;
+    Ada.Strings.Unbounded,
+    Ada.Finalization;
 
 
 package Packrat is
@@ -88,6 +89,82 @@ package Packrat is
     end Errors;
 
 
+
+
+    generic
+        type Label_Enum is (<>);
+        type Element is private;
+        type Element_Array is array (Positive range <>) of Element;
+    package Tokens is
+
+
+        type Token is new Ada.Finalization.Controlled with private;
+
+
+        function Create
+               (Ident  : in Label_Enum;
+                Start  : in Positive;
+                Finish : in Natural;
+                Value  : in Element_Array)
+            return Token;
+
+
+        --  Note: The Start and Finish indices indicate where the token was found
+        --        in whatever array it was lexed from. The Value does *not* have
+        --        to correspond with whatever is found in the Start .. Finish range.
+
+
+        function Initialized
+               (This : in Token)
+            return Boolean;
+
+
+        function Label
+               (This : in Token)
+            return Label_Enum
+            with Pre => Initialized (This);
+
+        function Start
+               (This : in Token)
+            return Positive;
+
+        function Finish
+               (This : in Token)
+            return Natural;
+
+        function Value
+               (This : in Token)
+            return Element_Array
+            with Pre => Initialized (This);
+
+
+    private
+
+
+        type Element_Array_Access is access Element_Array;
+
+
+        type Token is new Ada.Finalization.Controlled with record
+            Identifier  : Label_Enum;
+            Start_At    : Positive;
+            Finish_At   : Natural;
+            Token_Value : Element_Array_Access;
+        end record;
+
+
+        overriding procedure Initialize
+               (This : in out Token);
+
+        overriding procedure Adjust
+               (This : in out Token);
+
+        overriding procedure Finalize
+               (This : in out Token);
+
+
+    end Tokens;
+
+
 private
 
 
diff --git a/test/ratnest-tests.adb b/test/ratnest-tests.adb
index df17775..1f0950d 100644
--- a/test/ratnest-tests.adb
+++ b/test/ratnest-tests.adb
@@ -162,6 +162,48 @@ package body Ratnest.Tests is
 
 
 
+    function Token_Adjust_Check
+        return Test_Result
+    is
+        type My_Labels is (One, Two, Three);
+        package My_Tokens is new Packrat.Tokens (My_Labels, Character, String);
+
+        A : My_Tokens.Token;
+    begin
+        declare
+            B : My_Tokens.Token := My_Tokens.Create (One, 1, 3, "abc");
+        begin
+            A := B;
+        end;
+        if not A.Initialized or else A.Value /= "abc" then
+            return Failure;
+        end if;
+        return Success;
+    end Token_Adjust_Check;
+
+
+    function Token_Store_Check
+        return Test_Result
+    is
+        type My_Labels is (One, Two, Three);
+        package My_Tokens is new Packrat.Tokens (My_Labels, Character, String);
+
+        T : My_Tokens.Token := My_Tokens.Create (One, 1, 3, "abc");
+    begin
+        if  not T.Initialized or else
+            T.Label /= One or else
+            T.Start /= 1 or else T.Finish /= 3 or else
+            T.Value /= "abc"
+        then
+            return Failure;
+        end if;
+        return Success;
+    end Token_Store_Check;
+
+
+
+
+
     function In_Set_Check
         return Test_Result
     is
diff --git a/test/ratnest-tests.ads b/test/ratnest-tests.ads
index db20313..3c83a23 100644
--- a/test/ratnest-tests.ads
+++ b/test/ratnest-tests.ads
@@ -25,6 +25,16 @@ package Ratnest.Tests is
 
 
 
+    function Token_Adjust_Check return Test_Result;
+    function Token_Store_Check return Test_Result;
+
+    Token_Tests : Test_Array :=
+       ((+"Token Adjust", Token_Adjust_Check'Access),
+        (+"Token Storage", Token_Store_Check'Access));
+
+
+
+
     function In_Set_Check return Test_Result;
     function Not_In_Set_Check return Test_Result;
 
diff --git a/test/test_main.adb b/test/test_main.adb
index 0ce72b1..404e690 100644
--- a/test/test_main.adb
+++ b/test/test_main.adb
@@ -18,6 +18,10 @@ begin
     Run_Tests (Error_Tests);
     New_Line;
 
+    Put_Line ("Running tests for Packrat.Tokens...");
+    Run_Tests (Token_Tests);
+    New_Line;
+
     Put_Line ("Running tests for Packrat.Util...");
     Put_Line ("Testing set predicates...");
     Run_Tests (Set_Predicate_Tests);