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 | -------------------------------------------------------------------------------------
--
-- HAC - HAC Ada Compiler
--
-- A compiler in Ada for an Ada subset
--
-- Copyright, license, etc. : see top package.
--
-------------------------------------------------------------------------------------
--
with HAC_Sys.Co_Defs,
HAC_Sys.Defs,
HAC_Sys.Files.Default;
with HAT;
with Ada.Containers.Hashed_Maps,
Ada.Containers.Vectors,
Ada.Strings.Unbounded.Hash;
package HAC_Sys.Librarian is
Library_Level : constant := 0;
type Build_Mode is
(Read_HCU_Files
-- ^ Full compilation around main unit is done in memory.
-- If available and { up-to-date or no source file present },
-- .hcu files are downloaded to the compilation tables.
-- Write_HCU_Files
-- -- If a .hcu file not yet available or out-of-date,
-- -- the source is compiled and the .hcu file is (re)written.
);
-- HAC Compiled Unit files have the .hcu extension. Some may be stored in .zip library files.
type Compilation_Status is
(In_Progress, -- Specification or body-only is in progress.
Body_Postponed, -- Specification done, body will be done later.
Spec_Only, -- Specification-only is done, but we need to check absence of body.
Done); -- Specification done; possible body is done or its absence is checked.
subtype Spec_Done is Compilation_Status range Body_Postponed .. Spec_Only;
-- RM 10.1.1
type Unit_Kind is
(Package_Declaration, Package_Body,
Procedure_Unit, Function_Unit);
subtype Subprogram_Unit is Unit_Kind range Procedure_Unit .. Function_Unit;
type Library_Unit is record
full_name : HAT.VString; -- Full unit name, like "Ada.Strings.Fixed"
kind : Unit_Kind;
status : Compilation_Status;
id_index : Natural;
id_body_index : Natural;
spec_context : Co_Defs.Id_Maps.Map; -- WITH & USE's visible to the spec.
end record;
package Library_Unit_Vectors is new Ada.Containers.Vectors (Positive, Library_Unit);
package Library_Name_Mapping is new Ada.Containers.Hashed_Maps
(Key_Type => HAT.VString, -- Upper case of full unit name
Element_Type => Positive, -- Index in the library
Hash => Ada.Strings.Unbounded.Hash,
Equivalent_Keys => Ada.Strings.Unbounded."=");
default_file_catalogue : aliased Files.Default.File_Catalogue;
-- Global object used as a default for library file management.
type Library_Data is tagged record -- !! details -> private
library : Library_Unit_Vectors.Vector; -- The library itself (= the "books")
map : Library_Name_Mapping.Map; -- Quick access by name to unit number
cat : Files.Abstract_File_Catalogue_Reference :=
default_file_catalogue'Access;
end record;
procedure Set_Source_Access
(LD : in out Library_Data;
cat : in Files.Abstract_File_Catalogue_Reference);
-- Search for file (physical or not, depending on the
-- LD.cat.Exists function) corresponding to unit name.
-- First a spec, then a body.
-- If nothing found, return empty string.
--
function Find_Unit_File_Name
(LD : Library_Data;
Unit_Name : String)
return String;
-----------------------------------------------------
-- Apply WITH clause for any unit, including the --
-- Standard package and the special HAT package. --
-----------------------------------------------------
procedure Apply_WITH
(CD : in out Co_Defs.Compiler_Data;
LD : in out Library_Data;
Upper_Name : in String);
----------------------------------------------------------
-- Apply the invisible "with Standard; use Standard;" --
----------------------------------------------------------
procedure Apply_WITH_USE_Standard
(CD : in out Co_Defs.Compiler_Data;
LD : in out Library_Data);
----------------------------------------------------------------------
-- Add a new definition to the identifier table, at library level --
----------------------------------------------------------------------
procedure Enter_Library_Level_Def
(CD : in out Co_Defs.Compiler_Data;
Full_Ident : in String; -- "Main", "Standard.False", ...
New_Entity : in Co_Defs.Entity_Kind;
Base_Type : in Defs.Typen;
Size : in Integer;
Discrete_First : in Defs.HAC_Integer := Defs.HAC_Integer'First;
Discrete_Last : in Defs.HAC_Integer := Defs.HAC_Integer'Last;
is_built_in : in Boolean := False);
Circular_Unit_Dependency : exception;
procedure Register_Unit
(LD : in out Library_Data;
Descriptor : in Library_Unit);
procedure Change_Unit_Details
(LD : in out Library_Data;
Descriptor : in Library_Unit);
-- ^ Changes in the library the details for
-- unit named Descriptor.Full_Name.
----------------------------------------------------------------------
-- GNAT_File_Naming returns the file name that GNAT expects for --
-- a unit with the name Unit_Name. --
----------------------------------------------------------------------
function GNAT_File_Naming (Unit_Name : String) return String;
function Ada_RM_Casing (Identifier : String) return String;
private
end HAC_Sys.Librarian;
|