From e56d6c906e876d76b9e9c0526491d5d7472a13af Mon Sep 17 00:00:00 2001
From: Jed Barber <jjbarber@y7mail.com>
Date: Sun, 13 Jan 2019 00:32:20 +1100
Subject: All lexer combinators except Many and Many_Until now functional

---
 src/packrat-lexer-combinators.adb | 206 +++++++++++++++++++++++++++++++-------
 src/packrat-lexer-combinators.ads |  12 ---
 src/packrat-lexer.adb             |  49 +++++++--
 src/packrat-lexer.ads             |  11 +-
 4 files changed, 216 insertions(+), 62 deletions(-)

(limited to 'src')

diff --git a/src/packrat-lexer-combinators.adb b/src/packrat-lexer-combinators.adb
index 7dccede..6405efb 100644
--- a/src/packrat-lexer-combinators.adb
+++ b/src/packrat-lexer-combinators.adb
@@ -6,27 +6,87 @@ package body Packrat.Lexer.Combinators is
     function Sequence
            (Input : in Element_Array;
             Start : in Positive)
-        return Combinator_Result is
+        return Combinator_Result
+    is
+        Result : Combinator_Result := Create_Result (0, Success, Empty_Array);
+        Position : Positive := Start;
     begin
-        return Fail_Result;
+        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 := Result.Join (C (Input, Position));
+            exit when Result.Status = Failure;
+            Position := Start + Result.Length;
+        end loop;
+        return Result;
     end Sequence;
 
 
     function Count
            (Input : in Element_Array;
             Start : in Positive)
-        return Combinator_Result is
+        return Combinator_Result
+    is
+        Result : Combinator_Result := Create_Result (0, Success, Empty_Array);
+        Position : Positive := Start;
     begin
-        return Fail_Result;
+        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 := Result.Join (Param (Input, Position));
+            exit when Result.Status = Failure;
+            Position := Start + Result.Length;
+        end loop;
+        return Result;
     end Count;
 
 
     function Many
            (Input : in Element_Array;
             Start : in Positive)
-        return Combinator_Result is
+        return Combinator_Result
+    is
+        Result : Combinator_Result := Create_Result (0, Success, Empty_Array);
+        Temp   : Combinator_Result;
+        Position : Positive := Start;
+        Counter  : Natural := 0;
     begin
-        return Fail_Result;
+        if Start > Input'Last then
+            return Empty_Fail;
+        end if;
+        loop
+            Temp := Param (Input, Position);
+            exit when Temp.Status = Failure;
+            if Temp.Status = Needs_More then
+                Result.Status := Optional_More;
+                exit;
+            end if;
+            Result := Result.Join (Temp);
+            Counter := Counter + 1;
+            Position := Start + Result.Length;
+            if Position > Input'Last then
+                Result.Status := Optional_More;
+                exit;
+            end if;
+        end loop;
+        if Counter < Minimum then
+            if Result.Status = Optional_More then
+                Result.Status := Needs_More;
+            else
+                Result.Status := Failure;
+            end if;
+        end if;
+        return Result;
     end Many;
 
 
@@ -35,7 +95,7 @@ package body Packrat.Lexer.Combinators is
             Start : in Positive)
         return Combinator_Result is
     begin
-        return Fail_Result;
+        return Empty_Fail;
     end Many_Until;
 
 
@@ -47,7 +107,13 @@ package body Packrat.Lexer.Combinators is
             Start : in Positive)
         return Combinator_Result is
     begin
-        return Fail_Result;
+        if Start > Input'Last then
+            return Empty_Fail;
+        elsif Test (Input (Start)) then
+            return Create_Result (1, Success, (1 => Input (Start)));
+        else
+            return Empty_Fail;
+        end if;
     end Satisfy;
 
 
@@ -56,7 +122,13 @@ package body Packrat.Lexer.Combinators is
             Start : in Positive)
         return Combinator_Result is
     begin
-        return Fail_Result;
+        if Start > Input'Last then
+            return Empty_Fail;
+        elsif Test (Change (Input (Start))) then
+            return Create_Result (1, Success, (1 => Input (Start)));
+        else
+            return Empty_Fail;
+        end if;
     end Satisfy_With;
 
 
@@ -65,7 +137,13 @@ package body Packrat.Lexer.Combinators is
             Start : in Positive)
         return Combinator_Result is
     begin
