Main parse functions implemented

2 files changed, 146 insertions, 27 deletions

diff --git a/src/packrat-parsers.adb b/src/packrat-parsers.adb
index 8533b96..946bfdd 100644
--- a/src/packrat-parsers.adb
+++ b/src/packrat-parsers.adb
@@ -2,6 +2,7 @@
 
 with
 
+    Packrat.Errors,
     System;
 
 
@@ -119,7 +120,13 @@ package body Packrat.Parsers is
                 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.Insert (My_Key.Start);
+        end if;
         if Context.Memotable.Contains (My_Key) then
             Context.Memotable.Replace (My_Key, Result);
         else
@@ -306,6 +313,21 @@ package body Packrat.Parsers is
 
 
 
+    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;
+
+
+
+
+
     function Root
            (Input   : in     Traits.Element_Array;
             Context : in out Parser_Context;
@@ -316,7 +338,10 @@ package body Packrat.Parsers is
         Index : Positive := 1;
         Root_Elems : Graphs.Finished_Token_Array (1 .. Integer (Salt.Results.Length));
     begin
-        if Salt.Status /= Success then
+        if Salt.Status = Failure then
+            raise Parser_Error with Packrat.Errors.Encode
+               (Traits.Label_Enum'Image (Label), Start);
+        elsif Salt.Status /= Success then
             return (Status => Salt.Status);
         end if;
         for R of Salt.Results loop
@@ -337,25 +362,89 @@ package body Packrat.Parsers is
 
 
 
+    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;
+
+
     procedure Parse
            (Input   : in     Traits.Element_Array;
             Context : in out Parser_Context;
-            Result  :    out Graphs.Parse_Graph)
-    is
+            Result  :    out Graphs.Parse_Graph) is
     begin
-        --  to-do
-        null;
+        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 Context.Pass_Forward.Element & Input);
+        begin
+            if Root_Component (Real_Input, Context, Context.Global_Start).Status = Failure then
+                raise Parser_Error;
+            end if;
+            if Input'Length = 0 then
+                Result := Context.Result_So_Far;
+                Result.Delete_Unreachable;
+                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;
 
 
     function Parse_Only
            (Input   : in     Traits.Element_Array;
             Context : in out Parser_Context)
-        return Graphs.Parse_Graph
-    is
+        return Graphs.Parse_Graph is
     begin
-        --  to-do
-        return Graphs.Empty_Graph;
+        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 Context.Pass_Forward.Element & Input);
+        begin
+            if Root_Component (Real_Input, Context, Context.Global_Start).Status /= Success then
+                raise Parser_Error;
+            end if;
+            Context.Result_So_Far.Delete_Unreachable;
+            return Context.Result_So_Far;
+        end;
     end Parse_Only;
 
 
@@ -364,9 +453,18 @@ package body Packrat.Parsers is
             Context : in out Parser_Context)
         return Graphs.Parse_Graph
     is
+        procedure My_Parse is new Parse (Root_Component);
+        Result : Graphs.Parse_Graph;
     begin
-        --  to-do
-        return Graphs.Empty_Graph;
+        loop
+            declare
+                Next_Input : Traits.Element_Array := Input.all;
+            begin
+                My_Parse (Next_Input, Context, Result);
+                exit when Next_Input'Length = 0;
+            end;
+        end loop;
+        return Result;
     end Parse_With;
 
 
@@ -387,17 +485,20 @@ package body Packrat.Parsers is
             Current : Graphs.Finished_Token;
             Processed : Result_Sets.Set;
         begin
