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 | -- part of AdaYaml, (c) 2017 Felix Krause
-- released under the terms of the MIT license, see the file "copying.txt"
with Ada.Strings.Hash;
with Ada.Unchecked_Deallocation;
package body Yaml.Text_Set is
use type Ada.Containers.Hash_Type;
use type Text.Reference;
function Grow_If_Needed (Object : in out Reference) return Boolean;
function Non_Zero_Hash (S : Standard.String)
return Ada.Containers.Hash_Type;
function Raw_Set (Object : in out Reference;
Hash : Ada.Containers.Hash_Type;
S : Standard.String)
return not null access Holder;
function Non_Zero_Hash (S : Standard.String)
return Ada.Containers.Hash_Type is
Hash : constant Ada.Containers.Hash_Type := Ada.Strings.Hash (S);
begin
if Hash = 0 then
return 1;
else
return Hash;
end if;
end Non_Zero_Hash;
function Raw_Set (Object : in out Reference;
Hash : Ada.Containers.Hash_Type;
S : Standard.String)
return not null access Holder is
Pos : Natural :=
Natural (Hash mod Ada.Containers.Hash_Type (Object.Elements'Length));
Cur : not null access Holder := Object.Elements (Pos)'Access;
begin
while Cur.Hash /= 0 and then
(Cur.Hash /= Hash or else Cur.Key /= S) loop
Pos := Pos + 1;
if Pos = Object.Elements'Length then
Pos := 0;
end if;
Cur := Object.Elements (Pos)'Access;
end loop;
return Cur;
end Raw_Set;
procedure Free is new Ada.Unchecked_Deallocation
(Holder_Array, Holder_Array_Access);
function Grow_If_Needed (Object : in out Reference) return Boolean is
Old_Elements : Holder_Array_Access := Object.Elements;
begin
if Object.Count = Object.Elements'Length / 2 then
Object.Elements := new Holder_Array (0 .. Object.Count * 4 - 1);
Object.Elements.all := (others => (Hash => 0, others => <>));
for E of Old_Elements.all loop
if E.Hash /= 0 then
Raw_Set (Object, E.Hash, To_String (E.Key)).all := E;
end if;
end loop;
Free (Old_Elements);
return True;
else
return False;
end if;
end Grow_If_Needed;
function Get (Object : in out Reference; S : Standard.String;
Create : Boolean) return Holder is
Hash : constant Ada.Containers.Hash_Type := Non_Zero_Hash (S);
begin
<<Start>>
declare
Cur : constant not null access Holder := Raw_Set (Object, Hash, S);
begin
if Cur.Hash = 0 then
if Grow_If_Needed (Object) then
goto Start;
end if;
if Create then
Object.Count := Object.Count + 1;
Cur.Hash := Hash;
Cur.Key := Object.Pool.From_String (S);
end if;
end if;
return Cur.all;
end;
end Get;
procedure Update (Object : in out Reference; S : Standard.String;
Value : Value_Type) is
Hash : constant Ada.Containers.Hash_Type := Non_Zero_Hash (S);
begin
<<Start>>
declare
Cur : constant not null access Holder := Raw_Set (Object, Hash, S);
begin
if Cur.Hash = 0 then
if Grow_If_Needed (Object) then
goto Start;
end if;
Object.Count := Object.Count + 1;
Cur.Hash := Hash;
Cur.Key := Object.Pool.From_String (S);
end if;
Cur.Value := Value;
end;
end Update;
function Set (Object : in out Reference;
S : Standard.String; Value : Value_Type) return Boolean is
Hash : constant Ada.Containers.Hash_Type := Non_Zero_Hash (S);
begin
if Grow_If_Needed (Object) then null; end if;
declare
Cur : constant not null access Holder := Raw_Set (Object, Hash, S);
begin
if Cur.Hash = 0 then
Object.Count := Object.Count + 1;
Cur.Hash := Hash;
Cur.Key := Object.Pool.From_String (S);
Cur.Value := Value;
return True;
else
return False;
end if;
end;
end Set;
procedure Clear (Object : in out Reference) is
begin
Object.Elements.all := (others => (Hash => 0, others => <>));
Object.Count := 0;
end Clear;
procedure Init (Object : in out Reference; Pool : Text.Pool.Reference;
Initial_Size : Positive) is
begin
Object.Pool := Pool;
Object.Elements := new Holder_Array (0 .. Initial_Size - 1);
Clear (Object);
end Init;
overriding
procedure Finalize (Object : in out Reference) is
begin
if Object.Elements /= null then
Free (Object.Elements);
end if;
end Finalize;
end Yaml.Text_Set;
|