path: root/src/packrat-parsers.adb

--  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;
            Main_Key : in Combo_Key;
            Leftrecs : in Leftrectables.Map)
        return Boolean
    is
        Position : Positive := Main_Key.Start;
        Working_Key : Combo_Key;
    begin
        for Cursor in Result.Curtails.Iterate loop
            Working_Key := To_Key (Position, Curtail_Maps.Key (Cursor));
            if Working_Key = Main_Key then
                if not Leftrecs.Contains (Working_Key) then
                    if Curtail_Maps.Element (Cursor) > 1 then
                        return False;
                    end if;
                elsif Curtail_Maps.Element (Cursor) > Leftrecs.Element (Working_Key) + 1 then
                    return False;
                end if;
            else
                if not Leftrecs.Contains (Working_Key) or else
                    Curtail_Maps.Element (Cursor) > Leftrecs.Element (Working_Key)
                then
                    return False;
                end if;
            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, 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 Combo = My_Key.Func then
                        Left := Left + 1;
                    end if;
                    if Result.Curtails.Contains (Combo) then
                        Result.Curtails.Replace (Combo, Left);
                    else
                        Result.Curtails.Insert (Combo, Left);
                    end if;
                else
                    if Combo = My_Key.Func then
                        if Result.Curtails.Contains (Combo) then
                            Result.Curtails.Replace (Combo, 1);
                        else
                            Result.Curtails.Insert (Combo, 1);
                        end if;
                    end if;
                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 Curt is new Curtailment (To_Key (Start, Stamp'Access), Input, Actual);
        function Memo is new Memoize (To_Key (Start, Stamp'Access), Curt);
    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
            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 Curt is new Curtailment (To_Key (Start, Ignore'Access), Input, Actual);
        function Memo is new Memoize (To_Key (Start, Ignore'Access), Curt);
    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 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;


    --  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 Curt is new Curtailment (To_Key (Start, Sequence_2'Access), Input, Actual);
        function Memo is new Memoize (To_Key (Start, Sequence_2'Access), Curt);
    begin
        return Memo (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 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;


    --  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 Curt is new Curtailment (To_Key (Start, Choice_2'Access), Input, Actual);
        function Memo is new Memoize (To_Key (Start, Choice_2'Access), Curt);
    begin
        return Memo (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 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 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 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 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 Curt is new Curtailment (To_Key (Start, Followed_By'Access), Input, Actual);
        function Memo is new Memoize (To_Key (Start, Followed_By'Access), Curt);
    begin
        return Memo (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 Curt is new Curtailment (To_Key (Start, Not_Followed_By'Access), Input, Actual);
        function Memo is new Memoize (To_Key (Start, Not_Followed_By'Access), Curt);
    begin
        return Memo (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 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
            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 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 Sep_Seq is new Sequence_2 (Separator, 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 Curt is new Curtailment (To_Key (Start, Separate_By'Access), Input, Actual);
        function Memo is new Memoize (To_Key (Start, Separate_By'Access), Curt);
    begin
        return Memo (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 Sep_By is new Separate_By (Item, Separator, Minimum);
            function End_Seq is new Sequence_2 (Sep_By, Ender);
        begin
            return End_Seq (Input, Context, Start);
        end Actual;
        function Curt is new Curtailment (To_Key (Start, Separate_End_By'Access), Input, Actual);
        function Memo is new Memoize (To_Key (Start, Separate_End_By'Access), Curt);
    begin
        return Memo (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 Curt is new Curtailment (To_Key (Start, Between'Access), Input, Actual);
        function Memo is new Memoize (To_Key (Start, Between'Access), Curt);
    begin
        return Memo (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;