diff options
| -rw-r--r-- | src/packrat-lexer.adb | 145 | ||||
| -rw-r--r-- | test/ratnest-tests.adb | 20 |
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); |