All lexer functions should be functional now

2 files changed, 143 insertions, 22 deletions

diff --git a/src/packrat-lexer.adb b/src/packrat-lexer.adb
index 77ebf9f..eb126eb 100644
--- a/src/packrat-lexer.adb
+++ b/src/packrat-lexer.adb
@@ -196,7 +196,6 @@ package body Packrat.Lexer is
             Details.Pass_Forward := null;
         end if;
 
-        Details.Result_So_Far.Clear;
         Details.Empty_Labels.Clear;
         Details.Error_Labels.Clear;
         Details.Error_Labels.Reserve_Capacity (Number_Comp);
@@ -235,6 +234,36 @@ package body Packrat.Lexer is
     end Token_Vector_To_Array;
 
 
+    procedure Token_Vector_To_Array
+           (Input_Vector : in     Token_Vectors.Vector;
+            Padding      : in     Gen_Tokens.Token;
+            Output_Array :    out Gen_Tokens.Token_Array) is
+    begin
+        for N in Integer range 1 .. Output_Array'Length loop
+            if N <= Integer (Input_Vector.Length) then
+                Output_Array (Output_Array'First + N - 1) := Input_Vector.Element (N);
+            else
+                Output_Array (Output_Array'First + N - 1) := Padding;
+            end if;
+        end loop;
+    end Token_Vector_To_Array;
+
+
+    procedure Assign_New
+           (Location : in out Element_Array_Access;
+            Items    : in     Element_Array) is
+    begin
+        if Location /= null then
+            Free_Array (Location);
+        end if;
+        Location := new Element_Array (1 .. Items'Last - Items'First + 1);
+        Location.all := Items;
+    end Assign_New;
+
+
+
+
+
     function Scan
            (Input   : in     Element_Array;
             Context : in out Lexer_Context)
@@ -245,6 +274,7 @@ package body Packrat.Lexer is
         Raise_Error : Boolean;
     begin
         Tidy_Context (Context, Components'Length);
+        Context.Result_So_Far.Clear;
         Context.Allow_Incomplete := not (Input = Empty_Array);
 
         while Context.Status = Success and Context.Position <= Real_Input.Data'Length loop
@@ -259,7 +289,6 @@ package body Packrat.Lexer is
                 Raise_Lexer_Error (Context.Error_Labels, Context.Position);
             end if;
         end loop;
-
         return Token_Vector_To_Array (Context.Result_So_Far);
     end Scan;
 
@@ -274,6 +303,7 @@ package body Packrat.Lexer is
         Raise_Error : Boolean;
     begin
         Tidy_Context (Context, Components'Length);
+        Context.Result_So_Far.Clear;
         Context.Allow_Incomplete := False;
 
         while Context.Status = Success and Context.Position <= Real_Input.Data'Length loop
@@ -288,7 +318,6 @@ package body Packrat.Lexer is
                 Raise_Lexer_Error (Context.Error_Labels, Context.Position);
             end if;
         end loop;
-
         return Token_Vector_To_Array (Context.Result_So_Far);
     end Scan_Only;
 
@@ -298,27 +327,125 @@ package body Packrat.Lexer is
             Context : in out Lexer_Context)
         return Gen_Tokens.Token_Array
     is
-        Result : Gen_Tokens.Token_Array (1 .. 0);
+        Raise_Error : Boolean;
     begin
-        return Result;
+        Context.Result_So_Far.Clear;
+        loop
+            declare
+                New_Input : Element_Array := Input.all;
+                Real_Input : Input_Container :=
+                    Pass_Input (Context.Pass_Forward, New_Input'Unrestricted_Access);
+            begin
+                Tidy_Context (Context, Components'Length);
+                Context.Allow_Incomplete := not (New_Input = Empty_Array);
+
+                while Context.Status = Success and Context.Position <= Real_Input.Data'Length loop
+                    Raise_Error := True;
+                    for C of Components loop
+                        if C (Real_Input.Data.all, Context) = Component_Success then
+                            Raise_Error := False;
+                            exit;
+                        end if;
+                    end loop;
+                    if Raise_Error then
+                        Raise_Lexer_Error (Context.Error_Labels, Context.Position);
+                    end if;
+                end loop;
+
+                if New_Input = Empty_Array then
+                    exit;
+                end if;
+            end;
+        end loop;
+        return Token_Vector_To_Array (Context.Result_So_Far);
     end Scan_With;
 
 
     procedure Scan_Set
            (Input   : in     Element_Array;
             Context : in out Lexer_Context;
-            Output  :    out Gen_Tokens.Token_Array) is
+            Output  :    out Gen_Tokens.Token_Array)
+    is
+        Real_Input : Input_Container :=
+            Pass_Input (Context.Pass_Forward, Input'Unrestricted_Access);
+        Raise_Error : Boolean;
     begin
-        null;
+        Tidy_Context (Context, Components'Length);
+        Context.Result_So_Far.Clear;
+        Context.Allow_Incomplete := not (Input = Empty_Array or else Input (Input'First) = Pad_In);
+
+        while Context.Status = Success and then
+            Integer (Context.Result_So_Far.Length) < Output'Length and then
+            Context.Position <= Real_Input.Data'Length and then
+            Real_Input.Data (Context.Position) /= Pad_In
+        loop
+            Raise_Error := True;
+            for C of Components loop
+                if C (Real_Input.Data.all, Context) = Component_Success then
+                    Raise_Error := False;
+                    exit;
+                end if;
+            end loop;
+            if Raise_Error then
+                Raise_Lexer_Error (Context.Error_Labels, Context.Position);
+            end if;
+        end loop;
+
+        if Integer (Context.Result_So_Far.Length) >= Output'Length then
+            Assign_New (Context.Pass_Forward,
+                Real_Input.Data (Context.Position .. Real_Input.Data'Last));
+        end if;
+        Token_Vector_To_Array (Context.Result_So_Far, Pad_Out, Output);
     end Scan_Set;
 
 
     procedure Scan_Set_With
            (Input   : in     With_Input;
             Context : in out Lexer_Context;
-            Output  :    out Gen_Tokens.Token_Array) is
+            Output  :    out Gen_Tokens.Token_Array)
+    is
+        Raise_Error : Boolean;
     begin
-        null;
+        Context.Result_So_Far.Clear;
+        loop
+            declare
+                New_Input : Element_Array := Input.all;
+                Real_Input : Input_Container :=
+                    Pass_Input (Context.Pass_Forward, New_Input'Unrestricted_Access);
+            begin
+                Tidy_Context (Context, Components'Length);
+                Context.Allow_Incomplete := not
+                   (New_Input = Empty_Array or else New_Input (New_Input'First) = Pad_In);
+
+                while Context.Status = Success and then
+                    Integer (Context.Result_So_Far.Length) < Output'Length and then
+                    Context.Position <= Real_Input.Data'Length and then
+                    Real_Input.Data (Context.Position) /= Pad_In
+                loop
+                    Raise_Error := True;
+                    for C of Components loop
+                        if C (Real_Input.Data.all, Context) = Component_Success then
+                            Raise_Error := False;
+                            exit;
+                        end if;
+                    end loop;
+                    if Raise_Error then
+                        Raise_Lexer_Error (Context.Error_Labels, Context.Position);
+                    end if;
+                end loop;
+
+                if New_Input = Empty_Array or else New_Input (New_Input'First) = Pad_In then
+                    exit;
+                end if;
+
+                if Integer (Context.Result_So_Far.Length) >= Output'Length then
+                    Assign_New (Context.Pass_Forward,
+                        Real_Input.Data (Context.Position .. Real_Input.Data'Last));
+                    exit;
+                end if;
+            end;
+        end loop;
+        Token_Vector_To_Array (Context.Result_So_Far, Pad_Out, Output);
     end Scan_Set_With;
 
 
diff --git a/test/ratnest-tests.adb b/test/ratnest-tests.adb
index d5c150e..3d51081 100644
--- a/test/ratnest-tests.adb
+++ b/test/ratnest-tests.adb
@@ -6,7 +6,7 @@ with
     Ada.Strings.Maps,
     Ada.Exceptions,
     Packrat.Lexer.Debug,
-    Packrat.Util, Ada.Text_IO;
+    Packrat.Util;
 
 
 package body Ratnest.Tests is
@@ -907,12 +907,6 @@ package body Ratnest.Tests is
                 My_Scan ("", Test_Context);
         begin
             if Actual_Result1 /= Intended_Result1 or Actual_Result2 /= Intended_Result2 then
-                for T of Actual_Result1 loop
-                    Ada.Text_IO.Put_Line (T.Debug_String);
-                end loop;
-                for T of Actual_Result2 loop
-                    Ada.Text_IO.Put_Line (T.Debug_String);
-                end loop;
                 return Fail;
             end if;
             return Pass;
@@ -952,7 +946,7 @@ package body Ratnest.Tests is
             begin
                 if Sentinel > 1 then
                     Sentinel := 1;
-                    return "it will happen again ";
+                    return "it will happen  again";
                 elsif Sentinel > 0 then
                     Sentinel := 0;
                     return " and again and again";
@@ -970,11 +964,11 @@ package body Ratnest.Tests is
                (1 => Word_Tokens.Create (Word, 1, 2, "it"),
                 2 => Word_Tokens.Create (Word, 4, 7, "will"),
                 3 => Word_Tokens.Create (Word, 9, 14, "happen"),
-                4 => Word_Tokens.Create (Word, 16, 20, "again"),
-                5 => Word_Tokens.Create (Word, 22, 24, "and"),
-                6 => Word_Tokens.Create (Word, 26, 30, "again"),
-                7 => Word_Tokens.Create (Word, 32, 34, "and"),
-                8 => Word_Tokens.Create (Word, 36, 40, "again"));
+                4 => Word_Tokens.Create (Word, 17, 21, "again"),
+                5 => Word_Tokens.Create (Word, 23, 25, "and"),
+                6 => Word_Tokens.Create (Word, 27, 31, "again"),
+                7 => Word_Tokens.Create (Word, 33, 35, "and"),
+                8 => Word_Tokens.Create (Word, 37, 41, "again"));
 
             Actual_Result : Word_Tokens.Token_Array :=
                 My_Scan (More_Input'Unrestricted_Access, Test_Context);