-            if Salt.Status /= Success then
-                return Salt;
+            if Salt.Status = Failure then
+                raise Parser_Error with Packrat.Errors.Encode
+                   (Traits.Label_Enum'Image (Label), Start);
             end if;
             for R of Salt.Results loop
                 Current :=
                    (Token  => Traits.Tokens.Create (Label, Start, R.Value.Element),
                     Finish => R.Finish);
-                if R.Tokens.Element'Length > 0 then
-                    Context.Result_So_Far.Connect (Current, R.Tokens.Element);
-                else
-                    Context.Result_So_Far.Include (Current.Token);
+                if Salt.Status = Success then
+                    if R.Tokens.Element'Length > 0 then
+                        Context.Result_So_Far.Connect (Current, R.Tokens.Element);
+                    else
+                        Context.Result_So_Far.Include (Current.Token);
+                    end if;
                 end if;
                 Processed.Insert
                    ((Finish => R.Finish,
@@ -426,8 +527,9 @@ package body Packrat.Parsers is
             Salt : Combinator_Result := Combo (Input, Context, Start);
             Processed : Result_Sets.Set;
         begin
-            if Salt.Status /= Success then
-                return Salt;
+            if Salt.Status = Failure then
+                raise Parser_Error with Packrat.Errors.Encode
+                   (Traits.Label_Enum'Image (Label), Start);
             end if;
             for R of Salt.Results loop
                 Processed.Insert
diff --git a/src/packrat-parsers.ads b/src/packrat-parsers.ads
index 7ed2c89..6568238 100644
--- a/src/packrat-parsers.ads
+++ b/src/packrat-parsers.ads
@@ -7,6 +7,7 @@ with
 
 private with
 
+    Ada.Containers.Vectors,
     Ada.Containers.Ordered_Maps,
     Ada.Containers.Ordered_Sets,
     Ada.Containers.Indefinite_Holders;
@@ -133,6 +134,7 @@ package Packrat.Parsers is
         return Combinator_Result;
 
     generic
+        Label : in Traits.Label_Enum;
         with function Combo
                (Input   : in     Traits.Element_Array;
                 Context : in out Parser_Context;
@@ -367,6 +369,10 @@ private
            (Left, Right : in Combo_Key)
         return Boolean;
 
+    package Combo_Key_Vectors is new Ada.Containers.Vectors
+       (Index_Type   => Positive,
+        Element_Type => Combo_Key);
+
     --  This is needed to avoid some issues with using non-anonymous
     --  access values in a generic subprogram instantiation.
     function To_Key
@@ -411,8 +417,6 @@ private
     --  If there's anything in the Curtails, then Results should be empty
     --  and vice versa... union?
 
-    --  need to add an error string to percolate upwards for exceptions
-
     --  need to add a record of the total length of input available when
     --  result was computed, to allow for knowing when to recompute
     --  optional_more/need_more results
@@ -437,6 +441,9 @@ private
 
 
 
+    package Needs_Sets is new Ada.Containers.Ordered_Sets
+       (Element_Type => Positive);
+
     package Memotables is new Ada.Containers.Ordered_Maps
        (Key_Type     => Combo_Key,
         Element_Type => Combinator_Result);
@@ -450,9 +457,10 @@ private
 
     type Parser_Context is record
         Result_So_Far    : Graphs.Parse_Graph;
-        Position         : Positive := 1;
-        Offset           : Natural := 0;
-        Status           : Result_Status := Success;
+        Used_Before      : Boolean := False;
+        Global_Start     : Positive := 1;
+        Current_Position : Positive := 1;
+        Needs_More       : Needs_Sets.Set;
         Pass_Forward     : Elem_Holds.Holder;
         Memotable        : Memotables.Map;
         Leftrectable     : Leftrectables.Map;
@@ -461,9 +469,10 @@ private
 
     Empty_Context : constant Parser_Context :=
        (Result_So_Far    => Graphs.Empty_Graph,
-        Position         => 1,
-        Offset           => 0,
-        Status           => Success,
+        Used_Before      => False,
+        Global_Start     => 1,
+        Current_Position => 1,
+        Needs_More       => Needs_Sets.Empty_Set,
         Pass_Forward     => Elem_Holds.Empty_Holder,
         Memotable        => Memotables.Empty_Map,
         Leftrectable     => Leftrectables.Empty_Map,
@@ -555,6 +564,14 @@ private
             Allow  : in     Boolean);
 
 
+
+
+    function Slide
+           (Input    : in Traits.Element_Array;
+            Position : in Positive)
+        return Traits.Element_Array;
+
+
 end Packrat.Parsers;