blob: 0b0f571ce471b95f14c6d231a470346ac204a3df (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
|
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
null;
end Initialize;
procedure Adjust
(This : in out Combinator_Result) is
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;
end if;
end Adjust;
procedure Finalize
(This : in out Combinator_Result) is
begin
if This.Value /= null then
Free_Array (This.Value);
end if;
end Finalize;
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;
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 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 "="
(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 Result_Status is
begin
return This.Status;
end Status;
end Packrat.Lexer;
|
