diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/packrat-lexer.adb | 91 | ||||
-rw-r--r-- | src/packrat-lexer.ads | 14 | ||||
-rw-r--r-- | src/packrat-tokens.adb | 18 |
3 files changed, 101 insertions, 22 deletions
diff --git a/src/packrat-lexer.adb b/src/packrat-lexer.adb index f93b65b..0b0f571 100644 --- a/src/packrat-lexer.adb +++ b/src/packrat-lexer.adb @@ -1,8 +1,17 @@ +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 Combinator_Result) is begin @@ -13,14 +22,24 @@ package body Packrat.Lexer is procedure Adjust (This : in out Combinator_Result) is begin - null; + 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; + end if; end Adjust; procedure Finalize (This : in out Combinator_Result) is begin - null; + if This.Value /= null then + Free_Array (This.Value); + end if; end Finalize; @@ -31,26 +50,78 @@ package body Packrat.Lexer is (Length : in Natural; Status : in Result_Status; Value : in Element_Array) - return Combinator_Result is + return Combinator_Result + is + This : Combinator_Result; begin - return Fail_Result; + 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 + return Combinator_Result + is + Merge : Combinator_Result; + Left_Valsize, Right_Valsize, Total_Valsize : Natural; begin - return Fail_Result; + 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 then + Merge.Length := Left.Length + Right.Length; + Merge.Status := Right.Status; + if Total_Valsize /= 0 or Right.Status /= Failure then + Merge.Value := new Element_Array (1 .. Total_Valsize); + if Left_Valsize /= 0 then + Merge.Value.all (1 .. Left_Valsize) := Left.Value.all; + end if; + if Right_Valsize /= 0 then + Merge.Value.all (Left_Valsize + 1 .. Total_Valsize) := Right.Value.all; + end if; + end if; + return Merge; + else + return Left; + end if; end Join; - function Is_Failure + function "=" + (Left, Right : in Combinator_Result) + return Boolean + is + Null_Check : Boolean := + Left.Value = null and Right.Value = null; + Value_Check : Boolean := + Left.Value /= null and then Right.Value /= null and then + Left.Value.all = Right.Value.all; + begin + return Left.Length = Right.Length and + Left.Status = Right.Status and + (Null_Check or Value_Check); + end "="; + + + function Status (This : in Combinator_Result) - return Boolean is + return Result_Status is begin - return True; - end Is_Failure; + return This.Status; + end Status; end Packrat.Lexer; diff --git a/src/packrat-lexer.ads b/src/packrat-lexer.ads index 81c9d2a..ef08cb5 100644 --- a/src/packrat-lexer.ads +++ b/src/packrat-lexer.ads @@ -11,11 +11,11 @@ generic package Packrat.Lexer is - type Combinator_Result is private; + type Combinator_Result is new Ada.Finalization.Controlled with private; type Combinator is access function - (Input : in Element_Array; - Start : in Positive) + (Input : in Element_Array; + Start : in Positive) return Combinator_Result; type Combinator_Array is array (Positive range <>) of Combinator; @@ -34,10 +34,14 @@ package Packrat.Lexer is (Left, Right : in Combinator_Result) return Combinator_Result; - function Is_Failure - (This : in Combinator_Result) + function "=" + (Left, Right : in Combinator_Result) return Boolean; + function Status + (This : in Combinator_Result) + return Result_Status; + private diff --git a/src/packrat-tokens.adb b/src/packrat-tokens.adb index 70a866a..240ecee 100644 --- a/src/packrat-tokens.adb +++ b/src/packrat-tokens.adb @@ -30,13 +30,17 @@ package body Tokens is procedure Adjust - (This : in out Token) - is - New_Array : Element_Array_Access := - new Element_Array (This.Token_Value'Range); + (This : in out Token) is begin - New_Array.all := This.Token_Value.all; - This.Token_Value := New_Array; + 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; @@ -64,7 +68,7 @@ package body Tokens is This.Identifier := Ident; This.Start_At := Start; This.Finish_At := Finish; - This.Token_Value := new Element_Array (Value'Range); + This.Token_Value := new Element_Array (1 .. Value'Length); This.Token_Value.all := Value; return This; end Create; |