path: root/src/packrat-parsers.adb

with

    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 Traits.Tokens;
    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 To_Key
           (Start : in Positive;
            Func  : access function
                   (Input   : in     Traits.Element_Array;
                    Context : in out Parser_Context;
                    Start   : in     Positive)
                return Combinator_Result)
        return Combo_Key is
    begin
        return (Start => Start, Func => Func);
    end To_Key;





    function Reusable
           (Result   : in Combinator_Result;
            Position : in Positive;
            Leftrecs : in Leftrectables.Map)
        return Boolean
    is
        Working_Key : Combo_Key;
    begin
        for Cursor in Result.Curtails.Iterate loop
            Working_Key := To_Key (Position, Curtail_Maps.Key (Cursor));
            if Leftrecs.Contains (Working_Key) and then
                Curtail_Maps.Element (Cursor) > Leftrecs.Element (Working_Key)
            then
                return False;
            end if;
        end loop;
        return True;
    end Reusable;


    function Memoize
           (Context : in out Parser_Context)
        return Combinator_Result
    is
        Result : Combinator_Result;
    begin
        if Context.Memotable.Contains (My_Key) then
            Result := Context.Memotable.Element (My_Key);
            if Reusable (Result, My_Key.Start, Context.Leftrectable) then
                return Result;
            end if;
        end if;
        Result := Actual (Context);
        if Context.Memotable.Contains (My_Key) then
            Context.Memotable.Replace (My_Key, Result);
        else
            Context.Memotable.Insert (My_Key, Result);
        end if;
        return Result;
    end Memoize;





    procedure Inc_Leftrec
           (Key     : in     Combo_Key;
            Context : in out Parser_Context) is
    begin
        if Context.Leftrectable.Contains (Key) then
            Context.Leftrectable.Replace (Key, Context.Leftrectable.Element (Key) + 1);
        else
            Context.Leftrectable.Insert (Key, 1);
        end if;
    end Inc_Leftrec;


    procedure Dec_Leftrec
           (Key     : in     Combo_Key;
            Context : in out Parser_Context) is
    begin
        if Context.Leftrectable.Contains (Key) then
            if Context.Leftrectable.Element (Key) = 1 then
                Context.Leftrectable.Delete (Key);
            else
                Context.Leftrectable.Replace (Key, Context.Leftrectable.Element (Key) - 1);
            end if;
        end if;
    end Dec_Leftrec;


    function Exceeds_Curtail
           (Key     : in Combo_Key;
            Context : in Parser_Context;
            Input   : in Traits.Element_Array)
        return Boolean is
    begin
        return Context.Leftrectable.Contains (Key) and then
            Context.Leftrectable.Element (Key) > Input'Last - (Key.Start - 1) + 1;
    end Exceeds_Curtail;


    function Curtailment
           (Context : in out Parser_Context)
        return Combinator_Result
    is
        My_Result : Combinator_Result;
        My_Curtails : Curtail_Maps.Map;
    begin
        Inc_Leftrec (My_Key, Context);
        if Exceeds_Curtail (My_Key, Context, Input) then
            My_Curtails.Insert (My_Key.Func, Context.Leftrectable.Element (My_Key));
            My_Result :=
               (Results  => Result_Sets.Empty_Set,
                Curtails => My_Curtails,
                Status   => Failure);
        else
            My_Result := Actual (Context);
        end if;
        Dec_Leftrec (My_Key, Context);
        return My_Result;
    end Curtailment;





    function Root
           (Input   : in     Traits.Element_Array;
            Context : in out Parser_Context;
            Start   : in     Positive)
        return Component_Result
    is
    begin
        --  to-do
        return (Status => Failure);
    end Root;





    procedure Parse
           (Input   : in     Traits.Element_Array;
            Context : in out Parser_Context;
            Result  :    out Graphs.Parse_Graph)
    is
    begin
        --  to-do
        null;
    end Parse;


    function Parse_Only
           (Input   : in     Traits.Element_Array;
            Context : in out Parser_Context)
        return Graphs.Parse_Graph
    is
    begin
        --  to-do
        return Graphs.Empty_Graph;
    end Parse_Only;


    function Parse_With
           (Input   : in     With_Input;
            Context : in out Parser_Context)
        return Graphs.Parse_Graph
    is
    begin
        --  to-do
        return Graphs.Empty_Graph;
    end Parse_With;





    function Stamp
           (Input   : in     Traits.Element_Array;
            Context : in out Parser_Context;
            Start   : in     Positive)
        return Combinator_Result
    is
    begin
        --  to-do
        return
           (Results  => Result_Sets.Empty_Set,
            Curtails => Curtail_Maps.Empty_Map,
            Status   => Failure);
    end Stamp;


    function Ignore
           (Input   : in     Traits.Element_Array;
            Context : in out Parser_Context;
            Start   : in     Positive)
        return Combinator_Result
    is
    begin
        --  to-do
        return
           (Results  => Result_Sets.Empty_Set,
            Curtails => Curtail_Maps.Empty_Map,
            Status   => Failure);
    end Ignore;





    function Sequence
           (Input   : in     Traits.Element_Array;
            Context : in out Parser_Context;
            Start   : in     Positive)
        return Combinator_Result
    is
    begin
        --  to-do
        return
           (Results  => Result_Sets.Empty_Set,
            Curtails => Curtail_Maps.Empty_Map,
            Status   => Failure);
    end Sequence;


    function Choice
           (Input   : in     Traits.Element_Array;
            Context : in out Parser_Context;
            Start   : in     Positive)
        return Combinator_Result
    is
    begin
        --  to-do
        return
           (Results  => Result_Sets.Empty_Set,
            Curtails => Curtail_Maps.Empty_Map,
            Status   => Failure);
    end Choice;


    function Count
           (Input   : in     Traits.Element_Array;
            Context : in out Parser_Context;
            Start   : in     Positive)
        return Combinator_Result
    is
    begin
        --  to-do
        return
           (Results  => Result_Sets.Empty_Set,
            Curtails => Curtail_Maps.Empty_Map,
            Status   => Failure);
    end Count;


    function Many
           (Input   : in     Traits.Element_Array;
            Context : in out Parser_Context;
            Start   : in     Positive)
        return Combinator_Result
    is
    begin
        --  to-do
        return
           (Results  => Result_Sets.Empty_Set,
            Curtails => Curtail_Maps.Empty_Map,
            Status   => Failure);
    end Many;


    function Many_Until
           (Input   : in     Traits.Element_Array;
            Context : in out Parser_Context;
            Start   : in     Positive)
        return Combinator_Result
    is
    begin
        --  to-do
        return
           (Results  => Result_Sets.Empty_Set,
            Curtails => Curtail_Maps.Empty_Map,
            Status   => Failure);
    end Many_Until;





    function Satisfy
           (Input   : in     Traits.Element_Array;
            Context : in out Parser_Context;
            Start   : in     Positive)
        return Combinator_Result
    is
        use type Traits.Element_Type;
        function Actual
               (Context : in out Parser_Context)
            return Combinator_Result is
        begin
            if Start > Input'Last or else not Test (Input (Start)) then
                return Empty_Fail;
            else
                return
                   (Results  => Result_Sets.To_Set
                       ((Finish => Start,
                         Value  => Elem_Holds.To_Holder (Input (Start .. Start)),
                         Tokens => Tok_Holds.Empty_Holder)),
                    Curtails => Curtail_Maps.Empty_Map,
                    Status   => Success);
            end if;
        end Actual;
        function Call is new Memoize (To_Key (Start, Satisfy'Access), Actual);
    begin
        return Call (Context);
    end Satisfy;


    function Satisfy_With
           (Input   : in     Traits.Element_Array;
            Context : in out Parser_Context;
            Start   : in     Positive)
        return Combinator_Result
    is
        use type Traits.Element_Type;
        function Actual
               (Context : in out Parser_Context)
            return Combinator_Result is
        begin
            if Start > Input'Last or else not Test (Change (Input (Start))) then
                return Empty_Fail;
            else
                return
                   (Results  => Result_Sets.To_Set
                       ((Finish => Start,
                         Value  => Elem_Holds.To_Holder (Input (Start .. Start)),
                         Tokens => Tok_Holds.Empty_Holder)),
                    Curtails => Curtail_Maps.Empty_Map,
                    Status   => Success);
            end if;
        end Actual;
        function Call is new Memoize (To_Key (Start, Satisfy_With'Access), Actual);
    begin
        return Call (Context);
    end Satisfy_With;


    function Match
           (Input   : in     Traits.Element_Array;
            Context : in out Parser_Context;
            Start   : in     Positive)
        return Combinator_Result
    is
        use type Traits.Element_Type;
        function Actual
               (Context : in out Parser_Context)
            return Combinator_Result is
        begin
            if Start > Input'Last or else Input (Start) /= Item then
                return Empty_Fail;
            else
                return
                   (Results  => Result_Sets.To_Set
                       ((Finish => Start,
                         Value  => Elem_Holds.To_Holder (Input (Start .. Start)),
                         Tokens => Tok_Holds.Empty_Holder)),
                    Curtails => Curtail_Maps.Empty_Map,
                    Status   => Success);
            end if;
        end Actual;
        function Call is new Memoize (To_Key (Start, Match'Access), Actual);
    begin
        return Call (Context);
    end Match;


    function Match_With
           (Input   : in     Traits.Element_Array;
            Context : in out Parser_Context;
            Start   : in     Positive)
        return Combinator_Result
    is
        use type Traits.Element_Type;
        function Actual
               (Context : in out Parser_Context)
            return Combinator_Result is
        begin
            if Start > Input'Last or else Change (Input (Start)) /= Item then
                return Empty_Fail;
            else
                return
                   (Results  => Result_Sets.To_Set
                       ((Finish => Start,
                         Value  => Elem_Holds.To_Holder (Input (Start .. Start)),
                         Tokens => Tok_Holds.Empty_Holder)),
                    Curtails => Curtail_Maps.Empty_Map,
                    Status   => Success);
            end if;
        end Actual;
        function Call is new Memoize (To_Key (Start, Match_With'Access), Actual);
    begin
        return Call (Context);
    end Match_With;


    function Multimatch
           (Input   : in     Traits.Element_Array;
            Context : in out Parser_Context;
            Start   : in     Positive)
        return Combinator_Result
    is
        use type Traits.Element_Array;
        function Actual
               (Context : in out Parser_Context)
            return Combinator_Result
        is
            My_Offset : Natural;
        begin
            if Start > Input'Last then
                return Empty_Fail;
            elsif Items'Length = 0 then
                return Empty (Input, Context, Start);
            end if;
            My_Offset := Natural'Min (Input'Last - Start, Items'Length - 1);
            if Input (Start .. Start + My_Offset) /=
                Items (Items'First .. Items'First + My_Offset)
            then
                return Empty_Fail;
            end if;
            return
               (Results  => Result_Sets.To_Set
                   ((Finish => Start + My_Offset,
                     Value  => Elem_Holds.To_Holder (Input (Start .. Start + My_Offset)),
                     Tokens => Tok_Holds.Empty_Holder)),
                Curtails => Curtail_Maps.Empty_Map,
                Status   => (if My_Offset < Items'Length - 1 then Needs_More else Success));
        end Actual;
        function Call is new Memoize (To_Key (Start, Multimatch'Access), Actual);
    begin
        return 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
            My_Offset : Natural;
        begin
            if Start > Input'Last then
                return Empty_Fail;
            end if;
            My_Offset := Natural'Min (Input'Last - Start, Number - 1);
            return
               (Results  => Result_Sets.To_Set
                   ((Finish => Start + My_Offset,
                     Value  => Elem_Holds.To_Holder (Input (Start .. Start + My_Offset)),
                     Tokens => Tok_Holds.Empty_Holder)),
                Curtails => Curtail_Maps.Empty_Map,
                Status   => (if My_Offset < Number - 1 then Needs_More else Success));
        end Actual;
        function Call is new Memoize (To_Key (Start, Take'Access), Actual);
    begin
        return 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
            My_Finish : Positive := Start;
        begin
            if Start > Input'Last or else not Test (Input (Start)) then
                return Empty_Fail;
            end if;
            while My_Finish <= Input'Last and then Test (Input (My_Finish)) loop
                My_Finish := My_Finish + 1;
            end loop;
            My_Finish := My_Finish - 1;
            return
               (Results  => Result_Sets.To_Set
                   ((Finish => My_Finish,
                     Value  => Elem_Holds.To_Holder (Input (Start .. My_Finish)),
                     Tokens => Tok_Holds.Empty_Holder)),
                Curtails => Curtail_Maps.Empty_Map,
                Status   => (if My_Finish = Input'Last then Optional_More else Success));
        end Actual;
        function Call is new Memoize (To_Key (Start, Take_While'Access), Actual);
    begin
        return 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
            My_Finish : Positive := Start;
        begin
            if Start > Input'Last or else Test (Input (Start)) then
                return Empty_Fail;
            end if;
            while My_Finish <= Input'Last and then not Test (Input (My_Finish)) loop
                My_Finish := My_Finish + 1;
            end loop;
            My_Finish := My_Finish - 1;
            return
               (Results  => Result_Sets.To_Set
                   ((Finish => My_Finish,
                     Value  => Elem_Holds.To_Holder (Input (Start .. My_Finish)),
                     Tokens => Tok_Holds.Empty_Holder)),
                Curtails => Curtail_Maps.Empty_Map,
                Status   => (if My_Finish = Input'Last then Optional_More else Success));
        end Actual;
        function Call is new Memoize (To_Key (Start, Take_Until'Access), Actual);
    begin
        return Call (Context);
    end Take_Until;





    function Empty
           (Input   : in     Traits.Element_Array;
            Context : in out Parser_Context;
            Start   : in     Positive)
        return Combinator_Result is
    begin
        return
           (Results  => Result_Sets.To_Set
               ((Finish => Start - 1,
                 Value  => Elem_Holds.Empty_Holder,
                 Tokens => Tok_Holds.Empty_Holder)),
            Curtails => Curtail_Maps.Empty_Map,
            Status   => Success);
    end Empty;


end Packrat.Parsers;