All lexer functions should be functional now

1 files changed, 136 insertions, 9 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;