1
----------------------------------------------------------------------
2
-- Framework - Package specification --
4
-- This software is (c) The European Organisation for the Safety --
5
-- of Air Navigation (EUROCONTROL) and Adalog 2004-2005. The Ada --
6
-- Controller is free software; you can redistribute it and/or --
7
-- modify it under terms of the GNU General Public License as --
8
-- published by the Free Software Foundation; either version 2, or --
9
-- (at your option) any later version. This unit is distributed --
10
-- in the hope that it will be useful, but WITHOUT ANY WARRANTY; --
11
-- without even the implied warranty of MERCHANTABILITY or FITNESS --
12
-- FOR A PARTICULAR PURPOSE. See the GNU General Public License --
13
-- for more details. You should have received a copy of the GNU --
14
-- General Public License distributed with this program; see file --
15
-- COPYING. If not, write to the Free Software Foundation, 59 --
16
-- Temple Place - Suite 330, Boston, MA 02111-1307, USA. --
18
-- As a special exception, if other files instantiate generics --
19
-- from the units of this program, or if you link this unit with --
20
-- other files to produce an executable, this unit does not by --
21
-- itself cause the resulting executable to be covered by the GNU --
22
-- General Public License. This exception does not however --
23
-- invalidate any other reasons why the executable file might be --
24
-- covered by the GNU Public License. --
26
-- This software is distributed in the hope that it will be --
27
-- useful, but WITHOUT ANY WARRANTY; without even the implied --
28
-- warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR --
30
----------------------------------------------------------------------
34
Ada.Strings.Wide_Unbounded;
45
pragma Elaborate_All (Binary_Map);
50
-- General types for rules
53
type Rule_Types is (Check, Search, Count);
55
--------------------------------------
57
--------------------------------------
59
-- A location is the position of an element in a file
61
type Location is private;
62
Null_Location : constant Location;
64
function Create_Location (File : in Wide_String;
65
First_Line : in Natural;
66
First_Column : in Natural) return Location;
67
function Get_Location (E : in Asis.Element) return Location;
68
-- Returns location of an element
70
function Get_File_Name (L : in Location) return Wide_String;
71
-- Returns location file name
73
function Get_First_Line (L : in Location) return Natural;
74
-- Returns location first line
76
function Image (L : in Location) return Wide_String;
77
-- Returns image of a location
80
function Value (S : Wide_String) return Location;
81
-- Returns location value of a string
82
-- raises Constraint_Error for an incorrect input string
85
--------------------------------------
86
-- Entity_Specification --
87
--------------------------------------
89
-- An Entity_Specification is the structure that corresponds to
90
-- the specification of an Ada entity in the command language
92
type Entity_Specification is private;
93
function Image (Entity : Entity_Specification) return Wide_String;
94
function Value (Name : Wide_String) return Entity_Specification;
95
function Is_Box (Entity : Entity_Specification) return Boolean;
97
--------------------------------------
99
--------------------------------------
101
-- A context is a rule-specific information associated
102
-- to an entity specification
104
type Rule_Context is tagged null record;
105
procedure Clear (Context : in out Rule_Context);
106
-- The default (inherited) Clear does nothing.
107
-- Redefine clear if you extend Rule_Context with fields (like maps
108
-- or access value) that need finalization when the context store is cleared.
110
Empty_Context : constant Rule_Context := (null record);
111
No_Matching_Context : constant Rule_Context'Class;
113
-- A simple context is what most rules will need
114
type Simple_Context is new Rule_Context with
116
Rule_Type : Rule_Types;
117
Rule_Label : Ada.Strings.Wide_Unbounded.Unbounded_Wide_String;
120
--------------------------------------
122
--------------------------------------
124
-- A context_store associates a context to a specific entity specification
126
type Context_Store is limited private;
127
Already_In_Store : exception;
128
Not_In_Store : exception; -- Raised by Dissociate and Association only
130
procedure Balance (Store : in out Context_Store);
131
procedure Clear (Store : in out Context_Store);
133
procedure Associate (Into : in out Context_Store;
134
Specification : in Entity_Specification;
135
Context : in Rule_Context'Class;
136
Additive : in Boolean := False);
137
-- If Additive is False, only one context can be associated to the specification
138
-- (or Already_In_Store is raised)
139
-- If Additive is True, several contexts can be associated to a specification
141
procedure Associate_Default (Into : in out Context_Store;
142
Context : in Rule_Context'Class);
143
-- If a default context is defined, it will be returned by Matching_Context if
144
-- the name is not matched, instead of No_Matching_Context.
146
function Matching_Context (Into : Context_Store;
147
Name : Asis.Element) return Rule_Context'Class;
148
-- Retrieves the context associated to the element if there is a match
149
-- Returns No_Matching_Context otherwise (including if Name is a Nil_Element).
151
-- Appropriate Element_Kinds for Name:
152
-- A_Pragma (condition searched on pragma name)
156
-- Appropriate Expression_Kinds:
157
-- A_Selected_Component (condition searched on the selector)
159
-- An_Attribute_Reference (condition searched on Name'Attribute)
161
-- Matches are, in decreasing order of priority:
162
-- The name matches with overloading
163
-- The name matches without overloading
164
-- The name matches an "all" association with overloading
165
-- The name matches an "all" association without overloading
166
-- There is a default association (matches everything)
168
function Extended_Matching_Context (Into : Context_Store;
169
Name : Asis.Element) return Rule_Context'Class;
170
-- Same as Matching_Context, but extends the search to corresponding generics if Name is
171
-- an instantiation or part of an instantiation
172
-- Restricted to identifiers.
174
function Next_Matching_Context (Into : Context_Store) return Rule_Context'Class;
175
-- Use to retrieve other contexts of an additive association
176
-- Returns the default (or No_Matching_Context) when exhausted
178
function Last_Matching_Name (Into : Context_Store) return Wide_String;
179
-- Name that found the context in the last query to Matching_Context
181
procedure Update (Into : in out Context_Store;
182
Context : in Rule_Context'Class);
183
-- Updates context last returned by Matching_Context or Association
185
function Association (Into : in Context_Store;
186
Specification : in Entity_Specification) return Rule_Context'Class;
187
-- Returns the first Context associated to the specification
188
-- (currently used only for non-additive associations; this may change in the future)
190
procedure Dissociate (From : in out Context_Store;
191
Specification : in Entity_Specification);
192
-- Removes context associated to specification
195
use Ada.Strings.Wide_Unbounded;
201
type Location is record
202
File_Name : Unbounded_Wide_String;
203
First_Line : Asis.Text.Line_Number := 0;
204
First_Column : Asis.Text.Character_Position := 0;
206
Null_Location : constant Location := (Null_Unbounded_Wide_string, 0, 0);
210
-- Entity_Specification
213
type Entity_Specification (Is_Box : Boolean := False) is
220
Specification : Ada.Strings.Wide_Unbounded.Unbounded_Wide_String;
228
-- This way of defining No_Matching_Context ensures that it cannot
229
-- be used for anything else than comparisons.
230
type Not_Found_Context is new Rule_Context with null record;
231
No_Matching_Context : constant Rule_Context'Class
232
:= Not_Found_Context'(null record);
238
type Context_Access is access Rule_Context'Class;
240
type Context_Node_Access is access Context_Node;
243
Value : Context_Access;
244
Next : Context_Node_Access;
246
package Context_Tree is new Binary_Map
247
(Key_Type => Unbounded_Wide_String,
248
Value_Type => Context_Node_Access);
250
type Auto_Pointer (Self : access Context_Store) is limited null record;
251
-- Rosen trick strikes again...
253
type Context_Store is
255
This : Auto_Pointer (Context_Store'access);
256
Simple_Names : Context_Tree.Map;
257
Qualified_Names : Context_Tree.Map;
258
Default : Context_Node_Access;
259
Last_Returned : Context_Node_Access;
260
Last_Name : Unbounded_Wide_String;
added
removed
src/framework.ads
