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
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183 | --
-- Copyright (C) 2021, AdaCore
--
-- SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
--
with Ada.Strings.Wide_Wide_Unbounded; use Ada.Strings.Wide_Wide_Unbounded;
with Ada.Wide_Wide_Characters.Handling; use Ada.Wide_Wide_Characters.Handling;
with Ada.Wide_Wide_Text_IO; use Ada.Wide_Wide_Text_IO;
with UCD.Characters;
package body Gen_UCD.Enumeration_Types is
function Type_Identifier
(Property : not null UCD.Properties.Property_Access)
return Wide_Wide_String;
function Value_Identifier
(Property : not null UCD.Properties.Property_Access;
Value : not null UCD.Properties.Property_Value_Access)
return Wide_Wide_String;
function Representation
(Self : Enumeration_Type'Class;
Value : not null UCD.Properties.Property_Value_Access) return Natural;
function Minimum_Bits (Value : Ada.Containers.Count_Type) return Integer;
-------------------------------
-- Generate_Type_Declaration --
-------------------------------
procedure Generate_Type_Declaration
(Self : Enumeration_Type'Class;
File : Ada.Wide_Wide_Text_IO.File_Type)
is
First : Boolean := True;
begin
Put_Line (File, " type " & Type_Identifier (Self.Property) & " is");
for Value of Self.Property.All_Values loop
if Value.Is_Used then
if First then
Put (File, " (");
First := False;
else
Put_Line (File, ",");
Put (File, " ");
end if;
Put (File, Value_Identifier (Self.Property, Value));
end if;
end loop;
Put_Line (File, ");");
Put_Line
(File,
" for " & Type_Identifier (Self.Property) & "'Size use"
& Natural'Wide_Wide_Image (Minimum_Bits (Self.Map.Length))
& ";");
Put_Line (File, " for " & Type_Identifier (Self.Property) & " use");
First := True;
for Value of Self.Property.All_Values loop
if Value.Is_Used then
if First then
Put (File, " (");
First := False;
else
Put_Line (File, ",");
Put (File, " ");
end if;
Put (File, Value_Identifier (Self.Property, Value));
Put (File, " =>");
Put (File, Integer'Wide_Wide_Image (Self.Representation (Value)));
end if;
end loop;
Put_Line (File, ");");
New_Line (File);
end Generate_Type_Declaration;
----------------
-- Initialize --
----------------
procedure Initialize
(Self : in out Enumeration_Type'Class;
Property : not null UCD.Properties.Property_Access) is
begin
Self.Property := Property;
for Value of Self.Property.All_Values loop
if Value.Is_Used then
Self.Map.Insert (Value, Natural (Self.Map.Length));
end if;
end loop;
end Initialize;
------------------
-- Minimum_Bits --
------------------
function Minimum_Bits (Value : Ada.Containers.Count_Type) return Integer is
Aux : Unsigned_32 := Unsigned_32 (Value);
begin
return Result : Integer := 32 do
loop
exit when Aux / 16#8000_0000# = 1;
Result := Result - 1;
Aux := Aux * 2;
end loop;
end return;
end Minimum_Bits;
--------------------
-- Representation --
--------------------
function Representation
(Self : Enumeration_Type'Class;
Code : UCD.Code_Point) return Natural
is
Value : constant not null UCD.Properties.Property_Value_Access :=
UCD.Characters.Get (Code, Self.Property);
begin
return Self.Representation (Value);
end Representation;
--------------------
-- Representation --
--------------------
function Representation
(Self : Enumeration_Type'Class;
Value : not null UCD.Properties.Property_Value_Access) return Natural is
begin
return Self.Map (Value);
end Representation;
---------------------
-- Type_Identifier --
---------------------
function Type_Identifier
(Property : not null UCD.Properties.Property_Access)
return Wide_Wide_String
is
Property_Name : constant Wide_Wide_String :=
To_Upper (To_Wide_Wide_String (Property.Names.First_Element));
begin
return Property_Name & "_Values";
end Type_Identifier;
----------------------
-- Value_Identifier --
----------------------
function Value_Identifier
(Property : not null UCD.Properties.Property_Access;
Value : not null UCD.Properties.Property_Value_Access)
return Wide_Wide_String
is
Property_Name : constant Wide_Wide_String :=
To_Upper (To_Wide_Wide_String (Property.Names.First_Element));
Value_Name : constant Wide_Wide_String :=
To_Wide_Wide_String (Value.Names.First_Element);
begin
return Property_Name & '_' & Value_Name;
end Value_Identifier;
end Gen_UCD.Enumeration_Types;
|