diff options
| -rw-r--r-- | src/packrat-lexer.adb | 265 | ||||
| -rw-r--r-- | src/packrat-lexer.ads | 46 | ||||
| -rw-r--r-- | src/packrat-tokens.adb | 93 | ||||
| -rw-r--r-- | src/packrat.ads | 42 |
4 files changed, 126 insertions, 320 deletions
diff --git a/src/packrat-lexer.adb b/src/packrat-lexer.adb index eb126eb..faf8f71 100644 --- a/src/packrat-lexer.adb +++ b/src/packrat-lexer.adb @@ -1,81 +1,8 @@ -with - - Ada.Unchecked_Deallocation; - - package body Packrat.Lexer is - procedure Free_Array is new Ada.Unchecked_Deallocation - (Object => Element_Array, Name => Element_Array_Access); - - - procedure Initialize - (This : in out Lexer_Context) is - begin - null; - end Initialize; - - - procedure Adjust - (This : in out Lexer_Context) - is - New_Array : Element_Array_Access; - begin - 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 Lexer_Context) is - begin - if This.Pass_Forward /= null then - Free_Array (This.Pass_Forward); - end if; - end Finalize; - - - - - - procedure Finalize - (This : in out Input_Container) is - begin - if This.Dealloc then - Free_Array (This.Data); - end if; - 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 Join (Left, Right : in Combinator_Result) return Combinator_Result is @@ -130,9 +57,7 @@ package body Packrat.Lexer is 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.Pass_Forward.Replace_Element (Input (Context.Position .. Current_Result.Finish)); Context.Empty_Labels.Clear; end if; @@ -173,9 +98,7 @@ package body Packrat.Lexer is 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.Pass_Forward.Replace_Element (Input (Context.Position .. Current_Result.Finish)); Context.Empty_Labels.Clear; end if; @@ -191,10 +114,7 @@ package body Packrat.Lexer is (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.Pass_Forward := Input_Holders.Empty_Holder; Details.Empty_Labels.Clear; Details.Error_Labels.Clear; @@ -249,18 +169,6 @@ package body Packrat.Lexer is 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; - - @@ -269,18 +177,23 @@ package body Packrat.Lexer is Context : in out Lexer_Context) return Gen_Tokens.Token_Array is - Real_Input : Input_Container := - Pass_Input (Context.Pass_Forward, Input'Unrestricted_Access); + Real_Input : Input_Holders.Holder; Raise_Error : Boolean; begin + if not Context.Pass_Forward.Is_Empty then + Real_Input := Input_Holders.To_Holder (Context.Pass_Forward.Element & Input); + else + Real_Input := Input_Holders.To_Holder (Input); + end if; + Tidy_Context (Context, Components'Length); Context.Result_So_Far.Clear; - Context.Allow_Incomplete := not (Input = Empty_Array); + Context.Allow_Incomplete := Input'Length > 0; - while Context.Status = Success and Context.Position <= Real_Input.Data'Length loop + while Context.Status = Success and Context.Position <= Real_Input.Constant_Reference.Element'Length loop Raise_Error := True; for C of Components loop - if C (Real_Input.Data.all, Context) = Component_Success then + if C (Real_Input.Element, Context) = Component_Success then Raise_Error := False; exit; end if; @@ -298,18 +211,23 @@ package body Packrat.Lexer is Context : in out Lexer_Context) return Gen_Tokens.Token_Array is - Real_Input : Input_Container := - Pass_Input (Context.Pass_Forward, Input'Unrestricted_Access); + Real_Input : Input_Holders.Holder; Raise_Error : Boolean; begin + if not Context.Pass_Forward.Is_Empty then + Real_Input := Input_Holders.To_Holder (Context.Pass_Forward.Element & Input); + else + Real_Input := Input_Holders.To_Holder (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.Data'Length loop + while Context.Status = Success and Context.Position <= Real_Input.Constant_Reference.Element'Length loop Raise_Error := True; for C of Components loop - if C (Real_Input.Data.all, Context) = Component_Success then + if C (Real_Input.Element, Context) = Component_Success then Raise_Error := False; exit; end if; @@ -327,35 +245,36 @@ package body Packrat.Lexer is Context : in out Lexer_Context) return Gen_Tokens.Token_Array is - Raise_Error : Boolean; + Real_Input : Input_Holders.Holder; + Empty_Input, Raise_Error : Boolean; begin 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); + Real_Input := Input_Holders.To_Holder (Input.all); + Empty_Input := Real_Input.Constant_Reference.Element'Length = 0; + if not Context.Pass_Forward.Is_Empty then + Real_Input := Input_Holders.To_Holder (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.Constant_Reference.Element'Length loop + Raise_Error := True; + for C of Components loop + if C (Real_Input.Element, Context) = Component_Success then + Raise_Error := False; + exit; end if; end loop; - - if New_Input = Empty_Array then - exit; + if Raise_Error then + Raise_Lexer_Error (Context.Error_Labels, Context.Position); end if; - end; + end loop; + + if Empty_Input then + exit; + end if; end loop; return Token_Vector_To_Array (Context.Result_So_Far); end Scan_With; @@ -366,22 +285,27 @@ package body Packrat.Lexer is Context : in out Lexer_Context; Output : out Gen_Tokens.Token_Array) is - Real_Input : Input_Container := - Pass_Input (Context.Pass_Forward, Input'Unrestricted_Access); + Real_Input : Input_Holders.Holder; Raise_Error : Boolean; begin + if not Context.Pass_Forward.Is_Empty then + Real_Input := Input_Holders.To_Holder (Context.Pass_Forward.Element & Input); + else + Real_Input := Input_Holders.To_Holder (Input); + end if; + Tidy_Context (Context, Components'Length); Context.Result_So_Far.Clear; - Context.Allow_Incomplete := not (Input = Empty_Array or else Input (Input'First) = Pad_In); + 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.Data'Length and then - Real_Input.Data (Context.Position) /= Pad_In + Context.Position <= Real_Input.Constant_Reference.Element'Length and then + Real_Input.Constant_Reference.Element (Context.Position) /= Pad_In loop Raise_Error := True; for C of Components loop - if C (Real_Input.Data.all, Context) = Component_Success then + if C (Real_Input.Element, Context) = Component_Success then Raise_Error := False; exit; end if; @@ -391,10 +315,11 @@ package body Packrat.Lexer is end if; end loop; + -- suspect this is wrong, test more if Integer (Context.Result_So_Far.Length) >= Output'Length then - Assign_New (Context.Pass_Forward, - Real_Input.Data (Context.Position .. Real_Input.Data'Last)); + 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; @@ -404,51 +329,55 @@ package body Packrat.Lexer is Context : in out Lexer_Context; Output : out Gen_Tokens.Token_Array) is - Raise_Error : Boolean; + Real_Input : Input_Holders.Holder; + Empty_Input, Raise_Error : Boolean; begin 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); + Real_Input := Input_Holders.To_Holder (Input.all); + Empty_Input := Real_Input.Constant_Reference.Element'Length = 0 or + Real_Input.Constant_Reference.Element (Real_Input.Constant_Reference.Element'First) = Pad_In; + if not Context.Pass_Forward.Is_Empty then + Real_Input.Replace_Element (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.Constant_Reference.Element'Length and then + Real_Input.Constant_Reference.Element (Context.Position) /= Pad_In + loop + Raise_Error := True; + for C of Components loop + if C (Real_Input.Element, Context) = Component_Success then + Raise_Error := False; + exit; end if; end loop; - - if New_Input = Empty_Array or else New_Input (New_Input'First) = Pad_In then - exit; + 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)); - exit; - end if; - end; + if Empty_Input then + exit; + end if; + + -- suspect this is wrong, test more + 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; + -- factor out the internal scan loop to an internal function/procedure here + + diff --git a/src/packrat-lexer.ads b/src/packrat-lexer.ads index 0cd5c78..693064d 100644 --- a/src/packrat-lexer.ads +++ b/src/packrat-lexer.ads @@ -29,7 +29,7 @@ package Packrat.Lexer is - type Lexer_Context is new Ada.Finalization.Controlled with private; + type Lexer_Context is private; Empty_Context : constant Lexer_Context; @@ -263,26 +263,16 @@ private Element_Type => Gen_Tokens.Token, "=" => Gen_Tokens."="); - - - - type Element_Array_Access is access all Element_Array; - - Empty_Array : Element_Array (1 .. 0); - - - - 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); + package Input_Holders is new Ada.Containers.Indefinite_Holders + (Element_Type => Element_Array); + @@ -308,48 +298,24 @@ private Position : Positive; Offset : Natural; Status : Result_Status; - Pass_Forward : Element_Array_Access; + Pass_Forward : Input_Holders.Holder; 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, Offset => 0, Status => Success, - Pass_Forward => null, + Pass_Forward => Input_Holders.Empty_Holder, 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; diff --git a/src/packrat-tokens.adb b/src/packrat-tokens.adb index 382b8d8..aae0ae6 100644 --- a/src/packrat-tokens.adb +++ b/src/packrat-tokens.adb @@ -2,7 +2,6 @@ with - Ada.Unchecked_Deallocation, Ada.Characters.Latin_1; @@ -14,45 +13,6 @@ package body Tokens is package Latin renames Ada.Characters.Latin_1; - procedure Free_Array is new Ada.Unchecked_Deallocation - (Object => Element_Array, Name => Element_Array_Access); - - - - - - procedure Initialize - (This : in out Token) is - begin - This.Start_At := 1; - This.Finish_At := 0; - end Initialize; - - - procedure Adjust - (This : in out Token) is - begin - if This.Token_Value /= null then - declare - New_Array : Element_Array_Access := - new Element_Array (1 .. This.Token_Value'Length); - begin - New_Array.all := This.Token_Value.all; - This.Token_Value := New_Array; - end; - end if; - end Adjust; - - - procedure Finalize - (This : in out Token) is - begin - if This.Token_Value /= null then - Free_Array (This.Token_Value); - end if; - end Finalize; - - @@ -61,55 +21,20 @@ package body Tokens is Start : in Positive; Finish : in Natural; Value : in Element_Array) - return Token - is - This : Token; + return Token is begin - This.Identifier := Ident; - This.Start_At := Start; - This.Finish_At := Finish; - This.Token_Value := new Element_Array (1 .. Value'Length); - This.Token_Value.all := Value; - return This; + return This : Token do + This.Identifier := Ident; + This.Start_At := Start; + This.Finish_At := Finish; + This.Token_Value := Value_Holders.To_Holder (Value); + end return; end Create; - function "=" - (Left, Right : in Token) - return Boolean - is - Left_Valsize, Right_Valsize : Natural; - begin - if Left.Token_Value = null then - Left_Valsize := 0; - else - Left_Valsize := Left.Token_Value.all'Length; - end if; - if Right.Token_Value = null then - Right_Valsize := 0; - else - Right_Valsize := Right.Token_Value.all'Length; - end if; - - return Left.Identifier = Right.Identifier and - Left.Start_At = Right.Start_At and - Left.Finish_At = Right.Finish_At and - Left_Valsize = Right_Valsize and - (Left_Valsize = 0 or else Left.Token_Value.all = Right.Token_Value.all); - end "="; - - - function Initialized - (This : in Token) - return Boolean is - begin - return This.Token_Value /= null; - end Initialized; - - function Debug_String (This : in Token) return String @@ -119,7 +44,7 @@ package body Tokens is SU.Append (Result, "Token " & Label_Enum'Image (This.Identifier) & " at input position" & Integer'Image (This.Start_At) & " to" & Integer'Image (This.Finish_At) & " with value length" & - Integer'Image (This.Token_Value'Length) & Latin.LF); + Integer'Image (This.Token_Value.Constant_Reference.Element'Length) & Latin.LF); return -Result; end Debug_String; @@ -155,7 +80,7 @@ package body Tokens is (This : in Token) return Element_Array is begin - return This.Token_Value.all; + return This.Token_Value.Element; end Value; diff --git a/src/packrat.ads b/src/packrat.ads index 4abdaec..b2b0144 100644 --- a/src/packrat.ads +++ b/src/packrat.ads @@ -2,8 +2,11 @@ with - Ada.Strings.Unbounded, - Ada.Finalization; + Ada.Strings.Unbounded; + +private with + + Ada.Containers.Indefinite_Holders; package Packrat is @@ -106,10 +109,13 @@ package Packrat is package Tokens is - type Token is new Ada.Finalization.Controlled with private; + type Token is private; type Token_Array is array (Positive range <>) of Token; + -- will probably have to remove the Finish field to accommodate graphs properly + + function Create (Ident : in Label_Enum; Start : in Positive; @@ -117,20 +123,12 @@ package Packrat is Value : in Element_Array) return Token; - function "=" - (Left, Right : in Token) - return Boolean; - -- Note: The Start and Finish indices indicate where the token was found -- in whatever array it was lexed from. The Value does *not* have -- to correspond with whatever is found in the Start .. Finish range. - function Initialized - (This : in Token) - return Boolean; - function Debug_String (This : in Token) return String; @@ -138,8 +136,7 @@ package Packrat is function Label (This : in Token) - return Label_Enum - with Pre => Initialized (This); + return Label_Enum; function Start (This : in Token) @@ -151,34 +148,23 @@ package Packrat is function Value (This : in Token) - return Element_Array - with Pre => Initialized (This); + return Element_Array; private - type Element_Array_Access is access Element_Array; + package Value_Holders is new Ada.Containers.Indefinite_Holders (Element_Array); - type Token is new Ada.Finalization.Controlled with record + type Token is record Identifier : Label_Enum; Start_At : Positive; Finish_At : Natural; - Token_Value : Element_Array_Access; + Token_Value : Value_Holders.Holder; end record; - overriding procedure Initialize - (This : in out Token); - - overriding procedure Adjust - (This : in out Token); - - overriding procedure Finalize - (This : in out Token); - - end Tokens; |