summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/packrat-lexer.adb145
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;