-        return Fail_Result;
+        if Start > Input'Last then
+            return Empty_Fail;
+        elsif Input (Start) = Item then
+            return Create_Result (1, Success, (1 => Item));
+        else
+            return Empty_Fail;
+        end if;
     end Match;
 
 
@@ -74,16 +152,40 @@ package body Packrat.Lexer.Combinators is
             Start : in Positive)
         return Combinator_Result is
     begin
-        return Fail_Result;
+        if Start > Input'Last then
+            return Empty_Fail;
+        elsif Change (Input (Start)) = Item then
+            return Create_Result (1, Success, (1 => Input (Start)));
+        else
+            return Empty_Fail;
+        end if;
     end Match_With;
 
 
     function Multimatch
            (Input : in Element_Array;
             Start : in Positive)
-        return Combinator_Result is
+        return Combinator_Result
+    is
+        Current_Offset : Natural := 0;
     begin
-        return Fail_Result;
+        if Items'Length = 0 then
+            return Create_Result (0, Success, Empty_Array);
+        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 Create_Result (Current_Offset + 1, Success, Items);
+            elsif Start + Current_Offset = Input'Last then
+                return Create_Result (Current_Offset + 1, Needs_More, Input (Start .. Input'Last));
+            end if;
+            Current_Offset := Current_Offset + 1;
+        end loop;
+        return Create_Result (Current_Offset, Failure, Input (Start .. Start + Current_Offset - 1));
     end Multimatch;
 
 
@@ -92,64 +194,92 @@ package body Packrat.Lexer.Combinators is
             Start : in Positive)
         return Combinator_Result is
     begin
-        return Fail_Result;
+        if Start > Input'Last then
+            return Empty_Fail;
+        elsif Start + Number - 1 > Input'Last then
+            return Create_Result (Input'Last - Start + 1, Needs_More, Input (Start .. Input'Last));
+        else
+            return Create_Result (Number, Success, Input (Start .. Start + Number - 1));
+        end if;
     end Take;
 
 
     function Take_While
            (Input : in Element_Array;
             Start : in Positive)
-        return Combinator_Result is
+        return Combinator_Result
+    is
+        Finish : Positive := Start;
+        Status : Result_Status;
     begin
-        return Fail_Result;
+        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 Create_Result (Finish - Start, Status, Input (Start .. Finish - 1));
     end Take_While;
 
 
     function Take_Until
            (Input : in Element_Array;
             Start : in Positive)
-        return Combinator_Result is
+        return Combinator_Result
+    is
+        Finish : Positive := Start;
+        Status : Result_Status;
     begin
-        return Fail_Result;
+        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 Create_Result (Finish - Start, Status, Input (Start .. Finish - 1));
     end Take_Until;
 
 
 
 
 
-    function Line_Start
-           (Input : in Element_Array;
-            Start : in Positive)
-        return Combinator_Result is
-    begin
-        return Fail_Result;
-    end Line_Start;
-
-
     function Line_End
            (Input : in Element_Array;
             Start : in Positive)
         return Combinator_Result is
     begin
-        return Fail_Result;
+        if Start > Input'Last then
+            return Empty_Fail;
+        elsif Input (Start) = EOL_Item then
+            return Create_Result (1, Success, (1 => EOL_Item));
+        else
+            return Empty_Fail;
+        end if;
     end Line_End;
 
 
-    function Input_Start
-           (Input : in Element_Array;
-            Start : in Positive)
-        return Combinator_Result is
-    begin
-        return Fail_Result;
-    end Input_Start;
-
-
     function Input_End
            (Input : in Element_Array;
             Start : in Positive)
         return Combinator_Result is
     begin
-        return Fail_Result;
+        if Start > Input'Last then
+            return Empty_Fail;
+        elsif Input (Start) = EOF_Item then
+            return Create_Result (1, Success, (1 => EOF_Item));
+        else
+            return Empty_Fail;
+        end if;
     end Input_End;
 
 
diff --git a/src/packrat-lexer-combinators.ads b/src/packrat-lexer-combinators.ads
index b690a63..98df3d5 100644
--- a/src/packrat-lexer-combinators.ads
+++ b/src/packrat-lexer-combinators.ads
@@ -123,13 +123,6 @@ package Packrat.Lexer.Combinators is
 
 
 
-    generic
-        EOL_Item : in Element;
-    function Line_Start
-           (Input : in Element_Array;
-            Start : in Positive)
-        return Combinator_Result;
-
     generic
         EOL_Item : in Element;
     function Line_End
