Non-curtailing parser combinators implemented

1 files changed, 315 insertions, 55 deletions

diff --git a/src/packrat-parsers.adb b/src/packrat-parsers.adb
index 955c5cc..fcc69b8 100644
--- a/src/packrat-parsers.adb
+++ b/src/packrat-parsers.adb
@@ -9,7 +9,7 @@ package body Packrat.Parsers is
 
 
     function "<"
-           (Left, Right : in Elem_Array_Holders.Holder)
+           (Left, Right : in Elem_Holds.Holder)
         return Boolean
     is
         use Traits;
@@ -19,7 +19,7 @@ package body Packrat.Parsers is
 
 
     function "<"
-           (Left, Right : in Token_Array_Holders.Holder)
+           (Left, Right : in Tok_Holds.Holder)
         return Boolean
     is
         use Traits.Tokens;
@@ -44,7 +44,7 @@ package body Packrat.Parsers is
            (Left, Right : in Combo_Result_Part)
         return Boolean
     is
-        use type Elem_Array_Holders.Holder;
+        use type Elem_Holds.Holder;
     begin
         if Left.Finish = Right.Finish then
             if Left.Value = Right.Value then
@@ -71,6 +71,129 @@ package body Packrat.Parsers is
 
 
 
+    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;
@@ -78,6 +201,7 @@ package body Packrat.Parsers is
         return Component_Result
     is
     begin
+        --  to-do
         return (Status => Failure);
     end Root;
 
@@ -91,6 +215,7 @@ package body Packrat.Parsers is
             Result  :    out Graphs.Parse_Graph)
     is
     begin
+        --  to-do
         null;
     end Parse;
 
@@ -101,6 +226,7 @@ package body Packrat.Parsers is
         return Graphs.Parse_Graph
     is
     begin
+        --  to-do
         return Graphs.Empty_Graph;
     end Parse_Only;
 
@@ -111,6 +237,7 @@ package body Packrat.Parsers is
         return Graphs.Parse_Graph
     is
     begin
+        --  to-do
         return Graphs.Empty_Graph;
     end Parse_With;
 
@@ -125,6 +252,7 @@ package body Packrat.Parsers is
         return Combinator_Result
     is
     begin
