From a21cc8153592700ae7cb2cdfbb24b377e096a22a Mon Sep 17 00:00:00 2001
From: Jed Barber <jjbarber@y7mail.com>
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