summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/packrat-lexer.adb145
-rw-r--r--test/ratnest-tests.adb20
2 files changed, 143 insertions, 22 deletions
diff --git a/src/packrat-lexer.adb b/src/packrat-lexer.adb
index 77ebf9f..eb126eb 100644
--- a/src/packrat-lexer.adb
+++ b/src/packrat-lexer.adb
@@ -196,7 +196,6 @@ package body Packrat.Lexer is
Details.Pass_Forward := null;
end if;
- Details.Result_So_Far.Clear;
Details.Empty_Labels.Clear;
Details.Error_Labels.Clear;
Details.Error_Labels.Reserve_Capacity (Number_Comp);
@@ -235,6 +234,36 @@ package body Packrat.Lexer is
end Token_Vector_To_Array;
+ procedure Token_Vector_To_Array
+ (Input_Vector : in Token_Vectors.Vector;
+ Padding : in Gen_Tokens.Token;
+ Output_Array : out Gen_Tokens.Token_Array) is
+ begin
+ for N in Integer range 1 .. Output_Array'Length loop
+ if N <= Integer (Input_Vector.Length) then
+ Output_Array (Output_Array'First + N - 1) := Input_Vector.Element (N);
+ else
+ Output_Array (Output_Array'First + N - 1) := Padding;
+ end if;
+ end loop;
+ 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;
+
+
+
+
+
function Scan
(Input : in Element_Array;
Context : in out Lexer_Context)
@@ -245,6 +274,7 @@ package body Packrat.Lexer is
Raise_Error : Boolean;
begin
Tidy_Context (Context, Components'Length);
+ Context.Result_So_Far.Clear;
Context.Allow_Incomplete := not (Input = Empty_Array);
while Context.Status = Success and Context.Position <= Real_Input.Data'Length loop
@@ -259,7 +289,6 @@ package body Packrat.Lexer is
Raise_Lexer_Error (Context.Error_Labels, Context.Position);
end if;
end loop;
-
return Token_Vector_To_Array (Context.Result_So_Far);
end Scan;
@@ -274,6 +303,7 @@ package body Packrat.Lexer is
Raise_Error : Boolean;
begin
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
@@ -288,7 +318,6 @@ package body Packrat.Lexer is
Raise_Lexer_Error (Context.Error_Labels, Context.Position);
end if;
end loop;
-
return Token_Vector_To_Array (Context.Result_So_Far);
end Scan_Only;
@@ -298,27 +327,125 @@ package body Packrat.Lexer is
Context : in out Lexer_Context)
return Gen_Tokens.Token_Array
is
- Result : Gen_Tokens.Token_Array (1 .. 0);
+ Raise_Error : Boolean;
begin
- return Result;
+ 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);
+ end if;
+ end loop;
+
+ if New_Input = Empty_Array then
+ exit;
+ end if;
+ end;
+ end loop;
+ return Token_Vector_To_Array (Context.Result_So_Far);
end Scan_With;
procedure Scan_Set
(Input : in Element_Array;
Context : in out Lexer_Context;
- Output : out Gen_Tokens.Token_Array) is
+ Output : out Gen_Tokens.Token_Array)
+ is
+ Real_Input : Input_Container :=
+ Pass_Input (Context.Pass_Forward, Input'Unrestricted_Access);
+ Raise_Error : Boolean;
begin
- null;
+ Tidy_Context (Context, Components'Length);
+ Context.Result_So_Far.Clear;
+ Context.Allow_Incomplete := not (Input = Empty_Array 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
+ 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);
+ 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));
+ end if;
+ Token_Vector_To_Array (Context.Result_So_Far, Pad_Out, Output);
end Scan_Set;
procedure Scan_Set_With
(Input : in With_Input;
Context : in out Lexer_Context;
- Output : out Gen_Tokens.Token_Array) is
+ Output : out Gen_Tokens.Token_Array)
+ is
+ Raise_Error : Boolean;
begin
- null;
+ 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);
+ end if;
+ end loop;
+
+ if New_Input = Empty_Array or else New_Input (New_Input'First) = Pad_In then
+ exit;
+ end if;
+
+ 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;
+ end loop;
+ Token_Vector_To_Array (Context.Result_So_Far, Pad_Out, Output);
end Scan_Set_With;
diff --git a/test/ratnest-tests.adb b/test/ratnest-tests.adb
index d5c150e..3d51081 100644
--- a/test/ratnest-tests.adb
+++ b/test/ratnest-tests.adb
@@ -6,7 +6,7 @@ with
Ada.Strings.Maps,
Ada.Exceptions,
Packrat.Lexer.Debug,
- Packrat.Util, Ada.Text_IO;
+ Packrat.Util;
package body Ratnest.Tests is
@@ -907,12 +907,6 @@ package body Ratnest.Tests is
My_Scan ("", Test_Context);
begin
if Actual_Result1 /= Intended_Result1 or Actual_Result2 /= Intended_Result2 then
- for T of Actual_Result1 loop
- Ada.Text_IO.Put_Line (T.Debug_String);
- end loop;
- for T of Actual_Result2 loop
- Ada.Text_IO.Put_Line (T.Debug_String);
- end loop;
return Fail;
end if;
return Pass;
@@ -952,7 +946,7 @@ package body Ratnest.Tests is
begin
if Sentinel > 1 then
Sentinel := 1;
- return "it will happen again ";
+ return "it will happen again";
elsif Sentinel > 0 then
Sentinel := 0;
return " and again and again";
@@ -970,11 +964,11 @@ package body Ratnest.Tests is
(1 => Word_Tokens.Create (Word, 1, 2, "it"),
2 => Word_Tokens.Create (Word, 4, 7, "will"),
3 => Word_Tokens.Create (Word, 9, 14, "happen"),
- 4 => Word_Tokens.Create (Word, 16, 20, "again"),
- 5 => Word_Tokens.Create (Word, 22, 24, "and"),
- 6 => Word_Tokens.Create (Word, 26, 30, "again"),
- 7 => Word_Tokens.Create (Word, 32, 34, "and"),
- 8 => Word_Tokens.Create (Word, 36, 40, "again"));
+ 4 => Word_Tokens.Create (Word, 17, 21, "again"),
+ 5 => Word_Tokens.Create (Word, 23, 25, "and"),
+ 6 => Word_Tokens.Create (Word, 27, 31, "again"),
+ 7 => Word_Tokens.Create (Word, 33, 35, "and"),
+ 8 => Word_Tokens.Create (Word, 37, 41, "again"));
Actual_Result : Word_Tokens.Token_Array :=
My_Scan (More_Input'Unrestricted_Access, Test_Context);