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-lexers.adb | 686 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 686 insertions(+) create mode 100644 src/packrat-lexers.adb (limited to 'src/packrat-lexers.adb') 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; + + -- cgit