summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/packrat-lexer.adb91
-rw-r--r--src/packrat-lexer.ads14
-rw-r--r--src/packrat-tokens.adb18
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;