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 | --
-- Copyright (C) 2014-2022, AdaCore
-- SPDX-License-Identifier: Apache-2.0
--
with Ada.Unchecked_Deallocation;
with System; use System;
with System.Storage_Elements; use System.Storage_Elements;
package body Gpr_Parser_Support.Symbols is
procedure Deallocate is new Ada.Unchecked_Deallocation
(Symbol_Table_Record'Class, Symbol_Table);
-----------
-- Image --
-----------
function Image (S : Symbol_Type) return Text_Type is
begin
return (if S = null then "<no symbol>" else S.all);
end Image;
-----------
-- Image --
-----------
function Image
(S : Symbol_Type; With_Quotes : Boolean := False) return String is
begin
if S = null then
return "<no symbol>";
else
return Image (S.all, With_Quotes);
end if;
end Image;
-------------------------
-- Create_Symbol_Table --
-------------------------
function Create_Symbol_Table return Symbol_Table is
begin
return new Symbol_Table_Record;
end Create_Symbol_Table;
----------
-- Find --
----------
function Find
(ST : Symbol_Table;
T : Text_Type;
Create : Boolean := True)
return Thin_Symbol
is
use Maps;
T_Acc : Symbol_Type := T'Unrestricted_Access;
Result : constant Cursor := ST.Symbols_Map.Find (T_Acc);
begin
-- If we already have such a symbol, return the access we already
-- internalized. Otherwise, give up if asked to.
if Has_Element (Result) then
return Element (Result);
elsif not Create then
return No_Thin_Symbol;
end if;
-- At this point, we know we have to internalize a new symbol
T_Acc := new Text_Type'(T);
ST.Symbols.Append (T_Acc);
ST.Symbols_Map.Insert (T_Acc, Thin_Symbol (ST.Symbols.Last_Index));
return Thin_Symbol (ST.Symbols.Last_Index);
end Find;
-------------
-- Destroy --
-------------
procedure Destroy (ST : in out Symbol_Table) is
use Maps;
To_Free : Text_Access;
begin
ST.Symbols_Map.Clear;
for El of ST.Symbols loop
To_Free := Text_Access'(El.all'Unrestricted_Access);
Free (To_Free);
end loop;
ST.Symbols.Destroy;
Deallocate (ST);
end Destroy;
----------
-- Hash --
----------
function Hash (ST : Symbol_Type) return Hash_Type is
begin
if ST = null then
return Hash_Type (0);
else
return Hash_Type'Mod (To_Integer (ST.all'Address));
end if;
end Hash;
----------------
-- Get_Symbol --
----------------
function Get_Symbol
(Self : Symbol_Table; TS : Thin_Symbol) return Symbol_Type is
begin
if TS = No_Thin_Symbol then
return null;
else
return Self.Symbols.Get (Positive (TS));
end if;
end Get_Symbol;
---------------
-- Fold_Case --
---------------
function Fold_Case (Name : Text_Type) return Symbolization_Result is
begin
return Result : Symbolization_Result
(Success => True, Size => Name'Length)
do
for I in 1 .. Result.Size loop
Result.Symbol (I) := To_Lower (Name (Name'First + I - 1));
end loop;
end return;
end Fold_Case;
end Gpr_Parser_Support.Symbols;
|