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 | -- 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;
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.Value /= 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, E.Key.Value).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 not null access 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;
end;
end Get;
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;
procedure Finalize (Object : in out Reference) is
begin
if Object.Elements /= null then
Free (Object.Elements);
end if;
end Finalize;
end Yaml.Text_Set;
|