blob: 70a866a70f89f40a3e7dad36c7278ee3f166ea52 (
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
|
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
New_Array : Element_Array_Access :=
new Element_Array (This.Token_Value'Range);
begin
New_Array.all := This.Token_Value.all;
This.Token_Value := New_Array;
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 (Value'Range);
This.Token_Value.all := Value;
return This;
end Create;
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;
|