path: root/src/packrat-parsers.adb

with

    Packrat.Errors,
    System;


package body Packrat.Parsers is


    function "<"
           (Left, Right : in Elem_Holds.Holder)
        return Boolean
    is
        use Traits;
    begin
        return Left.Element < Right.Element;
    end "<";


    function "<"
           (Left, Right : in Tok_Holds.Holder)
        return Boolean
    is
        use type Graphs.Finished_Token_Array;
    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_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 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 Graphs.Finished_Token_Array is
    begin
        if Hold.Is_Empty then
            return Value : Graphs.Finished_Token_Array (1 .. 0);
        else
            return Hold.Element;
        end if;
    end Element;





    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;
        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
            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)) >
                    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 Graphs.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 => 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 : Graphs.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 : Graphs.Finished_Token;
            Processed : Result_Sets.Set;
        begin
            if Salt.Status = Failure then
                Ada.Strings.Unbounded.Append
                   (Context.Error_String,
                    Packrat.Errors.Encode (Traits.Label_Enum'Image (Label), Start));
            else
                Context.Error_String := +"";
            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);
    begin
        return Memo (Context);
    end Stamp;


    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
            if Salt.Status = Failure then
                Ada.Strings.Unbounded.Append
                   (Context.Error_String,
                    Packrat.Errors.Encode (Traits.Label_Enum'Image (Label), Start));
            else
                Context.Error_String := +"";
            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, Ignore'Access), Actual);
    begin
        return Memo (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 Parser_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 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
        return Memo (Context);
    end Sequence;


    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
            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
        return Memo (Context);
    end Choice;


    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
            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
        return Memo (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 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
        return Memo (Context);
    end Many;


    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_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.Include (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
        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;





    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;
            My_Offset : Natural;
        begin
            if Start > Input'Last then
                return Empty_Fail;
            elsif Items'Length = 0 then
                return Empty (Input, Context, Start);
            end if;
            if Input'Last - Start < Items'Length - 1 then
                if not Context.Allow_Incomplete then
                    return Empty_Fail;
                end if;
                My_Offset := Input'Last - Start;
            else
                My_Offset := Items'Length - 1;
            end if;
            if Input (Start .. Start + My_Offset) /=
                Items (Items'First .. Items'First + My_Offset)
            then
                return Empty_Fail;
            end if;
            return Salt : Combinator_Result do
                Part.Finish := Start + My_Offset;
                Part.Value := Elem_Holds.To_Holder (Input (Start .. Start + My_Offset));
                Salt.Results.Include (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
        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;
            My_Offset : Natural;
        begin
            if Start > Input'Last then
                return Empty_Fail;
            end if;
            if Input'Last - Start < Number - 1 then
                if not Context.Allow_Incomplete then
                    return Empty_Fail;
                end if;
                My_Offset := Input'Last - Start;
            else
                My_Offset := Number - 1;
            end if;
            return Salt : Combinator_Result do
                Part.Finish := Start + My_Offset;
                Part.Value := Elem_Holds.To_Holder (Input (Start .. Start + My_Offset));
                Salt.Results.Include (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
        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;


end Packrat.Parsers;