From 58e6b24df6935dcd3d6e03c2a926fdc6529cec70 Mon Sep 17 00:00:00 2001
From: Jed Barber <jjbarber@y7mail.com>
Date: Sun, 19 Apr 2020 20:36:57 +1000
Subject: Removal of manual memory management in favour of Holders

---
 src/packrat-lexer.adb  | 265 ++++++++++++++++++-------------------------------
 src/packrat-lexer.ads  |  46 ++-------
 src/packrat-tokens.adb |  93 ++---------------
 src/packrat.ads        |  42 +++-----
 4 files changed, 126 insertions(+), 320 deletions(-)

(limited to 'src')

diff --git a/src/packrat-lexer.adb b/src/packrat-lexer.adb
index eb126eb..faf8f71 100644
--- a/src/packrat-lexer.adb
+++ b/src/packrat-lexer.adb
@@ -1,81 +1,8 @@
 
 
-with
-
-    Ada.Unchecked_Deallocation;
-
-
 package body Packrat.Lexer is
 
 
-    procedure Free_Array is new Ada.Unchecked_Deallocation
-        (Object => Element_Array, Name => Element_Array_Access);
-
-
-    procedure Initialize
-           (This : in out Lexer_Context) is
-    begin
-        null;
-    end Initialize;
-
-
-    procedure Adjust
-           (This : in out Lexer_Context)
-    is
-        New_Array : Element_Array_Access;
-    begin
-        if This.Pass_Forward /= null then
-            New_Array := new Element_Array (1 .. This.Pass_Forward.all'Length);
-            New_Array.all := This.Pass_Forward.all;
-            This.Pass_Forward := New_Array;
-        end if;
-    end Adjust;
-
-
-    procedure Finalize
-           (This : in out Lexer_Context) is
-    begin
-        if This.Pass_Forward /= null then
-            Free_Array (This.Pass_Forward);
-        end if;
-    end Finalize;
-
-
-
-
-
-    procedure Finalize
-           (This : in out Input_Container) is
-    begin
-        if This.Dealloc then
-            Free_Array (This.Data);
-        end if;
-    end Finalize;
-
-
-    function Pass_Input
-           (Passed, Continuing : in Element_Array_Access)
-        return Input_Container is
-    begin
-        if Passed = null then
-            return This : Input_Container do
-                This.Data := Continuing;
-                This.Dealloc := False;
-            end return;
-        else
-            return This : Input_Container do
-                This.Data := new Element_Array (1 .. Passed'Length + Continuing'Length);
-                This.Data (1 .. Passed'Length) := Passed.all;
-                This.Data (Passed'Length + 1 .. This.Data'Last) := Continuing.all;
-                This.Dealloc := True;
-            end return;
-        end if;
-    end Pass_Input;
-
-
-
-
-
     function Join
            (Left, Right : in Combinator_Result)
         return Combinator_Result is
@@ -130,9 +57,7 @@ package body Packrat.Lexer is
             end if;
         else
             Context.Status := Current_Result.Status;
-            Context.Pass_Forward := new Element_Array
-                (1 .. Current_Result.Finish - Context.Position + 1);
-            Context.Pass_Forward.all := Input (Context.Position .. Current_Result.Finish);
+            Context.Pass_Forward.Replace_Element (Input (Context.Position .. Current_Result.Finish));
             Context.Empty_Labels.Clear;
         end if;
 
@@ -173,9 +98,7 @@ package body Packrat.Lexer is
             end if;
         else
             Context.Status := Current_Result.Status;
-            Context.Pass_Forward := new Element_Array
-                (1 .. Current_Result.Finish - Context.Position + 1);
-            Context.Pass_Forward.all := Input (Context.Position .. Current_Result.Finish);
+            Context.Pass_Forward.Replace_Element (Input (Context.Position .. Current_Result.Finish));
             Context.Empty_Labels.Clear;
         end if;
 
@@ -191,10 +114,7 @@ package body Packrat.Lexer is
            (Details     : in out Lexer_Context;
             Number_Comp : in     Ada.Containers.Count_Type) is
     begin
-        if Details.Pass_Forward /= null then
-            Free_Array (Details.Pass_Forward);
-            Details.Pass_Forward := null;
-        end if;
+        Details.Pass_Forward := Input_Holders.Empty_Holder;
 
         Details.Empty_Labels.Clear;
         Details.Error_Labels.Clear;
@@ -249,18 +169,6 @@ package body Packrat.Lexer is
     end Token_Vector_To_Array;
 
 
-    procedure Assign_New
-           (Location : in out Element_Array_Access;
-            Items    : in     Element_Array) is
-    begin
-        if Location /= null then
-            Free_Array (Location);
-        end if;
-        Location := new Element_Array (1 .. Items'Last - Items'First + 1);
-        Location.all := Items;
-    end Assign_New;
-
-
 
 
 
@@ -269,18 +177,23 @@ package body Packrat.Lexer is
             Context : in out Lexer_Context)
         return Gen_Tokens.Token_Array
     is
-        Real_Input : Input_Container :=
-            Pass_Input (Context.Pass_Forward, Input'Unrestricted_Access);
+        Real_Input : Input_Holders.Holder;
         Raise_Error : Boolean;
     begin
+        if not Context.Pass_Forward.Is_Empty then
+            Real_Input := Input_Holders.To_Holder (Context.Pass_Forward.Element & Input);
+        else
+            Real_Input := Input_Holders.To_Holder (Input);
+        end if;
+
         Tidy_Context (Context, Components'Length);
         Context.Result_So_Far.Clear;
-        Context.Allow_Incomplete := not (Input = Empty_Array);
+        Context.Allow_Incomplete := Input'Length > 0;
 
-        while Context.Status = Success and Context.Position <= Real_Input.Data'Length loop
+        while Context.Status = Success and Context.Position <= Real_Input.Constant_Reference.Element'Length loop
             Raise_Error := True;
             for C of Components loop
-                if C (Real_Input.Data.all, Context) = Component_Success then
+                if C (Real_Input.Element, Context) = Component_Success then
                     Raise_Error := False;
                     exit;
                 end if;
@@ -298,18 +211,23 @@ package body Packrat.Lexer is
             Context : in out Lexer_Context)
         return Gen_Tokens.Token_Array
     is
-        Real_Input : Input_Container :=
-            Pass_Input (Context.Pass_Forward, Input'Unrestricted_Access);
+        Real_Input : Input_Holders.Holder;
         Raise_Error : Boolean;
     begin
+        if not Context.Pass_Forward.Is_Empty then
+            Real_Input := Input_Holders.To_Holder (Context.Pass_Forward.Element & Input);
+        else
+            Real_Input := Input_Holders.To_Holder (Input);
+        end if;
+
         Tidy_Context (Context, Components'Length);
         Context.Result_So_Far.Clear;
         Context.Allow_Incomplete := False;
 
-        while Context.Status = Success and Context.Position <= Real_Input.Data'Length loop
+        while Context.Status = Success and Context.Position <= Real_Input.Constant_Reference.Element'Length loop
             Raise_Error := True;
             for C of Components loop
-                if C (Real_Input.Data.all, Context) = Component_Success then
+                if C (Real_Input.Element, Context) = Component_Success then
                     Raise_Error := False;
                     exit;
                 end if;
@@ -327,35 +245,36 @@ package body Packrat.Lexer is
             Context : in out Lexer_Context)
         return Gen_Tokens.Token_Array
     is
-        Raise_Error : Boolean;
+        Real_Input : Input_Holders.Holder;
+        Empty_Input, Raise_Error : Boolean;
     begin
         Context.Result_So_Far.Clear;
         loop
-            declare
-                New_Input : Element_Array := Input.all;
-                Real_Input : Input_Container :=
-                    Pass_Input (Context.Pass_Forward, New_Input'Unrestricted_Access);
-            begin
-                Tidy_Context (Context, Components'Length);
-                Context.Allow_Incomplete := not (New_Input = Empty_Array);
-
-                while Context.Status = Success and Context.Position <= Real_Input.Data'Length loop
-                    Raise_Error := True;
-                    for C of Components loop
-                        if C (Real_Input.Data.all, Context) = Component_Success then
-                            Raise_Error := False;
-                            exit;
-                        end if;
-                    end loop;
-                    if Raise_Error then
-                        Raise_Lexer_Error (Context.Error_Labels, Context.Position);
+            Real_Input := Input_Holders.To_Holder (Input.all);
+            Empty_Input := Real_Input.Constant_Reference.Element'Length = 0;
+            if not Context.Pass_Forward.Is_Empty then
+                Real_Input := Input_Holders.To_Holder (Context.Pass_Forward.Element & Real_Input.Element);
+            end if;
+
+            Tidy_Context (Context, Components'Length);
+            Context.Allow_Incomplete := not Empty_Input;
+
+            while Context.Status = Success and Context.Position <= Real_Input.Constant_Reference.Element'Length loop
+                Raise_Error := True;
+                for C of Components loop
+                    if C (Real_Input.Element, Context) = Component_Success then
+                        Raise_Error := False;
+                        exit;
                     end if;
                 end loop;
-
-                if New_Input = Empty_Array then
-                    exit;
+                if Raise_Error then
+                    Raise_Lexer_Error (Context.Error_Labels, Context.Position);
                 end if;
-            end;
+            end loop;
+
+            if Empty_Input then
+                exit;
+            end if;
         end loop;
         return Token_Vector_To_Array (Context.Result_So_Far);
     end Scan_With;
@@ -366,22 +285,27 @@ package body Packrat.Lexer is
             Context : in out Lexer_Context;
             Output  :    out Gen_Tokens.Token_Array)
     is
-        Real_Input : Input_Container :=
-            Pass_Input (Context.Pass_Forward, Input'Unrestricted_Access);
+        Real_Input : Input_Holders.Holder;
         Raise_Error : Boolean;
     begin
+        if not Context.Pass_Forward.Is_Empty then
+            Real_Input := Input_Holders.To_Holder (Context.Pass_Forward.Element & Input);
+        else
+            Real_Input := Input_Holders.To_Holder (Input);
+        end if;
+
         Tidy_Context (Context, Components'Length);
         Context.Result_So_Far.Clear;
-        Context.Allow_Incomplete := not (Input = Empty_Array or else Input (Input'First) = Pad_In);
+        Context.Allow_Incomplete := not (Input'Length = 0 or else Input (Input'First) = Pad_In);
 
         while Context.Status = Success and then
             Integer (Context.Result_So_Far.Length) < Output'Length and then
-            Context.Position <= Real_Input.Data'Length and then
-            Real_Input.Data (Context.Position) /= Pad_In
+            Context.Position <= Real_Input.Constant_Reference.Element'Length and then
+            Real_Input.Constant_Reference.Element (Context.Position) /= Pad_In
         loop
             Raise_Error := True;
             for C of Components loop
-                if C (Real_Input.Data.all, Context) = Component_Success then
+                if C (Real_Input.Element, Context) = Component_Success then
                     Raise_Error := False;
                     exit;
                 end if;
@@ -391,10 +315,11 @@ package body Packrat.Lexer is
             end if;
         end loop;
 
+        --  suspect this is wrong, test more
         if Integer (Context.Result_So_Far.Length) >= Output'Length then
-            Assign_New (Context.Pass_Forward,
-                Real_Input.Data (Context.Position .. Real_Input.Data'Last));
+            Context.Pass_Forward.Replace_Element (Real_Input.Element (Context.Position .. Real_Input.Element'Last));
         end if;
+
         Token_Vector_To_Array (Context.Result_So_Far, Pad_Out, Output);
     end Scan_Set;
 
@@ -404,51 +329,55 @@ package body Packrat.Lexer is
             Context : in out Lexer_Context;
             Output  :    out Gen_Tokens.Token_Array)
     is
-        Raise_Error : Boolean;
+        Real_Input : Input_Holders.Holder;
+        Empty_Input, Raise_Error : Boolean;
     begin
         Context.Result_So_Far.Clear;
         loop
-            declare
-                New_Input : Element_Array := Input.all;
-                Real_Input : Input_Container :=
-                    Pass_Input (Context.Pass_Forward, New_Input'Unrestricted_Access);
-            begin
-                Tidy_Context (Context, Components'Length);
-                Context.Allow_Incomplete := not
-                   (New_Input = Empty_Array or else New_Input (New_Input'First) = Pad_In);
-
-                while Context.Status = Success and then
-                    Integer (Context.Result_So_Far.Length) < Output'Length and then
-                    Context.Position <= Real_Input.Data'Length and then
-                    Real_Input.Data (Context.Position) /= Pad_In
-                loop
-                    Raise_Error := True;
-                    for C of Components loop
-                        if C (Real_Input.Data.all, Context) = Component_Success then
-                            Raise_Error := False;
-                            exit;
-                        end if;
-                    end loop;
-                    if Raise_Error then
-                        Raise_Lexer_Error (Context.Error_Labels, Context.Position);
+            Real_Input := Input_Holders.To_Holder (Input.all);
+            Empty_Input := Real_Input.Constant_Reference.Element'Length = 0 or
+                Real_Input.Constant_Reference.Element (Real_Input.Constant_Reference.Element'First) = Pad_In;
+            if not Context.Pass_Forward.Is_Empty then
+                Real_Input.Replace_Element (Context.Pass_Forward.Element & Real_Input.Element);
+            end if;
+
+            Tidy_Context (Context, Components'Length);
+            Context.Allow_Incomplete := not Empty_Input;
+
+            while Context.Status = Success and then
+                Integer (Context.Result_So_Far.Length) < Output'Length and then
+                Context.Position <= Real_Input.Constant_Reference.Element'Length and then
+                Real_Input.Constant_Reference.Element (Context.Position) /= Pad_In
+            loop
+                Raise_Error := True;
+                for C of Components loop
+                    if C (Real_Input.Element, Context) = Component_Success then
+                        Raise_Error := False;
+                        exit;
                     end if;
                 end loop;
-
-                if New_Input = Empty_Array or else New_Input (New_Input'First) = Pad_In then
-                    exit;
+                if Raise_Error then
+                    Raise_Lexer_Error (Context.Error_Labels, Context.Position);
                 end if;
+            end loop;
 
-                if Integer (Context.Result_So_Far.Length) >= Output'Length then
-                    Assign_New (Context.Pass_Forward,
-                        Real_Input.Data (Context.Position .. Real_Input.Data'Last));
-                    exit;
-                end if;
-            end;
+            if Empty_Input then
+                exit;
+            end if;
+
+            --  suspect this is wrong, test more
+            if Integer (Context.Result_So_Far.Length) >= Output'Length then
+                Context.Pass_Forward.Replace_Element (Real_Input.Element (Context.Position .. Real_Input.Element'Last));
+                exit;
+            end if;
         end loop;
         Token_Vector_To_Array (Context.Result_So_Far, Pad_Out, Output);
     end Scan_Set_With;
 
 
+    --  factor out the internal scan loop to an internal function/procedure here
+
+
 
 
 
diff --git a/src/packrat-lexer.ads b/src/packrat-lexer.ads
index 0cd5c78..693064d 100644
--- a/src/packrat-lexer.ads
+++ b/src/packrat-lexer.ads
@@ -29,7 +29,7 @@ package Packrat.Lexer is
 
 
 
-    type Lexer_Context is new Ada.Finalization.Controlled with private;
+    type Lexer_Context is private;
 
     Empty_Context : constant Lexer_Context;
 
@@ -263,26 +263,16 @@ private
         Element_Type => Gen_Tokens.Token,
         "="          => Gen_Tokens."=");
 
-
-
-
-    type Element_Array_Access is access all Element_Array;
-
-    Empty_Array : Element_Array (1 .. 0);
-
-
-
-
     package Label_Vectors is new Ada.Containers.Vectors
        (Index_Type   => Positive,
         Element_Type => Label_Enum);
 
-
-
-
     package Label_Sets is new Ada.Containers.Ordered_Sets
        (Element_Type => Label_Enum);
 
+    package Input_Holders is new Ada.Containers.Indefinite_Holders
+       (Element_Type => Element_Array);
+
 
 
 
@@ -308,48 +298,24 @@ private
         Position         : Positive;
         Offset           : Natural;
         Status           : Result_Status;
-        Pass_Forward     : Element_Array_Access;
+        Pass_Forward     : Input_Holders.Holder;
         Empty_Labels     : Label_Sets.Set;
         Error_Labels     : Label_Vectors.Vector;
         Allow_Incomplete : Boolean;
     end record;
 
-    overriding procedure Initialize
-           (This : in out Lexer_Context);
-
-    overriding procedure Adjust
-           (This : in out Lexer_Context);
-
-    overriding procedure Finalize
-           (This : in out Lexer_Context);
-
     Empty_Context : constant Lexer_Context :=
        (Ada.Finalization.Controlled with
         Result_So_Far    => Token_Vectors.Empty_Vector,
         Position         => 1,
         Offset           => 0,
         Status           => Success,
-        Pass_Forward     => null,
+        Pass_Forward     => Input_Holders.Empty_Holder,
         Empty_Labels     => Label_Sets.Empty_Set,
         Error_Labels     => Label_Vectors.Empty_Vector,
         Allow_Incomplete => True);
 
 
-
-
-    type Input_Container is new Ada.Finalization.Limited_Controlled with record
-        Data    : Element_Array_Access;
-        Dealloc : Boolean;
-    end record;
-
-    overriding procedure Finalize
-           (This : in out Input_Container);
-
-    function Pass_Input
-           (Passed, Continuing : in Element_Array_Access)
-        return Input_Container;
-
-
 end Packrat.Lexer;
 
 
diff --git a/src/packrat-tokens.adb b/src/packrat-tokens.adb
index 382b8d8..aae0ae6 100644
--- a/src/packrat-tokens.adb
+++ b/src/packrat-tokens.adb
@@ -2,7 +2,6 @@
 
 with
 
-    Ada.Unchecked_Deallocation,
     Ada.Characters.Latin_1;
 
 
@@ -14,45 +13,6 @@ package body Tokens is
     package Latin renames Ada.Characters.Latin_1;
 
 
-    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
-    begin
-        if This.Token_Value /= null then
-            declare
-                New_Array : Element_Array_Access :=
-                    new Element_Array (1 .. This.Token_Value'Length);
-            begin
-                New_Array.all := This.Token_Value.all;
-                This.Token_Value := New_Array;
-            end;
-        end if;
-    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;
-
-
 
 
 
@@ -61,55 +21,20 @@ package body Tokens is
             Start  : in Positive;
             Finish : in Natural;
             Value  : in Element_Array)
-        return Token
-    is
-        This : Token;
+        return Token is
     begin
-        This.Identifier := Ident;
-        This.Start_At := Start;
-        This.Finish_At := Finish;
-        This.Token_Value := new Element_Array (1 .. Value'Length);
-        This.Token_Value.all := Value;
-        return This;
+        return This : Token do
+            This.Identifier := Ident;
+            This.Start_At := Start;
+            This.Finish_At := Finish;
+            This.Token_Value := Value_Holders.To_Holder (Value);
+        end return;
     end Create;
 
 
-    function "="
-           (Left, Right : in Token)
-        return Boolean
-    is
-        Left_Valsize, Right_Valsize : Natural;
-    begin
-        if Left.Token_Value = null then
-            Left_Valsize := 0;
-        else
-            Left_Valsize := Left.Token_Value.all'Length;
-        end if;
-        if Right.Token_Value = null then
-            Right_Valsize := 0;
-        else
-            Right_Valsize := Right.Token_Value.all'Length;
-        end if;
-
-        return Left.Identifier = Right.Identifier and
-            Left.Start_At = Right.Start_At and
-            Left.Finish_At = Right.Finish_At and
-            Left_Valsize = Right_Valsize and
-            (Left_Valsize = 0 or else Left.Token_Value.all = Right.Token_Value.all);
-    end "=";
-
 
 
 
-
-    function Initialized
-           (This : in Token)
-        return Boolean is
-    begin
-        return This.Token_Value /= null;
-    end Initialized;
-
-
     function Debug_String
            (This : in Token)
         return String
@@ -119,7 +44,7 @@ package body Tokens is
         SU.Append (Result, "Token " & Label_Enum'Image (This.Identifier) &
             " at input position" & Integer'Image (This.Start_At) & " to" &
             Integer'Image (This.Finish_At) & " with value length" &
-            Integer'Image (This.Token_Value'Length) & Latin.LF);
+            Integer'Image (This.Token_Value.Constant_Reference.Element'Length) & Latin.LF);
         return -Result;
     end Debug_String;
 
@@ -155,7 +80,7 @@ package body Tokens is
            (This : in Token)
         return Element_Array is
     begin
-        return This.Token_Value.all;
+        return This.Token_Value.Element;
     end Value;
 
 
diff --git a/src/packrat.ads b/src/packrat.ads
index 4abdaec..b2b0144 100644
--- a/src/packrat.ads
+++ b/src/packrat.ads
@@ -2,8 +2,11 @@
 
 with
 
-    Ada.Strings.Unbounded,
-    Ada.Finalization;
+    Ada.Strings.Unbounded;
+
+private with
+
+    Ada.Containers.Indefinite_Holders;
 
 
 package Packrat is
@@ -106,10 +109,13 @@ package Packrat is
     package Tokens is
 
 
-        type Token is new Ada.Finalization.Controlled with private;
+        type Token is private;
         type Token_Array is array (Positive range <>) of Token;
 
 
+        --  will probably have to remove the Finish field to accommodate graphs properly
+
+
         function Create
                (Ident  : in Label_Enum;
                 Start  : in Positive;
@@ -117,20 +123,12 @@ package Packrat is
                 Value  : in Element_Array)
             return Token;
 
-        function "="
-               (Left, Right : in Token)
-            return Boolean;
-
 
         --  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 Debug_String
                (This : in Token)
             return String;
@@ -138,8 +136,7 @@ package Packrat is
 
         function Label
                (This : in Token)
-            return Label_Enum
-            with Pre => Initialized (This);
+            return Label_Enum;
 
         function Start
                (This : in Token)
@@ -151,34 +148,23 @@ package Packrat is
 
         function Value
                (This : in Token)
-            return Element_Array
-            with Pre => Initialized (This);
+            return Element_Array;
 
 
     private
 
 
-        type Element_Array_Access is access Element_Array;
+        package Value_Holders is new Ada.Containers.Indefinite_Holders (Element_Array);
 
 
-        type Token is new Ada.Finalization.Controlled with record
+        type Token is record
             Identifier  : Label_Enum;
             Start_At    : Positive;
             Finish_At   : Natural;
-            Token_Value : Element_Array_Access;
+            Token_Value : Value_Holders.Holder;
         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;
 
 
-- 
cgit