@@ -137,11 +130,6 @@ package Packrat.Lexer.Combinators is
             Start : in Positive)
         return Combinator_Result;
 
-    function Input_Start
-           (Input : in Element_Array;
-            Start : in Positive)
-        return Combinator_Result;
-
     generic
         EOF_Item : in Element;
     function Input_End
diff --git a/src/packrat-lexer.adb b/src/packrat-lexer.adb
index 0b0f571..ce793a5 100644
--- a/src/packrat-lexer.adb
+++ b/src/packrat-lexer.adb
@@ -81,19 +81,23 @@ package body Packrat.Lexer is
         end if;
         Total_Valsize := Left_Valsize + Right_Valsize;
 
-        if Left.Status = Success then
+        if Left.Status = Success or Left.Status = Optional_More then
             Merge.Length := Left.Length + Right.Length;
             Merge.Status := Right.Status;
-            if Total_Valsize /= 0 or Right.Status /= Failure then
+            if Total_Valsize > 0 then
                 Merge.Value := new Element_Array (1 .. Total_Valsize);
-                if Left_Valsize /= 0 then
+                if Left.Value /= null then
                     Merge.Value.all (1 .. Left_Valsize) := Left.Value.all;
                 end if;
-                if Right_Valsize /= 0 then
+                if Right.Value /= null then
                     Merge.Value.all (Left_Valsize + 1 .. Total_Valsize) := Right.Value.all;
                 end if;
             end if;
             return Merge;
+        elsif Left.Status = Needs_More then
+            Merge := Left;
+            Merge.Status := Failure;
+            return Merge;
         else
             return Left;
         end if;
@@ -104,15 +108,23 @@ package body Packrat.Lexer is
            (Left, Right : in Combinator_Result)
         return Boolean
     is
-        Null_Check : Boolean :=
-            Left.Value = null and Right.Value = null;
-        Value_Check : Boolean :=
-            Left.Value /= null and then Right.Value /= null and then
-            Left.Value.all = Right.Value.all;
+        Left_Valsize, Right_Valsize : Natural;
     begin
+        if Left.Value = null then
+            Left_Valsize := 0;
+        else
+            Left_Valsize := Left.Value.all'Length;
+        end if;
+        if Right.Value = null then
+            Right_Valsize := 0;
+        else
+            Right_Valsize := Right.Value.all'Length;
+        end if;
+
         return Left.Length = Right.Length and
             Left.Status = Right.Status and
-            (Null_Check or Value_Check);
+            Left_Valsize = Right_Valsize and
+            (Left_Valsize = 0 or else Left.Value.all = Right.Value.all);
     end "=";
 
 
@@ -124,6 +136,23 @@ package body Packrat.Lexer is
     end Status;
 
 
+    function Debug_String
+           (This : in Combinator_Result)
+        return String
+    is
+        Value_Length : Natural;
+    begin
+        if This.Value = null then
+            Value_Length := 0;
+        else
+            Value_Length := This.Value.all'Length;
+        end if;
+        return Integer'Image (This.Length)
+            & " " & Result_Status'Image (This.Status)
+            & " " & Integer'Image (Value_Length);
+    end Debug_String;
+
+
 end Packrat.Lexer;
 
 
diff --git a/src/packrat-lexer.ads b/src/packrat-lexer.ads
index ef08cb5..6c28bf8 100644
--- a/src/packrat-lexer.ads
+++ b/src/packrat-lexer.ads
@@ -21,7 +21,7 @@ package Packrat.Lexer is
     type Combinator_Array is array (Positive range <>) of Combinator;
 
 
-    Fail_Result : constant Combinator_Result;
+    Empty_Fail : constant Combinator_Result;
 
 
     function Create_Result
@@ -42,6 +42,10 @@ package Packrat.Lexer is
            (This : in Combinator_Result)
         return Result_Status;
 
+    function Debug_String
+           (This : in Combinator_Result)
+        return String;
+
 
 private
 
@@ -49,6 +53,9 @@ private
     type Element_Array_Access is access Element_Array;
 
 
+    Empty_Array : Element_Array (1 .. 0);
+
+
     type Combinator_Result is new Ada.Finalization.Controlled with record
         Length : Natural;
         Status : Result_Status;
@@ -66,7 +73,7 @@ private
            (This : in out Combinator_Result);
 
 
-    Fail_Result : constant Combinator_Result :=
+    Empty_Fail : constant Combinator_Result :=
        (Ada.Finalization.Controlled with
         Length => 0,
         Status => Failure,
-- 
cgit