From d5df1b33144f92b6070e957db293e36b27e14439 Mon Sep 17 00:00:00 2001 From: Jed Barber Date: Tue, 1 Dec 2020 16:04:17 +1100 Subject: Curtailing parser combinators implemented --- src/packrat-parsers.adb | 529 ++++++++++++++++++++++++++++++++++++------------ 1 file changed, 400 insertions(+), 129 deletions(-) (limited to 'src/packrat-parsers.adb') diff --git a/src/packrat-parsers.adb b/src/packrat-parsers.adb index fcc69b8..bfb67d7 100644 --- a/src/packrat-parsers.adb +++ b/src/packrat-parsers.adb @@ -133,39 +133,39 @@ package body Packrat.Parsers is procedure Inc_Leftrec - (Key : in Combo_Key; - Context : in out Parser_Context) is + (Key : in Combo_Key; + Leftrecs : in out Leftrectables.Map) is begin - if Context.Leftrectable.Contains (Key) then - Context.Leftrectable.Replace (Key, Context.Leftrectable.Element (Key) + 1); + if Leftrecs.Contains (Key) then + Leftrecs.Replace (Key, Leftrecs.Element (Key) + 1); else - Context.Leftrectable.Insert (Key, 1); + Leftrecs.Insert (Key, 1); end if; end Inc_Leftrec; procedure Dec_Leftrec - (Key : in Combo_Key; - Context : in out Parser_Context) is + (Key : in Combo_Key; + Leftrecs : in out Leftrectables.Map) is begin - if Context.Leftrectable.Contains (Key) then - if Context.Leftrectable.Element (Key) = 1 then - Context.Leftrectable.Delete (Key); + if Leftrecs.Contains (Key) then + if Leftrecs.Element (Key) = 1 then + Leftrecs.Delete (Key); else - Context.Leftrectable.Replace (Key, Context.Leftrectable.Element (Key) - 1); + Leftrecs.Replace (Key, Leftrecs.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) + (Key : in Combo_Key; + Leftrecs : in Leftrectables.Map; + 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; + return Leftrecs.Contains (Key) and then + Leftrecs.Element (Key) > Input'Last - (Key.Start - 1) + 1; end Exceeds_Curtail; @@ -176,8 +176,8 @@ package body Packrat.Parsers is My_Result : Combinator_Result; My_Curtails : Curtail_Maps.Map; begin - Inc_Leftrec (My_Key, Context); - if Exceeds_Curtail (My_Key, Context, Input) then + Inc_Leftrec (My_Key, Context.Leftrectable); + if Exceeds_Curtail (My_Key, Context.Leftrectable, Input) then My_Curtails.Insert (My_Key.Func, Context.Leftrectable.Element (My_Key)); My_Result := (Results => Result_Sets.Empty_Set, @@ -186,7 +186,7 @@ package body Packrat.Parsers is else My_Result := Actual (Context); end if; - Dec_Leftrec (My_Key, Context); + Dec_Leftrec (My_Key, Context.Leftrectable); return My_Result; end Curtailment; @@ -194,6 +194,118 @@ package body Packrat.Parsers is + procedure Merge + (Target : in out Curtail_Maps.Map; + Add : in Curtail_Maps.Map) is + begin + for Curse in Add.Iterate loop + if Target.Contains (Curtail_Maps.Key (Curse)) then + if Target.Element (Curtail_Maps.Key (Curse)) > + Add.Element (Curtail_Maps.Key (Curse)) + then + Target.Replace (Curtail_Maps.Key (Curse), Curtail_Maps.Element (Curse)); + end if; + else + Target.Insert (Curtail_Maps.Key (Curse), Curtail_Maps.Element (Curse)); + end if; + end loop; + end Merge; + + + function Merge + (Left, Right : in Curtail_Maps.Map) + return Curtail_Maps.Map is + begin + return Result : Curtail_Maps.Map := Left do + Merge (Result, Right); + end return; + end Merge; + + + procedure Merge + (Target : in out Combinator_Result; + Add : in Combinator_Result) is + begin + case Target.Status is + when Success => + Target.Results.Union (Add.Results); + if Add.Status = Optional_More or Add.Status = Needs_More then + Target.Status := Optional_More; + end if; + when Optional_More => + Target.Results.Union (Add.Results); + when Needs_More => + if Add.Status = Success or Add.Status = Optional_More then + Target.Results.Union (Add.Results); + Target.Status := Optional_More; + end if; + when Failure => + if Add.Status = Failure then + Merge (Target.Curtails, Add.Curtails); + else + Target := Add; + end if; + end case; + end Merge; + + + function Merge + (Left, Right : in Combinator_Result) + return Combinator_Result is + begin + return Salt : Combinator_Result := Left do + Merge (Salt, Right); + end return; + end Merge; + + + function Continue + (From : in Combinator_Result; + Input : in Traits.Element_Array; + Context : in out Parser_Context) + return Combinator_Result + is + use type Traits.Element_Array; + use type Traits.Tokens.Token_Array; + Salt, Temp : Combinator_Result; + Adjust : Result_Sets.Set; + begin + for R of From.Results loop + Temp := Next (Input, Context, R.Finish + 1); + Adjust.Clear; + for N of Temp.Results loop + Adjust.Insert + ((Finish => N.Finish, + Value => Elem_Holds.To_Holder (R.Value.Element & N.Value.Element), + Tokens => Tok_Holds.To_Holder (R.Tokens.Element & N.Tokens.Element))); + end loop; + Temp.Results := Adjust; + Merge (Salt, Temp); + end loop; + return Salt; + end Continue; + + + + + + procedure Complete_Status + (Result : in out Combinator_Result; + Allow : in Boolean) is + begin + if not Allow then + if Result.Status = Optional_More then + Result.Status := Success; + elsif Result.Status = Needs_More then + Result.Status := Failure; + end if; + end if; + end Complete_Status; + + + + + function Root (Input : in Traits.Element_Array; Context : in out Parser_Context; @@ -284,12 +396,33 @@ package body Packrat.Parsers is Start : in Positive) return Combinator_Result is + function Actual + (Context : in out Parser_Context) + return Combinator_Result + is + Salt : Combinator_Result; + begin + if Start > Input'Last then + return Empty_Fail; + elsif Params'Length = 0 then + return Empty (Input, Context, Start); + end if; + Salt := Params (Params'First) (Input, Context, Start); + for I in Integer range Params'First + 1 .. Params'Last loop + exit when Salt.Status = Failure; + declare + function Cont_Param is new Continue (Params (I).all); + begin + Salt := Cont_Param (Salt, Input, Context); + end; + end loop; + Complete_Status (Salt, Context.Allow_Incomplete); + return Salt; + end Actual; + function Curt is new Curtailment (To_Key (Start, Sequence'Access), Input, Actual); + function Memo is new Memoize (To_Key (Start, Sequence'Access), Curt); begin - -- to-do - return - (Results => Result_Sets.Empty_Set, - Curtails => Curtail_Maps.Empty_Map, - Status => Failure); + return Memo (Context); end Sequence; @@ -299,12 +432,27 @@ package body Packrat.Parsers is Start : in Positive) return Combinator_Result is + function Actual + (Context : in out Parser_Context) + return Combinator_Result + is + Salt : Combinator_Result; + begin + if Start > Input'Last then + return Empty_Fail; + elsif Params'Length = 0 then + return Empty (Input, Context, Start); + end if; + for C of Params loop + Merge (Salt, C (Input, Context, Start)); + end loop; + Complete_Status (Salt, Context.Allow_Incomplete); + return Salt; + end Actual; + function Curt is new Curtailment (To_Key (Start, Choice'Access), Input, Actual); + function Memo is new Memoize (To_Key (Start, Choice'Access), Curt); begin - -- to-do - return - (Results => Result_Sets.Empty_Set, - Curtails => Curtail_Maps.Empty_Map, - Status => Failure); + return Memo (Context); end Choice; @@ -314,12 +462,30 @@ package body Packrat.Parsers is Start : in Positive) return Combinator_Result is + function Actual + (Context : in out Parser_Context) + return Combinator_Result + is + function Cont_Param is new Continue (Param); + Salt : Combinator_Result; + Counter : Natural := 0; + begin + if Start > Input'Last then + return Empty_Fail; + end if; + Salt := Param (Input, Context, Start); + while Salt.Status /= Failure loop + Counter := Counter + 1; + exit when Counter = Number; + Salt := Cont_Param (Salt, Input, Context); + end loop; + Complete_Status (Salt, Context.Allow_Incomplete); + return Salt; + end Actual; + function Curt is new Curtailment (To_Key (Start, Count'Access), Input, Actual); + function Memo is new Memoize (To_Key (Start, Count'Access), Curt); begin - -- to-do - return - (Results => Result_Sets.Empty_Set, - Curtails => Curtail_Maps.Empty_Map, - Status => Failure); + return Memo (Context); end Count; @@ -329,12 +495,39 @@ package body Packrat.Parsers is Start : in Positive) return Combinator_Result is + function Actual + (Context : in out Parser_Context) + return Combinator_Result + is + function Not_Empty_Param is new Not_Empty (Param); + function Cont_Param is new Continue (Not_Empty_Param); + Salt, Temp : Combinator_Result; + Counter : Natural := 0; + begin + if Start > Input'Last then + return Empty_Fail; + end if; + if Minimum = 0 then + Merge (Salt, Empty (Input, Context, Start)); + end if; + Temp := Not_Empty_Param (Input, Context, Start); + while Temp.Status /= Failure loop + Counter := Counter + 1; + if Counter >= Minimum then + Merge (Salt, Temp); + elsif Temp.Status = Optional_More or Temp.Status = Needs_More then + Salt.Status := Needs_More; + exit; + end if; + Temp := Cont_Param (Temp, Input, Context); + end loop; + Complete_Status (Salt, Context.Allow_Incomplete); + return Salt; + end Actual; + function Curt is new Curtailment (To_Key (Start, Many'Access), Input, Actual); + function Memo is new Memoize (To_Key (Start, Many'Access), Curt); begin - -- to-do - return - (Results => Result_Sets.Empty_Set, - Curtails => Curtail_Maps.Empty_Map, - Status => Failure); + return Memo (Context); end Many; @@ -344,15 +537,80 @@ package body Packrat.Parsers is Start : in Positive) return Combinator_Result is + function Actual + (Context : in out Parser_Context) + return Combinator_Result + is + function Not_Empty_Param is new Not_Empty (Param); + function Cont_Param is new Continue (Not_Empty_Param); + Salt, Temp : Combinator_Result; + Adjust : Result_Sets.Set; + Counter : Natural := 0; + begin + if Start > Input'Last then + return Empty_Fail; + end if; + if Minimum = 0 then + Merge (Salt, Empty (Input, Context, Start)); + end if; + if Test (Input (Start)) then + return Salt; + end if; + Temp := Not_Empty_Param (Input, Context, Start); + while Temp.Status /= Failure loop + Counter := Counter + 1; + if Counter >= Minimum then + Merge (Salt, Temp); + elsif Temp.Status = Optional_More or Temp.Status = Needs_More then + Salt.Status := Needs_More; + exit; + end if; + Adjust.Clear; + for R of Temp.Results loop + if R.Finish = Input'Last or else not Test (Input (R.Finish + 1)) then + Adjust.Insert (R); + end if; + end loop; + Temp.Results.Assign (Adjust); + Temp := Cont_Param (Temp, Input, Context); + end loop; + Complete_Status (Salt, Context.Allow_Incomplete); + return Salt; + end Actual; + function Curt is new Curtailment (To_Key (Start, Many_Until'Access), Input, Actual); + function Memo is new Memoize (To_Key (Start, Many_Until'Access), Curt); begin - -- to-do - return - (Results => Result_Sets.Empty_Set, - Curtails => Curtail_Maps.Empty_Map, - Status => Failure); + return Memo (Context); end Many_Until; + function Optional + (Input : in Traits.Element_Array; + Context : in out Parser_Context; + Start : in Positive) + return Combinator_Result + is + function Actual + (Context : in out Parser_Context) + return Combinator_Result + is + function Not_Empty_Param is new Not_Empty (Param); + Salt : Combinator_Result := Empty (Input, Context, Start); + begin + if Start > Input'Last then + return Empty_Fail; + end if; + Merge (Salt, Not_Empty_Param (Input, Context, Start)); + Complete_Status (Salt, Context.Allow_Incomplete); + return Salt; + end Actual; + function Curt is new Curtailment (To_Key (Start, Optional'Access), Input, Actual); + function Memo is new Memoize (To_Key (Start, Optional'Access), Curt); + begin + return Memo (Context); + end Optional; + + @@ -362,22 +620,20 @@ 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 + return Combinator_Result + is + Part : Combo_Result_Part; + Salt : Combinator_Result; 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); + if Start <= Input'Last and then Test (Input (Start)) then + Part.Finish := Start; + Part.Value := Elem_Holds.To_Holder (Input (Start .. Start)); + Salt.Results.Insert (Part); + Salt.Status := Success; end if; + return Salt; end Actual; function Call is new Memoize (To_Key (Start, Satisfy'Access), Actual); begin @@ -391,22 +647,20 @@ 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 + return Combinator_Result + is + Part : Combo_Result_Part; + Salt : Combinator_Result; 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); + if Start <= Input'Last and then Test (Change (Input (Start))) then + Part.Finish := Start; + Part.Value := Elem_Holds.To_Holder (Input (Start .. Start)); + Salt.Results.Insert (Part); + Salt.Status := Success; end if; + return Salt; end Actual; function Call is new Memoize (To_Key (Start, Satisfy_With'Access), Actual); begin @@ -420,22 +674,21 @@ 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 + return Combinator_Result + is + use type Traits.Element_Type; + Part : Combo_Result_Part; + Salt : Combinator_Result; 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); + if Start <= Input'Last and then Input (Start) = Item then + Part.Finish := Start; + Part.Value := Elem_Holds.To_Holder (Input (Start .. Start)); + Salt.Results.Insert (Part); + Salt.Status := Success; end if; + return Salt; end Actual; function Call is new Memoize (To_Key (Start, Match'Access), Actual); begin @@ -449,22 +702,21 @@ 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 + return Combinator_Result + is + use type Traits.Element_Type; + Part : Combo_Result_Part; + Salt : Combinator_Result; 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); + if Start <= Input'Last and then Change (Input (Start)) = Item then + Part.Finish := Start; + Part.Value := Elem_Holds.To_Holder (Input (Start .. Start)); + Salt.Results.Insert (Part); + Salt.Status := Success; end if; + return Salt; end Actual; function Call is new Memoize (To_Key (Start, Match_With'Access), Actual); begin @@ -478,11 +730,12 @@ 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 + use type Traits.Element_Array; + Part : Combo_Result_Part; My_Offset : Natural; begin if Start > Input'Last then @@ -496,13 +749,12 @@ package body Packrat.Parsers is 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)); + return Salt : Combinator_Result do + Part.Finish := Start + My_Offset; + Part.Value := Elem_Holds.To_Holder (Input (Start .. Start + My_Offset)); + Salt.Results.Insert (Part); + Salt.Status := (if My_Offset < Items'Length - 1 then Needs_More else Success); + end return; end Actual; function Call is new Memoize (To_Key (Start, Multimatch'Access), Actual); begin @@ -520,19 +772,19 @@ package body Packrat.Parsers is (Context : in out Parser_Context) return Combinator_Result is + Part : Combo_Result_Part; 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)); + return Salt : Combinator_Result do + Part.Finish := Start + My_Offset; + Part.Value := Elem_Holds.To_Holder (Input (Start .. Start + My_Offset)); + Salt.Results.Insert (Part); + Salt.Status := (if My_Offset < Number - 1 then Needs_More else Success); + end return; end Actual; function Call is new Memoize (To_Key (Start, Take'Access), Actual); begin @@ -550,6 +802,7 @@ package body Packrat.Parsers is (Context : in out Parser_Context) return Combinator_Result is + Part : Combo_Result_Part; My_Finish : Positive := Start; begin if Start > Input'Last or else not Test (Input (Start)) then @@ -559,13 +812,12 @@ package body Packrat.Parsers is 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)); + return Salt : Combinator_Result do + Part.Finish := My_Finish; + Part.Value := Elem_Holds.To_Holder (Input (Start .. My_Finish)); + Salt.Results.Insert (Part); + Salt.Status := (if My_Finish = Input'Last then Optional_More else Success); + end return; end Actual; function Call is new Memoize (To_Key (Start, Take_While'Access), Actual); begin @@ -583,6 +835,7 @@ package body Packrat.Parsers is (Context : in out Parser_Context) return Combinator_Result is + Part : Combo_Result_Part; My_Finish : Positive := Start; begin if Start > Input'Last or else Test (Input (Start)) then @@ -592,13 +845,12 @@ package body Packrat.Parsers is 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)); + return Salt : Combinator_Result do + Part.Finish := My_Finish; + Part.Value := Elem_Holds.To_Holder (Input (Start .. My_Finish)); + Salt.Results.Insert (Part); + Salt.Status := (if My_Finish = Input'Last then Optional_More else Success); + end return; end Actual; function Call is new Memoize (To_Key (Start, Take_Until'Access), Actual); begin @@ -613,18 +865,37 @@ package body Packrat.Parsers is (Input : in Traits.Element_Array; Context : in out Parser_Context; Start : in Positive) - return Combinator_Result is + return Combinator_Result + is + Part : Combo_Result_Part; + Salt : Combinator_Result; begin - return - (Results => Result_Sets.To_Set - ((Finish => Start - 1, - Value => Elem_Holds.Empty_Holder, - Tokens => Tok_Holds.Empty_Holder)), - Curtails => Curtail_Maps.Empty_Map, - Status => Success); + Part.Finish := Start - 1; + Salt.Results.Insert (Part); + Salt.Status := Success; + return Salt; end Empty; + function Not_Empty + (Input : in Traits.Element_Array; + Context : in out Parser_Context; + Start : in Positive) + return Combinator_Result + is + Salt : Combinator_Result := Combo (Input, Context, Start); + Adjust : Result_Sets.Set; + begin + for R of Salt.Results loop + if R.Finish >= Start then + Adjust.Insert (R); + end if; + end loop; + Salt.Results.Assign (Adjust); + return Salt; + end Not_Empty; + + end Packrat.Parsers; -- cgit