From 6c296b5615699eac0fb569b5cfe29e96986904a5 Mon Sep 17 00:00:00 2001 From: Jed Barber Date: Sat, 28 Nov 2020 14:24:02 +1100 Subject: Skeleton of Packrat.Parsers --- src/packrat-parsers.adb | 370 ++++++++++++++++++++++++++++++++++++++++ src/packrat-parsers.ads | 436 ++++++++++++++++++++++++++++++++++++++++++++++++ src/packrat-tokens.adb | 44 ++--- src/packrat-tokens.ads | 10 ++ src/packrat-traits.adb | 20 +++ src/packrat-traits.ads | 5 + src/packrat.adb | 28 ++++ src/packrat.ads | 11 ++ 8 files changed, 902 insertions(+), 22 deletions(-) create mode 100644 src/packrat-parsers.adb create mode 100644 src/packrat-parsers.ads create mode 100644 src/packrat-traits.adb create mode 100644 src/packrat.adb diff --git a/src/packrat-parsers.adb b/src/packrat-parsers.adb new file mode 100644 index 0000000..955c5cc --- /dev/null +++ b/src/packrat-parsers.adb @@ -0,0 +1,370 @@ + + +with + + System; + + +package body Packrat.Parsers is + + + function "<" + (Left, Right : in Elem_Array_Holders.Holder) + return Boolean + is + use Traits; + begin + return Left.Element < Right.Element; + end "<"; + + + function "<" + (Left, Right : in Token_Array_Holders.Holder) + return Boolean + is + use Traits.Tokens; + begin + return Left.Element < Right.Element; + end "<"; + + + function "<" + (Left, Right : in Combo_Key) + return Boolean is + begin + if Left.Start = Right.Start then + return Left.Func < Right.Func; + else + return Left.Start < Right.Start; + end if; + end "<"; + + + function "<" + (Left, Right : in Combo_Result_Part) + return Boolean + is + use type Elem_Array_Holders.Holder; + begin + if Left.Finish = Right.Finish then + if Left.Value = Right.Value then + return Left.Tokens < Right.Tokens; + else + return Left.Value < Right.Value; + end if; + else + return Left.Finish < Right.Finish; + end if; + end "<"; + + + function "<" + (Left, Right : in Combinator) + return Boolean + is + use type System.Address; + begin + return Left.all'Address < Right.all'Address; + end "<"; + + + + + + function Root + (Input : in Traits.Element_Array; + Context : in out Parser_Context; + Start : in Positive) + return Component_Result + is + begin + return (Status => Failure); + end Root; + + + + + + procedure Parse + (Input : in Traits.Element_Array; + Context : in out Parser_Context; + Result : out Graphs.Parse_Graph) + is + begin + null; + end Parse; + + + function Parse_Only + (Input : in Traits.Element_Array; + Context : in out Parser_Context) + return Graphs.Parse_Graph + is + begin + return Graphs.Empty_Graph; + end Parse_Only; + + + function Parse_With + (Input : in With_Input; + Context : in out Parser_Context) + return Graphs.Parse_Graph + is + begin + return Graphs.Empty_Graph; + end Parse_With; + + + + + + function Stamp + (Input : in Traits.Element_Array; + Context : in out Parser_Context; + Start : in Positive) + return Combinator_Result + is + begin + return + (Results => Result_Sets.Empty_Set, + Curtails => Curtail_Maps.Empty_Map, + Status => Failure); + end Stamp; + + + function Ignore + (Input : in Traits.Element_Array; + Context : in out Parser_Context; + Start : in Positive) + return Combinator_Result + is + begin + return + (Results => Result_Sets.Empty_Set, + Curtails => Curtail_Maps.Empty_Map, + Status => Failure); + end Ignore; + + + + + + function Sequence + (Input : in Traits.Element_Array; + Context : in out Parser_Context; + Start : in Positive) + return Combinator_Result + is + begin + return + (Results => Result_Sets.Empty_Set, + Curtails => Curtail_Maps.Empty_Map, + Status => Failure); + end Sequence; + + + function Choice + (Input : in Traits.Element_Array; + Context : in out Parser_Context; + Start : in Positive) + return Combinator_Result + is + begin + return + (Results => Result_Sets.Empty_Set, + Curtails => Curtail_Maps.Empty_Map, + Status => Failure); + end Choice; + + + function Count + (Input : in Traits.Element_Array; + Context : in out Parser_Context; + Start : in Positive) + return Combinator_Result + is + begin + return + (Results => Result_Sets.Empty_Set, + Curtails => Curtail_Maps.Empty_Map, + Status => Failure); + end Count; + + + function Many + (Input : in Traits.Element_Array; + Context : in out Parser_Context; + Start : in Positive) + return Combinator_Result + is + begin + return + (Results => Result_Sets.Empty_Set, + Curtails => Curtail_Maps.Empty_Map, + Status => Failure); + end Many; + + + function Many_Until + (Input : in Traits.Element_Array; + Context : in out Parser_Context; + Start : in Positive) + return Combinator_Result + is + begin + return + (Results => Result_Sets.Empty_Set, + Curtails => Curtail_Maps.Empty_Map, + Status => Failure); + end Many_Until; + + + + + + function Satisfy + (Input : in Traits.Element_Array; + Context : in out Parser_Context; + Start : in Positive) + return Combinator_Result + is + begin + return + (Results => Result_Sets.Empty_Set, + Curtails => Curtail_Maps.Empty_Map, + Status => Failure); + end Satisfy; + + + function Satisfy_With + (Input : in Traits.Element_Array; + Context : in out Parser_Context; + Start : in Positive) + return Combinator_Result + is + begin + return + (Results => Result_Sets.Empty_Set, + Curtails => Curtail_Maps.Empty_Map, + Status => Failure); + end Satisfy_With; + + + function Match + (Input : in Traits.Element_Array; + Context : in out Parser_Context; + Start : in Positive) + return Combinator_Result + is + begin + return + (Results => Result_Sets.Empty_Set, + Curtails => Curtail_Maps.Empty_Map, + Status => Failure); + end Match; + + + function Match_With + (Input : in Traits.Element_Array; + Context : in out Parser_Context; + Start : in Positive) + return Combinator_Result + is + begin + return + (Results => Result_Sets.Empty_Set, + Curtails => Curtail_Maps.Empty_Map, + Status => Failure); + end Match_With; + + + function Multimatch + (Input : in Traits.Element_Array; + Context : in out Parser_Context; + Start : in Positive) + return Combinator_Result + is + begin + return + (Results => Result_Sets.Empty_Set, + Curtails => Curtail_Maps.Empty_Map, + Status => Failure); + end Multimatch; + + + function Take + (Input : in Traits.Element_Array; + Context : in out Parser_Context; + Start : in Positive) + return Combinator_Result + is + begin + return + (Results => Result_Sets.Empty_Set, + Curtails => Curtail_Maps.Empty_Map, + Status => Failure); + end Take; + + + function Take_While + (Input : in Traits.Element_Array; + Context : in out Parser_Context; + Start : in Positive) + return Combinator_Result + is + begin + return + (Results => Result_Sets.Empty_Set, + Curtails => Curtail_Maps.Empty_Map, + Status => Failure); + end Take_While; + + + function Take_Until + (Input : in Traits.Element_Array; + Context : in out Parser_Context; + Start : in Positive) + return Combinator_Result + is + begin + return + (Results => Result_Sets.Empty_Set, + Curtails => Curtail_Maps.Empty_Map, + Status => Failure); + end Take_Until; + + + + + + function Line_End + (Input : in Traits.Element_Array; + Context : in out Parser_Context; + Start : in Positive) + return Combinator_Result + is + begin + return + (Results => Result_Sets.Empty_Set, + Curtails => Curtail_Maps.Empty_Map, + Status => Failure); + end Line_End; + + + function Input_End + (Input : in Traits.Element_Array; + Context : in out Parser_Context; + Start : in Positive) + return Combinator_Result + is + begin + return + (Results => Result_Sets.Empty_Set, + Curtails => Curtail_Maps.Empty_Map, + Status => Failure); + end Input_End; + + +end Packrat.Parsers; + + diff --git a/src/packrat-parsers.ads b/src/packrat-parsers.ads new file mode 100644 index 0000000..8a0f39c --- /dev/null +++ b/src/packrat-parsers.ads @@ -0,0 +1,436 @@ + + +with + + Packrat.Traits, + Packrat.Parse_Graphs; + +private with + + Ada.Containers.Ordered_Maps, + Ada.Containers.Ordered_Sets, + Ada.Containers.Indefinite_Holders; + + +generic + + with package Traits is new Packrat.Traits (<>); + with package Graphs is new Packrat.Parse_Graphs (Traits); + +package Packrat.Parsers is + + + -- Memoize only adds to the Parse_Graph result when it is successful + -- so the Parser_Context will need to keep track of unsuccessful combinator + -- at given positions + + -- If all combinators are memoized in a memotable then no need to keep track of call stack + -- To do that, use start point and function access as the key? + + -- If a combinator at a position is already in the memotable, return result + -- Else run combinator, add/update result in memotable, then return result + -- As a side effect of this, the entry in the memotable will be updated several times + -- while left recursion unwinds + + -- Combinators need to return value strings as well as the finish sets + + -- Two functions, Symbolize and Ignore?, to create a node in the graph and to discard + -- the current return value string + + -- Some way to join tokens-of-tokens into just tokens + + + + + type Parser_Context is private; + + Empty_Context : constant Parser_Context; + + + + + type Combinator_Result is private; + + type Combinator is access function + (Input : in Traits.Element_Array; + Context : in out Parser_Context; + Start : in Positive) + return Combinator_Result; + + type Combinator_Array is array (Positive range <>) of Combinator; + + + + + type Component_Result is private; + + type Component is access function + (Input : in Traits.Element_Array; + Context : in out Parser_Context; + Start : in Positive) + return Component_Result; + + + + + type With_Input is access function + return Traits.Element_Array; + + + + + generic + Label : in Traits.Label_Enum; + with function Combo + (Input : in Traits.Element_Array; + Context : in out Parser_Context; + Start : in Positive) + return Combinator_Result; + function Root + (Input : in Traits.Element_Array; + Context : in out Parser_Context; + Start : in Positive) + return Component_Result; + + + + + generic + Root_Component : in Component; + procedure Parse + (Input : in Traits.Element_Array; + Context : in out Parser_Context; + Result : out Graphs.Parse_Graph); + + generic + Root_Component : in Component; + function Parse_Only + (Input : in Traits.Element_Array; + Context : in out Parser_Context) + return Graphs.Parse_Graph; + + generic + Root_Component : in Component; + function Parse_With + (Input : in With_Input; + Context : in out Parser_Context) + return Graphs.Parse_Graph; + + + + + generic + Label : in Traits.Label_Enum; + with function Combo + (Input : in Traits.Element_Array; + Context : in out Parser_Context; + Start : in Positive) + return Combinator_Result; + function Stamp + (Input : in Traits.Element_Array; + Context : in out Parser_Context; + Start : in Positive) + return Combinator_Result; + + generic + with function Combo + (Input : in Traits.Element_Array; + Context : in out Parser_Context; + Start : in Positive) + return Combinator_Result; + function Ignore + (Input : in Traits.Element_Array; + Context : in out Parser_Context; + Start : in Positive) + return Combinator_Result; + + + + + generic + Params : in Combinator_Array; + function Sequence + (Input : in Traits.Element_Array; + Context : in out Parser_Context; + Start : in Positive) + return Combinator_Result; + + generic + Params : in Combinator_Array; + function Choice + (Input : in Traits.Element_Array; + Context : in out Parser_Context; + Start : in Positive) + return Combinator_Result; + + generic + with function Param + (Input : in Traits.Element_Array; + Context : in out Parser_Context; + Start : in Positive) + return Combinator_Result; + Number : in Positive; + function Count + (Input : in Traits.Element_Array; + Context : in out Parser_Context; + Start : in Positive) + return Combinator_Result; + + generic + with function Param + (Input : in Traits.Element_Array; + Context : in out Parser_Context; + Start : in Positive) + return Combinator_Result; + Minimum : in Natural := 0; + function Many + (Input : in Traits.Element_Array; + Context : in out Parser_Context; + Start : in Positive) + return Combinator_Result; + + generic + with function Param + (Input : in Traits.Element_Array; + Context : in out Parser_Context; + Start : in Positive) + return Combinator_Result; + with function Test + (Item : in Traits.Element_Type) + return Boolean; + Minimum : in Natural := 0; + function Many_Until + (Input : in Traits.Element_Array; + Context : in out Parser_Context; + Start : in Positive) + return Combinator_Result; + + + + + generic + with function Test + (Item : in Traits.Element_Type) + return Boolean; + function Satisfy + (Input : in Traits.Element_Array; + Context : in out Parser_Context; + Start : in Positive) + return Combinator_Result; + + generic + with function Test + (Item : in Traits.Element_Type) + return Boolean; + with function Change + (From : in Traits.Element_Type) + return Traits.Element_Type; + function Satisfy_With + (Input : in Traits.Element_Array; + Context : in out Parser_Context; + Start : in Positive) + return Combinator_Result; + + generic + Item : in Traits.Element_Type; + function Match + (Input : in Traits.Element_Array; + Context : in out Parser_Context; + Start : in Positive) + return Combinator_Result; + + generic + Item : in Traits.Element_Type; + with function Change + (From : in Traits.Element_Type) + return Traits.Element_Type; + function Match_With + (Input : in Traits.Element_Array; + Context : in out Parser_Context; + Start : in Positive) + return Combinator_Result; + + generic + Items : in Traits.Element_Array; + function Multimatch + (Input : in Traits.Element_Array; + Context : in out Parser_Context; + Start : in Positive) + return Combinator_Result; + + generic + Number : in Positive := 1; + function Take + (Input : in Traits.Element_Array; + Context : in out Parser_Context; + Start : in Positive) + return Combinator_Result; + + generic + with function Test + (Item : in Traits.Element_Type) + return Boolean; + function Take_While + (Input : in Traits.Element_Array; + Context : in out Parser_Context; + Start : in Positive) + return Combinator_Result; + + generic + with function Test + (Item : in Traits.Element_Type) + return Boolean; + function Take_Until + (Input : in Traits.Element_Array; + Context : in out Parser_Context; + Start : in Positive) + return Combinator_Result; + + + + + generic + EOL_Item : in Traits.Element_Type; + function Line_End + (Input : in Traits.Element_Array; + Context : in out Parser_Context; + Start : in Positive) + return Combinator_Result; + + generic + EOF_Item : in Traits.Element_Type; + function Input_End + (Input : in Traits.Element_Array; + Context : in out Parser_Context; + Start : in Positive) + return Combinator_Result; + + +private + + + -- refactor Finish_Type from Parse_Graphs into Packrat and use here and in Lexers + + -- does the lexer handle input that doesn't start from 1 at the beginning? + + + -- results need to record what combinators were curtailed, if any, with leftrec count + + -- choice combinators can be curtailed by multiple combinators at once + + -- results need to deal with tokens to put in the graph somehow + + + -- Curtail when leftrec count exceeds number of remaining tokens plus 1 + -- for a given combinator/position + + + package Elem_Array_Holders is new Ada.Containers.Indefinite_Holders + (Element_Type => Traits.Element_Array, + "=" => Traits."="); + + package Token_Array_Holders is new Ada.Containers.Indefinite_Holders + (Element_Type => Traits.Tokens.Token_Array, + "=" => Traits.Tokens."="); + + function "<" + (Left, Right : in Elem_Array_Holders.Holder) + return Boolean; + + function "<" + (Left, Right : in Token_Array_Holders.Holder) + return Boolean; + + + + + type Combo_Key is record + Start : Positive; + Func : Combinator; + end record; + + function "<" + (Left, Right : in Combo_Key) + return Boolean; + + + + + type Combo_Result_Part is record + Finish : Natural; + Value : Elem_Array_Holders.Holder; + Tokens : Token_Array_Holders.Holder; + end record; + + function "<" + (Left, Right : in Combo_Result_Part) + return Boolean; + + package Result_Sets is new Ada.Containers.Ordered_Sets + (Element_Type => Combo_Result_Part); + + + + + function "<" + (Left, Right : in Combinator) + return Boolean; + + package Curtail_Maps is new Ada.Containers.Ordered_Maps + (Key_Type => Combinator, + Element_Type => Positive); + + + + + -- If there's anything in the Curtails, then Results should be empty + -- and vice versa... union? + type Combinator_Result is record + Results : Result_Sets.Set; + Curtails : Curtail_Maps.Map; + Status : Result_Status; + end record; + + type Component_Result is record + Status : Result_Status; + end record; + + + + + package Memotables is new Ada.Containers.Ordered_Maps + (Key_Type => Combo_Key, + Element_Type => Combinator_Result); + + package Leftrectables is new Ada.Containers.Ordered_Maps + (Key_Type => Combo_Key, + Element_Type => Positive); + + + + + type Parser_Context is record + Result_So_Far : Graphs.Parse_Graph; + Position : Positive := 1; + Offset : Natural := 0; + Status : Result_Status := Success; + Pass_Forward : Elem_Array_Holders.Holder; + Memotable : Memotables.Map; + Leftrectable : Leftrectables.Map; + Allow_Incomplete : Boolean := True; + end record; + + Empty_Context : constant Parser_Context := + (Result_So_Far => Graphs.Empty_Graph, + Position => 1, + Offset => 0, + Status => Success, + Pass_Forward => Elem_Array_Holders.Empty_Holder, + Memotable => Memotables.Empty_Map, + Leftrectable => Leftrectables.Empty_Map, + Allow_Incomplete => True); + + +end Packrat.Parsers; + + diff --git a/src/packrat-tokens.adb b/src/packrat-tokens.adb index 60d03e3..c07408c 100644 --- a/src/packrat-tokens.adb +++ b/src/packrat-tokens.adb @@ -15,33 +15,21 @@ package body Packrat.Tokens is + function "<" + (Left, Right : in Value_Holders.Holder) + return Boolean is + begin + return Left.Element < Right.Element; + end "<"; + + function "<" (Left, Right : in Token) - return Boolean - is - Left_Index, Right_Index : Positive; + return Boolean is begin if Left.Start_At = Right.Start_At then if Left.Identifier = Right.Identifier then - Left_Index := Left.Token_Value.Constant_Reference.Element'First; - Right_Index := Right.Token_Value.Constant_Reference.Element'First; - while Left_Index <= Left.Token_Value.Constant_Reference.Element'Last and - Right_Index <= Right.Token_Value.Constant_Reference.Element'Last - loop - if Left.Token_Value.Constant_Reference.Element (Left_Index) < - Right.Token_Value.Constant_Reference.Element (Right_Index) - then - return True; - elsif Left.Token_Value.Constant_Reference.Element (Left_Index) /= - Right.Token_Value.Constant_Reference.Element (Right_Index) - then - return False; - end if; - Left_Index := Left_Index + 1; - Right_Index := Right_Index + 1; - end loop; - return Left.Token_Value.Constant_Reference.Element'Length < - Right.Token_Value.Constant_Reference.Element'Length; + return Left.Token_Value < Right.Token_Value; else return Left.Identifier < Right.Identifier; end if; @@ -51,6 +39,18 @@ package body Packrat.Tokens is end "<"; + function "<" + (Left, Right : in Token_Array) + return Boolean + is + function LT is new Array_Less_Than + (Base_Type => Token, + Array_Type => Token_Array); + begin + return LT (Left, Right); + end "<"; + + diff --git a/src/packrat-tokens.ads b/src/packrat-tokens.ads index bfb70ac..cd691b5 100644 --- a/src/packrat-tokens.ads +++ b/src/packrat-tokens.ads @@ -12,6 +12,7 @@ generic type Element_Array is array (Positive range <>) of Element_Type; with function "<" (Left, Right : in Element_Type) return Boolean is <>; + with function "<" (Left, Right : in Element_Array) return Boolean is <>; package Packrat.Tokens is @@ -24,6 +25,10 @@ package Packrat.Tokens is (Left, Right : in Token) return Boolean; + function "<" + (Left, Right : in Token_Array) + return Boolean; + function Create (Ident : in Label_Enum; @@ -61,6 +66,11 @@ private package Value_Holders is new Ada.Containers.Indefinite_Holders (Element_Array); + function "<" + (Left, Right : in Value_Holders.Holder) + return Boolean; + + type Token is record Identifier : Label_Enum; Start_At : Positive; diff --git a/src/packrat-traits.adb b/src/packrat-traits.adb new file mode 100644 index 0000000..2f9715f --- /dev/null +++ b/src/packrat-traits.adb @@ -0,0 +1,20 @@ + + +package body Packrat.Traits is + + + function "<" + (Left, Right : in Element_Array) + return Boolean + is + function LT is new Array_Less_Than + (Base_Type => Element_Type, + Array_Type => Element_Array); + begin + return LT (Left, Right); + end "<"; + + +end Packrat.Traits; + + diff --git a/src/packrat-traits.ads b/src/packrat-traits.ads index d14b2fd..cf4ba89 100644 --- a/src/packrat-traits.ads +++ b/src/packrat-traits.ads @@ -16,6 +16,11 @@ generic package Packrat.Traits is + function "<" + (Left, Right : in Element_Array) + return Boolean; + + package Tokens is new Packrat.Tokens (Label_Enum, Element_Type, Element_Array); diff --git a/src/packrat.adb b/src/packrat.adb new file mode 100644 index 0000000..8c1c463 --- /dev/null +++ b/src/packrat.adb @@ -0,0 +1,28 @@ + + +package body Packrat is + + + function Array_Less_Than + (Left, Right : in Array_Type) + return Boolean + is + Left_Index : Positive := Left'First; + Right_Index : Positive := Right'First; + begin + while Left_Index <= Left'Last and Right_Index <= Right'Last loop + if Left (Left_Index) < Right (Right_Index) then + return True; + elsif Left (Left_Index) /= Right (Right_Index) then + return False; + end if; + Left_Index := Left_Index + 1; + Right_Index := Right_Index + 1; + end loop; + return Left'Length < Right'Length; + end Array_Less_Than; + + +end Packrat; + + diff --git a/src/packrat.ads b/src/packrat.ads index 7f124e1..e61fbc9 100644 --- a/src/packrat.ads +++ b/src/packrat.ads @@ -29,6 +29,17 @@ private renames Ada.Strings.Unbounded.To_String; + + + generic + type Base_Type is private; + type Array_Type is array (Positive range <>) of Base_Type; + with function "<" (Left, Right : in Base_Type) return Boolean is <>; + function Array_Less_Than + (Left, Right : in Array_Type) + return Boolean; + + end Packrat; -- cgit