From a21cc8153592700ae7cb2cdfbb24b377e096a22a Mon Sep 17 00:00:00 2001 From: Jed Barber Date: Fri, 4 Dec 2020 20:17:43 +1100 Subject: Scan/Parse functions are now packages, tests broken with linker errors --- example/sentence.adb | 27 ++- src/packrat-lexers.adb | 456 +++++++++++++++++++++++------------------- src/packrat-lexers.ads | 123 +++++++----- src/packrat-parsers.adb | 167 +++++++++------- src/packrat-parsers.ads | 47 +++-- test/packrat-lexers-debug.ads | 4 + test/rat_tests-lexers.adb | 86 ++++---- test/rat_tests-lexers.ads | 16 +- 8 files changed, 509 insertions(+), 417 deletions(-) diff --git a/example/sentence.adb b/example/sentence.adb index 288deeb..f522b5f 100644 --- a/example/sentence.adb +++ b/example/sentence.adb @@ -33,29 +33,26 @@ procedure Sentence is function Many_Blank is new My_Rat.Lexers.Many (Sat_Blank, 1); function Whitespace is new My_Rat.Lexers.Ignore (Whitespace, Many_Blank); - function Scanner is new My_Rat.Lexers.Scan_Only ((Word'Access, Whitespace'Access)); + package Scanner is new My_Rat.Lexers.Scan_Once ((Word'Access, Whitespace'Access)); - function Is_I is new My_Rat.Lexer_Tokens.Is_Value ("i"); - function Is_Saw is new My_Rat.Lexer_Tokens.Is_Value ("saw"); - function Is_A is new My_Rat.Lexer_Tokens.Is_Value ("a"); - function Is_Man is new My_Rat.Lexer_Tokens.Is_Value ("man"); function Is_In is new My_Rat.Lexer_Tokens.Is_Value ("in"); - function Is_The is new My_Rat.Lexer_Tokens.Is_Value ("the"); - function Is_Park is new My_Rat.Lexer_Tokens.Is_Value ("park"); function Is_With is new My_Rat.Lexer_Tokens.Is_Value ("with"); - function Is_Bat is new My_Rat.Lexer_Tokens.Is_Value ("bat"); - function Sat_In is new My_Rat.Parsers.Satisfy (Is_In); function Sat_With is new My_Rat.Parsers.Satisfy (Is_With); function Prep_Choice is new My_Rat.Parsers.Choice ((Sat_In'Access, Sat_With'Access)); function Prep is new My_Rat.Parsers.Stamp (Prep, Prep_Choice); + function Is_Saw is new My_Rat.Lexer_Tokens.Is_Value ("saw"); function Sat_Saw is new My_Rat.Parsers.Satisfy (Is_Saw); function Verb is new My_Rat.Parsers.Stamp (Verb, Sat_Saw); + function Is_I is new My_Rat.Lexer_Tokens.Is_Value ("i"); + function Is_Man is new My_Rat.Lexer_Tokens.Is_Value ("man"); + function Is_Park is new My_Rat.Lexer_Tokens.Is_Value ("park"); + function Is_Bat is new My_Rat.Lexer_Tokens.Is_Value ("bat"); function Sat_I is new My_Rat.Parsers.Satisfy (Is_I); function Sat_Man is new My_Rat.Parsers.Satisfy (Is_Man); function Sat_Park is new My_Rat.Parsers.Satisfy (Is_Park); @@ -64,11 +61,14 @@ procedure Sentence is ((Sat_I'Access, Sat_Man'Access, Sat_Park'Access, Sat_Bat'Access)); function Noun is new My_Rat.Parsers.Stamp (Noun, Noun_Choice); + function Is_A is new My_Rat.Lexer_Tokens.Is_Value ("a"); + function Is_The is new My_Rat.Lexer_Tokens.Is_Value ("the"); function Sat_A is new My_Rat.Parsers.Satisfy (Is_A); function Sat_The is new My_Rat.Parsers.Satisfy (Is_The); function Det_Choice is new My_Rat.Parsers.Choice ((Sat_A'Access, Sat_The'Access)); function Det is new My_Rat.Parsers.Stamp (Det, Det_Choice); + -- These redirectors are needed to resolve circular references in the instantiations. package NP_Redir is new My_Rat.Parsers.Redirect; package S_Redir is new My_Rat.Parsers.Redirect; @@ -89,15 +89,12 @@ procedure Sentence is function S_Choice is new My_Rat.Parsers.Choice ((S_Seq_1'Access, S_Seq_2'Access)); function S is new My_Rat.Parsers.Stamp (S, S_Choice); - function Parser is new My_Rat.Parsers.Parse_Only (S); - + package Parser is new My_Rat.Parsers.Parse_Once (S); - My_Lexer_Context : My_Rat.Lexers.Lexer_Context := My_Rat.Lexers.Empty_Context; - My_Parser_Context : My_Rat.Parsers.Parser_Context := My_Rat.Parsers.Empty_Context; - Lexed_Tokens : My_Rat.Lexer_Result := Scanner (Input, My_Lexer_Context); + Lexed_Tokens : My_Rat.Lexer_Result := Scanner.Scan (Input); Result_Graph : My_Rat.Parser_Result; @@ -109,7 +106,7 @@ begin NP_Redir.Set (NP'Access); S_Redir.Set (S'Access); - Result_Graph := Parser (Lexed_Tokens, My_Parser_Context); + Result_Graph := Parser.Parse (Lexed_Tokens); Put_Line ("Input:"); diff --git a/src/packrat-lexers.adb b/src/packrat-lexers.adb index fc63e4a..830fdeb 100644 --- a/src/packrat-lexers.adb +++ b/src/packrat-lexers.adb @@ -25,97 +25,6 @@ package body Packrat.Lexers is - function Stamp - (Input : in Traits.Element_Array; - Context : in out Lexer_Context) - return Component_Result - is - Current_Result : Combinator_Result := - Combo (Input, Context.Position); - begin - 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 (Traits.Tokens.Create - (Label, - Context.Position + 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.Replace_Element - (Input (Context.Position .. Current_Result.Finish)); - Context.Empty_Labels.Clear; - end if; - - Context.Error_Labels.Clear; - return Component_Success; - end Stamp; - - - function Ignore - (Input : in Traits.Element_Array; - Context : in out Lexer_Context) - return Component_Result - is - Current_Result : Combinator_Result := - Combo (Input, Context.Position); - begin - 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.Replace_Element - (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 @@ -208,142 +117,129 @@ package body Packrat.Lexers is - function Scan - (Input : in Traits.Element_Array; - Context : in out Lexer_Context) - return Traits.Tokens.Token_Array - is - Real_Input : Input_Holders.Holder; - begin - if not Context.Pass_Forward.Is_Empty then - Real_Input.Replace_Element (Slide (Context.Pass_Forward.Element) & Input); - else - Real_Input.Replace_Element (Input); - end if; + package body Scan_Parts is - Tidy_Context (Context, Components'Length); - Context.Result_So_Far.Clear; - Context.Allow_Incomplete := Input'Length > 0; - - while Context.Status = Success and Context.Position <= Real_Input.Element'Length loop - Internal_Scan_Core (Real_Input.Element, Context, Components); - end loop; - - return Token_Vector_To_Array (Context.Result_So_Far); - end Scan; + Context : Lexer_Context := Empty_Context; + function Scan + (Input : in Traits.Element_Array) + return Traits.Tokens.Token_Array + is + Real_Input : Input_Holders.Holder; + begin + if not Context.Pass_Forward.Is_Empty then + Real_Input.Replace_Element (Slide (Context.Pass_Forward.Element) & Input); + else + Real_Input.Replace_Element (Input); + end if; + Tidy_Context (Context, Components'Length); + Context.Result_So_Far.Clear; + Context.Allow_Incomplete := Input'Length > 0; + while Context.Status = Success and Context.Position <= Real_Input.Element'Length loop + Internal_Scan_Core (Real_Input.Element, Context, Components); + end loop; + return Token_Vector_To_Array (Context.Result_So_Far); + end Scan; - function Scan_Only - (Input : in Traits.Element_Array; - Context : in out Lexer_Context) - return Traits.Tokens.Token_Array - is - Real_Input : Input_Holders.Holder; - begin - if not Context.Pass_Forward.Is_Empty then - Real_Input.Replace_Element (Slide (Context.Pass_Forward.Element) & Input); - else - Real_Input.Replace_Element (Input); - end if; + procedure Reset is + begin + Context := Empty_Context; + end Reset; - Tidy_Context (Context, Components'Length); - Context.Result_So_Far.Clear; - Context.Allow_Incomplete := False; + end Scan_Parts; - while Context.Status = Success and Context.Position <= Real_Input.Element'Length loop - Internal_Scan_Core (Real_Input.Element, Context, Components); - end loop; - return Token_Vector_To_Array (Context.Result_So_Far); - end Scan_Only; + package body Scan_Once is + Context : Lexer_Context := Empty_Context; - function Scan_With - (Input : in With_Input; - Context : in out Lexer_Context) - return Traits.Tokens.Token_Array - is - Real_Input : Input_Holders.Holder; - Empty_Input : Boolean; - begin - Context.Result_So_Far.Clear; - loop - Real_Input.Replace_Element (Input.all); - Empty_Input := Real_Input.Element'Length = 0; + function Scan + (Input : in Traits.Element_Array) + return Traits.Tokens.Token_Array + is + Real_Input : Input_Holders.Holder; + begin if not Context.Pass_Forward.Is_Empty then - Real_Input.Replace_Element - (Slide (Context.Pass_Forward.Element) & Real_Input.Element); + Real_Input.Replace_Element (Slide (Context.Pass_Forward.Element) & Input); + else + Real_Input.Replace_Element (Input); end if; - Tidy_Context (Context, Components'Length); - Context.Allow_Incomplete := not Empty_Input; - + Context.Result_So_Far.Clear; + Context.Allow_Incomplete := False; while Context.Status = Success and Context.Position <= Real_Input.Element'Length loop Internal_Scan_Core (Real_Input.Element, Context, Components); end loop; + return Token_Vector_To_Array (Context.Result_So_Far); + end Scan; - if Empty_Input then - exit; - end if; - end loop; - return Token_Vector_To_Array (Context.Result_So_Far); - end Scan_With; + procedure Reset is + begin + Context := Empty_Context; + end Reset; + end Scan_Once; - procedure Scan_Set - (Input : in Traits.Element_Array; - Context : in out Lexer_Context; - Output : out Traits.Tokens.Token_Array) - is - Real_Input : Input_Holders.Holder; - begin - if not Context.Pass_Forward.Is_Empty then - Real_Input.Replace_Element (Slide (Context.Pass_Forward.Element) & Input); - else - Real_Input.Replace_Element (Input); - end if; - Tidy_Context (Context, Components'Length); - Context.Result_So_Far.Clear; - Context.Allow_Incomplete := not (Input'Length = 0 or else Input (Input'First) = Pad_In); + package body Scan_With is - while Context.Status = Success and then - Integer (Context.Result_So_Far.Length) < Output'Length and then - Context.Position <= Real_Input.Element'Length and then - Real_Input.Element (Context.Position) /= Pad_In - loop - Internal_Scan_Core (Real_Input.Element, Context, Components); - end loop; + Context : Lexer_Context := Empty_Context; - if Integer (Context.Result_So_Far.Length) = Output'Length then - 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; + function Scan + (Input : in With_Input) + return Traits.Tokens.Token_Array + is + Real_Input : Input_Holders.Holder; + Empty_Input : Boolean; + begin + Context.Result_So_Far.Clear; + loop + Real_Input.Replace_Element (Input.all); + Empty_Input := Real_Input.Element'Length = 0; + if not Context.Pass_Forward.Is_Empty then + Real_Input.Replace_Element + (Slide (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.Element'Length + loop + Internal_Scan_Core (Real_Input.Element, Context, Components); + end loop; + if Empty_Input then + exit; + end if; + end loop; + return Token_Vector_To_Array (Context.Result_So_Far); + end Scan; + procedure Reset is + begin + Context := Empty_Context; + end Reset; - procedure Scan_Set_With - (Input : in With_Input; - Context : in out Lexer_Context; - Output : out Traits.Tokens.Token_Array) - is - Real_Input : Input_Holders.Holder; - Empty_Input : Boolean; - begin - Context.Result_So_Far.Clear; - loop - Real_Input.Replace_Element (Input.all); - Empty_Input := Real_Input.Element'Length = 0 or else - Real_Input.Element (Real_Input.Element'First) = Pad_In; + end Scan_With; + + + package body Scan_Set is + + Context : Lexer_Context := Empty_Context; + + procedure Scan + (Input : in Traits.Element_Array; + Output : out Traits.Tokens.Token_Array) + is + Real_Input : Input_Holders.Holder; + begin if not Context.Pass_Forward.Is_Empty then - Real_Input.Replace_Element - (Slide (Context.Pass_Forward.Element) & Real_Input.Element); + Real_Input.Replace_Element (Slide (Context.Pass_Forward.Element) & Input); + else + Real_Input.Replace_Element (Input); end if; - Tidy_Context (Context, Components'Length); - Context.Allow_Incomplete := not Empty_Input; - + Context.Result_So_Far.Clear; + 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.Element'Length and then @@ -351,24 +247,164 @@ package body Packrat.Lexers is loop Internal_Scan_Core (Real_Input.Element, Context, Components); end loop; - - if Empty_Input then - exit; - end if; - 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); + Token_Vector_To_Array (Context.Result_So_Far, Pad_Out, Output); + end Scan; + + procedure Reset is + begin + Context := Empty_Context; + end Reset; + + end Scan_Set; + + + package body Scan_Set_With is + + Context : Lexer_Context := Empty_Context; + + procedure Scan + (Input : in With_Input; + Output : out Traits.Tokens.Token_Array) + is + Real_Input : Input_Holders.Holder; + Empty_Input : Boolean; + begin + Context.Result_So_Far.Clear; + loop + Real_Input.Replace_Element (Input.all); + Empty_Input := Real_Input.Element'Length = 0 or else + Real_Input.Element (Real_Input.Element'First) = Pad_In; + if not Context.Pass_Forward.Is_Empty then + Real_Input.Replace_Element + (Slide (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.Element'Length and then + Real_Input.Element (Context.Position) /= Pad_In + loop + Internal_Scan_Core (Real_Input.Element, Context, Components); + end loop; + if Empty_Input then + exit; + end if; + 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; + + procedure Reset is + begin + Context := Empty_Context; + end Reset; + end Scan_Set_With; + function Stamp + (Input : in Traits.Element_Array; + Context : in out Lexer_Context) + return Component_Result + is + Current_Result : Combinator_Result := + Combo (Input, Context.Position); + begin + 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 (Traits.Tokens.Create + (Label, + Context.Position + 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.Replace_Element + (Input (Context.Position .. Current_Result.Finish)); + Context.Empty_Labels.Clear; + end if; + + Context.Error_Labels.Clear; + return Component_Success; + end Stamp; + + + function Ignore + (Input : in Traits.Element_Array; + Context : in out Lexer_Context) + return Component_Result + is + Current_Result : Combinator_Result := + Combo (Input, Context.Position); + begin + 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.Replace_Element + (Input (Context.Position .. Current_Result.Finish)); + Context.Empty_Labels.Clear; + end if; + + Context.Error_Labels.Clear; + return Component_Success; + end Ignore; + + + + + function Sequence (Input : in Traits.Element_Array; Start : in Positive) diff --git a/src/packrat-lexers.ads b/src/packrat-lexers.ads index 57fc462..68a01d0 100644 --- a/src/packrat-lexers.ads +++ b/src/packrat-lexers.ads @@ -17,6 +17,11 @@ generic package Packrat.Lexers is + type Lexer_Context is private; + + + + type Combinator_Result is private; type Combinator is access function @@ -29,13 +34,6 @@ package Packrat.Lexers is - type Lexer_Context is private; - - Empty_Context : constant Lexer_Context; - - - - type Component_Result is private; type Component is access function @@ -55,68 +53,97 @@ package Packrat.Lexers is generic - Label : in Traits.Label_Enum; - with function Combo - (Input : in Traits.Element_Array; - Start : in Positive) - return Combinator_Result; - function Stamp - (Input : in Traits.Element_Array; - Context : in out Lexer_Context) - return Component_Result; + Components : in Component_Array; + package Scan_Parts is - generic - Label : in Traits.Label_Enum; - with function Combo - (Input : in Traits.Element_Array; - Start : in Positive) - return Combinator_Result; - function Ignore - (Input : in Traits.Element_Array; - Context : in out Lexer_Context) - return Component_Result; + function Scan + (Input : in Traits.Element_Array) + return Traits.Tokens.Token_Array; + procedure Reset; + end Scan_Parts; generic Components : in Component_Array; - function Scan - (Input : in Traits.Element_Array; - Context : in out Lexer_Context) - return Traits.Tokens.Token_Array; + package Scan_Once is + + function Scan + (Input : in Traits.Element_Array) + return Traits.Tokens.Token_Array; + + procedure Reset; + + end Scan_Once; - generic - Components : in Component_Array; - function Scan_Only - (Input : in Traits.Element_Array; - Context : in out Lexer_Context) - return Traits.Tokens.Token_Array; generic Components : in Component_Array; - function Scan_With - (Input : in With_Input; - Context : in out Lexer_Context) - return Traits.Tokens.Token_Array; + package Scan_With is + + function Scan + (Input : in With_Input) + return Traits.Tokens.Token_Array; + + procedure Reset; + + end Scan_With; + generic Components : in Component_Array; Pad_In : in Traits.Element_Type; Pad_Out : in Traits.Tokens.Token; - procedure Scan_Set - (Input : in Traits.Element_Array; - Context : in out Lexer_Context; - Output : out Traits.Tokens.Token_Array); + package Scan_Set is + + procedure Scan + (Input : in Traits.Element_Array; + Output : out Traits.Tokens.Token_Array); + + procedure Reset; + + end Scan_Set; + generic Components : in Component_Array; Pad_In : in Traits.Element_Type; Pad_Out : in Traits.Tokens.Token; - procedure Scan_Set_With - (Input : in With_Input; - Context : in out Lexer_Context; - Output : out Traits.Tokens.Token_Array); + package Scan_Set_With is + + procedure Scan + (Input : in With_Input; + Output : out Traits.Tokens.Token_Array); + + procedure Reset; + + end Scan_Set_With; + + + + + generic + Label : in Traits.Label_Enum; + with function Combo + (Input : in Traits.Element_Array; + Start : in Positive) + return Combinator_Result; + function Stamp + (Input : in Traits.Element_Array; + Context : in out Lexer_Context) + return Component_Result; + + generic + Label : in Traits.Label_Enum; + with function Combo + (Input : in Traits.Element_Array; + Start : in Positive) + return Combinator_Result; + function Ignore + (Input : in Traits.Element_Array; + Context : in out Lexer_Context) + return Component_Result; diff --git a/src/packrat-parsers.adb b/src/packrat-parsers.adb index df88e71..d854f73 100644 --- a/src/packrat-parsers.adb +++ b/src/packrat-parsers.adb @@ -416,82 +416,111 @@ package body Packrat.Parsers is end Finish_Root; - procedure Parse - (Input : in Traits.Element_Array; - Context : in out Parser_Context; - Result : out Graphs.Parse_Graph) is - begin - Tidy_Context (Input, Context); - Context.Allow_Incomplete := (Input'Length /= 0); - declare - use type Traits.Element_Array; - Real_Input : Traits.Element_Array := - (if Context.Pass_Forward.Is_Empty - then Slide (Input, Context.Current_Position) - else Element (Context.Pass_Forward) & Input); - Root_Result : Combinator_Result := - Root (Real_Input, Context, Context.Global_Start); - begin - if Root_Result.Status = Failure then - raise Parser_Error with -Context.Error_String; - end if; - if Input'Length = 0 then - Result := Finish_Root (Root_Result, Context); - return; - end if; - if not Context.Needs_More.Is_Empty then - Context.Current_Position := Context.Needs_More.First_Element; - Context.Pass_Forward.Replace_Element - (Real_Input (Context.Current_Position .. Real_Input'Last)); - else - Context.Current_Position := Real_Input'Last + 1; - Context.Pass_Forward.Clear; - end if; - end; - end Parse; + package body Parse_Parts is + Context : Parser_Context := Empty_Context; - function Parse_Only - (Input : in Traits.Element_Array; - Context : in out Parser_Context) - return Graphs.Parse_Graph is - begin - Tidy_Context (Input, Context); - Context.Allow_Incomplete := False; - declare - use type Traits.Element_Array; - Real_Input : Traits.Element_Array := - (if Context.Pass_Forward.Is_Empty - then Slide (Input, Context.Current_Position) - else Element (Context.Pass_Forward) & Input); - Root_Result : Combinator_Result := - Root (Real_Input, Context, Context.Global_Start); + procedure Parse + (Input : in Traits.Element_Array; + Result : out Graphs.Parse_Graph) is begin - if Root_Result.Status /= Success then - raise Parser_Error with -Context.Error_String; - end if; - return Finish_Root (Root_Result, Context); - end; - end Parse_Only; + Tidy_Context (Input, Context); + Context.Allow_Incomplete := (Input'Length /= 0); + declare + use type Traits.Element_Array; + Real_Input : Traits.Element_Array := + (if Context.Pass_Forward.Is_Empty + then Slide (Input, Context.Current_Position) + else Element (Context.Pass_Forward) & Input); + Root_Result : Combinator_Result := + Root (Real_Input, Context, Context.Global_Start); + begin + if Root_Result.Status = Failure then + raise Parser_Error with -Context.Error_String; + end if; + if Input'Length = 0 then + Result := Finish_Root (Root_Result, Context); + return; + end if; + if not Context.Needs_More.Is_Empty then + Context.Current_Position := Context.Needs_More.First_Element; + Context.Pass_Forward.Replace_Element + (Real_Input (Context.Current_Position .. Real_Input'Last)); + else + Context.Current_Position := Real_Input'Last + 1; + Context.Pass_Forward.Clear; + end if; + end; + end Parse; + procedure Reset is + begin + Context := Empty_Context; + end Reset; - function Parse_With - (Input : in With_Input; - Context : in out Parser_Context) - return Graphs.Parse_Graph - is - procedure My_Parse is new Parse (Root); - Result : Graphs.Parse_Graph; - begin - loop + end Parse_Parts; + + + package body Parse_Once is + + Context : Parser_Context := Empty_Context; + + function Parse + (Input : in Traits.Element_Array) + return Graphs.Parse_Graph is + begin + Tidy_Context (Input, Context); + Context.Allow_Incomplete := False; declare - Next_Input : Traits.Element_Array := Input.all; + use type Traits.Element_Array; + Real_Input : Traits.Element_Array := + (if Context.Pass_Forward.Is_Empty + then Slide (Input, Context.Current_Position) + else Element (Context.Pass_Forward) & Input); + Root_Result : Combinator_Result := + Root (Real_Input, Context, Context.Global_Start); begin - My_Parse (Next_Input, Context, Result); - exit when Next_Input'Length = 0; + if Root_Result.Status /= Success then + raise Parser_Error with -Context.Error_String; + end if; + return Finish_Root (Root_Result, Context); end; - end loop; - return Result; + end Parse; + + procedure Reset is + begin + Context := Empty_Context; + end Reset; + + end Parse_Once; + + + package body Parse_With is + + package My_Parse is new Parse_Parts (Root); + + function Parse + (Input : in With_Input) + return Graphs.Parse_Graph + is + Result : Graphs.Parse_Graph; + begin + loop + declare + Next_Input : Traits.Element_Array := Input.all; + begin + My_Parse.Parse (Next_Input, Result); + exit when Next_Input'Length = 0; + end; + end loop; + return Result; + end Parse; + + procedure Reset is + begin + My_Parse.Reset; + end Reset; + end Parse_With; @@ -584,6 +613,8 @@ package body Packrat.Parsers is package body Redirect is + Combo : Combinator := null; + procedure Set (Target : in Combinator) is begin diff --git a/src/packrat-parsers.ads b/src/packrat-parsers.ads index 8d0ba68..93d06dd 100644 --- a/src/packrat-parsers.ads +++ b/src/packrat-parsers.ads @@ -24,8 +24,6 @@ package Packrat.Parsers is type Parser_Context is private; - Empty_Context : constant Parser_Context; - @@ -54,10 +52,16 @@ package Packrat.Parsers is Context : in out Parser_Context; Start : in Positive) return Combinator_Result; - procedure Parse - (Input : in Traits.Element_Array; - Context : in out Parser_Context; - Result : out Graphs.Parse_Graph); + package Parse_Parts is + + procedure Parse + (Input : in Traits.Element_Array; + Result : out Graphs.Parse_Graph); + + procedure Reset; + + end Parse_Parts; + generic with function Root @@ -65,10 +69,16 @@ package Packrat.Parsers is Context : in out Parser_Context; Start : in Positive) return Combinator_Result; - function Parse_Only - (Input : in Traits.Element_Array; - Context : in out Parser_Context) - return Graphs.Parse_Graph; + package Parse_Once is + + function Parse + (Input : in Traits.Element_Array) + return Graphs.Parse_Graph; + + procedure Reset; + + end Parse_Once; + generic with function Root @@ -76,10 +86,15 @@ package Packrat.Parsers is Context : in out Parser_Context; Start : in Positive) return Combinator_Result; - function Parse_With - (Input : in With_Input; - Context : in out Parser_Context) - return Graphs.Parse_Graph; + package Parse_With is + + function Parse + (Input : in With_Input) + return Graphs.Parse_Graph; + + procedure Reset; + + end Parse_With; @@ -125,10 +140,6 @@ package Packrat.Parsers is Start : in Positive) return Combinator_Result; - private - - Combo : Combinator := null; - end Redirect; diff --git a/test/packrat-lexers-debug.ads b/test/packrat-lexers-debug.ads index 5c5320a..0dace45 100644 --- a/test/packrat-lexers-debug.ads +++ b/test/packrat-lexers-debug.ads @@ -9,6 +9,8 @@ generic package Packrat.Lexers.Debug is + Empty_Context : constant Lexer_Context; + Empty_Fail : constant Combinator_Result; @@ -78,6 +80,8 @@ package Packrat.Lexers.Debug is private + Empty_Context : constant Lexer_Context := Packrat.Lexers.Empty_Context; + Empty_Fail : constant Combinator_Result := Packrat.Lexers.Empty_Fail; diff --git a/test/rat_tests-lexers.adb b/test/rat_tests-lexers.adb index 0087f60..95324a9 100644 --- a/test/rat_tests-lexers.adb +++ b/test/rat_tests-lexers.adb @@ -571,8 +571,8 @@ package body Rat_Tests.Lexers is Test_Str1 : String := "abcdefghi"; Test_Str2 : String := "ab"; - Context1 : Slexy.Lexer_Context := Slexy.Empty_Context; - Context2 : Slexy.Lexer_Context := Slexy.Empty_Context; + Context1 : Slexy.Lexer_Context := Slebug.Empty_Context; + Context2 : Slexy.Lexer_Context := Slebug.Empty_Context; Comp_Code : Slexy.Component_Result; begin @@ -615,8 +615,8 @@ package body Rat_Tests.Lexers is Test_Str1 : String := "abcdefghi"; Test_Str2 : String := "ab"; - Context1 : Slexy.Lexer_Context := Slexy.Empty_Context; - Context2 : Slexy.Lexer_Context := Slexy.Empty_Context; + Context1 : Slexy.Lexer_Context := Slebug.Empty_Context; + Context2 : Slexy.Lexer_Context := Slebug.Empty_Context; Comp_Code : Slexy.Component_Result; begin @@ -666,14 +666,13 @@ package body Rat_Tests.Lexers is function Ignore_Whitespace is new Swordy.Ignore (Whitespace, Many_Whitespace); - function Scan_Check + function Scan_Parts_Check return Test_Result is - function My_Scan is new Swordy.Scan + package My_Scanner is new Swordy.Scan_Parts ((Stamp_Word'Access, Ignore_Whitespace'Access)); Test_Str : String := "one fine day"; - Test_Context : Swordy.Lexer_Context := Swordy.Empty_Context; Intended_Result1 : Swordy_Traits.Tokens.Token_Array := (1 => Swordy_Traits.Tokens.Create (Word, 1, "one"), @@ -682,25 +681,24 @@ package body Rat_Tests.Lexers is (1 => Swordy_Traits.Tokens.Create (Word, 10, "day")); Actual_Result1 : Swordy_Traits.Tokens.Token_Array := - My_Scan (Test_Str, Test_Context); + My_Scanner.Scan (Test_Str); Actual_Result2 : Swordy_Traits.Tokens.Token_Array := - My_Scan ("", Test_Context); + My_Scanner.Scan (""); begin if Actual_Result1 /= Intended_Result1 or Actual_Result2 /= Intended_Result2 then return Fail; end if; return Pass; - end Scan_Check; + end Scan_Parts_Check; - function Scan_Only_Check + function Scan_Once_Check return Test_Result is - function My_Scan is new Swordy.Scan_Only + package My_Scanner is new Swordy.Scan_Once ((Stamp_Word'Access, Ignore_Whitespace'Access)); Test_Str : String := "one fine day"; - Test_Context : Swordy.Lexer_Context := Swordy.Empty_Context; Intended_Result : Swordy_Traits.Tokens.Token_Array := (1 => Swordy_Traits.Tokens.Create (Word, 1, "one"), @@ -708,13 +706,13 @@ package body Rat_Tests.Lexers is 3 => Swordy_Traits.Tokens.Create (Word, 10, "day")); Actual_Result : Swordy_Traits.Tokens.Token_Array := - My_Scan (Test_Str, Test_Context); + My_Scanner.Scan (Test_Str); begin if Actual_Result /= Intended_Result then return Fail; end if; return Pass; - end Scan_Only_Check; + end Scan_Once_Check; function Scan_With_Check @@ -735,11 +733,9 @@ package body Rat_Tests.Lexers is end if; end More_Input; - function My_Scan is new Swordy.Scan_With + package My_Scanner is new Swordy.Scan_With ((Stamp_Word'Access, Ignore_Whitespace'Access)); - Test_Context : Swordy.Lexer_Context := Swordy.Empty_Context; - Intended_Result : Swordy_Traits.Tokens.Token_Array := (1 => Swordy_Traits.Tokens.Create (Word, 1, "it"), 2 => Swordy_Traits.Tokens.Create (Word, 4, "will"), @@ -751,7 +747,7 @@ package body Rat_Tests.Lexers is 8 => Swordy_Traits.Tokens.Create (Word, 37, "again")); Actual_Result : Swordy_Traits.Tokens.Token_Array := - My_Scan (More_Input'Unrestricted_Access, Test_Context); + My_Scanner.Scan (More_Input'Unrestricted_Access); begin if Actual_Result /= Intended_Result then return Fail; @@ -763,14 +759,13 @@ package body Rat_Tests.Lexers is function Scan_Set_Check return Test_Result is - procedure My_Scan is new Swordy.Scan_Set + package My_Scanner is new Swordy.Scan_Set ((Stamp_Word'Access, Ignore_Whitespace'Access), Latin.EOT, Swordy_Traits.Tokens.Create (Blank, 1, "")); Test_Str1 : String (1 .. 10) := "one tw"; Test_Str2 : String (1 .. 10) := "o three"; Test_Str3 : String (1 .. 10) := Latin.EOT & " "; - Test_Context : Swordy.Lexer_Context := Swordy.Empty_Context; Intended_Result1 : Swordy_Traits.Tokens.Token_Array := (1 => Swordy_Traits.Tokens.Create (Word, 1, "one"), @@ -787,15 +782,15 @@ package body Rat_Tests.Lexers is Actual_Result : Swordy_Traits.Tokens.Token_Array (1 .. 3); begin - My_Scan (Test_Str1, Test_Context, Actual_Result); + My_Scanner.Scan (Test_Str1, Actual_Result); if Actual_Result /= Intended_Result1 then return Fail; end if; - My_Scan (Test_Str2, Test_Context, Actual_Result); + My_Scanner.Scan (Test_Str2, Actual_Result); if Actual_Result /= Intended_Result2 then return Fail; end if; - My_Scan (Test_Str3, Test_Context, Actual_Result); + My_Scanner.Scan (Test_Str3, Actual_Result); if Actual_Result /= Intended_Result3 then return Fail; end if; @@ -821,12 +816,10 @@ package body Rat_Tests.Lexers is end if; end More_Input; - procedure My_Scan is new Swordy.Scan_Set_With + package My_Scanner is new Swordy.Scan_Set_With ((Stamp_Word'Access, Ignore_Whitespace'Access), Latin.EOT, Swordy_Traits.Tokens.Create (Blank, 1, "")); - Test_Context : Swordy.Lexer_Context := Swordy.Empty_Context; - Intended_Result1 : Swordy_Traits.Tokens.Token_Array := (1 => Swordy_Traits.Tokens.Create (Word, 1, "it"), 2 => Swordy_Traits.Tokens.Create (Word, 4, "will"), @@ -842,11 +835,11 @@ package body Rat_Tests.Lexers is Actual_Result : Swordy_Traits.Tokens.Token_Array (1 .. 5); begin - My_Scan (More_Input'Unrestricted_Access, Test_Context, Actual_Result); + My_Scanner.Scan (More_Input'Unrestricted_Access, Actual_Result); if Actual_Result /= Intended_Result1 then return Fail; end if; - My_Scan (More_Input'Unrestricted_Access, Test_Context, Actual_Result); + My_Scanner.Scan (More_Input'Unrestricted_Access, Actual_Result); if Actual_Result /= Intended_Result2 then return Fail; end if; @@ -854,22 +847,21 @@ package body Rat_Tests.Lexers is end Scan_Set_With_Check; - function Scan_Error_Check + function Scan_Parts_Error_Check return Test_Result is use type Packrat.Errors.Error_Info_Array; - function My_Scan is new Swordy.Scan + package My_Scanner is new Swordy.Scan_Parts ((Stamp_Word'Access, Ignore_Whitespace'Access)); Test_Str : String := "()()"; - Test_Context : Swordy.Lexer_Context := Swordy.Empty_Context; Expected_Errors : Packrat.Errors.Error_Info_Array := ((+"WORD", 1), (+"WHITESPACE", 1)); begin declare - Result : Swordy_Traits.Tokens.Token_Array := My_Scan (Test_Str, Test_Context); + Result : Swordy_Traits.Tokens.Token_Array := My_Scanner.Scan (Test_Str); begin return Fail; end; @@ -879,25 +871,24 @@ package body Rat_Tests.Lexers is return Fail; end if; return Pass; - end Scan_Error_Check; + end Scan_Parts_Error_Check; - function Scan_Only_Error_Check + function Scan_Once_Error_Check return Test_Result is use type Packrat.Errors.Error_Info_Array; - function My_Scan is new Swordy.Scan_Only + package My_Scanner is new Swordy.Scan_Once ((Stamp_Word'Access, Ignore_Whitespace'Access)); Test_Str : String := "()()"; - Test_Context : Swordy.Lexer_Context := Swordy.Empty_Context; Expected_Errors : Packrat.Errors.Error_Info_Array := ((+"WORD", 1), (+"WHITESPACE", 1)); begin declare - Result : Swordy_Traits.Tokens.Token_Array := My_Scan (Test_Str, Test_Context); + Result : Swordy_Traits.Tokens.Token_Array := My_Scanner.Scan (Test_Str); begin return Fail; end; @@ -907,7 +898,7 @@ package body Rat_Tests.Lexers is return Fail; end if; return Pass; - end Scan_Only_Error_Check; + end Scan_Once_Error_Check; function Scan_With_Error_Check @@ -927,17 +918,15 @@ package body Rat_Tests.Lexers is end if; end Get_Input; - function My_Scan is new Swordy.Scan_With + package My_Scanner is new Swordy.Scan_With ((Stamp_Word'Access, Ignore_Whitespace'Access)); - Test_Context : Swordy.Lexer_Context := Swordy.Empty_Context; - Expected_Errors : Packrat.Errors.Error_Info_Array := ((+"WORD", 1), (+"WHITESPACE", 1)); begin declare Result : Swordy_Traits.Tokens.Token_Array := - My_Scan (Get_Input'Unrestricted_Access, Test_Context); + My_Scanner.Scan (Get_Input'Unrestricted_Access); begin return Fail; end; @@ -955,19 +944,18 @@ package body Rat_Tests.Lexers is is use type Packrat.Errors.Error_Info_Array; - procedure My_Scan is new Swordy.Scan_Set + package My_Scanner is new Swordy.Scan_Set ((Stamp_Word'Access, Ignore_Whitespace'Access), Latin.EOT, Swordy_Traits.Tokens.Create (Blank, 1, "")); Test_Str : String := "()()"; - Test_Context : Swordy.Lexer_Context := Swordy.Empty_Context; Result : Swordy_Traits.Tokens.Token_Array (1 .. 5); Expected_Errors : Packrat.Errors.Error_Info_Array := ((+"WORD", 1), (+"WHITESPACE", 1)); begin - My_Scan (Test_Str, Test_Context, Result); + My_Scanner.Scan (Test_Str, Result); return Fail; exception when Msg : Packrat.Lexer_Error => @@ -995,18 +983,16 @@ package body Rat_Tests.Lexers is end if; end Get_Input; - procedure My_Scan is new Swordy.Scan_Set_With + package My_Scanner is new Swordy.Scan_Set_With ((Stamp_Word'Access, Ignore_Whitespace'Access), Latin.EOT, Swordy_Traits.Tokens.Create (Blank, 1, "")); - Test_Context : Swordy.Lexer_Context := Swordy.Empty_Context; - Result : Swordy_Traits.Tokens.Token_Array (1 .. 5); Expected_Errors : Packrat.Errors.Error_Info_Array := ((+"WORD", 1), (+"WHITESPACE", 1)); begin - My_Scan (Get_Input'Unrestricted_Access, Test_Context, Result); + My_Scanner.Scan (Get_Input'Unrestricted_Access, Result); return Fail; exception when Msg : Packrat.Lexer_Error => diff --git a/test/rat_tests-lexers.ads b/test/rat_tests-lexers.ads index 0cf86b7..fe6cca8 100644 --- a/test/rat_tests-lexers.ads +++ b/test/rat_tests-lexers.ads @@ -49,14 +49,14 @@ package Rat_Tests.Lexers is function Stamp_Check return Test_Result; function Ignore_Check return Test_Result; - function Scan_Check return Test_Result; - function Scan_Only_Check return Test_Result; + function Scan_Parts_Check return Test_Result; + function Scan_Once_Check return Test_Result; function Scan_With_Check return Test_Result; function Scan_Set_Check return Test_Result; function Scan_Set_With_Check return Test_Result; - function Scan_Error_Check return Test_Result; - function Scan_Only_Error_Check return Test_Result; + function Scan_Parts_Error_Check return Test_Result; + function Scan_Once_Error_Check return Test_Result; function Scan_With_Error_Check return Test_Result; function Scan_Set_Error_Check return Test_Result; function Scan_Set_With_Error_Check return Test_Result; @@ -64,13 +64,13 @@ package Rat_Tests.Lexers is Lexer_Tests : Test_Array := ((+"Stamp", Stamp_Check'Access), (+"Ignore", Ignore_Check'Access), - (+"Scan", Scan_Check'Access), - (+"Scan_Only", Scan_Only_Check'Access), + (+"Scan_Parts", Scan_Parts_Check'Access), + (+"Scan_Once", Scan_Once_Check'Access), (+"Scan_With", Scan_With_Check'Access), (+"Scan_Set", Scan_Set_Check'Access), (+"Scan_Set_With", Scan_Set_With_Check'Access), - (+"Scan Exception", Scan_Error_Check'Access), - (+"Scan_Only Exception", Scan_Only_Error_Check'Access), + (+"Scan_Parts Exception", Scan_Parts_Error_Check'Access), + (+"Scan_Once Exception", Scan_Once_Error_Check'Access), (+"Scan_With Exception", Scan_With_Error_Check'Access), (+"Scan_Set Exception", Scan_Set_Error_Check'Access), (+"Scan_Set_With Exception", Scan_Set_With_Error_Check'Access)); -- cgit