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
184
185
186
187
188
189
190
191
192
193
194 | -------------------------------------------------------------------------------------
--
-- HAC - HAC Ada Compiler
--
-- A compiler in Ada for an Ada subset
--
-- Copyright, license, etc. : see top package.
--
-------------------------------------------------------------------------------------
-- The target Semantics produces no machine code but
-- serves semantics analysis purposes, like cross-references
-- for an editor with auto-complete, contextual menus and tool tips.
with Ada.Containers.Hashed_Maps,
Ada.Containers.Ordered_Maps,
Ada.Strings.Unbounded.Hash;
with HAC_Sys.Co_Defs;
with HAT;
package HAC_Sys.Targets.Semantics is
type Reference_Point is tagged record
file_name : HAT.VString;
line, column : Integer;
end record;
type Declaration_Point is new Reference_Point with record
is_built_in : Boolean;
id_index : Integer;
spec_id : Natural := Co_Defs.No_Id; -- For a body item: link to its spec.
body_id : Natural := Co_Defs.No_Id; -- For a spec item: link to its body.
self_reference : Boolean := False;
end record;
-- Reference map
-- =============
--
-- This container holds all references to variables, functions,
-- types, etc. The search key is the exact position of the first
-- letter of the identifier.
--
-- Key Value
-- === =====
-- [file_name i j] index in the Id Table
package Reference_Mapping is new Ada.Containers.Hashed_Maps
(Key_Type => HAT.VString, -- [file_name i j]
Element_Type => Positive, -- Index in the Id Table
Hash => Ada.Strings.Unbounded.Hash,
Equivalent_Keys => Ada.Strings.Unbounded."=");
-- Declaration array
-- =================
--
-- This container holds the exact position of the declarations.
-- It is a simple array; the element #i corresponds to
-- the identifer #i in the compiler's identifier table.
--
-- Key Value
-- === =====
-- index in Id Table file_name, i, j of declaration
type Declaration_Point_Array is
array (Co_Defs.Identifier_Table_Type'Range) of Declaration_Point;
-- Possible sanity checks for an usage within an editor:
-- - compare identifiers between the one at [file_name i j] and
-- the one in the identifier table (weak check)
-- - ensure the analysis was completed after the latest
-- modification in the editor (keystroke, cut, paste, ...)
--
-- Declaration localization
-- ========================
--
-- This container provides the reverse operation of a
-- Declaration_Point_Array. It enables the localization of the index
-- of the last identifier on any given line in a source code file.
-- From the index, it is then possible to gather all the identifiers
-- visible at the next line (we don't go down to a column-wise
-- localization for simplicity purposes).
-- Due to nesting, that overall identifier list is not simply growing
-- along the text, so the list of visible identifiers it is a part of
-- a declaration tree. You build it by going from a leaf (index of
-- the last identifier) to the root.
package Declaration_Line_Maps is new Ada.Containers.Ordered_Maps
(Key_Type => Integer, -- Line number
Element_Type => Natural); -- Index in the Id Table
type Declaration_Line_Map_Access is access Declaration_Line_Maps.Map;
package File_Names_to_Line_Maps_Maps is new Ada.Containers.Hashed_Maps
(Key_Type => HAT.VString, -- File_name
Element_Type => Declaration_Line_Map_Access,
Hash => Ada.Strings.Unbounded.Hash,
Equivalent_Keys => Ada.Strings.Unbounded."=");
type Machine is limited new Targets.Machine with record
CD : Co_Defs.Compiler_Data_Access;
ref_map : Reference_Mapping.Map;
decl_array : Declaration_Point_Array;
loc_map : File_Names_to_Line_Maps_Maps.Map;
started : HAT.Time;
finished : HAT.Time;
total_time : Duration := 0.0;
busy : Boolean := False with Volatile;
end record;
type Semantics_Machine_Reference is access all Machine'Class;
overriding procedure Finalize (m : in out Machine);
--------------------
-- Informations --
--------------------
overriding function Name (m : Machine) return String is ("HAC Semantics");
overriding function CPU (m : Machine) return String is ("No CPU");
overriding function OS (m : Machine) return String is ("Any");
overriding function Null_Terminated_String_Literals (m : Machine) return Boolean is (False);
---------------------------------------
-- Initialize & Finalize Semantics --
---------------------------------------
overriding procedure Initialize_Code_Emission (m : in out Machine);
overriding procedure Finalize_Code_Emission
(m : in out Machine;
strings : String);
----------------------------
-- Machine Instructions --
----------------------------
overriding procedure Emit_Arithmetic_Binary_Instruction
(m : in out Machine;
operator : Defs.Arithmetic_Binary_Operator;
base_typ : Defs.Numeric_Typ) is null;
overriding procedure Emit_Halt (m : in out Machine) is null;
overriding procedure Emit_Push_Discrete_Literal
(m : in out Machine; x : Defs.HAC_Integer) is null;
overriding procedure Emit_Push_Discrete_Literals
(m : in out Machine; x, y : Defs.HAC_Integer) is null;
----------------------------
-- Built-In Subprograms --
----------------------------
overriding procedure Emit_HAT_Builtin_Procedure
(m : in out Machine;
builtin_proc : Defs.SP_Code;
parameter : Defs.HAC_Integer) is null;
-------------
-- Misc. --
-------------
overriding function Assembler_File_Name (m : Machine) return String is ("");
overriding procedure Mark_Reference
(m : in out Machine; located_id : Natural);
overriding procedure Mark_Declaration
(m : in out Machine; is_built_in : Boolean := False);
overriding procedure Mark_Spec_Body_Cross_References
(m : in out Machine;
spec_id, body_id : in Positive);
-- From given valid reference point, get the corresponding declaration.
procedure Find_Referenced_Declarations
(m : in Machine;
ref : in Reference_Point'Class;
decl_1, decl_2 : out Declaration_Point'Class;
found : out Natural);
-- This is for "auto-complete" purposes.
-- The list of identifiers is sorted, separated by spaces.
function Find_Possible_Declarations
(m : Machine;
point : Reference_Point'Class;
prefix : String;
max_list : Positive;
max_scan : Positive) return String;
end HAC_Sys.Targets.Semantics;
|