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 | with Ada.Unchecked_Deallocation;
with Ada.Wide_Wide_Text_IO;
package body AST is
Last : Natural := 0;
---------------
-- Reference --
---------------
procedure Dereference
(Self : access Node_Fabric;
Object : in out Node_Access)
is
procedure Free is new
Ada.Unchecked_Deallocation (AST.Node, AST.Node_Access);
begin
if Object.Count = 1 then
for X of Object.Children loop
if X /= null then
Dereference (Self, X);
end if;
end loop;
Free (Object);
else
Object.Count := Object.Count - 1;
end if;
end Dereference;
---------------
-- Reference --
---------------
procedure Reference
(Self : access Node_Fabric;
Object : Node_Access)
is
pragma Unreferenced (Self);
begin
Object.Count := Object.Count + 1;
end Reference;
---------------
-- Set_Child --
---------------
procedure Set_Child
(Self : access Node_Fabric;
Object : Node_Access;
Index : Positive;
Value : Node_Access) is
begin
Object.Children (Index) := Value;
Reference (Self, Value);
end Set_Child;
---------------
-- New_Token --
---------------
function New_Token
(Self : access Node_Fabric)
return Node_Access
is
pragma Unreferenced (Self);
begin
Last := Last + 1;
return new Node'(Identifier => Last,
Is_Token => True,
Is_Alternative => False,
Count => 1,
others => <>);
end New_Token;
--------------
-- New_Node --
--------------
function New_Node
(Self : access Node_Fabric;
Production : Anagram.Grammars.Production_Index)
return Node_Access
is
pragma Unreferenced (Self);
begin
Last := Last + 1;
return new Node'(Identifier => Last,
Is_Token => False,
Is_Alternative => False,
Prod => Production,
Count => 1,
others => <>);
end New_Node;
---------------------
-- New_Alternative --
---------------------
function New_Alternative
(Self : access Node_Fabric;
NT : Anagram.Grammars.Non_Terminal_Index)
return Node_Access
is
pragma Unreferenced (Self);
begin
Last := Last + 1;
return new Node'(Identifier => Last,
Is_Token => False,
Is_Alternative => True,
NT => NT,
Count => 1,
others => <>);
end New_Alternative;
-----------
-- Print --
-----------
procedure Print (Self : Node; Input : Anagram.Grammars.Grammar) is
begin
Ada.Wide_Wide_Text_IO.Put (Integer'Wide_Wide_Image (Self.Identifier));
if Self.Is_Token then
Ada.Wide_Wide_Text_IO.Put (" token");
elsif Self.Is_Alternative then
Ada.Wide_Wide_Text_IO.Put
(" alternative " &
Input.Non_Terminal (Self.NT).Name.To_Wide_Wide_String);
else
Ada.Wide_Wide_Text_IO.Put
(" node " &
Input.Production (Self.Prod).Name.To_Wide_Wide_String);
end if;
end Print;
end AST;
|