blob: 382b8d85f8b42285f2dd78a607129d1ce40055c9 (
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
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
|
with
Ada.Unchecked_Deallocation,
Ada.Characters.Latin_1;
separate (Packrat)
package body Tokens is
package SU renames Ada.Strings.Unbounded;
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;
function Create
(Ident : in Label_Enum;
Start : in Positive;
Finish : in Natural;
Value : in Element_Array)
return Token
is
This : Token;
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;
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
is
Result : SU.Unbounded_String := +"";
begin
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);
return -Result;
end Debug_String;
function Label
(This : in Token)
return Label_Enum is
begin
return This.Identifier;
end Label;
function Start
(This : in Token)
return Positive is
begin
return This.Start_At;
end Start;
function Finish
(This : in Token)
return Natural is
begin
return This.Finish_At;
end Finish;
function Value
(This : in Token)
return Element_Array is
begin
return This.Token_Value.all;
end Value;
end Tokens;
|
