diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/packrat-lexer.adb | 346 | ||||
| -rw-r--r-- | src/packrat-lexer.ads | 129 |
2 files changed, 320 insertions, 155 deletions
diff --git a/src/packrat-lexer.adb b/src/packrat-lexer.adb index 7cbd527..77ebf9f 100644 --- a/src/packrat-lexer.adb +++ b/src/packrat-lexer.adb @@ -13,32 +13,30 @@ package body Packrat.Lexer is procedure Initialize - (This : in out Combinator_Result) is + (This : in out Lexer_Context) is begin null; end Initialize; procedure Adjust - (This : in out Combinator_Result) is + (This : in out Lexer_Context) + is + New_Array : Element_Array_Access; begin - if This.Value /= null then - declare - New_Array : Element_Array_Access := - new Element_Array (1 .. This.Value.all'Length); - begin - New_Array.all := This.Value.all; - This.Value := New_Array; - end; + if This.Pass_Forward /= null then + New_Array := new Element_Array (1 .. This.Pass_Forward.all'Length); + New_Array.all := This.Pass_Forward.all; + This.Pass_Forward := New_Array; end if; end Adjust; procedure Finalize - (This : in out Combinator_Result) is + (This : in out Lexer_Context) is begin - if This.Value /= null then - Free_Array (This.Value); + if This.Pass_Forward /= null then + Free_Array (This.Pass_Forward); end if; end Finalize; @@ -46,85 +44,46 @@ package body Packrat.Lexer is - function "=" - (Left, Right : in Combinator_Result) - return Boolean - is - Left_Valsize, Right_Valsize : Natural; + procedure Finalize + (This : in out Input_Container) is begin - if Left.Value = null then - Left_Valsize := 0; - else - Left_Valsize := Left.Value.all'Length; + if This.Dealloc then + Free_Array (This.Data); 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 - Left_Valsize = Right_Valsize and - (Left_Valsize = 0 or else Left.Value.all = Right.Value.all); - end "="; + end Finalize; + function Pass_Input + (Passed, Continuing : in Element_Array_Access) + return Input_Container is + begin + if Passed = null then + return This : Input_Container do + This.Data := Continuing; + This.Dealloc := False; + end return; + else + return This : Input_Container do + This.Data := new Element_Array (1 .. Passed'Length + Continuing'Length); + This.Data (1 .. Passed'Length) := Passed.all; + This.Data (Passed'Length + 1 .. This.Data'Last) := Continuing.all; + This.Dealloc := True; + end return; + end if; + end Pass_Input; - function Create_Result - (Length : in Natural; - Status : in Result_Status; - Value : in Element_Array) - return Combinator_Result - is - This : Combinator_Result; - begin - This.Length := Length; - This.Status := Status; - This.Value := new Element_Array (1 .. Value'Length); - This.Value.all := Value; - return This; - end Create_Result; function Join (Left, Right : in Combinator_Result) - return Combinator_Result - is - Merge : Combinator_Result; - Left_Valsize, Right_Valsize, Total_Valsize : Natural; + return Combinator_Result is begin - if Left.Value /= null then - Left_Valsize := Left.Value.all'Length; - else - Left_Valsize := 0; - end if; - if Right.Value /= null then - Right_Valsize := Right.Value.all'Length; - else - Right_Valsize := 0; - end if; - Total_Valsize := Left_Valsize + Right_Valsize; - if Left.Status = Success or Left.Status = Optional_More then - Merge.Length := Left.Length + Right.Length; - Merge.Status := Right.Status; - if Total_Valsize > 0 then - Merge.Value := new Element_Array (1 .. Total_Valsize); - if Left.Value /= null then - Merge.Value.all (1 .. Left_Valsize) := Left.Value.all; - end if; - if Right.Value /= null then - Merge.Value.all (Left_Valsize + 1 .. Total_Valsize) := Right.Value.all; - end if; - end if; - return Merge; + return (Integer'Max (Left.Finish, Right.Finish), Right.Status); elsif Left.Status = Needs_More then - Merge := Left; - Merge.Status := Failure; - return Merge; + return (Left.Finish, Failure); else return Left; end if; @@ -134,33 +93,174 @@ package body Packrat.Lexer is - procedure Stamp + function Stamp (Input : in Element_Array; - Context : in out Lexer_Context) is + Context : in out Lexer_Context) + return Component_Result + is + Current_Result : Combinator_Result := + Combo (Input, Context.Position); begin - null; + 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 (Gen_Tokens.Create + (Label, + Context.Position + Context.Offset, + Current_Result.Finish + 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 := new Element_Array + (1 .. Current_Result.Finish - Context.Position + 1); + Context.Pass_Forward.all := Input (Context.Position .. Current_Result.Finish); + Context.Empty_Labels.Clear; + end if; + + Context.Error_Labels.Clear; + return Component_Success; end Stamp; - procedure Ignore + function Ignore (Input : in Element_Array; - Context : in out Lexer_Context) is + Context : in out Lexer_Context) + return Component_Result + is + Current_Result : Combinator_Result := + Combo (Input, Context.Position); begin - null; + 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 := new Element_Array + (1 .. Current_Result.Finish - Context.Position + 1); + Context.Pass_Forward.all := 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 + if Details.Pass_Forward /= null then + Free_Array (Details.Pass_Forward); + 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); + + 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 : 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 := +Label_Enum'Image (Label_List.Element (I)); + Error_Info_List (I).Position := Position; + end loop; + raise Lexer_Error with Errors.Encode_Array (Error_Info_List); + end Raise_Lexer_Error; + + + function Token_Vector_To_Array + (Input_Vector : in Token_Vectors.Vector) + return Gen_Tokens.Token_Array + is + Result_Array : Gen_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; + + function Scan (Input : in Element_Array; Context : in out Lexer_Context) return Gen_Tokens.Token_Array is - Result : Gen_Tokens.Token_Array (1 .. 0); + Real_Input : Input_Container := + Pass_Input (Context.Pass_Forward, Input'Unrestricted_Access); + Raise_Error : Boolean; begin - return Result; + Tidy_Context (Context, Components'Length); + Context.Allow_Incomplete := not (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; + + return Token_Vector_To_Array (Context.Result_So_Far); end Scan; @@ -169,14 +269,32 @@ package body Packrat.Lexer is Context : in out Lexer_Context) return Gen_Tokens.Token_Array is - Result : Gen_Tokens.Token_Array (1 .. 0); + Real_Input : Input_Container := + Pass_Input (Context.Pass_Forward, Input'Unrestricted_Access); + Raise_Error : Boolean; begin - return Result; + Tidy_Context (Context, Components'Length); + Context.Allow_Incomplete := False; + + 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; + + return Token_Vector_To_Array (Context.Result_So_Far); end Scan_Only; function Scan_With - (Input : in Lexer_With_Input; + (Input : in With_Input; Context : in out Lexer_Context) return Gen_Tokens.Token_Array is @@ -196,7 +314,7 @@ package body Packrat.Lexer is procedure Scan_Set_With - (Input : in Lexer_With_Input; + (Input : in With_Input; Context : in out Lexer_Context; Output : out Gen_Tokens.Token_Array) is begin @@ -212,7 +330,7 @@ package body Packrat.Lexer is Start : in Positive) return Combinator_Result is - Result : Combinator_Result := Create_Result (0, Success, Empty_Array); + Result : Combinator_Result := (0, Success); Position : Positive := Start; begin if Start > Input'Last then @@ -225,7 +343,7 @@ package body Packrat.Lexer is end if; Result := Join (Result, C (Input, Position)); exit when Result.Status = Failure; - Position := Start + Result.Length; + Position := Result.Finish + 1; end loop; return Result; end Sequence; @@ -236,7 +354,7 @@ package body Packrat.Lexer is Start : in Positive) return Combinator_Result is - Result : Combinator_Result := Create_Result (0, Success, Empty_Array); + Result : Combinator_Result := (0, Success); Position : Positive := Start; begin if Start > Input'Last then @@ -249,7 +367,7 @@ package body Packrat.Lexer is end if; Result := Join (Result, Param (Input, Position)); exit when Result.Status = Failure; - Position := Start + Result.Length; + Position := Result.Finish + 1; end loop; return Result; end Count; @@ -260,7 +378,7 @@ package body Packrat.Lexer is Start : in Positive) return Combinator_Result is - Result : Combinator_Result := Create_Result (0, Success, Empty_Array); + Result : Combinator_Result := (0, Success); Temp : Combinator_Result; Position : Positive := Start; Counter : Natural := 0; @@ -274,7 +392,7 @@ package body Packrat.Lexer is exit when Temp.Status = Failure or Temp.Status = Needs_More; Result := Join (Result, Temp); Counter := Counter + 1; - Position := Start + Result.Length; + Position := Result.Finish + 1; end loop; if Counter < Minimum then if Position > Input'Last or Temp.Status = Needs_More then @@ -296,7 +414,7 @@ package body Packrat.Lexer is Start : in Positive) return Combinator_Result is - Result : Combinator_Result := Create_Result (0, Success, Empty_Array); + Result : Combinator_Result := (0, Success); Temp : Combinator_Result; Position : Positive := Start; Counter : Natural := 0; @@ -310,7 +428,7 @@ package body Packrat.Lexer is exit when Temp.Status = Failure or Temp.Status = Needs_More or Test (Input (Position)); Result := Join (Result, Temp); Counter := Counter + 1; - Position := Start + Result.Length; + Position := Result.Finish + 1; end loop; if Counter < Minimum then if Position > Input'Last or Temp.Status = Needs_More then @@ -342,7 +460,7 @@ package body Packrat.Lexer is if Start > Input'Last then return Empty_Fail; elsif Test (Input (Start)) then - return Create_Result (1, Success, (1 => Input (Start))); + return (Start, Success); else return Empty_Fail; end if; @@ -357,7 +475,7 @@ package body Packrat.Lexer is if Start > Input'Last then return Empty_Fail; elsif Test (Change (Input (Start))) then - return Create_Result (1, Success, (1 => Input (Start))); + return (Start, Success); else return Empty_Fail; end if; @@ -372,7 +490,7 @@ package body Packrat.Lexer is if Start > Input'Last then return Empty_Fail; elsif Input (Start) = Item then - return Create_Result (1, Success, (1 => Item)); + return (Start, Success); else return Empty_Fail; end if; @@ -387,7 +505,7 @@ package body Packrat.Lexer is if Start > Input'Last then return Empty_Fail; elsif Change (Input (Start)) = Item then - return Create_Result (1, Success, (1 => Input (Start))); + return (Start, Success); else return Empty_Fail; end if; @@ -402,7 +520,7 @@ package body Packrat.Lexer is Current_Offset : Natural := 0; begin if Items'Length = 0 then - return Create_Result (0, Success, Empty_Array); + return (0, Success); end if; if Input'Last - Start + 1 <= 0 then @@ -411,13 +529,17 @@ package body Packrat.Lexer is 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); + return (Start + Current_Offset, Success); elsif Start + Current_Offset = Input'Last then - return Create_Result (Current_Offset + 1, Needs_More, Input (Start .. Input'Last)); + return (Start + Current_Offset, Needs_More); end if; Current_Offset := Current_Offset + 1; end loop; - return Create_Result (Current_Offset, Failure, Input (Start .. Start + Current_Offset - 1)); + if Current_Offset = 0 then + return Empty_Fail; + else + return (Start + Current_Offset - 1, Failure); + end if; end Multimatch; @@ -429,9 +551,9 @@ package body Packrat.Lexer is 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)); + return (Input'Last, Needs_More); else - return Create_Result (Number, Success, Input (Start .. Start + Number - 1)); + return (Start + Number - 1, Success); end if; end Take; @@ -455,7 +577,7 @@ package body Packrat.Lexer is else Status := Success; end if; - return Create_Result (Finish - Start, Status, Input (Start .. Finish - 1)); + return (Finish - 1, Status); end Take_While; @@ -478,7 +600,7 @@ package body Packrat.Lexer is else Status := Success; end if; - return Create_Result (Finish - Start, Status, Input (Start .. Finish - 1)); + return (Finish - 1, Status); end Take_Until; @@ -493,7 +615,7 @@ package body Packrat.Lexer is if Start > Input'Last then return Empty_Fail; elsif Input (Start) = EOL_Item then - return Create_Result (1, Success, (1 => EOL_Item)); + return (Start, Success); else return Empty_Fail; end if; @@ -508,7 +630,7 @@ package body Packrat.Lexer is if Start > Input'Last then return Empty_Fail; elsif Input (Start) = EOF_Item then - return Create_Result (1, Success, (1 => EOF_Item)); + return (Start, Success); else return Empty_Fail; end if; diff --git a/src/packrat-lexer.ads b/src/packrat-lexer.ads index 2d152bf..0cd5c78 100644 --- a/src/packrat-lexer.ads +++ b/src/packrat-lexer.ads @@ -2,7 +2,8 @@ private with - Ada.Containers.Vectors; + Ada.Containers.Vectors, + Ada.Containers.Ordered_Sets; generic @@ -16,7 +17,7 @@ generic package Packrat.Lexer is - type Combinator_Result is new Ada.Finalization.Controlled with private; + type Combinator_Result is private; type Combinator is access function (Input : in Element_Array; @@ -25,10 +26,6 @@ package Packrat.Lexer is type Combinator_Array is array (Positive range <>) of Combinator; - function "=" - (Left, Right : in Combinator_Result) - return Boolean; - @@ -39,16 +36,19 @@ package Packrat.Lexer is - type Lexer_Component is access procedure + type Component_Result is private; + + type Component is access function (Input : in Element_Array; - Context : in out Lexer_Context); + Context : in out Lexer_Context) + return Component_Result; - type Component_Array is array (Positive range <>) of Lexer_Component; + type Component_Array is array (Positive range <>) of Component; - type Lexer_With_Input is access function + type With_Input is access function return Element_Array; @@ -60,9 +60,10 @@ package Packrat.Lexer is (Input : in Element_Array; Start : in Positive) return Combinator_Result; - procedure Stamp + function Stamp (Input : in Element_Array; - Context : in out Lexer_Context); + Context : in out Lexer_Context) + return Component_Result; generic Label : in Label_Enum; @@ -70,9 +71,10 @@ package Packrat.Lexer is (Input : in Element_Array; Start : in Positive) return Combinator_Result; - procedure Ignore + function Ignore (Input : in Element_Array; - Context : in out Lexer_Context); + Context : in out Lexer_Context) + return Component_Result; @@ -94,7 +96,7 @@ package Packrat.Lexer is generic Components : in Component_Array; function Scan_With - (Input : in Lexer_With_Input; + (Input : in With_Input; Context : in out Lexer_Context) return Gen_Tokens.Token_Array; @@ -112,7 +114,7 @@ package Packrat.Lexer is Pad_In : in Element; Pad_Out : in Gen_Tokens.Token; procedure Scan_Set_With - (Input : in Lexer_With_Input; + (Input : in With_Input; Context : in out Lexer_Context; Output : out Gen_Tokens.Token_Array); @@ -256,55 +258,96 @@ package Packrat.Lexer is private - type Element_Array_Access is access Element_Array; + package Token_Vectors is new Ada.Containers.Vectors + (Index_Type => Positive, + Element_Type => Gen_Tokens.Token, + "=" => Gen_Tokens."="); + + + + + type Element_Array_Access is access all Element_Array; Empty_Array : Element_Array (1 .. 0); - type Combinator_Result is new Ada.Finalization.Controlled with record - Length : Natural; + package Label_Vectors is new Ada.Containers.Vectors + (Index_Type => Positive, + Element_Type => Label_Enum); + + + + + package Label_Sets is new Ada.Containers.Ordered_Sets + (Element_Type => Label_Enum); + + + + + type Combinator_Result is record + Finish : Natural; Status : Result_Status; - Value : Element_Array_Access; end record; - overriding procedure Initialize - (This : in out Combinator_Result); + Empty_Fail : constant Combinator_Result := + (Finish => 0, + Status => Failure); - overriding procedure Adjust - (This : in out Combinator_Result); - overriding procedure Finalize - (This : in out Combinator_Result); - Empty_Fail : constant Combinator_Result := - (Ada.Finalization.Controlled with - Length => 0, - Status => Failure, - Value => null); + type Component_Result is (Component_Failure, Component_Success); - package Token_Vectors is new Ada.Containers.Vectors - (Index_Type => Positive, - Element_Type => Gen_Tokens.Token, - "=" => Gen_Tokens."="); type Lexer_Context is new Ada.Finalization.Controlled with record - Result_So_Far : Token_Vectors.Vector; - Position : Positive; - Status : Result_Status; - Pass_Forward : Element_Array_Access; + Result_So_Far : Token_Vectors.Vector; + Position : Positive; + Offset : Natural; + Status : Result_Status; + Pass_Forward : Element_Array_Access; + Empty_Labels : Label_Sets.Set; + Error_Labels : Label_Vectors.Vector; + Allow_Incomplete : Boolean; end record; + overriding procedure Initialize + (This : in out Lexer_Context); + + overriding procedure Adjust + (This : in out Lexer_Context); + + overriding procedure Finalize + (This : in out Lexer_Context); + Empty_Context : constant Lexer_Context := (Ada.Finalization.Controlled with - Result_So_Far => Token_Vectors.Empty_Vector, - Position => 1, - Status => Success, - Pass_Forward => null); + Result_So_Far => Token_Vectors.Empty_Vector, + Position => 1, + Offset => 0, + Status => Success, + Pass_Forward => null, + Empty_Labels => Label_Sets.Empty_Set, + Error_Labels => Label_Vectors.Empty_Vector, + Allow_Incomplete => True); + + + + + type Input_Container is new Ada.Finalization.Limited_Controlled with record + Data : Element_Array_Access; + Dealloc : Boolean; + end record; + + overriding procedure Finalize + (This : in out Input_Container); + + function Pass_Input + (Passed, Continuing : in Element_Array_Access) + return Input_Container; end Packrat.Lexer; |