-- This source is licensed under the Sunset License v1.0 with Packrat.Errors, System; package body Packrat.Parsers is function Element (Hold : in Elem_Holds.Holder) return Traits.Element_Array is begin if Hold.Is_Empty then return Value : Traits.Element_Array (1 .. 0); else return Hold.Element; end if; end Element; function Element (Hold : in Tok_Holds.Holder) return Traits.Tokens.Finished_Token_Array is begin if Hold.Is_Empty then return Value : Traits.Tokens.Finished_Token_Array (1 .. 0); else return Hold.Element; end if; end Element; function "<" (Left, Right : in Elem_Holds.Holder) return Boolean is use Traits; begin return Element (Left) < Element (Right); end "<"; function "<" (Left, Right : in Tok_Holds.Holder) return Boolean is use type Traits.Tokens.Finished_Token_Array; begin return Element (Left) < Element (Right); 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_Holds.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 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 not Leftrecs.Contains (Working_Key) or else 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, Previous : Combinator_Result; Combo : Combinator; Left : Positive; begin if Context.Memotable.Contains (My_Key) then Previous := Context.Memotable.Element (My_Key); if Reusable (Previous, My_Key.Start, Context.Leftrectable) then return Previous; end if; end if; if My_Key.Start < Context.Current_Position then raise Constraint_Error; end if; Result := Actual (Context); if Result.Status = Needs_More or Result.Status = Optional_More then Context.Needs_More.Include (My_Key.Start); end if; if Context.Memotable.Contains (My_Key) then for C in Previous.Curtails.Iterate loop Combo := Curtail_Maps.Key (C); if Context.Leftrectable.Contains (To_Key (My_Key.Start, Combo)) then Left := Context.Leftrectable.Element (To_Key (My_Key.Start, Combo)); if not Result.Results.Is_Empty and then Result.Results.Last_Element.Finish - Left > My_Key.Start then Result.Curtails.Exclude (Combo); elsif Result.Curtails.Contains (Combo) then Result.Curtails.Replace (Combo, Left); else Result.Curtails.Insert (Combo, Left); end if; else Result.Curtails.Exclude (Combo); end if; end loop; 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; Leftrecs : in out Leftrectables.Map) is begin if Leftrecs.Contains (Key) then Leftrecs.Replace (Key, Leftrecs.Element (Key) + 1); else Leftrecs.Insert (Key, 1); end if; end Inc_Leftrec; procedure Dec_Leftrec (Key : in Combo_Key; Leftrecs : in out Leftrectables.Map) is begin if Leftrecs.Contains (Key) then if Leftrecs.Element (Key) = 1 then Leftrecs.Delete (Key); else Leftrecs.Replace (Key, Leftrecs.Element (Key) - 1); end if; end if; end Dec_Leftrec; function Exceeds_Curtail (Key : in Combo_Key; Leftrecs : in Leftrectables.Map; Input : in Traits.Element_Array) return Boolean is begin return Leftrecs.Contains (Key) and then Leftrecs.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.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, Curtails => My_Curtails, Status => Failure); else My_Result := Actual (Context); end if; Dec_Leftrec (My_Key, Context.Leftrectable); return My_Result; end Curtailment; 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)) < Curtail_Maps.Element (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 Merge (Target.Curtails, Add.Curtails); case Target.Status is when Success => case Add.Status is when Success => Target.Results.Union (Add.Results); when Optional_More => Target.Results.Union (Add.Results); Target.Status := Optional_More; when Needs_More => Target.Status := Optional_More; when Failure => null; end case; when Optional_More => case Add.Status is when Success | Optional_More => Target.Results.Union (Add.Results); when Needs_More | Failure => null; end case; when Needs_More => case Add.Status is when Success | Optional_More => Target.Results.Union (Add.Results); Target.Status := Optional_More; when Needs_More | Failure => null; end case; when Failure => case Add.Status is when Success | Optional_More => Target.Results.Union (Add.Results); Target.Status := Add.Status; when Needs_More => null; Target.Status := Add.Status; when Failure => null; end case; 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.Finished_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.Include ((Finish => Integer'Max (R.Finish, N.Finish), Value => Elem_Holds.To_Holder (Element (R.Value) & Element (N.Value)), Tokens => Tok_Holds.To_Holder (Element (R.Tokens) & Element (N.Tokens)))); 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 Slide (Input : in Traits.Element_Array; Position : in Positive) return Traits.Element_Array is subtype Slider is Traits.Element_Array (Position .. Position + Input'Length - 1); begin return Slider (Input); end Slide; procedure Tidy_Context (Input : in Traits.Element_Array; Context : in out Parser_Context) is Delete_Keys : Combo_Key_Vectors.Vector; begin if Context.Result_So_Far.Has_Root then raise Constraint_Error; end if; Context.Needs_More.Clear; Context.Leftrectable.Clear; if not Context.Used_Before then Context.Used_Before := True; Context.Global_Start := Input'First; Context.Current_Position := Input'First; end if; for C in Context.Memotable.Iterate loop if Memotables.Element (C).Status = Optional_More or Memotables.Element (C).Status = Needs_More then Delete_Keys.Append (Memotables.Key (C)); end if; end loop; for K of Delete_Keys loop Context.Memotable.Delete (K); end loop; end Tidy_Context; function Finish_Root (Root_Result : in Combinator_Result; Context : in out Parser_Context) return Graphs.Parse_Graph is Length : Natural := 0; Index : Positive := 1; begin for R of Root_Result.Results loop if not R.Tokens.Is_Empty then Length := Length + Integer (Element (R.Tokens)'Length); end if; end loop; if Length = 0 then return Graphs.Empty_Graph; end if; declare Root_Elems : Traits.Tokens.Finished_Token_Array (1 .. Length); begin for R of Root_Result.Results loop for T of Element (R.Tokens) loop Root_Elems (Index) := T; Index := Index + 1; end loop; end loop; Context.Result_So_Far.Set_Root (Root_Elems); Context.Result_So_Far.Delete_Unreachable; return Context.Result_So_Far; end; end Finish_Root; package body Parse_Parts is Context : Parser_Context := Empty_Context; procedure Parse (Input : in Traits.Element_Array; 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; procedure Reset is begin Context := Empty_Context; end Reset; 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 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 /= Success then raise Parser_Error with -Context.Error_String; end if; return Finish_Root (Root_Result, Context); end; 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; function Stamp (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 Salt : Combinator_Result := Combo (Input, Context, Start); Current : Traits.Tokens.Finished_Token_Type; Processed : Result_Sets.Set; begin if Salt.Status = Failure then declare Error : String := Packrat.Errors.Encode (Traits.Label_Enum'Image (Label), Start); begin if Ada.Strings.Unbounded.Index (Context.Error_String, Error) = 0 then Ada.Strings.Unbounded.Append (Context.Error_String, Error); end if; end; return Salt; end if; for R of Salt.Results loop Current := (Token => Traits.Tokens.Create (Label, Start, Element (R.Value)), Finish => R.Finish); if Salt.Status = Success then if not R.Tokens.Is_Empty then Context.Result_So_Far.Connect (Current, Element (R.Tokens)); else Context.Result_So_Far.Include (Current.Token); end if; end if; Processed.Include ((Finish => R.Finish, Value => Elem_Holds.Empty_Holder, Tokens => Tok_Holds.To_Holder ((1 => Current)))); end loop; Salt.Results := Processed; return Salt; end Actual; function Memo is new Memoize (To_Key (Start, Stamp'Access), Actual); function Curt is new Curtailment (To_Key (Start, Stamp'Access), Input, Memo); begin return Curt (Context); end Stamp; function Discard (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 Salt : Combinator_Result := Combo (Input, Context, Start); Processed : Result_Sets.Set; begin if Salt.Status = Failure then declare Error : String := Packrat.Errors.Encode (Traits.Label_Enum'Image (Label), Start); begin if Ada.Strings.Unbounded.Index (Context.Error_String, Error) = 0 then Ada.Strings.Unbounded.Append (Context.Error_String, Error); end if; end; return Salt; end if; for R of Salt.Results loop Processed.Include ((Finish => R.Finish, Value => Elem_Holds.Empty_Holder, Tokens => Tok_Holds.Empty_Holder)); end loop; Salt.Results := Processed; return Salt; end Actual; function Memo is new Memoize (To_Key (Start, Discard'Access), Actual); function Curt is new Curtailment (To_Key (Start, Discard'Access), Input, Memo); begin return Curt (Context); end Discard; function Ignore (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 Salt : Combinator_Result := Combo (Input, Context, Start); Processed : Result_Sets.Set; begin for R of Salt.Results loop Processed.Include ((Finish => R.Finish, Value => Elem_Holds.Empty_Holder, Tokens => Tok_Holds.Empty_Holder)); end loop; Salt.Results := Processed; return Salt; end Actual; function Memo is new Memoize (To_Key (Start, Ignore'Access), Actual); function Curt is new Curtailment (To_Key (Start, Ignore'Access), Input, Memo); begin return Curt (Context); end Ignore; package body Redirect is Combo : Combinator := null; procedure Set (Target : in Combinator) is begin Combo := Target; end Set; function Call (Input : in Traits.Element_Array; Context : in out Parser_Context; Start : in Positive) return Combinator_Result is begin if Combo = null then raise Constraint_Error; else return Combo (Input, Context, Start); end if; end Call; end Redirect; function Sequence (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 Salt : Combinator_Result; begin if 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 Memo is new Memoize (To_Key (Start, Sequence'Access), Actual); function Curt is new Curtailment (To_Key (Start, Sequence'Access), Input, Memo); begin return Curt (Context); end Sequence; -- This exists purely to get around errors that would otherwise -- result from using Sequence internally due to the access types. function Sequence_2 (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 Cont_Param is new Continue (Part_Two); Salt : Combinator_Result; begin Salt := Part_One (Input, Context, Start); Salt := Cont_Param (Salt, Input, Context); return Salt; end Actual; function Memo is new Memoize (To_Key (Start, Sequence_2'Access), Actual); function Curt is new Curtailment (To_Key (Start, Sequence_2'Access), Input, Memo); begin return Curt (Context); end Sequence_2; function Choice (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 Salt : Combinator_Result; begin for C of Params loop Merge (Salt, C (Input, Context, Start)); end loop; Complete_Status (Salt, Context.Allow_Incomplete); return Salt; end Actual; function Memo is new Memoize (To_Key (Start, Choice'Access), Actual); function Curt is new Curtailment (To_Key (Start, Choice'Access), Input, Memo); begin return Curt (Context); end Choice; -- This exists because otherwise Sequence_2 would look weird. function Choice_2 (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 begin return Merge (Choice_One (Input, Context, Start), Choice_Two (Input, Context, Start)); end Actual; function Memo is new Memoize (To_Key (Start, Choice_2'Access), Actual); function Curt is new Curtailment (To_Key (Start, Choice_2'Access), Input, Memo); begin return Curt (Context); end Choice_2; function Count (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 Cont_Param is new Continue (Param); Salt : Combinator_Result; Counter : Natural := 0; begin Salt := Param (Input, Context, Start); while Salt.Status /= Failure loop Counter := Counter + 1; exit when Counter = Number; if Salt.Status = Optional_More or Salt.Status = Needs_More or (for some P of Salt.Results => P.Finish = Input'Last) then Salt.Results.Clear; Salt.Status := Needs_More; exit; end if; Salt := Cont_Param (Salt, Input, Context); end loop; Complete_Status (Salt, Context.Allow_Incomplete); return Salt; end Actual; function Memo is new Memoize (To_Key (Start, Count'Access), Actual); function Curt is new Curtailment (To_Key (Start, Count'Access), Input, Memo); begin return Curt (Context); end Count; function Many (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); function Cont_Param is new Continue (Not_Empty_Param); Salt, Temp : Combinator_Result; Counter : Natural := 0; begin 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); if Temp.Status = Optional_More or Temp.Status = Needs_More or (for some P of Temp.Results => P.Finish = Input'Last) then Salt.Status := Optional_More; exit; end if; elsif Temp.Status = Optional_More or Temp.Status = Needs_More or (for some P of Temp.Results => P.Finish = Input'Last) 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 Memo is new Memoize (To_Key (Start, Many'Access), Actual); function Curt is new Curtailment (To_Key (Start, Many'Access), Input, Memo); begin return Curt (Context); end Many; function Followed_By (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 begin case Param (Input, Context, Start).Status is when Success | Optional_More => return Empty (Input, Context, Start); when Needs_More => return Salt : Combinator_Result do if Context.Allow_Incomplete then Salt.Status := Needs_More; end if; end return; when Failure => return Salt : Combinator_Result do if Context.Allow_Incomplete and Start > Input'Last then Salt.Status := Needs_More; end if; end return; end case; end Actual; function Memo is new Memoize (To_Key (Start, Followed_By'Access), Actual); function Curt is new Curtailment (To_Key (Start, Followed_By'Access), Input, Memo); begin return Curt (Context); end Followed_By; function Not_Followed_By (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 begin case Param (Input, Context, Start).Status is when Success | Optional_More => return Salt : Combinator_Result; when Needs_More => if Context.Allow_Incomplete then return Salt : Combinator_Result do Salt.Status := Needs_More; end return; else return Empty (Input, Context, Start); end if; when Failure => if Context.Allow_Incomplete and Start > Input'Last then return Salt : Combinator_Result do Salt.Status := Needs_More; end return; else return Empty (Input, Context, Start); end if; end case; end Actual; function Memo is new Memoize (To_Key (Start, Not_Followed_By'Access), Actual); function Curt is new Curtailment (To_Key (Start, Not_Followed_By'Access), Input, Memo); begin return Curt (Context); end Not_Followed_By; function Many_Until (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_Till is new Not_Followed_By (Test); function Till is new Followed_By (Test); function Sep_End_By is new Separate_End_By (Param, Not_Till, Till, Minimum); begin return Sep_End_By (Input, Context, Start); end Actual; function Memo is new Memoize (To_Key (Start, Many_Until'Access), Actual); function Curt is new Curtailment (To_Key (Start, Many_Until'Access), Input, Memo); begin return Curt (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 Merge (Salt, Not_Empty_Param (Input, Context, Start)); Complete_Status (Salt, Context.Allow_Incomplete); return Salt; end Actual; function Memo is new Memoize (To_Key (Start, Optional'Access), Actual); function Curt is new Curtailment (To_Key (Start, Optional'Access), Input, Memo); begin return Curt (Context); end Optional; function Separate_By (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_Item is new Not_Empty (Item); function Ignore_Sep is new Ignore (Separator); function Sep_Seq is new Sequence_2 (Ignore_Sep, Not_Empty_Item); function Many_Sep_Seq is new Many (Sep_Seq, (if Minimum = 0 then Minimum else Minimum - 1)); function Full_Seq is new Sequence_2 (Not_Empty_Item, Many_Sep_Seq); begin if Minimum = 0 then return Merge (Empty (Input, Context, Start), Full_Seq (Input, Context, Start)); else return Full_Seq (Input, Context, Start); end if; end Actual; function Memo is new Memoize (To_Key (Start, Separate_By'Access), Actual); function Curt is new Curtailment (To_Key (Start, Separate_By'Access), Input, Memo); begin return Curt (Context); end Separate_By; function Separate_End_By (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 Ignore_Ender is new Ignore (Ender); function Sep_By is new Separate_By (Item, Separator, Minimum); function End_Seq is new Sequence_2 (Sep_By, Ignore_Ender); begin return End_Seq (Input, Context, Start); end Actual; function Memo is new Memoize (To_Key (Start, Separate_End_By'Access), Actual); function Curt is new Curtailment (To_Key (Start, Separate_End_By'Access), Input, Memo); begin return Curt (Context); end Separate_End_By; function Between (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 Ignore_Start is new Ignore (Starter); function Ignore_End is new Ignore (Ender); function Part_Seq is new Sequence_2 (Ignore_Start, Item); function Full_Seq is new Sequence_2 (Part_Seq, Ignore_End); begin return Full_Seq (Input, Context, Start); end Actual; function Memo is new Memoize (To_Key (Start, Between'Access), Actual); function Curt is new Curtailment (To_Key (Start, Between'Access), Input, Memo); begin return Curt (Context); end Between; function Satisfy (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 Part : Combo_Result_Part; Salt : Combinator_Result; begin if Start <= Input'Last and then Test (Input (Start)) then Part.Finish := Start; Part.Value := Elem_Holds.To_Holder (Input (Start .. Start)); Salt.Results.Include (Part); Salt.Status := Success; end if; return Salt; end Actual; function Call is new Memoize (To_Key (Start, Satisfy'Access), Actual); begin return Call (Context); end Satisfy; function Satisfy_With (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 Part : Combo_Result_Part; Salt : Combinator_Result; begin 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.Include (Part); Salt.Status := Success; end if; return Salt; end Actual; function Call is new Memoize (To_Key (Start, Satisfy_With'Access), Actual); begin return Call (Context); end Satisfy_With; function Match (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 use type Traits.Element_Type; Part : Combo_Result_Part; Salt : Combinator_Result; begin if Start <= Input'Last and then Input (Start) = Item then Part.Finish := Start; Part.Value := Elem_Holds.To_Holder (Input (Start .. Start)); Salt.Results.Include (Part); Salt.Status := Success; end if; return Salt; end Actual; function Call is new Memoize (To_Key (Start, Match'Access), Actual); begin return Call (Context); end Match; function Match_With (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 use type Traits.Element_Type; Part : Combo_Result_Part; Salt : Combinator_Result; begin 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.Include (Part); Salt.Status := Success; end if; return Salt; end Actual; function Call is new Memoize (To_Key (Start, Match_With'Access), Actual); begin return Call (Context); end Match_With; function Multimatch (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 use type Traits.Element_Array; Part : Combo_Result_Part; begin if Start > Input'Last then return Salt : Combinator_Result; elsif Items'Length = 0 then return Empty (Input, Context, Start); end if; if Input'Last - Start < Items'Length - 1 then return Salt : Combinator_Result do if Context.Allow_Incomplete and Input (Start .. Input'Last) = Items (Items'First .. Items'First + Input'Last - Start) then Salt.Status := Needs_More; end if; end return; end if; if Input (Start .. Start + Items'Length - 1) /= Items (Items'First .. Items'Last) then return Salt : Combinator_Result; end if; return Salt : Combinator_Result do Part.Finish := Start + Items'Length - 1; Part.Value := Elem_Holds.To_Holder (Input (Start .. Start + Items'Length - 1)); Salt.Results.Include (Part); Salt.Status := Success; end return; end Actual; function Call is new Memoize (To_Key (Start, Multimatch'Access), Actual); begin return Call (Context); end Multimatch; function Take (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 Part : Combo_Result_Part; begin if Start > Input'Last then return Salt : Combinator_Result; end if; if Input'Last - Start < Number - 1 then return Salt : Combinator_Result do if Context.Allow_Incomplete then Salt.Status := Needs_More; end if; end return; end if; return Salt : Combinator_Result do Part.Finish := Start + Number - 1; Part.Value := Elem_Holds.To_Holder (Input (Start .. Start + Number - 1)); Salt.Results.Include (Part); Salt.Status := Success; end return; end Actual; function Call is new Memoize (To_Key (Start, Take'Access), Actual); begin return Call (Context); end Take; function Take_While (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 Part : Combo_Result_Part; 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 Salt : Combinator_Result do Part.Finish := My_Finish; Part.Value := Elem_Holds.To_Holder (Input (Start .. My_Finish)); Salt.Results.Include (Part); Salt.Status := (if My_Finish = Input'Last and Context.Allow_Incomplete then Optional_More else Success); end return; end Actual; function Call is new Memoize (To_Key (Start, Take_While'Access), Actual); begin return Call (Context); end Take_While; function Take_Until (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 Part : Combo_Result_Part; 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 Salt : Combinator_Result do Part.Finish := My_Finish; Part.Value := Elem_Holds.To_Holder (Input (Start .. My_Finish)); Salt.Results.Include (Part); Salt.Status := (if My_Finish = Input'Last and Context.Allow_Incomplete then Optional_More else Success); end return; end Actual; function Call is new Memoize (To_Key (Start, Take_Until'Access), Actual); begin return Call (Context); end Take_Until; function Empty (Input : in Traits.Element_Array; Context : in out Parser_Context; Start : in Positive) return Combinator_Result is Part : Combo_Result_Part; Salt : Combinator_Result; begin Part.Finish := Start - 1; Salt.Results.Include (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.Include (R); end if; end loop; Salt.Results.Assign (Adjust); return Salt; end Not_Empty; function End_Of_Input (Input : in Traits.Element_Array; Context : in out Parser_Context; Start : in Positive) return Combinator_Result is begin if Start > Input'Last then return Empty (Input, Context, Start); else return Salt : Combinator_Result; end if; end End_Of_Input; end Packrat.Parsers;