From 81c4526fa275a256bfefe0f8a7cd638369ea1252 Mon Sep 17 00:00:00 2001 From: Jed Barber Date: Sat, 28 Nov 2020 16:24:04 +1100 Subject: Cleaned up Lexer, Util package names --- src/packrat-lexer.adb | 686 -------------------------------------------------- 1 file changed, 686 deletions(-) delete mode 100644 src/packrat-lexer.adb (limited to 'src/packrat-lexer.adb') diff --git a/src/packrat-lexer.adb b/src/packrat-lexer.adb deleted file mode 100644 index 486aae5..0000000 --- a/src/packrat-lexer.adb +++ /dev/null @@ -1,686 +0,0 @@ - - -with - - Packrat.Errors; - - -package body Packrat.Lexer 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.Lexer; - - -- cgit