diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/packrat-lexer.adb | 145 |
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; |