diff options
| -rw-r--r-- | src/packrat-parsers.adb | 370 | ||||
| -rw-r--r-- | src/packrat-parsers.ads | 89 |
2 files changed, 385 insertions, 74 deletions
diff --git a/src/packrat-parsers.adb b/src/packrat-parsers.adb index 955c5cc..fcc69b8 100644 --- a/src/packrat-parsers.adb +++ b/src/packrat-parsers.adb @@ -9,7 +9,7 @@ package body Packrat.Parsers is function "<" - (Left, Right : in Elem_Array_Holders.Holder) + (Left, Right : in Elem_Holds.Holder) return Boolean is use Traits; @@ -19,7 +19,7 @@ package body Packrat.Parsers is function "<" - (Left, Right : in Token_Array_Holders.Holder) + (Left, Right : in Tok_Holds.Holder) return Boolean is use Traits.Tokens; @@ -44,7 +44,7 @@ package body Packrat.Parsers is (Left, Right : in Combo_Result_Part) return Boolean is - use type Elem_Array_Holders.Holder; + use type Elem_Holds.Holder; begin if Left.Finish = Right.Finish then if Left.Value = Right.Value then @@ -71,6 +71,129 @@ package body Packrat.Parsers is + function To_Key + (Start : in Positive; + Func : access function + (Input : in Traits.Element_Array; + Context : in out Parser_Context; + Start : in Positive) + return Combinator_Result) + return Combo_Key is + begin + return (Start => Start, Func => Func); + end To_Key; + + + + + + function Reusable + (Result : in Combinator_Result; + Position : in Positive; + Leftrecs : in Leftrectables.Map) + return Boolean + is + Working_Key : Combo_Key; + begin + for Cursor in Result.Curtails.Iterate loop + Working_Key := To_Key (Position, Curtail_Maps.Key (Cursor)); + if Leftrecs.Contains (Working_Key) and then + Curtail_Maps.Element (Cursor) > Leftrecs.Element (Working_Key) + then + return False; + end if; + end loop; + return True; + end Reusable; + + + function Memoize + (Context : in out Parser_Context) + return Combinator_Result + is + Result : Combinator_Result; + begin + if Context.Memotable.Contains (My_Key) then + Result := Context.Memotable.Element (My_Key); + if Reusable (Result, My_Key.Start, Context.Leftrectable) then + return Result; + end if; + end if; + Result := Actual (Context); + if Context.Memotable.Contains (My_Key) then + Context.Memotable.Replace (My_Key, Result); + else + Context.Memotable.Insert (My_Key, Result); + end if; + return Result; + end Memoize; + + + + + + procedure Inc_Leftrec + (Key : in Combo_Key; + Context : in out Parser_Context) is + begin + if Context.Leftrectable.Contains (Key) then + Context.Leftrectable.Replace (Key, Context.Leftrectable.Element (Key) + 1); + else + Context.Leftrectable.Insert (Key, 1); + end if; + end Inc_Leftrec; + + + procedure Dec_Leftrec + (Key : in Combo_Key; + Context : in out Parser_Context) is + begin + if Context.Leftrectable.Contains (Key) then + if Context.Leftrectable.Element (Key) = 1 then + Context.Leftrectable.Delete (Key); + else + Context.Leftrectable.Replace (Key, Context.Leftrectable.Element (Key) - 1); + end if; + end if; + end Dec_Leftrec; + + + function Exceeds_Curtail + (Key : in Combo_Key; + Context : in Parser_Context; + Input : in Traits.Element_Array) + return Boolean is + begin + return Context.Leftrectable.Contains (Key) and then + Context.Leftrectable.Element (Key) > Input'Last - (Key.Start - 1) + 1; + end Exceeds_Curtail; + + + function Curtailment + (Context : in out Parser_Context) + return Combinator_Result + is + My_Result : Combinator_Result; + My_Curtails : Curtail_Maps.Map; + begin + Inc_Leftrec (My_Key, Context); + if Exceeds_Curtail (My_Key, Context, Input) then + My_Curtails.Insert (My_Key.Func, Context.Leftrectable.Element (My_Key)); + My_Result := + (Results => Result_Sets.Empty_Set, + Curtails => My_Curtails, + Status => Failure); + else + My_Result := Actual (Context); + end if; + Dec_Leftrec (My_Key, Context); + return My_Result; + end Curtailment; + + + + + function Root (Input : in Traits.Element_Array; Context : in out Parser_Context; @@ -78,6 +201,7 @@ package body Packrat.Parsers is return Component_Result is begin + -- to-do return (Status => Failure); end Root; @@ -91,6 +215,7 @@ package body Packrat.Parsers is Result : out Graphs.Parse_Graph) is begin + -- to-do null; end Parse; @@ -101,6 +226,7 @@ package body Packrat.Parsers is return Graphs.Parse_Graph is begin + -- to-do return Graphs.Empty_Graph; end Parse_Only; @@ -111,6 +237,7 @@ package body Packrat.Parsers is return Graphs.Parse_Graph is begin + -- to-do return Graphs.Empty_Graph; end Parse_With; @@ -125,6 +252,7 @@ package body Packrat.Parsers is return Combinator_Result is begin + -- to-do return (Results => Result_Sets.Empty_Set, Curtails => Curtail_Maps.Empty_Map, @@ -139,6 +267,7 @@ package body Packrat.Parsers is return Combinator_Result is begin + -- to-do return (Results => Result_Sets.Empty_Set, Curtails => Curtail_Maps.Empty_Map, @@ -156,6 +285,7 @@ package body Packrat.Parsers is return Combinator_Result is begin + -- to-do return (Results => Result_Sets.Empty_Set, Curtails => Curtail_Maps.Empty_Map, @@ -170,6 +300,7 @@ package body Packrat.Parsers is return Combinator_Result is begin + -- to-do return (Results => Result_Sets.Empty_Set, Curtails => Curtail_Maps.Empty_Map, @@ -184,6 +315,7 @@ package body Packrat.Parsers is return Combinator_Result is begin + -- to-do return (Results => Result_Sets.Empty_Set, Curtails => Curtail_Maps.Empty_Map, @@ -198,6 +330,7 @@ package body Packrat.Parsers is return Combinator_Result is begin + -- to-do return (Results => Result_Sets.Empty_Set, Curtails => Curtail_Maps.Empty_Map, @@ -212,6 +345,7 @@ package body Packrat.Parsers is return Combinator_Result is begin + -- to-do return (Results => Result_Sets.Empty_Set, Curtails => Curtail_Maps.Empty_Map, @@ -228,11 +362,26 @@ package body Packrat.Parsers is Start : in Positive) return Combinator_Result is + use type Traits.Element_Type; + function Actual + (Context : in out Parser_Context) + return Combinator_Result is + begin + if Start > Input'Last or else not Test (Input (Start)) then + return Empty_Fail; + else + return + (Results => Result_Sets.To_Set + ((Finish => Start, + Value => Elem_Holds.To_Holder (Input (Start .. Start)), + Tokens => Tok_Holds.Empty_Holder)), + Curtails => Curtail_Maps.Empty_Map, + Status => Success); + end if; + end Actual; + function Call is new Memoize (To_Key (Start, Satisfy'Access), Actual); begin - return - (Results => Result_Sets.Empty_Set, - Curtails => Curtail_Maps.Empty_Map, - Status => Failure); + return Call (Context); end Satisfy; @@ -242,11 +391,26 @@ package body Packrat.Parsers is Start : in Positive) return Combinator_Result is + use type Traits.Element_Type; + function Actual + (Context : in out Parser_Context) + return Combinator_Result is + begin + if Start > Input'Last or else not Test (Change (Input (Start))) then + return Empty_Fail; + else + return + (Results => Result_Sets.To_Set + ((Finish => Start, + Value => Elem_Holds.To_Holder (Input (Start .. Start)), + Tokens => Tok_Holds.Empty_Holder)), + Curtails => Curtail_Maps.Empty_Map, + Status => Success); + end if; + end Actual; + function Call is new Memoize (To_Key (Start, Satisfy_With'Access), Actual); begin - return - (Results => Result_Sets.Empty_Set, - Curtails => Curtail_Maps.Empty_Map, - Status => Failure); + return Call (Context); end Satisfy_With; @@ -256,11 +420,26 @@ package body Packrat.Parsers is Start : in Positive) return Combinator_Result is + use type Traits.Element_Type; + function Actual + (Context : in out Parser_Context) + return Combinator_Result is + begin + if Start > Input'Last or else Input (Start) /= Item then + return Empty_Fail; + else + return + (Results => Result_Sets.To_Set + ((Finish => Start, + Value => Elem_Holds.To_Holder (Input (Start .. Start)), + Tokens => Tok_Holds.Empty_Holder)), + Curtails => Curtail_Maps.Empty_Map, + Status => Success); + end if; + end Actual; + function Call is new Memoize (To_Key (Start, Match'Access), Actual); begin - return - (Results => Result_Sets.Empty_Set, - Curtails => Curtail_Maps.Empty_Map, - Status => Failure); + return Call (Context); end Match; @@ -270,11 +449,26 @@ package body Packrat.Parsers is Start : in Positive) return Combinator_Result is + use type Traits.Element_Type; + function Actual + (Context : in out Parser_Context) + return Combinator_Result is + begin + if Start > Input'Last or else Change (Input (Start)) /= Item then + return Empty_Fail; + else + return + (Results => Result_Sets.To_Set + ((Finish => Start, + Value => Elem_Holds.To_Holder (Input (Start .. Start)), + Tokens => Tok_Holds.Empty_Holder)), + Curtails => Curtail_Maps.Empty_Map, + Status => Success); + end if; + end Actual; + function Call is new Memoize (To_Key (Start, Match_With'Access), Actual); begin - return - (Results => Result_Sets.Empty_Set, - Curtails => Curtail_Maps.Empty_Map, - Status => Failure); + return Call (Context); end Match_With; @@ -284,11 +478,35 @@ package body Packrat.Parsers is Start : in Positive) return Combinator_Result is + use type Traits.Element_Array; + function Actual + (Context : in out Parser_Context) + return Combinator_Result + is + My_Offset : Natural; + begin + if Start > Input'Last then + return Empty_Fail; + elsif Items'Length = 0 then + return Empty (Input, Context, Start); + end if; + My_Offset := Natural'Min (Input'Last - Start, Items'Length - 1); + if Input (Start .. Start + My_Offset) /= + Items (Items'First .. Items'First + My_Offset) + then + return Empty_Fail; + end if; + return + (Results => Result_Sets.To_Set + ((Finish => Start + My_Offset, + Value => Elem_Holds.To_Holder (Input (Start .. Start + My_Offset)), + Tokens => Tok_Holds.Empty_Holder)), + Curtails => Curtail_Maps.Empty_Map, + Status => (if My_Offset < Items'Length - 1 then Needs_More else Success)); + end Actual; + function Call is new Memoize (To_Key (Start, Multimatch'Access), Actual); begin - return - (Results => Result_Sets.Empty_Set, - Curtails => Curtail_Maps.Empty_Map, - Status => Failure); + return Call (Context); end Multimatch; @@ -298,11 +516,27 @@ package body Packrat.Parsers is Start : in Positive) return Combinator_Result is + function Actual + (Context : in out Parser_Context) + return Combinator_Result + is + My_Offset : Natural; + begin + if Start > Input'Last then + return Empty_Fail; + end if; + My_Offset := Natural'Min (Input'Last - Start, Number - 1); + return + (Results => Result_Sets.To_Set + ((Finish => Start + My_Offset, + Value => Elem_Holds.To_Holder (Input (Start .. Start + My_Offset)), + Tokens => Tok_Holds.Empty_Holder)), + Curtails => Curtail_Maps.Empty_Map, + Status => (if My_Offset < Number - 1 then Needs_More else Success)); + end Actual; + function Call is new Memoize (To_Key (Start, Take'Access), Actual); begin - return - (Results => Result_Sets.Empty_Set, - Curtails => Curtail_Maps.Empty_Map, - Status => Failure); + return Call (Context); end Take; @@ -312,11 +546,30 @@ package body Packrat.Parsers is Start : in Positive) return Combinator_Result is + function Actual + (Context : in out Parser_Context) + return Combinator_Result + is + My_Finish : Positive := Start; + begin + if Start > Input'Last or else not Test (Input (Start)) then + return Empty_Fail; + end if; + while My_Finish <= Input'Last and then Test (Input (My_Finish)) loop + My_Finish := My_Finish + 1; + end loop; + My_Finish := My_Finish - 1; + return + (Results => Result_Sets.To_Set + ((Finish => My_Finish, + Value => Elem_Holds.To_Holder (Input (Start .. My_Finish)), + Tokens => Tok_Holds.Empty_Holder)), + Curtails => Curtail_Maps.Empty_Map, + Status => (if My_Finish = Input'Last then Optional_More else Success)); + end Actual; + function Call is new Memoize (To_Key (Start, Take_While'Access), Actual); begin - return - (Results => Result_Sets.Empty_Set, - Curtails => Curtail_Maps.Empty_Map, - Status => Failure); + return Call (Context); end Take_While; @@ -326,43 +579,50 @@ package body Packrat.Parsers is Start : in Positive) return Combinator_Result is + function Actual + (Context : in out Parser_Context) + return Combinator_Result + is + My_Finish : Positive := Start; + begin + if Start > Input'Last or else Test (Input (Start)) then + return Empty_Fail; + end if; + while My_Finish <= Input'Last and then not Test (Input (My_Finish)) loop + My_Finish := My_Finish + 1; + end loop; + My_Finish := My_Finish - 1; + return + (Results => Result_Sets.To_Set + ((Finish => My_Finish, + Value => Elem_Holds.To_Holder (Input (Start .. My_Finish)), + Tokens => Tok_Holds.Empty_Holder)), + Curtails => Curtail_Maps.Empty_Map, + Status => (if My_Finish = Input'Last then Optional_More else Success)); + end Actual; + function Call is new Memoize (To_Key (Start, Take_Until'Access), Actual); begin - return - (Results => Result_Sets.Empty_Set, - Curtails => Curtail_Maps.Empty_Map, - Status => Failure); + return Call (Context); end Take_Until; - function Line_End + function Empty (Input : in Traits.Element_Array; Context : in out Parser_Context; Start : in Positive) - return Combinator_Result - is + return Combinator_Result is begin return - (Results => Result_Sets.Empty_Set, + (Results => Result_Sets.To_Set + ((Finish => Start - 1, + Value => Elem_Holds.Empty_Holder, + Tokens => Tok_Holds.Empty_Holder)), 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; + Status => Success); + end Empty; end Packrat.Parsers; diff --git a/src/packrat-parsers.ads b/src/packrat-parsers.ads index 8a0f39c..55cb12a 100644 --- a/src/packrat-parsers.ads +++ b/src/packrat-parsers.ads @@ -289,17 +289,7 @@ package Packrat.Parsers is - 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 + function Empty (Input : in Traits.Element_Array; Context : in out Parser_Context; Start : in Positive) @@ -325,20 +315,20 @@ private -- for a given combinator/position - package Elem_Array_Holders is new Ada.Containers.Indefinite_Holders + package Elem_Holds is new Ada.Containers.Indefinite_Holders (Element_Type => Traits.Element_Array, "=" => Traits."="); - package Token_Array_Holders is new Ada.Containers.Indefinite_Holders + package Tok_Holds is new Ada.Containers.Indefinite_Holders (Element_Type => Traits.Tokens.Token_Array, "=" => Traits.Tokens."="); function "<" - (Left, Right : in Elem_Array_Holders.Holder) + (Left, Right : in Elem_Holds.Holder) return Boolean; function "<" - (Left, Right : in Token_Array_Holders.Holder) + (Left, Right : in Tok_Holds.Holder) return Boolean; @@ -353,13 +343,24 @@ private (Left, Right : in Combo_Key) return Boolean; + -- This is needed to avoid some issues with using non-anonymous + -- access values in a generic subprogram instantiation. + function To_Key + (Start : in Positive; + Func : access function + (Input : in Traits.Element_Array; + Context : in out Parser_Context; + Start : in Positive) + return Combinator_Result) + return Combo_Key; + type Combo_Result_Part is record Finish : Natural; - Value : Elem_Array_Holders.Holder; - Tokens : Token_Array_Holders.Holder; + Value : Elem_Holds.Holder; + Tokens : Tok_Holds.Holder; end record; function "<" @@ -395,6 +396,11 @@ private Status : Result_Status; end record; + Empty_Fail : constant Combinator_Result := + (Results => Result_Sets.Empty_Set, + Curtails => Curtail_Maps.Empty_Map, + Status => Failure); + @@ -414,7 +420,7 @@ private Position : Positive := 1; Offset : Natural := 0; Status : Result_Status := Success; - Pass_Forward : Elem_Array_Holders.Holder; + Pass_Forward : Elem_Holds.Holder; Memotable : Memotables.Map; Leftrectable : Leftrectables.Map; Allow_Incomplete : Boolean := True; @@ -425,12 +431,57 @@ private Position => 1, Offset => 0, Status => Success, - Pass_Forward => Elem_Array_Holders.Empty_Holder, + Pass_Forward => Elem_Holds.Empty_Holder, Memotable => Memotables.Empty_Map, Leftrectable => Leftrectables.Empty_Map, Allow_Incomplete => True); + + + function Reusable + (Result : in Combinator_Result; + Position : in Positive; + Leftrecs : in Leftrectables.Map) + return Boolean; + + generic + My_Key : in Combo_Key; + with function Actual + (Context : in out Parser_Context) + return Combinator_Result; + function Memoize + (Context : in out Parser_Context) + return Combinator_Result; + + + + + procedure Inc_Leftrec + (Key : in Combo_Key; + Context : in out Parser_Context); + + procedure Dec_Leftrec + (Key : in Combo_Key; + Context : in out Parser_Context); + + function Exceeds_Curtail + (Key : in Combo_Key; + Context : in Parser_Context; + Input : in Traits.Element_Array) + return Boolean; + + generic + My_Key : in Combo_Key; + Input : in Traits.Element_Array; + with function Actual + (Context : in out Parser_Context) + return Combinator_Result; + function Curtailment + (Context : in out Parser_Context) + return Combinator_Result; + + end Packrat.Parsers; |