+        --  to-do
         return
            (Results  => Result_Sets.Empty_Set,
             Curtails => Curtail_Maps.Empty_Map,
@@ -139,6 +267,7 @@ package body Packrat.Parsers is
         return Combinator_Result
     is
     begin
+        --  to-do
         return
            (Results  => Result_Sets.Empty_Set,
             Curtails => Curtail_Maps.Empty_Map,
@@ -156,6 +285,7 @@ package body Packrat.Parsers is
         return Combinator_Result
     is
     begin
+        --  to-do
         return
            (Results  => Result_Sets.Empty_Set,
             Curtails => Curtail_Maps.Empty_Map,
@@ -170,6 +300,7 @@ package body Packrat.Parsers is
         return Combinator_Result
     is
     begin
+        --  to-do
         return
            (Results  => Result_Sets.Empty_Set,
             Curtails => Curtail_Maps.Empty_Map,
@@ -184,6 +315,7 @@ package body Packrat.Parsers is
         return Combinator_Result
     is
     begin
+        --  to-do
         return
            (Results  => Result_Sets.Empty_Set,
             Curtails => Curtail_Maps.Empty_Map,
@@ -198,6 +330,7 @@ package body Packrat.Parsers is
         return Combinator_Result
     is
     begin
+        --  to-do
         return
            (Results  => Result_Sets.Empty_Set,
             Curtails => Curtail_Maps.Empty_Map,
@@ -212,6 +345,7 @@ package body Packrat.Parsers is
         return Combinator_Result
     is
     begin
+        --  to-do
         return
            (Results  => Result_Sets.Empty_Set,
             Curtails => Curtail_Maps.Empty_Map,
@@ -228,11 +362,26 @@ package body Packrat.Parsers is
             Start   : in     Positive)
         return Combinator_Result
     is
+        use type Traits.Element_Type;
+        function Actual
+               (Context : in out Parser_Context)
+            return Combinator_Result is
+        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
-           (Results  => Result_Sets.Empty_Set,
-            Curtails => Curtail_Maps.Empty_Map,
-            Status   => Failure);
+        return Call (Context);
     end Satisfy;
 
 
@@ -242,11 +391,26 @@ package body Packrat.Parsers is
             Start   : in     Positive)
         return Combinator_Result
     is
+        use type Traits.Element_Type;
+        function Actual
+               (Context : in out Parser_Context)
+            return Combinator_Result is
+        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
-           (Results  => Result_Sets.Empty_Set,
-            Curtails => Curtail_Maps.Empty_Map,
-            Status   => Failure);
+        return Call (Context);
     end Satisfy_With;
 
 
@@ -256,11 +420,26 @@ package body Packrat.Parsers is
             Start   : in     Positive)
         return Combinator_Result
     is
+        use type Traits.Element_Type;
+        function Actual
+               (Context : in out Parser_Context)
+            return Combinator_Result is
+        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
-           (Results  => Result_Sets.Empty_Set,
-            Curtails => Curtail_Maps.Empty_Map,
-            Status   => Failure);
+        return Call (Context);
     end Match;
 
 
@@ -270,11 +449,26 @@ package body Packrat.Parsers is
             Start   : in     Positive)
         return Combinator_Result
     is
+        use type Traits.Element_Type;
+        function Actual
+               (Context : in out Parser_Context)
+            return Combinator_Result is
+        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
-           (Results  => Result_Sets.Empty_Set,
-            Curtails => Curtail_Maps.Empty_Map,
-            Status   => Failure);
+        return Call (Context);
     end Match_With;
 
 
@@ -284,11 +478,35 @@ package body Packrat.Parsers is
             Start   : in     Positive)
         return Combinator_Result
     is
+        use type Traits.Element_Array;
+        function Actual
+               (Context : in out Parser_Context)
+            return Combinator_Result
+        is
+            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
-           (Results  => Result_Sets.Empty_Set,
-            Curtails => Curtail_Maps.Empty_Map,
-            Status   => Failure);
+        return Call (Context);
     end Multimatch;
 
 
@@ -298,11 +516,27 @@ package body Packrat.Parsers is
             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
-           (Results  => Result_Sets.Empty_Set,
-            Curtails => Curtail_Maps.Empty_Map,
-            Status   => Failure);
+        return Call (Context);
     end Take;
 
 
@@ -312,11 +546,30 @@ package body Packrat.Parsers is
             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
-           (Results  => Result_Sets.Empty_Set,
-            Curtails => Curtail_Maps.Empty_Map,
-            Status   => Failure);
+        return Call (Context);
     end Take_While;
 
 
@@ -326,43 +579,50 @@ package body Packrat.Parsers is
             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
-           (Results  => Result_Sets.Empty_Set,
-            Curtails => Curtail_Maps.Empty_Map,
-            Status   => Failure);
+        return Call (Context);
     end Take_Until;
 
 
 
 
 
-    function Line_End
+    function Empty
            (Input   : in     Traits.Element_Array;
             Context : in out Parser_Context;
             Start   : in     Positive)
-        return Combinator_Result
-    is
+        return Combinator_Result is
     begin
         return
-           (Results  => Result_Sets.Empty_Set,
+           (Results  => Result_Sets.To_Set
+               ((Finish => Start - 1,
+                 Value  => Elem_Holds.Empty_Holder,
+                 Tokens => Tok_Holds.Empty_Holder)),
             Curtails => Curtail_Maps.Empty_Map,
-            Status   => Failure);
-    end Line_End;
-
-
-    function Input_End
-           (Input   : in     Traits.Element_Array;
-            Context : in out Parser_Context;
-            Start   : in     Positive)
-        return Combinator_Result
-    is
-    begin
-        return
-           (Results  => Result_Sets.Empty_Set,
-            Curtails => Curtail_Maps.Empty_Map,
-            Status   => Failure);
-    end Input_End;
+            Status   => Success);
+    end Empty;
 
 
 end Packrat.Parsers;