summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorJed Barber <jjbarber@y7mail.com>2020-04-19 20:36:57 +1000
committerJed Barber <jjbarber@y7mail.com>2020-04-19 20:36:57 +1000
commit58e6b24df6935dcd3d6e03c2a926fdc6529cec70 (patch)
tree0d22d8bbb1091cd797de387fe52a4daea48a27b7 /src
parent670b311fa2c60c10878d7ca7984392b0d2b0ef03 (diff)
Removal of manual memory management in favour of Holders
Diffstat (limited to 'src')
-rw-r--r--src/packrat-lexer.adb265
-rw-r--r--src/packrat-lexer.ads46
-rw-r--r--src/packrat-tokens.adb93
-rw-r--r--src/packrat.ads42
4 files changed, 126 insertions, 320 deletions
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;