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 | with Ada.Numerics.Discrete_Random;
package body WL.Guids is
package Element_Random is
new Ada.Numerics.Discrete_Random (Element);
Gen : Element_Random.Generator;
subtype Element_String is String (1 .. 2);
function To_Hex (E : Element) return Element_String
with Unreferenced;
----------
-- Hash --
----------
function Hash (Id : Guid) return Ada.Containers.Hash_Type is
use Ada.Containers;
H : Hash_Type := 0;
begin
for E of Id loop
H := (H * 64) xor Hash_Type (E);
end loop;
return H;
end Hash;
--------------
-- Is_Valid --
--------------
function Is_Valid (S : String) return Boolean is
Index : Natural := 0;
begin
if S'Length /= 36 then
return False;
end if;
for Ch of S loop
Index := Index + 1;
if Index in 9 | 14 | 19 | 24 then
if Ch /= '-' then
return False;
end if;
else
if Ch not in '0' .. '9'
and then Ch not in 'a' .. 'f'
and then Ch not in 'A' .. 'F'
then
return False;
end if;
end if;
end loop;
return True;
end Is_Valid;
--------------
-- New_Guid --
--------------
function New_Guid return Guid is
begin
return G : Guid do
for E of G loop
E := Element_Random.Random (Gen);
end loop;
G (7) := (G (7) and 16#0F#) or 16#40#;
G (9) := (G (9) and 16#3F#) or 16#80#;
end return;
end New_Guid;
-------------
-- To_Guid --
-------------
function To_Guid (S : String) return Guid is
Last : Positive := S'First;
function From_Hex (Ch : Character) return Element
with Pre => Ch in '0' .. '9' | 'a' .. 'f' | 'A' .. 'F';
--------------
-- From_Hex --
--------------
function From_Hex (Ch : Character) return Element is
begin
if Ch in '0' .. '9' then
return Character'Pos (Ch) - Character'Pos ('0');
elsif Ch in 'a' .. 'f' then
return Character'Pos (Ch) - Character'Pos ('a') + 10;
elsif Ch in 'A' .. 'F' then
return Character'Pos (Ch) - Character'Pos ('A') + 10;
else
raise Constraint_Error with "From_Hex: precondition failed";
end if;
end From_Hex;
begin
return G : Guid do
for E of G loop
if S (Last) = '-' then
Last := Last + 1;
end if;
E := From_Hex (S (Last)) * 16 + From_Hex (S (Last + 1));
Last := Last + 2;
end loop;
end return;
end To_Guid;
------------
-- To_Hex --
------------
function To_Hex (E : Element) return Element_String is
Ds : constant String := "0123456789abcdef";
It : Element := E;
begin
return H : Element_String do
for Ch of reverse H loop
Ch := Ds (Natural (It mod 16) + 1);
It := It / 16;
end loop;
end return;
end To_Hex;
---------------
-- To_String --
---------------
function To_String (Id : Guid) return String is
Ds : constant String := "0123456789abcdef";
function Hi (E : Element) return Character
is (Ds (Natural (E / 16) + 1));
function Lo (E : Element) return Character
is (Ds (Natural (E mod 16) + 1));
Index : constant array (Id'Range) of Positive :=
(1, 3, 5, 7, 10, 12, 15, 17, 20, 22, 25, 27, 29, 31, 33, 35);
Hyphens : constant array (1 .. 4) of Positive :=
(9, 14, 19, 24);
begin
return Result : String (1 .. 36) do
for I in Id'Range loop
Result (Index (I)) := Hi (Id (I));
Result (Index (I) + 1) := Lo (Id (I));
end loop;
for H of Hyphens loop
Result (H) := '-';
end loop;
end return;
end To_String;
end WL.Guids;
|