diff options
| -rw-r--r-- | src/packrat-lexer.adb | 346 | ||||
| -rw-r--r-- | src/packrat-lexer.ads | 129 | ||||
| -rw-r--r-- | test/packrat-lexer-debug.adb | 80 | ||||
| -rw-r--r-- | test/packrat-lexer-debug.ads | 16 | ||||
| -rw-r--r-- | test/ratnest-tests.adb | 219 |
5 files changed, 478 insertions, 312 deletions
diff --git a/src/packrat-lexer.adb b/src/packrat-lexer.adb index 7cbd527..77ebf9f 100644 --- a/src/packrat-lexer.adb +++ b/src/packrat-lexer.adb @@ -13,32 +13,30 @@ package body Packrat.Lexer is procedure Initialize - (This : in out Combinator_Result) is + (This : in out Lexer_Context) is begin null; end Initialize; procedure Adjust - (This : in out Combinator_Result) is + (This : in out Lexer_Context) + is + New_Array : Element_Array_Access; begin - if This.Value /= null then - declare - New_Array : Element_Array_Access := - new Element_Array (1 .. This.Value.all'Length); - begin - New_Array.all := This.Value.all; - This.Value := New_Array; - end; + 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 Combinator_Result) is + (This : in out Lexer_Context) is begin - if This.Value /= null then - Free_Array (This.Value); + if This.Pass_Forward /= null then + Free_Array (This.Pass_Forward); end if; end Finalize; @@ -46,85 +44,46 @@ package body Packrat.Lexer is - function "=" - (Left, Right : in Combinator_Result) - return Boolean - is - Left_Valsize, Right_Valsize : Natural; + procedure Finalize + (This : in out Input_Container) is begin - if Left.Value = null then - Left_Valsize := 0; - else - Left_Valsize := Left.Value.all'Length; + if This.Dealloc then + Free_Array (This.Data); end if; - if Right.Value = null then - Right_Valsize := 0; - else - Right_Valsize := Right.Value.all'Length; - end if; - - return Left.Length = Right.Length and - Left.Status = Right.Status and - Left_Valsize = Right_Valsize and - (Left_Valsize = 0 or else Left.Value.all = Right.Value.all); - end "="; + 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 Create_Result - (Length : in Natural; - Status : in Result_Status; - Value : in Element_Array) - return Combinator_Result - is - This : Combinator_Result; - begin - This.Length := Length; - This.Status := Status; - This.Value := new Element_Array (1 .. Value'Length); - This.Value.all := Value; - return This; - end Create_Result; function Join (Left, Right : in Combinator_Result) - return Combinator_Result - is - Merge : Combinator_Result; - Left_Valsize, Right_Valsize, Total_Valsize : Natural; + return Combinator_Result is begin - if Left.Value /= null then - Left_Valsize := Left.Value.all'Length; - else - Left_Valsize := 0; - end if; - if Right.Value /= null then - Right_Valsize := Right.Value.all'Length; - else - Right_Valsize := 0; - end if; - Total_Valsize := Left_Valsize + Right_Valsize; - if Left.Status = Success or Left.Status = Optional_More then - Merge.Length := Left.Length + Right.Length; - Merge.Status := Right.Status; - if Total_Valsize > 0 then - Merge.Value := new Element_Array (1 .. Total_Valsize); - if Left.Value /= null then - Merge.Value.all (1 .. Left_Valsize) := Left.Value.all; - end if; - if Right.Value /= null then - Merge.Value.all (Left_Valsize + 1 .. Total_Valsize) := Right.Value.all; - end if; - end if; - return Merge; + return (Integer'Max (Left.Finish, Right.Finish), Right.Status); elsif Left.Status = Needs_More then - Merge := Left; - Merge.Status := Failure; - return Merge; + return (Left.Finish, Failure); else return Left; end if; @@ -134,33 +93,174 @@ package body Packrat.Lexer is - procedure Stamp + function Stamp (Input : in Element_Array; - Context : in out Lexer_Context) is + Context : in out Lexer_Context) + return Component_Result + is + Current_Result : Combinator_Result := + Combo (Input, Context.Position); begin - null; + if Context.Status /= Success or Context.Position > Input'Last or + Context.Empty_Labels.Contains (Label) + then + return Component_Failure; + end if; + + if (Current_Result.Status = Needs_More and not Context.Allow_Incomplete) or + Current_Result.Status = Failure + then + Context.Error_Labels.Append (Label); + return Component_Failure; + end if; + + if (Current_Result.Status = Optional_More and not Context.Allow_Incomplete) or + Current_Result.Status = Success + then + Context.Result_So_Far.Append (Gen_Tokens.Create + (Label, + Context.Position + Context.Offset, + Current_Result.Finish + Context.Offset, + Input (Context.Position .. Current_Result.Finish))); + if Current_Result.Finish = 0 then + Context.Empty_Labels.Insert (Label); + else + Context.Empty_Labels.Clear; + Context.Position := Current_Result.Finish + 1; + 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.Empty_Labels.Clear; + end if; + + Context.Error_Labels.Clear; + return Component_Success; end Stamp; - procedure Ignore + function Ignore (Input : in Element_Array; - Context : in out Lexer_Context) is + Context : in out Lexer_Context) + return Component_Result + is + Current_Result : Combinator_Result := + Combo (Input, Context.Position); begin - null; + if Context.Status /= Success or Context.Position > Input'Last or + Context.Empty_Labels.Contains (Label) + then + return Component_Failure; + end if; + + if (Current_Result.Status = Needs_More and not Context.Allow_Incomplete) or + Current_Result.Status = Failure + then + Context.Error_Labels.Append (Label); + return Component_Failure; + end if; + + if (Current_Result.Status = Optional_More and not Context.Allow_Incomplete) or + Current_Result.Status = Success + then + if Current_Result.Finish = 0 then + Context.Empty_Labels.Insert (Label); + else + Context.Empty_Labels.Clear; + Context.Position := Current_Result.Finish + 1; + 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.Empty_Labels.Clear; + end if; + + Context.Error_Labels.Clear; + return Component_Success; end Ignore; + procedure Tidy_Context + (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.Result_So_Far.Clear; + Details.Empty_Labels.Clear; + Details.Error_Labels.Clear; + Details.Error_Labels.Reserve_Capacity (Number_Comp); + + Details.Offset := Details.Offset + Details.Position - 1; + Details.Position := 1; + Details.Status := Success; + end Tidy_Context; + + + procedure Raise_Lexer_Error + (Label_List : in Label_Vectors.Vector; + Position : in Positive) + is + Error_Info_List : Errors.Error_Info_Array + (Label_List.First_Index .. Label_List.Last_Index); + begin + for I in Integer range Error_Info_List'First .. Error_Info_List'Last loop + Error_Info_List (I).Symbol := +Label_Enum'Image (Label_List.Element (I)); + Error_Info_List (I).Position := Position; + end loop; + raise Lexer_Error with Errors.Encode_Array (Error_Info_List); + end Raise_Lexer_Error; + + + function Token_Vector_To_Array + (Input_Vector : in Token_Vectors.Vector) + return Gen_Tokens.Token_Array + is + Result_Array : Gen_Tokens.Token_Array (1 .. Integer (Input_Vector.Length)); + begin + for I in Integer range 1 .. Integer (Input_Vector.Length) loop + Result_Array (I) := Input_Vector.Element (I); + end loop; + return Result_Array; + end Token_Vector_To_Array; + + function Scan (Input : in Element_Array; Context : in out Lexer_Context) return Gen_Tokens.Token_Array is - Result : Gen_Tokens.Token_Array (1 .. 0); + Real_Input : Input_Container := + Pass_Input (Context.Pass_Forward, Input'Unrestricted_Access); + Raise_Error : Boolean; begin - return Result; + Tidy_Context (Context, Components'Length); + Context.Allow_Incomplete := not (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; + + return Token_Vector_To_Array (Context.Result_So_Far); end Scan; @@ -169,14 +269,32 @@ package body Packrat.Lexer is Context : in out Lexer_Context) return Gen_Tokens.Token_Array is - Result : Gen_Tokens.Token_Array (1 .. 0); + Real_Input : Input_Container := + Pass_Input (Context.Pass_Forward, Input'Unrestricted_Access); + Raise_Error : Boolean; begin - return Result; + Tidy_Context (Context, Components'Length); + Context.Allow_Incomplete := False; + + 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; + + return Token_Vector_To_Array (Context.Result_So_Far); end Scan_Only; function Scan_With - (Input : in Lexer_With_Input; + (Input : in With_Input; Context : in out Lexer_Context) return Gen_Tokens.Token_Array is @@ -196,7 +314,7 @@ package body Packrat.Lexer is procedure Scan_Set_With - (Input : in Lexer_With_Input; + (Input : in With_Input; Context : in out Lexer_Context; Output : out Gen_Tokens.Token_Array) is begin @@ -212,7 +330,7 @@ package body Packrat.Lexer is Start : in Positive) return Combinator_Result is - Result : Combinator_Result := Create_Result (0, Success, Empty_Array); + Result : Combinator_Result := (0, Success); Position : Positive := Start; begin if Start > Input'Last then @@ -225,7 +343,7 @@ package body Packrat.Lexer is end if; Result := Join (Result, C (Input, Position)); exit when Result.Status = Failure; - Position := Start + Result.Length; + Position := Result.Finish + 1; end loop; return Result; end Sequence; @@ -236,7 +354,7 @@ package body Packrat.Lexer is Start : in Positive) return Combinator_Result is - Result : Combinator_Result := Create_Result (0, Success, Empty_Array); + Result : Combinator_Result := (0, Success); Position : Positive := Start; begin if Start > Input'Last then @@ -249,7 +367,7 @@ package body Packrat.Lexer is end if; Result := Join (Result, Param (Input, Position)); exit when Result.Status = Failure; - Position := Start + Result.Length; + Position := Result.Finish + 1; end loop; return Result; end Count; @@ -260,7 +378,7 @@ package body Packrat.Lexer is Start : in Positive) return Combinator_Result is - Result : Combinator_Result := Create_Result (0, Success, Empty_Array); + Result : Combinator_Result := (0, Success); Temp : Combinator_Result; Position : Positive := Start; Counter : Natural := 0; @@ -274,7 +392,7 @@ package body Packrat.Lexer is exit when Temp.Status = Failure or Temp.Status = Needs_More; Result := Join (Result, Temp); Counter := Counter + 1; - Position := Start + Result.Length; + Position := Result.Finish + 1; end loop; if Counter < Minimum then if Position > Input'Last or Temp.Status = Needs_More then @@ -296,7 +414,7 @@ package body Packrat.Lexer is Start : in Positive) return Combinator_Result is - Result : Combinator_Result := Create_Result (0, Success, Empty_Array); + Result : Combinator_Result := (0, Success); Temp : Combinator_Result; Position : Positive := Start; Counter : Natural := 0; @@ -310,7 +428,7 @@ package body Packrat.Lexer is exit when Temp.Status = Failure or Temp.Status = Needs_More or Test (Input (Position)); Result := Join (Result, Temp); Counter := Counter + 1; - Position := Start + Result.Length; + Position := Result.Finish + 1; end loop; if Counter < Minimum then if Position > Input'Last or Temp.Status = Needs_More then @@ -342,7 +460,7 @@ package body Packrat.Lexer is if Start > Input'Last then return Empty_Fail; elsif Test (Input (Start)) then - return Create_Result (1, Success, (1 => Input (Start))); + return (Start, Success); else return Empty_Fail; end if; @@ -357,7 +475,7 @@ package body Packrat.Lexer is if Start > Input'Last then return Empty_Fail; elsif Test (Change (Input (Start))) then - return Create_Result (1, Success, (1 => Input (Start))); + return (Start, Success); else return Empty_Fail; end if; @@ -372,7 +490,7 @@ package body Packrat.Lexer is if Start > Input'Last then return Empty_Fail; elsif Input (Start) = Item then - return Create_Result (1, Success, (1 => Item)); + return (Start, Success); else return Empty_Fail; end if; @@ -387,7 +505,7 @@ package body Packrat.Lexer is if Start > Input'Last then return Empty_Fail; elsif Change (Input (Start)) = Item then - return Create_Result (1, Success, (1 => Input (Start))); + return (Start, Success); else return Empty_Fail; end if; @@ -402,7 +520,7 @@ package body Packrat.Lexer is Current_Offset : Natural := 0; begin if Items'Length = 0 then - return Create_Result (0, Success, Empty_Array); + return (0, Success); end if; if Input'Last - Start + 1 <= 0 then @@ -411,13 +529,17 @@ package body Packrat.Lexer is while Input (Start + Current_Offset) = Items (Items'First + Current_Offset) loop if Items'First + Current_Offset = Items'Last then - return Create_Result (Current_Offset + 1, Success, Items); + return (Start + Current_Offset, Success); elsif Start + Current_Offset = Input'Last then - return Create_Result (Current_Offset + 1, Needs_More, Input (Start .. Input'Last)); + return (Start + Current_Offset, Needs_More); end if; Current_Offset := Current_Offset + 1; end loop; - return Create_Result (Current_Offset, Failure, Input (Start .. Start + Current_Offset - 1)); + if Current_Offset = 0 then + return Empty_Fail; + else + return (Start + Current_Offset - 1, Failure); + end if; end Multimatch; @@ -429,9 +551,9 @@ package body Packrat.Lexer is if Start > Input'Last then return Empty_Fail; elsif Start + Number - 1 > Input'Last then - return Create_Result (Input'Last - Start + 1, Needs_More, Input (Start .. Input'Last)); + return (Input'Last, Needs_More); else - return Create_Result (Number, Success, Input (Start .. Start + Number - 1)); + return (Start + Number - 1, Success); end if; end Take; @@ -455,7 +577,7 @@ package body Packrat.Lexer is else Status := Success; end if; - return Create_Result (Finish - Start, Status, Input (Start .. Finish - 1)); + return (Finish - 1, Status); end Take_While; @@ -478,7 +600,7 @@ package body Packrat.Lexer is else Status := Success; end if; - return Create_Result (Finish - Start, Status, Input (Start .. Finish - 1)); + return (Finish - 1, Status); end Take_Until; @@ -493,7 +615,7 @@ package body Packrat.Lexer is if Start > Input'Last then return Empty_Fail; elsif Input (Start) = EOL_Item then - return Create_Result (1, Success, (1 => EOL_Item)); + return (Start, Success); else return Empty_Fail; end if; @@ -508,7 +630,7 @@ package body Packrat.Lexer is if Start > Input'Last then return Empty_Fail; elsif Input (Start) = EOF_Item then - return Create_Result (1, Success, (1 => EOF_Item)); + return (Start, Success); else return Empty_Fail; end if; diff --git a/src/packrat-lexer.ads b/src/packrat-lexer.ads index 2d152bf..0cd5c78 100644 --- a/src/packrat-lexer.ads +++ b/src/packrat-lexer.ads @@ -2,7 +2,8 @@ private with - Ada.Containers.Vectors; + Ada.Containers.Vectors, + Ada.Containers.Ordered_Sets; generic @@ -16,7 +17,7 @@ generic package Packrat.Lexer is - type Combinator_Result is new Ada.Finalization.Controlled with private; + type Combinator_Result is private; type Combinator is access function (Input : in Element_Array; @@ -25,10 +26,6 @@ package Packrat.Lexer is type Combinator_Array is array (Positive range <>) of Combinator; - function "=" - (Left, Right : in Combinator_Result) - return Boolean; - @@ -39,16 +36,19 @@ package Packrat.Lexer is - type Lexer_Component is access procedure + type Component_Result is private; + + type Component is access function (Input : in Element_Array; - Context : in out Lexer_Context); + Context : in out Lexer_Context) + return Component_Result; - type Component_Array is array (Positive range <>) of Lexer_Component; + type Component_Array is array (Positive range <>) of Component; - type Lexer_With_Input is access function + type With_Input is access function return Element_Array; @@ -60,9 +60,10 @@ package Packrat.Lexer is (Input : in Element_Array; Start : in Positive) return Combinator_Result; - procedure Stamp + function Stamp (Input : in Element_Array; - Context : in out Lexer_Context); + Context : in out Lexer_Context) + return Component_Result; generic Label : in Label_Enum; @@ -70,9 +71,10 @@ package Packrat.Lexer is (Input : in Element_Array; Start : in Positive) return Combinator_Result; - procedure Ignore + function Ignore (Input : in Element_Array; - Context : in out Lexer_Context); + Context : in out Lexer_Context) + return Component_Result; @@ -94,7 +96,7 @@ package Packrat.Lexer is generic Components : in Component_Array; function Scan_With - (Input : in Lexer_With_Input; + (Input : in With_Input; Context : in out Lexer_Context) return Gen_Tokens.Token_Array; @@ -112,7 +114,7 @@ package Packrat.Lexer is Pad_In : in Element; Pad_Out : in Gen_Tokens.Token; procedure Scan_Set_With - (Input : in Lexer_With_Input; + (Input : in With_Input; Context : in out Lexer_Context; Output : out Gen_Tokens.Token_Array); @@ -256,55 +258,96 @@ package Packrat.Lexer is private - type Element_Array_Access is access Element_Array; + package Token_Vectors is new Ada.Containers.Vectors + (Index_Type => Positive, + Element_Type => Gen_Tokens.Token, + "=" => Gen_Tokens."="); + + + + + type Element_Array_Access is access all Element_Array; Empty_Array : Element_Array (1 .. 0); - type Combinator_Result is new Ada.Finalization.Controlled with record - Length : Natural; + 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); + + + + + type Combinator_Result is record + Finish : Natural; Status : Result_Status; - Value : Element_Array_Access; end record; - overriding procedure Initialize - (This : in out Combinator_Result); + Empty_Fail : constant Combinator_Result := + (Finish => 0, + Status => Failure); - overriding procedure Adjust - (This : in out Combinator_Result); - overriding procedure Finalize - (This : in out Combinator_Result); - Empty_Fail : constant Combinator_Result := - (Ada.Finalization.Controlled with - Length => 0, - Status => Failure, - Value => null); + type Component_Result is (Component_Failure, Component_Success); - package Token_Vectors is new Ada.Containers.Vectors - (Index_Type => Positive, - Element_Type => Gen_Tokens.Token, - "=" => Gen_Tokens."="); type Lexer_Context is new Ada.Finalization.Controlled with record - Result_So_Far : Token_Vectors.Vector; - Position : Positive; - Status : Result_Status; - Pass_Forward : Element_Array_Access; + Result_So_Far : Token_Vectors.Vector; + Position : Positive; + Offset : Natural; + Status : Result_Status; + Pass_Forward : Element_Array_Access; + 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, - Status => Success, - Pass_Forward => null); + Result_So_Far => Token_Vectors.Empty_Vector, + Position => 1, + Offset => 0, + Status => Success, + Pass_Forward => null, + 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/test/packrat-lexer-debug.adb b/test/packrat-lexer-debug.adb index 335e3d2..d4cc2e2 100644 --- a/test/packrat-lexer-debug.adb +++ b/test/packrat-lexer-debug.adb @@ -4,57 +4,22 @@ package body Packrat.Lexer.Debug is function Create_Result - (Length : in Natural; - Status : in Result_Status; - Value : in Element_Array) - return Combinator_Result - is - This : Combinator_Result; + (Finish : in Natural; + Status : in Result_Status) + return Combinator_Result is begin - This.Length := Length; - This.Status := Status; - This.Value := new Element_Array (1 .. Value'Length); - This.Value.all := Value; - return This; + return (Finish, Status); end Create_Result; function Join (Left, Right : in Combinator_Result) - return Combinator_Result - is - Merge : Combinator_Result; - Left_Valsize, Right_Valsize, Total_Valsize : Natural; + return Combinator_Result is begin - if Left.Value /= null then - Left_Valsize := Left.Value.all'Length; - else - Left_Valsize := 0; - end if; - if Right.Value /= null then - Right_Valsize := Right.Value.all'Length; - else - Right_Valsize := 0; - end if; - Total_Valsize := Left_Valsize + Right_Valsize; - if Left.Status = Success or Left.Status = Optional_More then - Merge.Length := Left.Length + Right.Length; - Merge.Status := Right.Status; - if Total_Valsize > 0 then - Merge.Value := new Element_Array (1 .. Total_Valsize); - if Left.Value /= null then - Merge.Value.all (1 .. Left_Valsize) := Left.Value.all; - end if; - if Right.Value /= null then - Merge.Value.all (Left_Valsize + 1 .. Total_Valsize) := Right.Value.all; - end if; - end if; - return Merge; + return Right; elsif Left.Status = Needs_More then - Merge := Left; - Merge.Status := Failure; - return Merge; + return (Left.Finish, Failure); else return Left; end if; @@ -71,18 +36,10 @@ package body Packrat.Lexer.Debug is function Debug_String (This : in Combinator_Result) - return String - is - Value_Length : Natural; + return String is begin - if This.Value = null then - Value_Length := 0; - else - Value_Length := This.Value.all'Length; - end if; - return Integer'Image (This.Length) - & " " & Result_Status'Image (This.Status) - & " " & Integer'Image (Value_Length); + return Integer'Image (This.Finish) + & " " & Result_Status'Image (This.Status); end Debug_String; @@ -133,6 +90,23 @@ package body Packrat.Lexer.Debug is end Element; + + + function Is_Failure + (Result : in Component_Result) + return Boolean is + begin + return Result = Component_Failure; + end Is_Failure; + + function Is_Success + (Result : in Component_Result) + return Boolean is + begin + return Result = Component_Success; + end Is_Success; + + end Packrat.Lexer.Debug; diff --git a/test/packrat-lexer-debug.ads b/test/packrat-lexer-debug.ads index 77614aa..a1cb768 100644 --- a/test/packrat-lexer-debug.ads +++ b/test/packrat-lexer-debug.ads @@ -13,9 +13,8 @@ package Packrat.Lexer.Debug is function Create_Result - (Length : in Natural; - Status : in Result_Status; - Value : in Element_Array) + (Finish : in Natural; + Status : in Result_Status) return Combinator_Result; function Join @@ -61,6 +60,17 @@ package Packrat.Lexer.Debug is return Gen_Tokens.Token; + + + function Is_Failure + (Result : in Component_Result) + return Boolean; + + function Is_Success + (Result : in Component_Result) + return Boolean; + + private diff --git a/test/ratnest-tests.adb b/test/ratnest-tests.adb index 9a493da..d5c150e 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; + Packrat.Util, Ada.Text_IO; package body Ratnest.Tests is @@ -251,36 +251,38 @@ package body Ratnest.Tests is function Join_Check return Test_Result is - One : Slexy.Combinator_Result := - Slebug.Create_Result (1, Packrat.Success, "a"); - Two : Slexy.Combinator_Result := - Slebug.Create_Result (2, Packrat.Success, "bc"); - Three : Slexy.Combinator_Result := - Slebug.Create_Result (3, Packrat.Success, "abc"); - - Four : Slexy.Combinator_Result := - Slebug.Create_Result (3, Packrat.Failure, "xyz"); - Five : Slexy.Combinator_Result := - Slebug.Create_Result (4, Packrat.Failure, "axyz"); - - Six : Slexy.Combinator_Result := - Slebug.Create_Result (4, Packrat.Needs_More, "cd"); - Seven : Slexy.Combinator_Result := - Slebug.Create_Result (5, Packrat.Needs_More, "acd"); - - Eight : Slexy.Combinator_Result := - Slebug.Create_Result (4, Packrat.Failure, "cd"); - - Nine : Slexy.Combinator_Result := - Slebug.Create_Result (3, Packrat.Optional_More, "abc"); - Ten : Slexy.Combinator_Result := - Slebug.Create_Result (5, Packrat.Success, "abcbc"); + One : Slexy.Combinator_Result := + Slebug.Create_Result (1, Packrat.Success); + Two : Slexy.Combinator_Result := + Slebug.Create_Result (3, Packrat.Success); + Three : Slexy.Combinator_Result := + Slebug.Create_Result (3, Packrat.Success); + + Four : Slexy.Combinator_Result := + Slebug.Create_Result (4, Packrat.Failure); + Five : Slexy.Combinator_Result := + Slebug.Create_Result (4, Packrat.Failure); + + Six : Slexy.Combinator_Result := + Slebug.Create_Result (3, Packrat.Needs_More); + Seven : Slexy.Combinator_Result := + Slebug.Create_Result (3, Packrat.Needs_More); + + Eight : Slexy.Combinator_Result := + Slebug.Create_Result (3, Packrat.Failure); + + Nine : Slexy.Combinator_Result := + Slebug.Create_Result (3, Packrat.Optional_More); + Ten : Slexy.Combinator_Result := + Slebug.Create_Result (5, Packrat.Success); + Eleven : Slexy.Combinator_Result := + Slebug.Create_Result (5, Packrat.Success); begin if Slebug.Join (One, Two) /= Three or Slebug.Join (One, Four) /= Five or Slebug.Join (One, Six) /= Seven or Slebug.Join (Four, Six) /= Four or Slebug.Join (Five, Two) /= Five or Slebug.Join (Six, Three) /= Eight or Slebug.Join (Slebug.Empty_Fail, One) /= Slebug.Empty_Fail or - Slebug.Join (Nine, Two) /= Ten + Slebug.Join (Nine, Ten) /= Eleven then return Fail; end if; @@ -292,9 +294,9 @@ package body Ratnest.Tests is return Test_Result is One : Slexy.Combinator_Result := - Slebug.Create_Result (3, Packrat.Success, "abc"); + Slebug.Create_Result (3, Packrat.Success); Two : Slexy.Combinator_Result := - Slebug.Create_Result (0, Packrat.Failure, ""); + Slebug.Create_Result (0, Packrat.Failure); begin if One = Two or Two /= Slebug.Empty_Fail then return Fail; @@ -320,14 +322,14 @@ package body Ratnest.Tests is Test_Str : String := "aababcabcab"; Result1 : Slexy.Combinator_Result := - Slebug.Create_Result (1, Packrat.Failure, "a"); + Slebug.Create_Result (1, Packrat.Failure); Result2 : Slexy.Combinator_Result := - Slebug.Create_Result (2, Packrat.Needs_More, "ab"); + Slebug.Create_Result (11, Packrat.Needs_More); Result3 : Slexy.Combinator_Result := - Slebug.Create_Result (3, Packrat.Success, "abc"); + Slebug.Create_Result (6, Packrat.Success); Result4 : Slexy.Combinator_Result := Slebug.Empty_Fail; Result5 : Slexy.Combinator_Result := - Slebug.Create_Result (2, Packrat.Failure, "ab"); + Slebug.Create_Result (3, Packrat.Failure); begin if Seq_Abc (Test_Str, 1) /= Result1 or Seq_Abc (Test_Str, 2) /= Result5 or Seq_Abc (Test_Str, 4) /= Result3 or Seq_Abc (Test_Str, 10) /= Result2 or @@ -351,15 +353,15 @@ package body Ratnest.Tests is Test_Str : String := "abaabbaaabbbaaaabbbb"; Result1 : Slexy.Combinator_Result := - Slebug.Create_Result (1, Packrat.Failure, "a"); + Slebug.Create_Result (1, Packrat.Failure); Result2 : Slexy.Combinator_Result := - Slebug.Create_Result (2, Packrat.Success, "aa"); + Slebug.Create_Result (4, Packrat.Success); Result3 : Slexy.Combinator_Result := - Slebug.Create_Result (1, Packrat.Failure, "b"); + Slebug.Create_Result (2, Packrat.Failure); Result4 : Slexy.Combinator_Result := - Slebug.Create_Result (2, Packrat.Needs_More, "bb"); + Slebug.Create_Result (20, Packrat.Needs_More); Result5 : Slexy.Combinator_Result := - Slebug.Create_Result (3, Packrat.Success, "bbb"); + Slebug.Create_Result (12, Packrat.Success); Result6 : Slexy.Combinator_Result := Slebug.Empty_Fail; begin if Count_2A (Test_Str, 1) /= Result1 or Count_2A (Test_Str, 3) /= Result2 or @@ -394,22 +396,22 @@ package body Ratnest.Tests is Test_Str2 : String := "aababcabcab"; Result1 : Slexy.Combinator_Result := - Slebug.Create_Result (3, Packrat.Success, "aaa"); + Slebug.Create_Result (3, Packrat.Success); Result2 : Slexy.Combinator_Result := - Slebug.Create_Result (2, Packrat.Optional_More, "aa"); + Slebug.Create_Result (13, Packrat.Optional_More); Result3 : Slexy.Combinator_Result := - Slebug.Create_Result (5, Packrat.Success, "aaaaa"); + Slebug.Create_Result (10, Packrat.Success); Result4 : Slexy.Combinator_Result := - Slebug.Create_Result (3, Packrat.Failure, "aaa"); + Slebug.Create_Result (3, Packrat.Failure); Result5 : Slexy.Combinator_Result := Slebug.Empty_Fail; Result6 : Slexy.Combinator_Result := - Slebug.Create_Result (2, Packrat.Needs_More, "aa"); + Slebug.Create_Result (13, Packrat.Needs_More); Result7 : Slexy.Combinator_Result := - Slebug.Create_Result (0, Packrat.Success, ""); + Slebug.Create_Result (0, Packrat.Success); Result8 : Slexy.Combinator_Result := - Slebug.Create_Result (6, Packrat.Optional_More, "abcabc"); + Slebug.Create_Result (9, Packrat.Optional_More); Result9 : Slexy.Combinator_Result := - Slebug.Create_Result (6, Packrat.Needs_More, "abcabc"); + Slebug.Create_Result (9, Packrat.Needs_More); begin if Many_0 (Test_Str, 1) /= Result1 or Many_4 (Test_Str, 1) /= Result4 or Many_4 (Test_Str, 6) /= Result3 or Many_0 (Test_Str, 4) /= Result7 or @@ -433,11 +435,11 @@ package body Ratnest.Tests is Test_Str : String := "aaaabbaaa123aaa"; Result1 : Slexy.Combinator_Result := - Slebug.Create_Result (4, Packrat.Failure, "aaaa"); + Slebug.Create_Result (4, Packrat.Failure); Result2 : Slexy.Combinator_Result := - Slebug.Create_Result (3, Packrat.Success, "aaa"); + Slebug.Create_Result (9, Packrat.Success); Result3 : Slexy.Combinator_Result := - Slebug.Create_Result (3, Packrat.Needs_More, "aaa"); + Slebug.Create_Result (15, Packrat.Needs_More); Result4 : Slexy.Combinator_Result := Slebug.Empty_Fail; begin if Many_Until_0 (Test_Str, 1) /= Result1 or @@ -476,9 +478,9 @@ package body Ratnest.Tests is Test_Str : String := "abc123456def"; Result1 : Slexy.Combinator_Result := - Slebug.Create_Result (1, Packrat.Success, "b"); + Slebug.Create_Result (2, Packrat.Success); Result2 : Slexy.Combinator_Result := - Slebug.Create_Result (1, Packrat.Success, "3"); + Slebug.Create_Result (6, Packrat.Success); Result3 : Slexy.Combinator_Result := Slebug.Empty_Fail; begin if Satisfy_123 (Test_Str, 6) /= Result2 or @@ -520,9 +522,9 @@ package body Ratnest.Tests is Test_Str : String := "abcde12345"; Result1 : Slexy.Combinator_Result := - Slebug.Create_Result (1, Packrat.Success, "c"); + Slebug.Create_Result (3, Packrat.Success); Result2 : Slexy.Combinator_Result := - Slebug.Create_Result (1, Packrat.Success, "2"); + Slebug.Create_Result (7, Packrat.Success); Result3 : Slexy.Combinator_Result := Slebug.Empty_Fail; begin if Satisfy_Bcd (Test_Str, 3) /= Result1 or @@ -546,11 +548,11 @@ package body Ratnest.Tests is Test_Str : String := "abc1234./5"; Result1 : Slexy.Combinator_Result := - Slebug.Create_Result (1, Packrat.Success, "a"); + Slebug.Create_Result (1, Packrat.Success); Result2 : Slexy.Combinator_Result := - Slebug.Create_Result (1, Packrat.Success, "/"); + Slebug.Create_Result (9, Packrat.Success); Result3 : Slexy.Combinator_Result := - Slebug.Create_Result (1, Packrat.Success, "4"); + Slebug.Create_Result (7, Packrat.Success); Result4 : Slexy.Combinator_Result := Slebug.Empty_Fail; begin if Match_A (Test_Str, 1) /= Result1 or @@ -581,9 +583,9 @@ package body Ratnest.Tests is Test_Str : String := "abc5678"; Result1 : Slexy.Combinator_Result := - Slebug.Create_Result (1, Packrat.Success, "a"); + Slebug.Create_Result (1, Packrat.Success); Result2 : Slexy.Combinator_Result := - Slebug.Create_Result (1, Packrat.Success, "6"); + Slebug.Create_Result (5, Packrat.Success); Result3 : Slexy.Combinator_Result := Slebug.Empty_Fail; begin if Match_A (Test_Str, 1) /= Result1 or @@ -606,13 +608,13 @@ package body Ratnest.Tests is Test_Str : String := "abcdefabhelloworldab"; Result1 : Slexy.Combinator_Result := - Slebug.Create_Result (3, Packrat.Success, "abc"); + Slebug.Create_Result (3, Packrat.Success); Result2 : Slexy.Combinator_Result := - Slebug.Create_Result (2, Packrat.Needs_More, "ab"); + Slebug.Create_Result (20, Packrat.Needs_More); Result3 : Slexy.Combinator_Result := - Slebug.Create_Result (5, Packrat.Success, "hello"); + Slebug.Create_Result (13, Packrat.Success); Result4 : Slexy.Combinator_Result := - Slebug.Create_Result (2, Packrat.Failure, "ab"); + Slebug.Create_Result (8, Packrat.Failure); Result5 : Slexy.Combinator_Result := Slebug.Empty_Fail; begin if Match_String1 (Test_Str, 1) /= Result1 or @@ -637,11 +639,11 @@ package body Ratnest.Tests is Test_Str : String := "abcdefghi"; Result1 : Slexy.Combinator_Result := - Slebug.Create_Result (1, Packrat.Success, "b"); + Slebug.Create_Result (2, Packrat.Success); Result2 : Slexy.Combinator_Result := - Slebug.Create_Result (3, Packrat.Needs_More, "ghi"); + Slebug.Create_Result (9, Packrat.Needs_More); Result3 : Slexy.Combinator_Result := - Slebug.Create_Result (5, Packrat.Success, "cdefg"); + Slebug.Create_Result (7, Packrat.Success); Result4 : Slexy.Combinator_Result := Slebug.Empty_Fail; begin if Take_1 (Test_Str, 2) /= Result1 or Take_5 (Test_Str, 7) /= Result2 or @@ -664,16 +666,16 @@ package body Ratnest.Tests is Test_Str : String := "abcde,./;'fghi[]=-^563"; Result1 : Slexy.Combinator_Result := - Slebug.Create_Result (4, Packrat.Success, "bcde"); + Slebug.Create_Result (5, Packrat.Success); Result2 : Slexy.Combinator_Result := - Slebug.Create_Result (2, Packrat.Success, "hi"); + Slebug.Create_Result (14, Packrat.Success); Result3 : Slexy.Combinator_Result := - Slebug.Create_Result (5, Packrat.Success, ",./;'"); + Slebug.Create_Result (10, Packrat.Success); Result4 : Slexy.Combinator_Result := - Slebug.Create_Result (3, Packrat.Success, "=-^"); + Slebug.Create_Result (19, Packrat.Success); Result5 : Slexy.Combinator_Result := Slebug.Empty_Fail; Result6 : Slexy.Combinator_Result := - Slebug.Create_Result (3, Packrat.Optional_More, "563"); + Slebug.Create_Result (22, Packrat.Optional_More); begin if Take_Letters (Test_Str, 2) /= Result1 or Take_Letters (Test_Str, 13) /= Result2 or @@ -698,13 +700,13 @@ package body Ratnest.Tests is Test_Str : String := "abcde12345;;;fghi67"; Result1 : Slexy.Combinator_Result := - Slebug.Create_Result (7, Packrat.Success, "de12345"); + Slebug.Create_Result (10, Packrat.Success); Result2 : Slexy.Combinator_Result := - Slebug.Create_Result (4, Packrat.Optional_More, "hi67"); + Slebug.Create_Result (19, Packrat.Optional_More); Result3 : Slexy.Combinator_Result := - Slebug.Create_Result (5, Packrat.Success, "abcde"); + Slebug.Create_Result (5, Packrat.Success); Result4 : Slexy.Combinator_Result := - Slebug.Create_Result (6, Packrat.Success, ";;fghi"); + Slebug.Create_Result (17, Packrat.Success); Result5 : Slexy.Combinator_Result := Slebug.Empty_Fail; begin if Take_Till_Punch (Test_Str, 4) /= Result1 or @@ -729,9 +731,9 @@ package body Ratnest.Tests is Test_Str : String := "abcd" & Latin.LF & "e"; Result1 : Slexy.Combinator_Result := - Slebug.Create_Result (1, Packrat.Success, (1 => Latin.LF)); + Slebug.Create_Result (5, Packrat.Success); Result2 : Slexy.Combinator_Result := - Slebug.Create_Result (1, Packrat.Success, "c"); + Slebug.Create_Result (3, Packrat.Success); Result3 : Slexy.Combinator_Result := Slebug.Empty_Fail; begin if LF_End (Test_Str, 5) /= Result1 or C_End (Test_Str, 3) /= Result2 or @@ -752,9 +754,9 @@ package body Ratnest.Tests is Test_Str : String := "abcde"; Result1 : Slexy.Combinator_Result := - Slebug.Create_Result (1, Packrat.Success, "e"); + Slebug.Create_Result (5, Packrat.Success); Result2 : Slexy.Combinator_Result := - Slebug.Create_Result (1, Packrat.Success, "c"); + Slebug.Create_Result (3, Packrat.Success); Result3 : Slexy.Combinator_Result := Slebug.Empty_Fail; begin if C_End (Test_Str, 3) /= Result2 or E_End (Test_Str, 5) /= Result1 or @@ -775,6 +777,7 @@ package body Ratnest.Tests is is use type String_Tokens.Token; use type Packrat.Result_Status; + use type Slexy.Component_Result; function Match_A is new Slexy.Match ('a'); function Match_B is new Slexy.Match ('b'); @@ -783,15 +786,17 @@ package body Ratnest.Tests is ((Match_A'Unrestricted_Access, Match_B'Unrestricted_Access, Match_C'Unrestricted_Access)); - procedure My_Stamp is new Slexy.Stamp (One, Seq_Abc); + function My_Stamp is new Slexy.Stamp (One, Seq_Abc); Test_Str1 : String := "abcdefghi"; Test_Str2 : String := "ab"; Context1 : Slexy.Lexer_Context := Slexy.Empty_Context; Context2 : Slexy.Lexer_Context := Slexy.Empty_Context; + + Comp_Code : Slexy.Component_Result; begin - My_Stamp (Test_Str1, Context1); + Comp_Code := My_Stamp (Test_Str1, Context1); if (Slebug.So_Far (Context1).Length /= 1 or else Slebug.So_Far (Context1).Element (1) /= String_Tokens.Create (One, 1, 3, "abc")) or Slebug.Position (Context1) /= 4 or Slebug.Status (Context1) /= Packrat.Success or @@ -799,15 +804,15 @@ package body Ratnest.Tests is then return Fail; end if; - My_Stamp (Test_Str1, Context1); + Comp_Code := My_Stamp (Test_Str1, Context1); if (Slebug.So_Far (Context1).Length /= 1 or else Slebug.So_Far (Context1).Element (1) /= String_Tokens.Create (One, 1, 3, "abc")) or - Slebug.Position (Context1) /= 4 or Slebug.Status (Context1) /= Packrat.Failure or + Slebug.Position (Context1) /= 4 or not Slebug.Is_Failure (Comp_Code) or Slebug.Pass (Context1) /= null then return Fail; end if; - My_Stamp (Test_Str2, Context2); + Comp_Code := My_Stamp (Test_Str2, Context2); if Slebug.So_Far (Context2).Length /= 0 or Slebug.Position (Context2) /= 1 or Slebug.Status (Context2) /= Packrat.Needs_More or @@ -825,29 +830,31 @@ package body Ratnest.Tests is use type Packrat.Result_Status; function Match_Abc is new Slexy.Multimatch ("abc"); - procedure My_Ignore is new Slexy.Ignore (Two, Match_Abc); + function My_Ignore is new Slexy.Ignore (Two, Match_Abc); Test_Str1 : String := "abcdefghi"; Test_Str2 : String := "ab"; Context1 : Slexy.Lexer_Context := Slexy.Empty_Context; Context2 : Slexy.Lexer_Context := Slexy.Empty_Context; + + Comp_Code : Slexy.Component_Result; begin - My_Ignore (Test_Str1, Context1); + Comp_Code := My_Ignore (Test_Str1, Context1); if Slebug.So_Far (Context1).Length /= 0 or Slebug.Position (Context1) /= 4 or Slebug.Status (Context1) /= Packrat.Success or Slebug.Pass (Context1) /= null then return Fail; end if; - My_Ignore (Test_Str1, Context1); + Comp_Code := My_Ignore (Test_Str1, Context1); if Slebug.So_Far (Context1).Length /= 0 or - Slebug.Position (Context1) /= 4 or Slebug.Status (Context1) /= Packrat.Failure or + Slebug.Position (Context1) /= 4 or not Slebug.Is_Failure (Comp_Code) or Slebug.Pass (Context1) /= null then return Fail; end if; - My_Ignore (Test_Str2, Context2); + Comp_Code := My_Ignore (Test_Str2, Context2); if Slebug.So_Far (Context2).Length /= 0 or Slebug.Position (Context2) /= 1 or Slebug.Status (Context2) /= Packrat.Needs_More or (Slebug.Pass (Context2) = null or else Slebug.Pass (Context2).all /= "ab") @@ -875,8 +882,8 @@ package body Ratnest.Tests is function Satisfy_Whitespace is new Swordy.Satisfy (PU.Is_Whitespace); function Many_Whitespace is new Swordy.Many (Satisfy_Whitespace, 1); - procedure Stamp_Word is new Swordy.Stamp (Word, Many_Letter); - procedure Ignore_Whitespace is new Swordy.Ignore (Whitespace, Many_Whitespace); + function Stamp_Word is new Swordy.Stamp (Word, Many_Letter); + function Ignore_Whitespace is new Swordy.Ignore (Whitespace, Many_Whitespace); function Scan_Check @@ -900,6 +907,12 @@ 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; @@ -1075,13 +1088,14 @@ package body Ratnest.Tests is Test_Str : String := "()()"; Test_Context : Swordy.Lexer_Context := Swordy.Empty_Context; - Result : Word_Tokens.Token_Array := - My_Scan (Test_Str, Test_Context); - Expected_Errors : Packrat.Errors.Error_Info_Array := ((+"WORD", 1), (+"WHITESPACE", 1)); begin - return Fail; + declare + Result : Word_Tokens.Token_Array := My_Scan (Test_Str, Test_Context); + begin + return Fail; + end; exception when Msg : Packrat.Lexer_Error => if Packrat.Errors.Decode (Except.Exception_Message (Msg)) /= Expected_Errors then @@ -1102,13 +1116,14 @@ package body Ratnest.Tests is Test_Str : String := "()()"; Test_Context : Swordy.Lexer_Context := Swordy.Empty_Context; - Result : Word_Tokens.Token_Array := - My_Scan (Test_Str, Test_Context); - Expected_Errors : Packrat.Errors.Error_Info_Array := ((+"WORD", 1), (+"WHITESPACE", 1)); begin - return Fail; + declare + Result : Word_Tokens.Token_Array := My_Scan (Test_Str, Test_Context); + begin + return Fail; + end; exception when Msg : Packrat.Lexer_Error => if Packrat.Errors.Decode (Except.Exception_Message (Msg)) /= Expected_Errors then @@ -1140,13 +1155,15 @@ package body Ratnest.Tests is Test_Context : Swordy.Lexer_Context := Swordy.Empty_Context; - Result : Word_Tokens.Token_Array := - My_Scan (Get_Input'Unrestricted_Access, Test_Context); - Expected_Errors : Packrat.Errors.Error_Info_Array := ((+"WORD", 1), (+"WHITESPACE", 1)); begin - return Fail; + declare + Result : Word_Tokens.Token_Array := + My_Scan (Get_Input'Unrestricted_Access, Test_Context); + begin + return Fail; + end; exception when Msg : Packrat.Lexer_Error => if Packrat.Errors.Decode (Except.Exception_Message (Msg)) /= Expected_Errors then |