Cleaned up Lexer, Util package names

1 files changed, 686 insertions, 0 deletions

diff --git a/src/packrat-lexers.adb b/src/packrat-lexers.adb
new file mode 100644
index 0000000..fc63e4a
--- /dev/null
+++ b/src/packrat-lexers.adb
@@ -0,0 +1,686 @@
+
+
+with
+
+    Packrat.Errors;
+
+
+package body Packrat.Lexers is
+
+
+    function Join
+           (Left, Right : in Combinator_Result)
+        return Combinator_Result is
+    begin
+        if Left.Status = Success or Left.Status = Optional_More then
+            return (Integer'Max (Left.Finish, Right.Finish), Right.Status);
+        elsif Left.Status = Needs_More then
+            return (Left.Finish, Failure);
+        else
+            return Left;
+        end if;
+    end Join;
+
+
+
+
+
+    function Stamp
+           (Input   : in     Traits.Element_Array;
+            Context : in out Lexer_Context)
+        return Component_Result
+    is
+        Current_Result : Combinator_Result :=
+            Combo (Input, Context.Position);
+    begin
+        if  Context.Status /= Success or Context.Position > Input'Last or
+            Context.Empty_Labels.Contains (Label)
+        then
+            return Component_Failure;
+        end if;
+
+        if (Current_Result.Status = Needs_More and not Context.Allow_Incomplete) or
+            Current_Result.Status = Failure
+        then
+            Context.Error_Labels.Append (Label);
+            return Component_Failure;
+        end if;
+
+        if (Current_Result.Status = Optional_More and not Context.Allow_Incomplete) or
+            Current_Result.Status = Success
+        then
+            Context.Result_So_Far.Append (Traits.Tokens.Create
+               (Label,
+                Context.Position + Context.Offset,
+                Input (Context.Position .. Current_Result.Finish)));
+            if Current_Result.Finish = 0 then
+                Context.Empty_Labels.Insert (Label);
+            else
+                Context.Empty_Labels.Clear;
+                Context.Position := Current_Result.Finish + 1;
+            end if;
+        else
+            Context.Status := Current_Result.Status;
+            Context.Pass_Forward.Replace_Element
+                (Input (Context.Position .. Current_Result.Finish));
+            Context.Empty_Labels.Clear;
+        end if;
+
+        Context.Error_Labels.Clear;
+        return Component_Success;
+    end Stamp;
+
+
+    function Ignore
+           (Input   : in     Traits.Element_Array;
+            Context : in out Lexer_Context)
+        return Component_Result
+    is
+        Current_Result : Combinator_Result :=
+            Combo (Input, Context.Position);
+    begin
+        if  Context.Status /= Success or Context.Position > Input'Last or
+            Context.Empty_Labels.Contains (Label)
+        then
+            return Component_Failure;
+        end if;
+
+        if (Current_Result.Status = Needs_More and not Context.Allow_Incomplete) or
+            Current_Result.Status = Failure
+        then
+            Context.Error_Labels.Append (Label);
+            return Component_Failure;
+        end if;
+
+        if (Current_Result.Status = Optional_More and not Context.Allow_Incomplete) or
+            Current_Result.Status = Success
+        then
+            if Current_Result.Finish = 0 then
+                Context.Empty_Labels.Insert (Label);
+            else
+                Context.Empty_Labels.Clear;
+                Context.Position := Current_Result.Finish + 1;
+            end if;
+        else
+            Context.Status := Current_Result.Status;
+            Context.Pass_Forward.Replace_Element
+                (Input (Context.Position .. Current_Result.Finish));
+            Context.Empty_Labels.Clear;
+        end if;
+
+        Context.Error_Labels.Clear;
+        return Component_Success;
+    end Ignore;
+
+
+
+
+
+    procedure Tidy_Context
+           (Details     : in out Lexer_Context;
+            Number_Comp : in     Ada.Containers.Count_Type) is
+    begin
+        Details.Pass_Forward.Clear;
+
+        Details.Empty_Labels.Clear;
+        Details.Error_Labels.Clear;
+        Details.Error_Labels.Reserve_Capacity (Number_Comp);
+
+        Details.Offset := Details.Offset + Details.Position - 1;
+        Details.Position := 1;
+        Details.Status := Success;
+    end Tidy_Context;
+
+
+    procedure Raise_Lexer_Error
+           (Label_List : in Label_Vectors.Vector;
+            Position   : in Positive)
+    is
+        Error_Info_List : Packrat.Errors.Error_Info_Array
+           (Label_List.First_Index .. Label_List.Last_Index);
+    begin
+        for I in Integer range Error_Info_List'First .. Error_Info_List'Last loop
+            Error_Info_List (I).Symbol := +Traits.Label_Enum'Image (Label_List.Element (I));
+            Error_Info_List (I).Position := Position;
+        end loop;
+        raise Lexer_Error with Packrat.Errors.Encode_Array (Error_Info_List);
+    end Raise_Lexer_Error;
+
+
+    function Token_Vector_To_Array
+           (Input_Vector : in Token_Vectors.Vector)
+        return Traits.Tokens.Token_Array
+    is
+        Result_Array : Traits.Tokens.Token_Array (1 .. Integer (Input_Vector.Length));
+    begin
+        for I in Integer range 1 .. Integer (Input_Vector.Length) loop
+            Result_Array (I) := Input_Vector.Element (I);
+        end loop;
+        return Result_Array;
+    end Token_Vector_To_Array;
+
+
+    procedure Token_Vector_To_Array
+           (Input_Vector : in     Token_Vectors.Vector;
+            Padding      : in     Traits.Tokens.Token;
+            Output_Array :    out Traits.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;
+
+
+    function Slide
+           (Input : in Traits.Element_Array)
+        return Traits.Element_Array
+    is
+        subtype Slider is Traits.Element_Array (1 .. Input'Length);
+    begin
+        return Slider (Input);
+    end Slide;
+
+
+    procedure Internal_Scan_Core
+           (Input      : in     Traits.Element_Array;
+            Context    : in out Lexer_Context;
+            Components : in     Component_Array)
+    is
+        Raise_Error : Boolean;
+    begin
+        Raise_Error := True;
+        for C of Components loop
+            if C (Input, 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 Internal_Scan_Core;
+
+
+
+
+
+    function Scan
+           (Input   : in     Traits.Element_Array;
+            Context : in out Lexer_Context)
+        return Traits.Tokens.Token_Array
+    is
+        Real_Input : Input_Holders.Holder;
+    begin
+        if not Context.Pass_Forward.Is_Empty then
+            Real_Input.Replace_Element (Slide (Context.Pass_Forward.Element) & Input);
+        else
+            Real_Input.Replace_Element (Input);
+        end if;
+
+        Tidy_Context (Context, Components'Length);
+        Context.Result_So_Far.Clear;
+        Context.Allow_Incomplete := Input'Length > 0;
+
+        while Context.Status = Success and Context.Position <= Real_Input.Element'Length loop
+            Internal_Scan_Core (Real_Input.Element, Context, Components);
+        end loop;
+
+        return Token_Vector_To_Array (Context.Result_So_Far);
+    end Scan;
+
+
+    function Scan_Only
+           (Input   : in     Traits.Element_Array;
+            Context : in out Lexer_Context)
+        return Traits.Tokens.Token_Array
+    is
+        Real_Input : Input_Holders.Holder;
+    begin
+        if not Context.Pass_Forward.Is_Empty then
+            Real_Input.Replace_Element (Slide (Context.Pass_Forward.Element) & Input);
+        else
+            Real_Input.Replace_Element (Input);
+        end if;
+
+        Tidy_Context (Context, Components'Length);
+        Context.Result_So_Far.Clear;
+        Context.Allow_Incomplete := False;
+
+        while Context.Status = Success and Context.Position <= Real_Input.Element'Length loop
+            Internal_Scan_Core (Real_Input.Element, Context, Components);
+        end loop;
+
+        return Token_Vector_To_Array (Context.Result_So_Far);
+    end Scan_Only;
+
+
+    function Scan_With
+           (Input   : in     With_Input;
+            Context : in out Lexer_Context)
+        return Traits.Tokens.Token_Array
+    is
+        Real_Input : Input_Holders.Holder;
+        Empty_Input : Boolean;
+    begin
+        Context.Result_So_Far.Clear;
+        loop
+            Real_Input.Replace_Element (Input.all);
+            Empty_Input := Real_Input.Element'Length = 0;
+            if not Context.Pass_Forward.Is_Empty then
+                Real_Input.Replace_Element
+                    (Slide (Context.Pass_Forward.Element) & Real_Input.Element);
+            end if;
+
+            Tidy_Context (Context, Components'Length);
+            Context.Allow_Incomplete := not Empty_Input;
+
+            while Context.Status = Success and Context.Position <= Real_Input.Element'Length loop
+                Internal_Scan_Core (Real_Input.Element, Context, Components);
+            end loop;
+
+            if Empty_Input then
+                exit;
+            end if;
+        end loop;
+        return Token_Vector_To_Array (Context.Result_So_Far);
+    end Scan_With;
+
+
+    procedure Scan_Set
+           (Input   : in     Traits.Element_Array;
+            Context : in out Lexer_Context;
+            Output  :    out Traits.Tokens.Token_Array)
+    is
+        Real_Input : Input_Holders.Holder;
+    begin
+        if not Context.Pass_Forward.Is_Empty then
+            Real_Input.Replace_Element (Slide (Context.Pass_Forward.Element) & Input);
+        else
+            Real_Input.Replace_Element (Input);
+        end if;
+
+        Tidy_Context (Context, Components'Length);
+        Context.Result_So_Far.Clear;
+        Context.Allow_Incomplete := not (Input'Length = 0 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.Element'Length and then
+            Real_Input.Element (Context.Position) /= Pad_In
+        loop
+            Internal_Scan_Core (Real_Input.Element, Context, Components);
+        end loop;
+
+        if Integer (Context.Result_So_Far.Length) = Output'Length then
+            Context.Pass_Forward.Replace_Element
+                (Real_Input.Element (Context.Position .. Real_Input.Element'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 Traits.Tokens.Token_Array)
+    is
+        Real_Input : Input_Holders.Holder;
+        Empty_Input : Boolean;
+    begin
+        Context.Result_So_Far.Clear;
+        loop
+            Real_Input.Replace_Element (Input.all);
+            Empty_Input := Real_Input.Element'Length = 0 or else
+                Real_Input.Element (Real_Input.Element'First) = Pad_In;
+            if not Context.Pass_Forward.Is_Empty then
+                Real_Input.Replace_Element
+                    (Slide (Context.Pass_Forward.Element) & Real_Input.Element);
+            end if;
+
+            Tidy_Context (Context, Components'Length);
+            Context.Allow_Incomplete := not Empty_Input;
+
+            while Context.Status = Success and then
+                Integer (Context.Result_So_Far.Length) < Output'Length and then
+                Context.Position <= Real_Input.Element'Length and then
+                Real_Input.Element (Context.Position) /= Pad_In
+            loop
+                Internal_Scan_Core (Real_Input.Element, Context, Components);
+            end loop;
+
+            if Empty_Input then
+                exit;
+            end if;
+
+            if Integer (Context.Result_So_Far.Length) = Output'Length then
+                Context.Pass_Forward.Replace_Element
+                    (Real_Input.Element (Context.Position .. Real_Input.Element'Last));
+                exit;
+            end if;
+        end loop;
+        Token_Vector_To_Array (Context.Result_So_Far, Pad_Out, Output);
+    end Scan_Set_With;
+
+
+
+
+
+    function Sequence
+           (Input : in Traits.Element_Array;
+            Start : in Positive)
+        return Combinator_Result
+    is
+        Result : Combinator_Result := (0, Success);
+        Position : Positive := Start;
+    begin
+        if Start > Input'Last then
+            return Empty_Fail;
+        end if;
+        for C of Params loop
+            if Position > Input'Last then
+                Result.Status := Needs_More;
+                exit;
+            end if;
+            Result := Join (Result, C (Input, Position));
+            exit when Result.Status = Failure;
+            Position := Result.Finish + 1;
+        end loop;
+        return Result;
+    end Sequence;
+
+
+    function Count
+           (Input : in Traits.Element_Array;
+            Start : in Positive)
+        return Combinator_Result
+    is
+        Result : Combinator_Result := (0, Success);
+        Position : Positive := Start;
+    begin
+        if Start > Input'Last then
+            return Empty_Fail;
+        end if;
+        for I in Integer range 1 .. Number loop
+            if Position > Input'Last then
+                Result.Status := Needs_More;
+                exit;
+            end if;
+            Result := Join (Result, Param (Input, Position));
+            exit when Result.Status = Failure;
+            Position := Result.Finish + 1;
+        end loop;
+        return Result;
+    end Count;
+
+
+    function Many
+           (Input : in Traits.Element_Array;
+            Start : in Positive)
+        return Combinator_Result
+    is
+        Result : Combinator_Result := (0, Success);
+        Temp   : Combinator_Result;
+        Position : Positive := Start;
+        Counter  : Natural := 0;
+    begin
+        if Start > Input'Last then
+            return Empty_Fail;
+        end if;
+        loop
+            exit when Position > Input'Last;
+            Temp := Param (Input, Position);
+            exit when Temp.Status = Failure or Temp.Status = Needs_More;
+            Result := Join (Result, Temp);
+            Counter := Counter + 1;
+            Position := Result.Finish + 1;
+        end loop;
+        if Counter < Minimum then
+            if Position > Input'Last or Temp.Status = Needs_More then
+                Result.Status := Needs_More;
+            else
+                Result.Status := Failure;
+            end if;
+        elsif Position > Input'Last or Temp.Status = Needs_More then
+            Result.Status := Optional_More;
+        else
+            Result.Status := Success;
+        end if;
+        return Result;
+    end Many;
+
+
+    function Many_Until
+           (Input : in Traits.Element_Array;
+            Start : in Positive)
+        return Combinator_Result
+    is
+        Result : Combinator_Result := (0, Success);
+        Temp   : Combinator_Result;
+        Position : Positive := Start;
+        Counter  : Natural := 0;
+    begin
+        if Start > Input'Last then
+            return Empty_Fail;
+        end if;
+        loop
+            exit when Position > Input'Last;
+            Temp := Param (Input, Position);
+            exit when Temp.Status = Failure or Temp.Status = Needs_More or Test (Input (Position));
+            Result := Join (Result, Temp);
+            Counter := Counter + 1;
+            Position := Result.Finish + 1;
+        end loop;
+        if Counter < Minimum then
+            if Position > Input'Last or Temp.Status = Needs_More then
+                Result.Status := Needs_More;
+            else
+                Result.Status := Failure;
+            end if;
+        elsif Position > Input'Last then
+            Result.Status := Needs_More;
+        elsif Temp.Status = Needs_More and Test (Input (Position)) then
+            Result.Status := Optional_More;
+        elsif Test (Input (Position)) then
+            Result.Status := Success;
+        else
+            Result.Status := Failure;
+        end if;
+        return Result;
+    end Many_Until;
+
+
+
+
+
+    function Satisfy
+           (Input : in Traits.Element_Array;
+            Start : in Positive)
+        return Combinator_Result is
+    begin
+        if Start > Input'Last then
+            return Empty_Fail;
+        elsif Test (Input (Start)) then
+            return (Start, Success);
+        else
+            return Empty_Fail;
+        end if;
+    end Satisfy;
+
+
+    function Satisfy_With
+           (Input : in Traits.Element_Array;
+            Start : in Positive)
+        return Combinator_Result is
+    begin
+        if Start > Input'Last then
+            return Empty_Fail;
+        elsif Test (Change (Input (Start))) then
+            return (Start, Success);
+        else
+            return Empty_Fail;
+        end if;
+    end Satisfy_With;
+
+
+    function Match
+           (Input : in Traits.Element_Array;
+            Start : in Positive)
+        return Combinator_Result is
+    begin
+        if Start > Input'Last then
+            return Empty_Fail;
+        elsif Input (Start) = Item then
+            return (Start, Success);
+        else
+            return Empty_Fail;
+        end if;
+    end Match;
+
+
+    function Match_With
+           (Input : in Traits.Element_Array;
+            Start : in Positive)
+        return Combinator_Result is
+    begin
+        if Start > Input'Last then
+            return Empty_Fail;
+        elsif Change (Input (Start)) = Item then
+            return (Start, Success);
+        else
+            return Empty_Fail;
+        end if;
+    end Match_With;
+
+
+    function Multimatch
+           (Input : in Traits.Element_Array;
+            Start : in Positive)
+        return Combinator_Result
+    is
+        Current_Offset : Natural := 0;
+    begin
+        if Items'Length = 0 then
+            return (0, Success);
+        end if;
+
+        if Input'Last - Start + 1 <= 0 then
+            return Empty_Fail;
+        end if;
+
+        while Input (Start + Current_Offset) = Items (Items'First + Current_Offset) loop
+            if Items'First + Current_Offset = Items'Last then
+                return (Start + Current_Offset, Success);
+            elsif Start + Current_Offset = Input'Last then
+                return (Start + Current_Offset, Needs_More);
+            end if;
+            Current_Offset := Current_Offset + 1;
+        end loop;
+        if Current_Offset = 0 then
+            return Empty_Fail;
+        else
+            return (Start + Current_Offset - 1, Failure);
+        end if;
+    end Multimatch;
+
+
+    function Take
+           (Input : in Traits.Element_Array;
+            Start : in Positive)
+        return Combinator_Result is
+    begin
+        if Start > Input'Last then
+            return Empty_Fail;
+        elsif Start + Number - 1 > Input'Last then
+            return (Input'Last, Needs_More);
+        else
+            return (Start + Number - 1, Success);
+        end if;
+    end Take;
+
+
+    function Take_While
+           (Input : in Traits.Element_Array;
+            Start : in Positive)
+        return Combinator_Result
+    is
+        Finish : Positive := Start;
+        Status : Result_Status;
+    begin
+        if Start > Input'Last or else not Test (Input (Start)) then
+            return Empty_Fail;
+        end if;
+        while Finish <= Input'Last and then Test (Input (Finish)) loop
+            Finish := Finish + 1;
+        end loop;
+        if Finish > Input'Last then
+            Status := Optional_More;
+        else
+            Status := Success;
+        end if;
+        return (Finish - 1, Status);
+    end Take_While;
+
+
+    function Take_Until
+           (Input : in Traits.Element_Array;
+            Start : in Positive)
+        return Combinator_Result
+    is
+        Finish : Positive := Start;
+        Status : Result_Status;
+    begin
+        if Start > Input'Last or else Test (Input (Start)) then
+            return Empty_Fail;
+        end if;
+        while Finish <= Input'Last and then not Test (Input (Finish)) loop
+            Finish := Finish + 1;
+        end loop;
+        if Finish > Input'Last then
+            Status := Optional_More;
+        else
+            Status := Success;
+        end if;
+        return (Finish - 1, Status);
+    end Take_Until;
+
+
+
+
+
+    function Line_End
+           (Input : in Traits.Element_Array;
+            Start : in Positive)
+        return Combinator_Result is
+    begin
+        if Start > Input'Last then
+            return Empty_Fail;
+        elsif Input (Start) = EOL_Item then
+            return (Start, Success);
+        else
+            return Empty_Fail;
+        end if;
+    end Line_End;
+
+
+    function Input_End
+           (Input : in Traits.Element_Array;
+            Start : in Positive)
+        return Combinator_Result is
+    begin
+        if Start > Input'Last then
+            return Empty_Fail;
+        elsif Input (Start) = EOF_Item then
+            return (Start, Success);
+        else
+            return Empty_Fail;
+        end if;
+    end Input_End;
+
+
+end Packrat.Lexers;
+
+