|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 232112 (0x38ab0)
Types: TextFile
Notes: R1k Text-file segment
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦45d8281ba⟧
└─⟦this⟧
package Design_Implementation is
procedure Complete (Include_Optional_Annotations : Boolean := False);
procedure Definition (In_Place : Boolean := False;
Visible : Boolean := True);
procedure Enclosing (In_Place : Boolean := False);
procedure Explain;
procedure Format;
procedure Show_Usage (In_World : String := "$$");
procedure Display_All_Targets;
procedure Display_Target (For_World : String := "$$");
procedure Set_Target (To_Value : String := ">>DESIGN TARGET<<";
For_World : String := "$$");
procedure Display_All_Phases (For_World : String := "$$");
procedure Display_Phase (For_World : String := "$$");
procedure Set_Phase (To_Value : String := ">>DESIGN PHASE<<";
For_World : String := "$$");
function Current_Target_Image (For_World : String := "$$") return String;
function Current_Phase_Image (For_World : String := "$$") return String;
procedure Create_Model (Compiler_Model : String;
Design_Facility_Model : String;
New_Model_Name : String);
pragma Subsystem (Design_Facility, Closed);
pragma Module_Name (4, 3599);
pragma Bias_Key (27);
end Design_Implementation;with Errors;
with Heap_Strings;
with Mapping;
package Abstract_Document is
subtype Astring is Heap_Strings.Astring;
subtype Pathname is String;
subtype Pathnames is String; -- NAMING.NAME format.
subtype Text is String;
subtype Title_Text is String;
Point : constant := 1.0 / 72;
type Inches is digits 5 range 0.0 .. 100.0; -- For Graphic sizes
Default_Size : constant Inches := 0.0;
type Percentage is digits 5 range 0.0 .. 100.0; -- For Table column sizes
Default_Percentage : constant Percentage := 1.0;
type Position is (Left,
Right,
Center,
Fill); -- For Cover_Item & column-header
type Linkage_Info (Valid : Boolean := False) is private;
Nil_Linkage : constant Linkage_Info;
-- Return True if the Linkage_Info is null
function Is_Nil (For_Linkage : Linkage_Info) return Boolean;
subtype Font_Families is Text;
Default_Font_Family : constant Font_Families := "";
subtype Font_Styles is Text;
Default_Font_Style : constant Font_Styles := "";
type Point_Sizes is new Natural range 0 .. 255;
Default_Point_Size : constant Point_Sizes := 0;
Default_User_Info : constant Text := "";
type Format_Info (Valid : Boolean := False) is private;
Nil_Format : constant Format_Info;
-- Return True if the Format_Info is null
function Is_Nil (For_Format : Format_Info) return Boolean;
type Handle is private;
type Access_Mode is (Read,
Write,
Read_Write);
-- Open a document file
procedure Open (The_Document : in out Handle;
Name : Pathname;
Status : in out Errors.Condition;
Mode : Access_Mode := Abstract_Document.Read;
Check_Obsolescence : Boolean := True);
-- Create a new document file
procedure Create (The_Document : in out Handle;
Name : Pathname;
Status : in out Errors.Condition;
Mode : Access_Mode := Abstract_Document.Write;
Check_Obsolescence : Boolean := True);
-- Close a document file
procedure Close (The_Document : in out Handle);
-- If an interface operation raises FAILED, a status condition
-- can be extracted from the handle associated with that operation,
-- and an error message can be written.
Failed : exception;
Uninitialized_Handle : exception;
-- Get the status condition associated with a document file
procedure Get_Status (From_Handle : Handle;
Result : in out Errors.Condition);
pragma Page;
-- Documents are organized as trees with nodes having a kind.
-- Documents may be traversed by asking for Parent, Brother,
-- and children starting at the Root node.
-- Kind-dependent operations may be performed on nodes
-- to extract interesting information about them.
type Node_Kinds is (Nil,
Root,
Cover,
Cover_Item,
Paragraph,
Appendix,
Text_Block,
File,
Graphic,
List,
List_Item,
Table,
Table_Row,
Table_Column,
Table_Entry,
White_Space,
User_Defined,
Future_Node_1,
Future_Node_2,
Future_Node_3,
Future_Node_4);
type Node is private;
Nil_Node : constant Node;
-- Return True if a Node is null
function Is_Nil (For_Node : Node) return Boolean;
-- Get the Node_Kind of a Node
function Kind (Of_Node : Node) return Node_Kinds;
-- Return True if a node is the Root node
function Is_Root (A_Node : Node) return Boolean;
-- Get the Root node of a document
function Root_Node (Of_Document : Handle) return Node;
--------------------------------------------------------
-- This generic VISITs the nodes in the document in --
-- the order appropriate for printing a document. --
-- NOTE : This generic generates garbage and thus --
-- should only be instantiated within a procedure --
-- or in a non-permanent job. --
--------------------------------------------------------
type Visit_Status is (Ok,
Abandon_Children,
Abandon_Brothers,
Complete);
generic
with procedure Operation (On_Node : Node; Status : out Visit_Status);
procedure Visit_Nodes (Start_Node : Node);
pragma Page;
------------------------------
-- DOCUMENT ENTRY INTERFACE --
------------------------------
package Specify is
----------------------------------------------------------------
-- Every document must start with a COVER, which may be null,
-- and every non-null Cover must contain at least one Cover_Item.
-- A COVER_ITEM can only be inserted within a Cover, but a Cover
-- can also contain File, Graphic, or White_Space nodes.
-- The Cover is done when the first PARAGRAPH call is made, or
-- when the document ends if there are no Paragraphs.
----------------------------------------------------------------
procedure Cover (Document : Handle;
User_Info : Text;
Linkage : Linkage_Info :=
Abstract_Document.Nil_Linkage;
Format : Format_Info := Abstract_Document.Nil_Format);
procedure Cover_Item
(Document : Handle;
Item : Title_Text;
Line_Positions : Position := Abstract_Document.Center;
Linkage : Linkage_Info := Abstract_Document.Nil_Linkage;
Format : Format_Info := Abstract_Document.Nil_Format);
-----------------------------------------------------------------------
-- Sectioning operations.
-----------------------------------------------------------------------
--
-- PARAGRAPH causes the section level to be reset to 1 and sets the
-- level-1 section number (the current paragraph number) to NUMBERED.
-- Every document must have at least one Paragraph, and
-- Paragraph numbers (NUMBERED) must be in increasing order.
-- A Paragraph is composed of a sequence of Text_Block, File, Graphic,
-- List, Table, White_Space, User_Defined and/or sub-Paragraph nodes.
-- NEW_LEVEL increments to the next section level and sets that
-- level's section number to 0. Nothing is output to the document.
-- NEXT_SUB_PARAGRAPH causes the current level's (rightmost) section
-- number to be incremented.
-- NEW_SUB_PARAGRAPH is equivalent to NEW_LEVEL followed by
-- NEXT_SUB_PARAGRAPH, i.e., it increments to the next
-- section level and sets that level's section number to 1.
-- END_LEVEL decrements the section level.
-- xxx_LEVEL operations are used for setting up a loop which uses
-- NEXT_SUB_PARAGRAPH to generate nested sections.
-- APPENDIX is like PARAGRAPH except for the numbering format
-- (Roman numerals or letters).
-- Appendix numbers (NUMBERED) must be in increasing order.
-- A PARAGRAPH cannot follow an APPENDIX.
-----------------------------------------------------------------------
procedure Paragraph
(Document : Handle;
Numbered : Positive;
Title : Title_Text;
Linkage : Linkage_Info := Abstract_Document.Nil_Linkage;
Format : Format_Info := Abstract_Document.Nil_Format);
procedure Appendix (Document : Handle;
Numbered : Positive;
Title : Title_Text;
Linkage : Linkage_Info :=
Abstract_Document.Nil_Linkage;
Format : Format_Info :=
Abstract_Document.Nil_Format);
procedure New_Sub_Paragraph
(Document : Handle;
Title : Title_Text;
Linkage : Linkage_Info := Abstract_Document.Nil_Linkage;
Format : Format_Info := Abstract_Document.Nil_Format);
procedure Next_Sub_Paragraph
(Document : Handle;
Title : Title_Text;
Linkage : Linkage_Info := Abstract_Document.Nil_Linkage;
Format : Format_Info := Abstract_Document.Nil_Format);
procedure New_Level (Document : Handle);
procedure End_Level (Document : Handle);
-----------------------------------------------------------------
-- The TEXT_BLOCK procedure causes a block of text to be inserted
-- in the body of the document (within a Paragraph or Appendix)
-- or in the body of a List_Item.
-----------------------------------------------------------------
procedure Text_Block
(Document : Handle;
T : Text;
Linkage : Linkage_Info := Abstract_Document.Nil_Linkage;
Format : Format_Info := Abstract_Document.Nil_Format);
-----------------------------------------------------------------------
-- Operations to insert text FILE or GRAPHIC objects into the DOCUMENT.
-- They can go into the Cover, a Paragraph/Appendix, or a List_Item.
-- For GRAPHIC objects, the FROM_PATHNAMES parameter may resolve to
-- multiple objects. These objects map to device-dependent graphic
-- files to be included in the generated markup language.
-----------------------------------------------------------------------
procedure File (Document : Handle;
From_Pathnames : Pathnames;
Explain : Text := "";
Format : Format_Info := Abstract_Document.Nil_Format);
procedure Graphic
(Document : Handle;
From_Pathnames : Pathnames;
Title : Title_Text;
Preface : Text;
Size : Inches := Abstract_Document.Default_Size;
Perform_Scaling : Boolean := False;
Explain : Text := "";
Format : Format_Info := Abstract_Document.Nil_Format);
--------------------------------------------------------------------
-- List description operations.
--------------------------------------------------------------------
--
-- A List is composed of one or more List_Items, each of which has a
-- header, and a body composed of a sequence of Text_Block, File,
-- Graphic, List, Table, White_Space, and/or User_Defined nodes.
-- If Linkage and/or Format is not included in a List node when
-- it is constructed (by a START_LIST), it can be inserted by
-- the corresponding END_LIST.
--------------------------------------------------------------------
procedure Start_List
(Document : Handle;
Title : Title_Text;
Linkage : Linkage_Info := Abstract_Document.Nil_Linkage;
Format : Format_Info := Abstract_Document.Nil_Format);
procedure List_Item
(Document : Handle;
Header_Text : Text;
Linkage : Linkage_Info := Abstract_Document.Nil_Linkage;
Format : Format_Info := Abstract_Document.Nil_Format);
procedure End_List (Document : Handle;
Linkage : Linkage_Info :=
Abstract_Document.Nil_Linkage;
Format : Format_Info :=
Abstract_Document.Nil_Format);
----------------------------------------------------------------------
-- Table description operations.
----------------------------------------------------------------------
--
-- COLUMN_INFORMATION is used to define a table's columns.
-- The column information is done when the first TABLE_ENTRY
-- call is made. If COLUMNS is defaulted to 0, the actual number
-- of columns supplied will be used, but otherwise the number
-- supplied must match COLUMNS. All rows of a Table must be filled,
-- so if there are 3 columns, the total number of Table_Entrys
-- must be a multiple of 3. A Table must have at least one entry
-- (at least one column and one row).
-- If Linkage and/or Format is not included in a Table node when
-- it is constructed (by a START_TABLE), it can be inserted by
-- the corresponding END_TABLE.
----------------------------------------------------------------------
procedure Start_Table
(Document : Handle;
Name : Title_Text;
Preface : Text;
Columns : Natural := 0;
Linkage : Linkage_Info := Abstract_Document.Nil_Linkage;
Format : Format_Info := Abstract_Document.Nil_Format);
procedure Column_Information
(Document : Handle;
Title : Title_Text;
Entry_Justification : Position :=
Abstract_Document.Center;
Percentage_Size : Percentage :=
Abstract_Document.Default_Percentage;
Linkage : Linkage_Info := Abstract_Document.Nil_Linkage;
Format : Format_Info := Abstract_Document.Nil_Format);
procedure Table_Entry
(Document : Handle;
Item_Text : Title_Text;
Linkage : Linkage_Info := Abstract_Document.Nil_Linkage;
Format : Format_Info := Abstract_Document.Nil_Format);
procedure End_Table (Document : Handle;
Linkage : Linkage_Info :=
Abstract_Document.Nil_Linkage;
Format : Format_Info :=
Abstract_Document.Nil_Format);
----------------------------------------------------------------
-- Miscellaneous
----------------------------------------------------------------
--
-- These 'White-Space' nodes can appear in a Cover, Paragraph,
-- Appendix, or List, but not in a Table.
----------------------------------------------------------------
procedure New_Page (Document : Handle; Count : Positive := 1);
procedure Blank_Line (Document : Handle; Count : Positive := 1);
-----------------------------------------------------------------------
-- A USER_DEFINED node is similar to a TEXT_BLOCK but has an additional
-- user-defined data that will not be presented in the PREVIEW OE.
-- USER_DEFINED nodes can appear anywhere in a document.
-----------------------------------------------------------------------
procedure User_Defined
(Document : Handle;
T : Text;
User_Data : Text;
Linkage : Linkage_Info := Abstract_Document.Nil_Linkage;
Format : Format_Info := Abstract_Document.Nil_Format);
-----------------------------------------------
-- Routines for generating Linkages.
-- Storage is allocated in the document's heap.
-----------------------------------------------
function Gen_Linkage (Document : Handle;
Explain : Text := "";
Definition : Mapping.Target_Info :=
Mapping.Nil_Target_Info;
Usage : Mapping.Target_Info :=
Mapping.Nil_Target_Info;
Derivation : Mapping.Target_Info :=
Mapping.Nil_Target_Info) return Linkage_Info;
-----------------------------------------------
-- Construction operation for Format data.
-- Storage is allocated in the document's heap.
-----------------------------------------------
function Gen_Format
(Document : Handle;
Font_Family : Font_Families :=
Abstract_Document.Default_Font_Family;
Font_Style : Font_Styles :=
Abstract_Document.Default_Font_Style;
Point_Size : Point_Sizes :=
Abstract_Document.Default_Point_Size;
User_Info : Text := Abstract_Document.Default_User_Info)
return Format_Info;
end Specify;
pragma Page;
--------------------------
-- EXTRACTION INTERFACE --
--------------------------
package Extract is
---------------------------------
-- Node-independent operations --
---------------------------------
function Parent (Of_Node : Node) return Node;
function Brother (Of_Node : Node) return Node;
function Linkage (Of_Node : Node) return Linkage_Info;
function Format (Of_Node : Node) return Format_Info;
function Image (Of_Node : Node) return String;
function Image (Of_Handle : Handle) return String;
-- The following provide debugger Image functions --
-- for Abstract_Document's private types --
function Debug_Image (Of_Linkage : Linkage_Info;
Level : Natural;
Prefix : String;
Expand_Pointers : Boolean) return String;
function Debug_Image (Of_Format : Format_Info;
Level : Natural;
Prefix : String;
Expand_Pointers : Boolean) return String;
function Debug_Image (Of_Handle : Handle;
Level : Natural;
Prefix : String;
Expand_Pointers : Boolean) return String;
function Debug_Image (Of_Node : Node;
Level : Natural;
Prefix : String;
Expand_Pointers : Boolean) return String;
-- ROOT --
function Cover (Root_Node : Node) return Node;
function First_Paragraph (Root_Node : Node) return Node;
-- COVER --
function First_Cover_Item (Cover_Node : Node) return Node;
function Cover_Info (Cover_Node : Node) return String;
function Cover_Item_Text (Cover_Item_Node : Node) return String;
function Cover_Item_Justification
(Cover_Item_Node : Node) return Position;
-- PARAGRAPHs and APPENDIXs - composed of NUMBER and TITLE --
function Paragraph_Number
(Paragraph_Or_Appendix_Node : Node) return String;
-- eg : "3.4.5".
function Para_Depth (Paragraph_Or_Appendix_Node : Node) return Natural;
function Para_Index (Paragraph_Or_Appendix_Node : Node) return Natural;
function Paragraph_Title
(Paragraph_Or_Appendix_Node : Node) return String;
function First_Contents (Paragraph_Or_Appendix_Node : Node) return Node;
-- TEXT_BLOCKs and USER_DEFINED --
-- Use IMAGE, LINKAGE, and FORMAT to get info about these --
function User_Data (User_Defined_Node : Node) return String;
-- GRAPHICs and FILEs - composed of FILE_NAME and optional scaling info
function File_Name (Graphic_Or_File_Node : Node) return String;
function Graphic_Title (Graphic_Node : Node) return String;
function Graphic_Preface (Graphic_Node : Node) return String;
function Graphic_Size (Graphic_Node : Node) return Inches;
function Perform_Scaling (Graphic_Node : Node) return Boolean;
-- LISTs - composed of LIST_ITEMs, each with a header. --
-- Use BROTHER on a LIST_ITEM node to get the next item. --
function List_Count (List_Node : Node) return Natural;
function List_Title (List_Node : Node) return String;
function First_List_Item (List_Node : Node) return Node;
function Header_Text (List_Item_Node : Node) return String;
function First_List_Contents (List_Item_Node : Node) return Node;
-- TABLEs - composed of column information and rows of TABLE_ENTRYs --
function Table_Title (Table_Node : Node) return String;
function Table_Preface (Table_Node : Node) return String;
function Column_Count (Table_Node : Node) return Natural;
function Row_Count (Table_Node : Node) return Natural;
function First_Column (Table_Node : Node) return Node;
function First_Row (Table_Node : Node) return Node;
function Column_Title (Table_Column_Node : Node) return String;
function Column_Justification
(Table_Column_Node : Node) return Position;
function Column_Percentage_Size
(Table_Column_Node : Node) return Percentage;
function First_Table_Entry (Table_Row_Node : Node) return Node;
-- COLUMNs may have LINKAGE/FORMAT info; so may TABLE_ENTRYs. --
-- Use IMAGE, LINKAGE, and FORMAT to get info about TABLE_ENTRYs. --
-- Use BROTHER to get next for ROWs, COLUMNs, and TABLE_ENTRYs. --
-- WHITE_SPACE - composed of an image of the requested spacing --
-- (use IMAGE). ASCII.LFs indicate new lines, ASCII.FFs new pages. --
-- LINKAGE --
function Explain_Text (For_Linkage : Linkage_Info) return String;
function Definition (For_Linkage : Linkage_Info)
return Mapping.Target_Info;
function Usage (For_Linkage : Linkage_Info) return Mapping.Target_Info;
function Derivation (For_Linkage : Linkage_Info)
return Mapping.Target_Info;
function Image (Of_Linkage : Linkage_Info) return String;
-- The following produce string representations of the items LINKed to
function Definition (For_Linkage : Linkage_Info) return String;
function Usage (For_Linkage : Linkage_Info) return String;
function Derivation (For_Linkage : Linkage_Info) return String;
-- FORMAT --
function Font_Family (For_Format : Format_Info) return Font_Families;
function Font_Style (For_Format : Format_Info) return Font_Styles;
function Point_Size (For_Format : Format_Info) return Point_Sizes;
function User_Info (For_Format : Format_Info) return String;
function Image (Of_Format : Format_Info) return String;
-- Raise this exception if anything is wrong with the node --
Bad_Node : exception;
-- Raise this exception if DEFINITION, USAGE or DERIVATION
-- have resolution problems. Use the STATUS call to get the
-- error status associated with the resolution problem.
Bad_Linkage : exception;
function Status return Errors.Condition;
-- Returns the number of consecutive graphic nodes, including the
-- specified node. If the specified node is not a graphic node, this
-- function returns a value of zero.
--
function Number_Of_Figures (Graphic_Node : Node) return Natural;
-- Returns the last consecutive graphic node following the specified
-- node. If there is only one graphics node, this becomes the identity
-- function.
--
function Last_Figure (Graphic_Node : Node)
return Abstract_Document.Node;
end Extract;
-- Delete a document file
procedure Delete (The_Document : Handle; Status : in out Errors.Condition);
-- Get the Form of a document file
--[This merely returns the null string for now]
function Form (The_Document : Handle) return String;
-- Return True if a document file is open
function Is_Open (The_Document : Handle) return Boolean;
-- Get the access mode (Read, Write, Read_Write) of a document file
function Mode (The_Document : Handle) return Access_Mode;
-- Get the name of a document file
function Name (The_Document : Handle) return String;
pragma Subsystem (Design_Facility, Closed);
pragma Module_Name (4, 3590);
pragma Bias_Key (27);
private
type Handle_Object;
type Handle is access Handle_Object;
pragma Segmented_Heap (Handle);
type Node_Data (Kind : Node_Kinds := Nil;
Has_Linkage : Boolean := False;
Has_Format : Boolean := False);
type Node is access Node_Data;
pragma Segmented_Heap (Node);
Nil_Node : constant Node := null;
type String_Table_Index is new Natural range 0 .. 2 ** 16 - 1;
type Linkage_Entry (Valid : Boolean := False) is
record
case Valid is
when True =>
Explain : String_Table_Index;
Definition : String_Table_Index;
Usage : String_Table_Index;
Derivation : String_Table_Index;
when False =>
null;
end case;
end record;
-- This structure is used to pass along linkage information.
type Linkage_Info (Valid : Boolean := False) is
record
The_Entry : Linkage_Entry (Valid => Valid);
case Valid is
when True =>
Assoc_Node : Node;
when False =>
null;
end case;
end record;
Nil_Linkage : constant Linkage_Info :=
Linkage_Info'(Valid => False,
The_Entry => Linkage_Entry'(Valid => False));
type Format_Entry (Valid : Boolean := False) is
record
case Valid is
when True =>
Font_Family : String_Table_Index;
Font_Style : String_Table_Index;
Point_Size : Point_Sizes;
User_Info : String_Table_Index;
when False =>
null;
end case;
end record;
-- This structure is used to pass along format information.
type Format_Info (Valid : Boolean := False) is
record
The_Entry : Format_Entry (Valid => Valid);
case Valid is
when True =>
Assoc_Node : Node;
when False =>
null;
end case;
end record;
Nil_Format : constant Format_Info :=
Format_Info'(Valid => False, The_Entry => Format_Entry'(Valid => False));
-- The following limits are enforced for an Abstract Document:
--
-- Maximum paragraph number = 65535
-- Maximum number of paragraph levels = 65535
-- Maximum paragraph nesting level = 15
-- Maximum number of items in a list = 65535
-- Maximum nesting level for lists = 15
-- Maximum number of columns in a table = 255
-- Maximum number of rows in a table = 65535
end Abstract_Document;with Directory;
with Errors;
package Design_Switches is
type Kinds is (Options, Phase);
function Value (Of_Switch : Kinds;
In_World : String) return String;
procedure Set (Switch : Kinds;
To_Value : String;
In_World : String);
--| Raises: FAILED when TO_VALUE is not an appropriate
--| value for SWITCH or when IN_WORLD is erroneous.
Failed : exception;
function Diagnosis return String;
function Status return Errors.Condition;
--| May be used to obtain further information on the cause of the
--| FAILED exception. DIAGNOSIS returns "" after successful operations.
pragma Subsystem (Design_Facility, Closed);
pragma Module_Name (4, 3592);
pragma Bias_Key (27);
end Design_Switches;with Directory_Tools;
with Errors;
with Heap_Strings;
with System;
package Document is
package Object renames Directory_Tools.Object;
type Element is private;
Nil_Element : constant Element;
function Is_Nil (An_Element : Element) return Boolean;
type Classes is (Postscript, Lineprinter, Document_Db, Markup, Unknown);
subtype Devices is Classes range Postscript .. Lineprinter;
type Paragraph_Mark_Kinds is (Title, Number, None);
subtype Paragraph_Mark is String;
type Element_States is (Nil, Unresolved, Unmarked, Valid);
-- An element resolves to a particular library object and can
-- mark a particular paragraph in that object.
--
-- The state of an element reflects this info :
--
-- ELEMENT_STATE Reason for being in the state
-- ------------- -----------------------------------
-- NIL Uninitialized or set to NIL_ELEMENT.
-- UNRESOLVED RESOLVE of ELEMENT failed, no object exists,
-- access violation or lock error.
-- UNMARKED RESOLVE worked but no mark was set or
-- mark did not exist in the object.
-- MARKED RESOLVE worked and paragraph mark was found.
function State_Of (The_Element : Element) return Element_States;
function Last_Status_Of (The_Element : Element) return Errors.Condition;
-- NIL, MARKED and UNMARKED with no mark set return ERRORS.OK.
procedure Resolve (An_Element : in out Element;
To_Pathname : String;
Class : Classes := Unknown;
Status : in out Errors.Condition);
procedure Resolve (An_Element : in out Element;
To_Handle : Object.Handle;
Class : Classes := Unknown;
Status : in out Errors.Condition);
function Handle_Of (The_Element : Element) return Object.Handle;
-- Returns a nil handle if the element is NIL or UNRESOLVED.
function Pathname_Of (The_Element : Element) return String;
-- Returns a null string if the element is NIL.
function Class_Of (The_Element : Element) return Classes;
-- Returns Unknown if the element is NIL or UNRESOLVED.
procedure Set_Mark (Of_Element : in out Element;
With_Paragraph_Mark_Kind : Paragraph_Mark_Kinds := None;
With_Paragraph_Mark_Image : String := "";
Status : in out Errors.Condition);
function Mark_Of (An_Element : Element;
Which : Paragraph_Mark_Kinds) return String;
-----------------------------------------------------------
-- ELEMENTs are not 'safe' objects. To save them in
-- permanent objects (like files), they must be converted to
-- ELEMENT_PERMANENT_REPRESENTATIONs.
--
-- ELEMENT_PERMANENT_REPRESENTATIONs of elements in any
-- ELEMENT_STATE can be made. If, after conversion from
-- PERMANENT_REPRESENTATION back to ELEMENT, a previously
-- UNRESOLVED or UNMARKED element can now be resolved or
-- who's set mark now exists, the element state is changed
-- and queries (like HANDLE_OF) may return different results.
-- Similarly, if the object or mark has disappeared while
-- the element was permanently stored, a previously MARKED
-- or RESOLVED element may be restored as UNRESOLVED or UNMARKED.
-----------------------------------------------------------
type Element_Permanent_Representation is new String;
function Convert (An_Element : Element;
Within : String := "<SUBSYSTEM>")
return Element_Permanent_Representation;
-- The WITHIN parameter specifies how fully qualified the
-- representation is (or should be resolved). When converting from
-- an element to a permanent representation, the values can be :
-- <FULL> - The element's fully qualified resolution is
-- returned.
-- <SUBSYSTEM> - The resolution of the element is subsystem
-- relative. Subsystem name and spec or load origin
-- is preserved.
-- <VIEW> - The resolution of the element is view relative.
-- No origin information is preserved.
--
-- Storage for <SUBSYSTEM> or <VIEW> representation are less than
-- <FULL> but some origin information is lost.
--
procedure Convert (An_Element_Rep : Element_Permanent_Representation;
Result : out Element;
Status : in out Errors.Condition;
Within : String := "<DEFAULT>");
-- When converting from a permanent representation to an element,
-- an attempt is made to fill in any missing information in the
-- permanent representation from the WITHIN parameter. So, in all
-- cases, if the permanent representation was FULLy resolved the
-- WITHIN parameter is ignored, otherwise :
-- <DEFAULT> - For <SUBSYSTEM>, the view selected by
-- the current activity for the stored subsystem is
-- used as the origin. The spec or load origin of the
-- representation is used to pick the specific view.
-- For <VIEW>, the current view context is used as
-- the origin.
-- subsystem name - For <SUBSYSTEM>, same as <DEFAULT>.
-- For <VIEW>, the view selected by the current
-- activity for the specified subsystem is used.
-- The subsystem name can be followed by "'SPEC" or
-- "'LOAD" to force use of the spec view or load
-- view from the activity. (Defaults to Spec View)
-- view name - For <SUBSYSTEM>, if the subsystem containing the
-- specified view matches the representation's
-- subsystem, the specified view is used.
-- If no match, same as <DEFAULT>.
-- For <VIEW> the specified view is used.
function Unique_Id (For_Element : Element) return Long_Integer;
-- Generates a unique number for any element.
-- Useful for building maps for elements.
-------------------
-- LIST operations
-------------------
type Element_List is private;
Nil_List : constant Element_List;
-- Assignment on a LIST * * DOES NOT CAUSE A COPY TO BE MADE! * *
-- Use COPY to do that.
procedure Copy (From_List : Element_List; To_List : in out Element_List);
procedure Add (An_Element : Element; To_List : in out Element_List);
procedure Reset (A_List : in out Element_List);
function Value (In_List : Element_List) return Element;
procedure Next (In_List : in out Element_List);
function Done (With_List : Element_List) return Boolean;
-- These two operations return information relating to the cause/nature
-- of the condition which caused FAILED to be raised.
Failed : exception;
function Diagnosis return String;
function Status return Errors.Condition;
---------------
-- UTILITIES
---------------
-------------------------------------------------
-- Operations to bring up a window on an Element
-------------------------------------------------
procedure Definition (On_Element : Element;
In_Place : Boolean := False;
Edit : Boolean := False;
Library_Item_Only : Boolean := False;
Status : in out Errors.Condition);
-- The LIBRARY_ITEM_ONLY parameter specifies if definition for
-- UNMARKED elements is to bring up a window on the contents of
-- the element or a Library OE window of the library containing
-- the element with the element name highlighted.
-- Hide these ...
procedure Convert (An_Element_Rep : Element_Permanent_Representation;
Result : out Element;
Status : in out Errors.Condition;
Within : String := "<DEFAULT>";
Use_Heap : System.Segment);
procedure Field_Copy (From_List : Element_List;
To_List : in out Element_List);
-- If a data type contains a LIST and that data type is stored
-- in a segmented heap and a selector on that pointed-to object
-- returns a LIST, use this to get the LIST out.
-- It will un-normalize the internal segmented heap pointers.
function Debug_Image (Of_Element : Element;
Level : Natural;
Prefix : String;
Expand_Pointers : Boolean) return String;
function Debug_Image (Of_List : Element_List;
Level : Natural;
Prefix : String;
Expand_Pointers : Boolean) return String;
pragma Subsystem (Design_Facility, Closed);
pragma Module_Name (4, 3581);
pragma Bias_Key (27);
private
type Element_Item;
type Element is access Element_Item;
pragma Segmented_Heap (Element);
Nil_Element : constant Element := null;
type Element_List_Item;
type Element_List_Item_Pointer is access Element_List_Item;
pragma Segmented_Heap (Element_List_Item_Pointer);
type Element_List_Item is
record
An_Element : Element;
Next : Element_List_Item_Pointer;
end record;
type Element_List is
record
Root : Element_List_Item_Pointer;
Current : Element_List_Item_Pointer;
end record;
Nil_List : constant Element_List := (null, null);
end Document;with Action;
with Ada_Program;
with Directory;
with Errors;
package Element_Cache is
subtype Element is Ada_Program.Element;
subtype Element_List is Ada_Program.Element_List;
type Handle is limited private;
type Modes is (Create, Read, Update);
--------------------------
-- Old Style Interfaces --
--------------------------
-- These interfaces are obsolete and their use is discouraged. The
-- preferred interfaces are declared below function Debug_Image.
procedure Open (Cache : in out Handle;
Mode : Modes;
Name : String);
procedure Close (Cache : in out Handle);
procedure Destroy (Cache : in out Handle);
subtype Key is String;
procedure Add (An_Element : Element;
To_Cache : in out Handle;
With_Key : Key);
procedure Remove (An_Element : Element;
From_Cache : in out Handle;
With_Key : Key);
procedure Add (An_Element_List : Element_List;
To_Cache : in out Handle;
With_Key : Key);
procedure Remove (An_Element_List : Element_List;
From_Cache : in out Handle;
With_Key : Key);
procedure Retrieve (Elements : out Element_List;
From_Cache : Handle;
With_Key : Key;
In_Context : String := "<DEFAULT>");
--
-- This operation does not raise FAILED when errors are detected
-- during the retrieval of ELEMENTS from FROM_CACHE. Instead, as
-- many valid elements as possible are retieved and placed in
-- ELEMENTS. When the complete success of the retrieval operation
-- must be known, STATUS and DIAGNOSIS can be queried after the call
-- to RETRIVE in order to determine if any problems were encountered
-- during the operation.
Failed : exception;
--
-- FAILED is raised when any of the above operations
-- cannot be successfully completed. STATUS and DIAGNOSIS
-- may be used to obtain additional information about the
-- nature of the failure.
function Diagnosis return String;
function Status return Errors.Condition;
function Debug_Image (Of_Handle : Handle;
Level : Natural;
Prefix : String;
Expand_Pointers : Boolean) return String;
--------------------------
-- Preferred Interfaces --
--------------------------
-- The following subprograms provide the same functionality as their
-- overloaded counterparts above, except that these subprograms
-- provide a STATUS parameter where appropriate and generally do not
-- raise the FAILED exception.
procedure Open (Cache : in out Handle;
Mode : Modes;
Name : String;
Status : in out Errors.Condition;
Action_Id : Action.Id := Action.Null_Id);
--
-- When ACTION_ID = ACTION.NULL_ID, an action managed by the
-- job is used by the open, and is finished as appropriate at
-- the end of the job. When ACTION_ID /= ACTION.NULL_ID,
-- ACTION_ID is used in subsequent operations and should be
-- finished by the client which started it.
procedure Close (Cache : in out Handle;
Status : in out Errors.Condition);
procedure Destroy (Cache : in out Handle;
Status : in out Errors.Condition);
type Storage_Formats is (Fully_Qualified,
Subsystem_Relative,
View_Relative);
--
-- Type STORAGE_FORMATS determines how elements are
-- represented in the cache. The permanent representation
-- used in the caches is equivalent to that provided in the
-- Ada_Program.Conversion.Convert operations. A summary of
-- the storage formats is provided below.
--
-- FULLY_QUALIFIED => The element's fully qualified resolution
-- is stored. This format is useful for
-- elements from non-subsystem contexts or
-- when subsystem/view information must be
-- saved.
--
-- SUBSYSTEM_RELATIVE => The resolution of the element is subsystem
-- relative. The subsystem name along with
-- an SPEC/LOAD view indication are stored.
-- This format is useful for elements in
-- subystem contexts when retreival is desired
-- in a potentially different view context. See
-- the IN_CONTEXT parameter on procedure RETRIEVE
-- below.
--
-- VIEW_RELATIVE => The resolution of the element is completely
-- view relative. No subsystem or SPEC/LOAD
-- indication is stored. This format is useful
-- for elements in subsystem contexts which will
-- ALWAYS be retrieved in a particular
-- subsystem/view pair.
procedure Add (An_Element : Element;
To_Cache : in out Handle;
With_Key : Key;
Status : in out Errors.Condition;
Format : Storage_Formats :=
Element_Cache.Subsystem_Relative);
--
-- Stores AN_ELEMENT in TO_CACHE under WITH_KEY in FORMAT
-- representation. If AN_ELEMENT was previously ADD'ed
-- with the same parameters, this operation is a no-op.
-- When a single element is ADD'ed to the same cache with
-- different values for the FORMAT parameter, separate
-- entries for each given format are stored.
--
-- NOTE: In order to REMOVE a given element from the cache,
-- the same values for WITH_KEY and FORMAT must be provided.
procedure Remove (An_Element : Element;
From_Cache : in out Handle;
With_Key : Key;
Status : in out Errors.Condition;
Format : Storage_Formats :=
Element_Cache.Subsystem_Relative);
--
-- Removes AN_ELEMENT stored under WITH_KEY from FROM_CACHE in
-- FORMAT representation. When AN_ELEMENT is not stored under
-- WITH_KEY in the specified FORMAT, UNDEFINED_ELEMENT is returned
-- in STATUS. When WITH_KEY is not defined in FROM_CACHE,
-- UNDEFINED_KEY is returned in STATUS.
procedure Add (An_Element_List : Element_List;
To_Cache : in out Handle;
With_Key : Key;
Status : in out Errors.Condition;
Format : Storage_Formats :=
Element_Cache.Subsystem_Relative);
--
-- Equivalent to single element ADD as defined above on each
-- element in AN_ELEMENT_LIST.
procedure Remove (An_Element_List : Element_List;
From_Cache : in out Handle;
With_Key : Key;
Status : in out Errors.Condition;
Format : Storage_Formats :=
Element_Cache.Subsystem_Relative);
--
-- Equivalent to single element REMOVE as defined above on each
-- element in AN_ELEMENT_LIST.
procedure Retrieve (Elements : out Element_List;
From_Cache : Handle;
With_Key : Key;
Status : in out Errors.Condition;
Format : Storage_Formats :=
Element_Cache.Subsystem_Relative;
In_Context : String := "<DEFAULT>");
--
-- Restores the ELEMENTS that were saved in FROM_CACHE under
-- WITH_KEY in FORMAT representation. The IN_CONTEXT parameter
-- determines how the resolution of saved elements will be
-- performed. In all cases, if the elements were saved in
-- FULLY_QUALIFED format this parameter is ignored. Otherwise, the
-- following algorithm is followed.
--
-- <DEFAULT> => For elements saved in SUBSYSTEM_RELATIVE format,
-- the view selected by the current activity and
-- the stored subsystem is used as the origin. The
-- spec or load origin of the representation is
-- used to choose the specific view. For elements
-- saved in VIEW_RELATIVE format, the current view
-- context is used as the origin.
--
-- Subsystem Name => For elements saved in SUBSYSTEM_RELATIVE format,
-- this behaves the same as <DEFAULT>. For elements
-- saved in VIEW_RELATIVE format, the view selected
-- by the current activity for the given subsystem
-- is used. The subsystem name can be followed by
-- "'SPEC" or "'LOAD" to force use of the spec view
-- or load view from the activity; DEFAULT: Spec View
--
-- View Name => For elements saved in SUBSYSTEM_RELATIVE format,
-- if the subsystem enclosing the given view name
-- matches the representation's subsystem, the
-- given view is used. Otherwise, this behaves
-- the same as <DEFAULT>. For elements saved in
-- VIEW_RELATIVE format the specified view is used.
----------------------
-- Cache Compaction --
----------------------
procedure Compactify (The_Cache : in out Handle;
Status : in out Errors.Condition);
--
-- Reorganizes cache data structures into a more optimal format.
-- Assert => MODE (THE_CACHE) /= READ.
--------------------------
-- Cache Handle Queries --
--------------------------
function Is_Open (Cache : Handle) return Boolean;
function Mode (Of_Cache : Handle) return Modes;
--
-- Raises FAILED when not IS_OPEN (OF_CACHE)
function Name (Of_Cache : Handle) return String;
--
-- Raises FAILED when not IS_OPEN (OF_CACHE)
function Object_Id (Of_Cache : Handle) return Directory.Object;
--
-- Raises FAILED when not IS_OPEN (OF_CACHE)
-------------------
-- Key Iterators --
-------------------
-- The following type and operations provide a means of
-- iterating over the set of keys defined for a given cache.
type Key_Iterator is private;
procedure Initialize (Iterator : in out Key_Iterator;
From_Cache : Handle);
function Done (Iterator : Key_Iterator) return Boolean;
function Value (Of_Iterator : Key_Iterator) return Key;
procedure Next (The_Iterator : in out Key_Iterator);
------------------------------
-- Predefined Status Values --
------------------------------
Undefined_Element : constant Errors.Error_Kinds :=
Errors.Make ("UNDEFINED_ELEMENT", Errors.Warn);
Undefined_Key : constant Errors.Error_Kinds :=
Errors.Make ("UNDEFINED_KEY", Errors.Warn);
pragma Subsystem (Design_Facility, Closed);
pragma Module_Name (4, 3593);
pragma Bias_Key (27);
private
type Handle_Data;
type Handle is access Handle_Data;
pragma Segmented_Heap (Handle);
type Key_Data;
type Key_Iterator is access Key_Data;
pragma Segmented_Heap (Key_Iterator);
end Element_Cache;with Profile;
with Simple_Status;
package Errors is
subtype Error_Kinds is Simple_Status.Condition_Name;
subtype Condition is Simple_Status.Condition;
subtype Error_Severity is Simple_Status.Condition_Class;
-- A CONDITION should be used to return error information from
-- procedure calls. They are relatively large and should always
-- be passed by mode IN OUT.
--
-- A CONDITION consists of an ERROR_KINDS and a message string. The
-- ERROR_KINDS indicates the type of error (if any) and how
-- serious the error is (or if completion was successful). The
-- Message provides additional information about the error. A
-- CONDITION is self-initializing to severity Normal and an empty
-- message.
--
-- By convention, the set of defined ERROR_KINDS in an application
-- should be standardized so that error conditions can be tested
-- programmatically.
----- Error_Severity Constants
--
Normal : constant Error_Severity := Simple_Status.Normal;
Warn : constant Error_Severity := Simple_Status.Warning;
Problem : constant Error_Severity := Simple_Status.Problem;
Fatal : constant Error_Severity := Simple_Status.Fatal;
function Make (Error_Name : String;
Severity : Error_Severity) return Error_Kinds
renames Simple_Status.Create_Condition_Name;
--
-- Useful for creating predefined ERROR_KINDS.
--
-- NOTE: The length of ERROR_NAME is limited to 63 characters.
procedure Append_Condition (A_Condition : in out Condition;
Owner : String;
Error_Kind : Error_Kinds;
Message : String);
procedure Set_Ok (A_Condition : in out Condition)
renames Simple_Status.Initialize;
procedure Set (A_Condition : in out Condition;
Error_Kind : Error_Kinds;
Message : String)
renames Simple_Status.Create_Condition;
--
-- Augment A_CONDITION with a new ERROR_KIND and MESSAGE. The REPORT
-- procedures declared below display the information most recently
-- SET. Use REPORT_CONDITION at the end of this package to display
-- all information stored in a given CONDITION.
function Kind (Of_Condition : Condition) return Error_Kinds
renames Simple_Status.Error_Type;
--
-- Returns the current ERROR_KIND from OF_CONDITION.
function Severity (Of_Condition : Condition) return Error_Severity
renames Simple_Status.Severity;
--
-- Returns the current ERROR_SEVERITY from OF_CONDITION.
function Info (From_Condition : Condition) return String;
--
-- Returns the most recently SET information contained in
-- FROM_CONDITION formatted in a style suitable for use in
-- generating log messages. The format of this information
-- is ... ERROR_NAME & ", " & MESSAGE
--
-- When either of ERROR_NAME or MESSAGE are the empty string, the
-- intervening delimiter is omitted. In this description,
-- ERROR_NAME refers to the value provided in the first parameter of
-- MAKE, and MESSAGE refers to the value provided in the MESSAGE
-- parameter of APPEND_CONDITION and SET.
function Exception_Info return String;
--
-- Called in the context of an exception handler, returns
-- descriptive information about the name of the exception
-- and the location at which it was raised.
function Is_Error (A_Condition : Condition;
Severity : Error_Severity := Errors.Warn)
return Boolean renames Simple_Status.Error;
--
-- Returns SEVERITY (A_CONDITION) >= SEVERITY.
-- (e.g. IS_ERROR (NONE) => False; IS_ERROR (OPEN_ERROR) => True)
function Is_Equal (A_Condition : Condition;
An_Error : Error_Kinds) return Boolean
renames Simple_Status.Equal;
--
-- Returns KIND (A_CONDITION) = AN_ERROR.
--
-- NOTE: The severity component of A_CONDITION does not
-- participate in the comparison.
----------------------------------------------------------
-- The following are utilities for logging error messages
----------------------------------------------------------
subtype Log_Level is Profile.Msg_Kind;
----- Log_Level Constants
--
Auxiliary : constant Log_Level := Profile.Auxiliary_Msg;
Debug : constant Log_Level := Profile.Debug_Msg;
Note : constant Log_Level := Profile.Note_Msg;
Positive : constant Log_Level := Profile.Positive_Msg;
Position : constant Log_Level := Profile.Position_Msg;
Negative : constant Log_Level := Profile.Negative_Msg;
Warning : constant Log_Level := Profile.Warning_Msg;
Error : constant Log_Level := Profile.Error_Msg;
Xception : constant Log_Level := Profile.Exception_Msg;
Sharp : constant Log_Level := Profile.Sharp_Msg;
At_Sign : constant Log_Level := Profile.At_Msg;
Dollar : constant Log_Level := Profile.Dollar_Msg;
procedure Report_Exception (Where, What : String;
Level : Log_Level := Errors.Error;
Dont_Log, In_Message_Window : Boolean := False);
--
-- To be called in the context of an exception handler to
-- display EXCEPTION_INFO in addition to information normally
-- generated by REPORT below.
procedure Report (Where, What : String;
With_Condition : Condition;
Level : Log_Level := Errors.Note;
Dont_Log, In_Message_Window : Boolean := False);
--
-- Generates a message of the following format to the current log
-- device ... WHERE & "; " & WHAT & " (" & INFO (WITH_CONDITION) & ')'
--
-- When WHERE is the null string, the semicolon separator is omitted
-- from the display. When WITH_CONDITION contains good status, the
-- parentheses and their contents are omitted from the display.
procedure Report (Where, What : String;
Level : Log_Level := Errors.Note;
Dont_Log, In_Message_Window : Boolean := False);
--
-- Generates a message of the following format to the current log
-- device ... WHERE & "; " & WHAT
--
-- When WHERE is the null string, the semicolon separator is omitted
-- from the display.
--------------------------------------------------------------
-- The following are errors used within the Design Facility
--------------------------------------------------------------
None : constant Error_Kinds :=
Make ("NONE", Errors.Normal);
Internal_Error : constant Error_Kinds :=
Make ("INTERNAL_ERROR", Errors.Fatal);
Unknown : constant Error_Kinds :=
Make ("UNKNOWN", Errors.Fatal);
Unhandled_Exception : constant Error_Kinds :=
Make ("UNHANDLED_EXCEPTION", Errors.Fatal);
Unimplemented : constant Error_Kinds :=
Make ("UNIMPLEMENTED", Errors.Fatal);
Open_Error : constant Error_Kinds :=
Make ("OPEN_ERROR", Errors.Problem);
Create_Error : constant Error_Kinds :=
Make ("CREATE_ERROR", Errors.Problem);
Access_Error : constant Error_Kinds :=
Make ("ACCESS_ERROR", Errors.Problem);
Lock_Error : constant Error_Kinds :=
Make ("LOCK_ERROR", Errors.Problem);
Mapping_Error : constant Error_Kinds :=
Make ("MAPPING_ERROR", Errors.Problem);
Inconsistency : constant Error_Kinds :=
Make ("INCONSISTENCY", Errors.Problem);
Table_Overflow : constant Error_Kinds :=
Make ("TABLE_OVERFLOW", Errors.Problem);
Undefined : constant Error_Kinds :=
Make ("UNDEFINED", Errors.Warn);
Obsolete : constant Error_Kinds :=
Make ("OBSOLETE", Errors.Warn);
Invalid_Options : constant Error_Kinds :=
Make ("INVALID_OPTIONS", Errors.Fatal);
Warnings_Generated : constant Error_Kinds :=
Make ("WARNINGS_GENERATED", Errors.Warn);
procedure Report_Condition (Status : Condition);
--
-- Displays the accumulated information contained in STATUS.
pragma Subsystem (Design_Facility, Closed);
pragma Module_Name (4, 3584);
pragma Bias_Key (27);
end Errors;with System;
package Heap_Strings is
type Astring is access String;
pragma Segmented_Heap (Astring);
---------------------------------------------------------------------
-- If you're going to do a lot of ASTRING allocation within a
-- job, getting and initializing a STORAGE_HEAP object (and using
-- the flavor of calls that take a STORAGE_HEAP) will improve
-- preformance somewhat.
---------------------------------------------------------------------
type Storage_Heap is private;
function Initialize return Storage_Heap;
---------------------------------------------------------------------
-- Allocate new ASTRINGs. The order below indicates the relative
-- performance, the first is slowest, last is the fastest.
-- The middle call allocates the new ASTRING on the STORAGE_HEAP of
-- the FROM_POINTER param, if FROM_POINTER is uninitialized, the call
-- is identical to the first.
---------------------------------------------------------------------
function Allocate (Data : String) return Astring;
function Allocate (Data : String; From_Pointer : Astring) return Astring;
function Allocate (Data : String; From_Heap : Storage_Heap) return Astring;
---------------------------------------------------------------------
-- Append to an ASTRING. If the target is uninitialized, append will
-- allocate the strings on the default STORAGE_HEAP or on the
-- source's STORAGE_HEAP (if it is an ASTRING and it is initialized).
---------------------------------------------------------------------
procedure Append (To_Target : in out Astring; Source : String);
procedure Append (To_Target : in out Astring; Source : Astring);
procedure Replace (In_Target : Astring; The_Char, With_Char : Character);
-- Hide this one ...
function Allocate
(Data : String; From_Heap : System.Segment) return Astring;
pragma Subsystem (Design_Facility, Closed);
pragma Module_Name (4, 3580);
pragma Bias_Key (27);
private
type Storage_Heap is new System.Segment;
end Heap_Strings;with Ada_Program;
with Errors;
with Document;
with Pdl;
with System;
package Mapping is
subtype Area is Pdl.Area;
Nil_Area : Area renames Pdl.Default_Area;
procedure Set (The_Area : out Area;
First_Line : Natural;
First_Column : Natural;
Last_Line : Natural;
Last_Column : Natural)
renames Pdl.Set_Range;
Nil_Document : Document.Element renames Document.Nil_Element;
Nil_Pdl : Ada_Program.Element renames Ada_Program.Nil_Element;
-----------------------------------------------------------
-- TARGET_INFOs are not 'safe' objects. To save them in
-- permanent objects (like files) they must be converted to
-- TARGET_INFO_PERMANENT_REPRESENTATIONs.
-----------------------------------------------------------
type Target_Info is private;
Nil_Target_Info : constant Target_Info;
function Is_Nil (A_Target : Target_Info) return Boolean;
function Create (Pdl_Reference : Ada_Program.Element := Nil_Pdl;
Document_Reference : Document.Element := Nil_Document;
Pdl_Area : Area := Nil_Area;
Document_Area : Area := Nil_Area) return Target_Info;
function Create (Pdl_References : Ada_Program.Element_List;
Document_References : Document.Element_List)
return Target_Info;
procedure Add_Pdl_Reference (To_Target : in out Target_Info;
Pdl_References : Ada_Program.Element_List);
procedure Add_Pdl_Reference
(To_Target : in out Target_Info;
Pdl_Reference : Ada_Program.Element;
Pdl_Area : Area := Nil_Area);
procedure Add_Document_Reference
(To_Target : in out Target_Info;
Document_References : Document.Element_List);
procedure Add_Document_Reference
(To_Target : in out Target_Info;
Document_Reference : Document.Element;
Document_Area : Area := Nil_Area);
function Contains_Pdl_Reference (In_Target : Target_Info) return Boolean;
function Contains_Document_Reference
(In_Target : Target_Info) return Boolean;
function Documents_In (A_Target : Target_Info) return Document.Element_List;
function Pdl_In (A_Target : Target_Info) return Ada_Program.Element_List;
-----------------------------------------------------------
-- TARGET_INFOs are not 'safe' objects. To save them in
-- permanent objects (like files), they must be converted to
-- TARGET_INFO_PERMANENT_REPRESENTATIONs.
-----------------------------------------------------------
type Target_Info_Permanent_Representation is new String;
function Convert (Target : Target_Info;
Within : String := "<SUBSYSTEM>")
return Target_Info_Permanent_Representation;
-- The WITHIN parameter specifies how fully qualified the
-- representation is (or should be resolved). When converting from
-- a target info to a permanent representation, the values can be :
-- <FULL> - The info's fully qualified resolution is
-- returned.
-- <SUBSYSTEM> - The resolution of the info is subsystem
-- relative. Subsystem name and spec or load origin
-- is preserved.
-- <VIEW> - The resolution of the element is view relative.
-- No origin information is preserved.
--
-- Storage for <SUBSYSTEM> or <VIEW> representation are less than
-- <FULL> but some origin information is lost.
--
procedure Convert (Target_Rep : Target_Info_Permanent_Representation;
Result : out Target_Info;
Status : in out Errors.Condition;
Within : String := "<DEFAULT>");
-- When converting from a permanent representation to a target info,
-- an attempt is made to fill in any missing information in the
-- permanent representation from the WITHIN parameter. So, in all
-- cases, if the permanent representation was FULLy resolved the
-- WITHIN parameter is ignored, otherwise :
-- <DEFAULT> - For <SUBSYSTEM>, the view selected by
-- the current activity for the stored subsystem is
-- used as the origin. The spec or load origin of the
-- representation is used to pick the specific view.
-- For <VIEW>, the current view context is used as
-- the origin.
-- subsystem name - For <SUBSYSTEM>, same as <DEFAULT>.
-- For <VIEW>, the view selected by the current
-- activity for the specified subsystem is used.
-- The subsystem name can be followed by "'SPEC" or
-- "'LOAD" to force use of the spec view or load
-- view from the activity. (Defaults to Spec View)
-- view name - For <SUBSYSTEM>, if the subsystem containing the
-- specified view matches the representation's
-- subsystem, the specified view is used.
-- If no match, same as <DEFAULT>.
-- For <VIEW> the specified view is used.
procedure Definition (Of_Target_Info : Target_Info;
In_Place : Boolean := False;
Edit : Boolean := False;
Status : in out Errors.Condition);
-- Hide these ...
procedure Convert (Target_Rep : Target_Info_Permanent_Representation;
Result : out Target_Info;
Status : in out Errors.Condition;
Within : String := "<DEFAULT>";
Use_Heap : System.Segment);
function Create
(Pdl_Reference : Ada_Program.Element := Nil_Pdl;
Document_Reference : Document.Element := Nil_Document;
Pdl_Area : Area := Nil_Area;
Document_Area : Area := Nil_Area;
Use_Heap : System.Segment) return Target_Info;
function Create (Pdl_References : Ada_Program.Element_List;
Document_References : Document.Element_List;
Use_Heap : System.Segment) return Target_Info;
function Debug_Image (Of_Target_Info : Target_Info;
Level : Natural;
Prefix : String;
Expand_Pointers : Boolean) return String;
pragma Subsystem (Design_Facility, Closed);
pragma Module_Name (4, 3583);
pragma Bias_Key (27);
private
type Target_Data;
type Target_Info is access Target_Data;
pragma Segmented_Heap (Target_Info);
Nil_Target_Info : constant Target_Info := null;
end Mapping;with Ada_Program;
with Errors;
with Heap_Strings;
with System;
pragma Private_Eyes_Only;
with Ada_Text;
package Pdl is
subtype Astring is Heap_Strings.Astring;
-------------------------
---- ADA ERROR MARKS ----
-------------------------
procedure Mark_Error (At_Element : Ada_Program.Element;
Message : String);
procedure Mark_Warning (At_Element : Ada_Program.Element;
Message : String);
-- For marking error or warning messages on a particular element node,
-- these will show up a underlined/annotated areas in the AOE.
-- Should be used only by knowledgeable individuals.
-------------------------
---- ERROR DIAGNOSIS ----
-------------------------
Failed : exception;
-- This exception indicates a specification or internal error, more
-- information can be extracted by calling DIAGNOSIS or STATUS.
function Diagnosis return String;
function Status return Errors.Condition;
-- Whenever an error condition is detected (and exception is raised)
-- a diagnostic message/status is stored. These functions retrieve the
-- diagnostic for the most recent error.
---------------
---- AREAs ----
---------------
-- AREAs are used to indicate where a construct lives in the ada image.
-- AREAs should only be used by knowledgeable individuals.
type Area is private;
Default_Area : constant Area;
procedure Get_Range (Of_Area : Area;
Start_Line, Start_Column,
Finish_Line, Finish_Column : out Natural);
procedure Set_Range (Of_Area : out Area;
Start_Line, Start_Column,
Finish_Line, Finish_Column : Natural);
\f
--------------------------------
---- PDL REGISTRATION TYPES ----
--------------------------------
--------------
-- Analysis --
--------------
type Analysis_Mode is (Complete, Demote, Promote);
type Unit_State is (Source, Installed, Coded);
-- At the start of PDL Analysis, the user is called through the
-- generic formal TRAVERSAL_PRE_OP. Several items of interest
-- are passed to the user at this point.
--
-- 1) The current analysis mode (Complete, Demote, Promote)
-- 2) The current unit state (Source, Installed, Coded)
-- 3) The desired goal state (Source, Installed, Coded)
--
-- This information should be used to determine the exact form
-- of analysis which is to be performed during the subsequent
-- traversal.
subtype Traversal_Control is Ada_Program.Traversal_Control;
type Analysis_Status is (Success, Warning, Error);
---------------------
-- Command Mapping --
---------------------
type Mapping_Operation is (Explain,
Definition,
Enclosing,
Show_Usage);
type Mapping_Parameters (For_Operation : Mapping_Operation) is
record
case For_Operation is
when Definition | Enclosing =>
In_Place : Boolean;
case For_Operation is
when Definition =>
Visible : Boolean;
when others =>
null;
end case;
when Explain =>
null;
when Show_Usage =>
In_World : Heap_Strings.Astring;
end case;
end record;
type Mapping_Status is (Success, Not_Defined, Error);
--------------------
-- Identification --
--------------------
subtype Pdl_Names is String;
type Pdl_Ids is (Pdl_01, Pdl_02, Pdl_03, Pdl_04, Pdl_05, Pdl_06,
Pdl_07, Pdl_08, Pdl_09, Pdl_10, Pdl_11, Pdl_12);
--------------------------------------------------------------------------
--
-- Official Interface to the Design Facility Operations.
--
-- The following operations require that one of the preceding
-- PDL_IDS has been registered on the machine and is associated
-- with the view in which they are executed.
--
-- Each operation raises Pdl.Failed when it cannot be
-- successfully completed.
--
package Operations is
procedure Complete (Include_Optional_Annotations : Boolean := False);
procedure Definition (In_Place : Boolean := False;
Visible : Boolean := True);
procedure Enclosing (In_Place : Boolean := False);
procedure Explain;
procedure Format;
procedure Show_Usage (In_World : String := "");
end Operations;
\f
------------------------------
---- ANNOTATION UTILITIES ----
------------------------------
-- The following functions are used as defaults for the annotation
-- generic. The defaults are the standard for Rational's PDL.
procedure At_Recognizer (S : String;
Keyword_Start, Keyword_End : out Natural;
Argument_Start : out Natural);
-- Recognizes strings that have '@' in them delimited by a ' '.
-- Returns position of '@' +1, ' ' -1 and ' ' +1.
function Bar_Recognizer (S : String) return Natural;
-- Given a string, returns the position of the first non-blank
-- characters after "--|". Returns 0 if the first non-blank
-- characters are not "--|". Returns S'Last + 1 if there are
-- no non-blank characters after the "--|".
function At_Prepend (S : String) return String;
-- Given a string, prepends '@' to it.
function Bar_Prepend (S : String) return String;
-- Given a string, prepends "--| " to it.
----------------------------
---- ANNOTATION GENERIC ----
----------------------------
generic
type Keywords is (<>); -- Keywords'First MUST be the enumeral Nil
type Phases is (<>); -- Phases'First MUST be the enumeral Nil
type Elements is (<>); -- Elements'First MUST be the enumeral Nil
type Rules is (<>); -- Rules'First MUST be the enumeral Nil
with function Keyword_Image (Keyword : Keywords)
return String is Keywords'Image;
with function Phase_Image (Phase : Phases)
return String is Phases'Image;
with function Element_Image (Element : Elements)
return String is Elements'Image;
with function Rule_Image (Rule : Rules)
return String is Rules'Image;
with function Annotation_Recognizer (Comment_Line : String)
return Natural is Bar_Recognizer;
-- Used to identify comments that are annotations.
-- Should return an index into COMMENT_LINE of the first non-blank
-- characters after the annotation indication. Should return 0
-- if the comment line is not an annotation. Should return
-- COMMENT_LINE'Last + 1 if there are no non-blank characters other
-- than the annotation indicators. The default recognizes the
-- characters "--|" as an annotation indicator.
with procedure Keyword_Recognizer
(S : String;
Keyword_Start, Keyword_End : out Natural;
Argument_Start : out Natural) is At_Recognizer;
-- Returns the locations in the string to scan for a keyword
-- and arguments.
-- KEYWORD_START = 0 indicates this string can't contain a
-- keyword. KEYWORD_END = 0 may be used to indicate that the
-- keyword extends to the end of the string. ARGUMENT_START
-- indicates the location to be used to start scanning for
-- arguments (if set to 0 indicates no argument exists in S).
-- Leading and trailing blanks between _START and _END are ignored.
-- The default recognizes '@' as the keyword prefix and ' ' as
-- the keyword terminator.
with function Keyword_Generator
(Keyword_Image : String) return String is At_Prepend;
-- Returns the formatted string that the keyword recognizer would
-- successfully recognize as a keyword. The default prepends an
-- '@' to the keyword image.
with function Annotation_Generator
(Annotation_Image : String) return String is
Bar_Prepend;
-- Returns the formatted string that the annotation recognizer would
-- successfully recognize as an annotation. The default prepends
-- "--| " to the annotation image.
package Annotation is
------------------------------
---- ANNOTATION ARGUMENTS ----
------------------------------
package Argument is
type Kinds is
(Nil, Name, Number, Text, Associated,
Indexed, Prompt, List, Reserved_None);
subtype Object_Kinds is Kinds range Name .. Prompt;
subtype Object_Identifier_Kinds is
Object_Kinds range Name .. Number;
type Kind_Vector is array (Kinds) of Boolean;
type Description is
record
Legal_Kinds : Kind_Vector;
User_Check : Boolean := False;
Prompt : Astring := null;
Error_Message : Astring := null;
Add_Prompt_Delimiters : Boolean := True;
end record;
function Create_Description
(Legal_Kinds : Kind_Vector;
User_Check : Boolean := False;
Prompt : Astring := null;
Error_Message : Astring := null;
Add_Prompt_Delimiters : Boolean := True)
return Description;
--
-- This procedure is supplied as a convenience for generating
-- a DESCRIPTION that has defaults.
type Info is private;
Nil_Info : constant Info;
function Is_Nil (An_Info : Info) return Boolean;
type Info_List is private;
Nil_List : constant Info_List;
function Is_Nil (A_List : Info_List) return Boolean;
function Create_Default
(Description_Info : Description) return Info;
-- Creates an argument with the correct kind and image (a prompt
-- if appropriate). This is mainly used in COMPLETION.
function Kind (Of_Info : Info) return Kinds;
-- NIL is returned if an uninitialized INFO is specified.
function Image (Of_Info : Info) return String;
-- Null string ("") is returned if an uninitialized INFO is specified.
function Argument_Area (Of_Info : Info) return Area;
-- DEFAULT_AREA is returned if an uninitialized INFO is specified or
-- if the INFO was not extracted from an Annotation that is attached
-- to an ADA_PROGRAM.ELEMENT. (e.g. created by CREATE_DEFAULT).
function Associated_Ada_Program_Element
(Of_Info : Info) return Ada_Program.Element;
-- ADA_PROGRAM.NIL_ELEMENT is returned if an uninitialized INFO is
-- specified or if the INFO was not extracted from an Annotation
-- that is attached to an ADA_PROGRAM.ELEMENT.
function Corresponding_Info
(At_Area : Area;
In_Element : Ada_Program.Element) return Info;
--
-- Returns the INFO described by AT_AREA and IN_ELEMENT. When
-- these parameters do not correlate to an INFO, the NIL_INFO
-- is returned.
procedure Definition (Of_Info : Info;
In_Place : Boolean := False;
Edit : Boolean := False;
Status : in out Errors.Condition);
--
-- Brings up an Ada window on the Ada element attached to OF_INFO.
---------------------------
-- Operations on OBJECTs --
---------------------------
-- Names : <ada-simple>
-- | { <ada-simple or prompt>. } <ada-simple or prompt>
-- | <directory-naming-expression>
subtype Name_Info is Info;
type Name_Kinds is (Ada_Simple, Ada_Complex, Naming_Expression,
Id_Prompt, Not_A_Name);
function Name_Kind (Of_Name : Name_Info) return Name_Kinds;
function Segment_Count (Of_Name : Name_Info) return Positive;
function Parent (Of_Name : Name_Info) return Name_Info;
-- Returns the parent of the name
-- Parent ("A.B.C") => "A.B"
-- Parent ("A") => Nil_Info
function Simple_Name (Of_Name : Name_Info) return Name_Info;
-- Returns the simple name of the name
-- Simple_Name ("A.B.C") => "C"
-- Simple_Name ("A") => "A"
-- Numbers : ada number
subtype Number_Info is Info;
type Number_Kinds is (Integer_Literal, Real_Literal, Not_A_Number);
function Number_Kind (Of_Number : Number_Info) return Number_Kinds;
function Value (Of_Integer_Number : Number_Info)
return Long_Integer;
--
-- Returns the integer value for OF_INTEGER_NUMBER.
-- When NUMBER_KIND (OF_INTEGER_NUMBER) /= INTEGER_LITERAL,
-- Long_Integer'First is returned.
function Value (Of_Real_Number : Number_Info) return Float;
--
-- Returns the float value for OF_REAL_NUMBER.
-- When NUMBER_KIND (OF_REAL_NUMBER) /= REAL_LITERAL,
-- Float'First is returned.
-- Associated Arguments : <name> => <info>
function Association_Name (For_Association : Info) return Name_Info;
-- returns NAME_INFOs only.
function Associated_Info (For_Association : Info) return Info;
-- returns any KINDS.
-- Indexed Arguments : <name> <list>
subtype Indexed_Info is Info;
function Indexed_Name (Of_Argument : Indexed_Info) return Name_Info;
-- returns NAME_INFOs only.
function Index_List (Of_Argument : Indexed_Info) return Info_List;
-- returns a list of INFOs of any KINDS.
-------------------------
-- Operations on LISTs --
-------------------------
function Initialize (From_Info : Info) return Info_List;
-- Works on anything;
-- If KIND is LIST, returns a iterator of list components.
-- If KIND is TEXT, examines the TEXT for list delimiters and
-- returns an iterator of those delimited components.
-- delimiters are NEW LINES and commas.
-- If KIND is anything else, returns a list containing the one
-- component, FROM_INFO.
procedure Copy (From : Info_List;
To : out Info_List);
--
-- The entire contents of FROM are copied onto TO regardless of
-- the current 'position' of FROM. The previous contents of
-- TO are lost, and INFOs are not shared between FROM and TO.
procedure Append (An_Info : Info;
To : in out Info_List);
procedure Prepend (An_Info : Info;
To : in out Info_List);
procedure Append (From : Info_List;
To : in out Info_List);
function Length (Of_List : Info_List) return Natural;
--
-- Returns the number of INFOs in OF_LIST. This operation is
-- independent of the current 'position' in the list. When
-- IS_NIL (OF_LIST), 0 is returned.
function Done (On_List : Info_List) return Boolean;
function Value (Of_List : Info_List) return Info;
procedure Next (On_List : in out Info_List);
procedure Reset (A_List : in out Info_List);
function Value_Image (Of_List : Info_List) return String;
-- Image of the current value, equivalent to the call:
-- Argument.Image (Argument.Value (Of_List))
----------------------------------
-- Argument Errors and Warnings --
----------------------------------
procedure Mark_Error (On_Info : Info; Message : String);
procedure Mark_Warning (On_Info : Info; Message : String);
--
-- For marking error or warning messages on a particular arguments,
-- these will show up a underlined/annotated areas in the AOE.
--
-- Raises PDL.FAILED when IS_NIL (ON_INFO) is true OR
-- when ON_INFO is not associated with an Ada image.
----------------------
-- Argument Parsing --
----------------------
procedure Parse (Input : String;
Result : out Info);
--
-- Parses INPUT and produces an argument info in RESULT.
-- Leading and trailing blanks are ignored. When INPUT
-- has syntax errors, PDL.FAILED is raised. STATUS and
-- DIAGNOSIS may be used to obtain additional information
-- about the error.
--
-- NOTE: Since RESULT is not associated with an
-- ADA_PROGRAM.ELEMENT, the result cannot
-- be used in a call to MARK_ERROR or
-- MARK_WARNING.
-- Hide these ...
function Create
(Kind : Kinds;
Image : String;
Use_Heap : System.Segment;
Add_Prompt_Delimiters : Boolean := True) return Info;
-- Creates an argument INFO. If the KIND is OBJECT_NAME the text string
-- is resolved as a fully qualified object name.
-- If the IMAGE is wrong for a particular KIND, FAILED is raised.
-- If the IMAGE string is defaulted, a default INFO (that may not
-- parse) is created.
procedure Parse (Input : String;
Use_Heap : System.Segment;
Result : in out Info);
-- Parse Input and produce an argument Info. Leading and
-- trailing blanks are ignored. Failed will be raised if
-- there is a syntax error in the argument.
-- Note that the result cannot be used to MARK_xxx.
procedure Parse (Associated : Ada_Program.Element;
Argument_Image_Area : Area;
Use_Heap : System.Segment;
Result : in out Info);
-- Parse argument specified by ARGUMENT_IMAGE_AREA in the
-- ASSOCIATED ada program image and produce an argument INFO.
-- Leading and trailing blanks are ignored. FAILED will be raised
-- if there is a syntax error in the argument.
procedure Field_Copy (From_Info : Info;
To_Info : in out Info);
-- If a data type contains an Info and that data type is stored
-- in a segmented heap and a selector on that pointed to object
-- returns an Info, use this to get the Info. It will un-
-- normalize the internal segmented heap pointers.
procedure Field_Copy (From_List : Info_List;
To_List : in out Info_List);
-- If a data type contains an Info_List and that data type is
-- stored in a segmented heap and a selector on that pointed
-- to object returns an Info, use this to get the Info. It
-- will un-normalize the internal segmented heap pointers.
function Debug_Image (Of_Info : Info;
Level : Natural;
Prefix : String;
Expand_Pointers : Boolean) return String;
function Debug_Image (Of_List : Info_List;
Level : Natural;
Prefix : String;
Expand_Pointers : Boolean) return String;
private
type Node_Data (Kind : Kinds);
type Node is access Node_Data;
pragma Segmented_Heap (Node);
type Info is
record
-- True if this is from an Ada unit; False if it is
-- from a string
From_Ada_Unit : Boolean;
-- This field is there if From_Ada_Unit is True
Element : Ada_Program.Element;
-- This field is there if From_Ada_Unit is False
Source : Astring;
-- This is the root of the Info
Tree : Node;
end record;
Nil_Info : constant Info :=
Info'(From_Ada_Unit => False,
Element => Ada_Program.Nil_Element,
Source => null,
Tree => null);
type Info_List is
record
-- True if this is from an Ada unit; False if it is
-- from a string
From_Ada_Unit : Boolean;
-- This field is there if From_Ada_Unit is True
Element : Ada_Program.Element;
-- This field is there if From_Ada_Unit is False
Source : Astring;
-- The number of elements in the list
Length : Natural;
-- First is the start of the list. Current is the
-- current element of the list.
First : Node;
Current : Node;
end record;
Nil_List : constant Info_List :=
Info_List'(From_Ada_Unit => False,
Element => Ada_Program.Nil_Element,
Source => null,
Length => 0,
First => null,
Current => null);
end Argument;
-- Annotation ELEMENTs form the basis for querying and manipulating
-- annotations. Every ELEMENT is 'attached' to a ADA_PROGRAM.ELEMENT
-- (unless the annotation is isolated - separated from all ada
-- constructs by blank lines - or is generated by CREATE).
type Kinds is (Invalid, Keyword, Simple);
type Element is private;
Nil_Element : constant Element;
function Is_Nil (An_Element : Element) return Boolean;
function Is_Attached (The_Annotation : Element) return Boolean;
function Attached_To (The_Annotation : Element)
return Ada_Program.Element;
function Annotation_Area (The_Annotation : Element) return Area;
function Corresponding_Element
(At_Area : Area;
In_Element : Ada_Program.Element) return Element;
--
-- Returns the ELEMENT described by AT_AREA and IN_ELEMENT. When
-- these parameters do not correlate to any element, the NIL_ELEMENT
-- is returned.
procedure Definition (Of_Element : Element;
In_Place : Boolean := False;
Edit : Boolean := False;
Status : in out Errors.Condition);
--
-- Brings up an Ada window on OF_ELEMENT. This operation is
-- intended only for ELEMENTs for which IS_ATTACHED (OF_ELEMENT)
-- is TRUE.
----------------------
-- Query Operations --
----------------------
function Kind (Of_Annotation : Element) return Kinds;
function Image (Of_Annotation : Element) return String;
function Keyword (Of_Annotation : Element) return Keywords;
function Argument_Of (The_Annotation : Element) return Argument.Info;
-- Argument and Keyword are valid only for Keyword
-- kinds of annotations. FAILED is raised otherwise.
-- BAD_ANNOTATION may be raised if the annotation is bogus.
-- Use DIAGNOSE on that annotation to determine what the problem is.
Bad_Annotation : exception;
function Diagnose (An_Annotation : Element) return String;
-- Returns an analysis of a bad annotation or the null string
-- if nothing is wrong.
----------------------
-- Annotation Lists --
----------------------
-- Annotation ELEMENT_LISTs are the obvious. Operations are provided
-- to query and manipulate these lists.
type Element_List is private;
Nil_List : constant Element_List;
-- Assignment on ELEMENT_LISTs DOES NOT CAUSE A COPY TO BE MADE!
-- Use COPY to do that.
procedure Copy (From_List : Element_List;
To_List : in out Element_List);
procedure Add (An_Element : Element; To_List : in out Element_List);
procedure Append (A_List : Element_List; To_List : in out Element_List);
function Done (The_List : Element_List) return Boolean;
function Value (In_List : Element_List) return Element;
procedure Next (In_List : in out Element_List);
procedure Reset (The_List : in out Element_List);
-----------------------------
-- Annotation Manipulation --
-----------------------------
-- The following are operations to query, modify and mark PDL.
-- The mark and modification routines should only be used within
-- the confines of the PDL definition code (toolsmith code
-- registered by the PDL.ANNOTATION.DESCRIPTION generic)
type Positions is (Before, After, Inside, Any);
-- Annotations can live before, after or inside PDL elements.
-- (inside is the same as after if the PDL element doesn't have
-- internal structure, EG. Package specs or subprogram bodies
-- have internal structure while IDs or variable decls don't)
-- FIND and INSERT use the above enumeration to identify areas
-- of interest.
procedure Find (For_Element : Ada_Program.Element;
Result : in out Element_List;
Contains_Bad_Annotations : out Boolean;
Position : Positions := Any);
-- FIND can be used to find any annotations attached to an element.
-- If CONTAINS_BAD_ANNOTATIONS is true, some elements in the list
-- are bad (contain invalid keywords for example), use DIAGNOSE
-- on each list element to figure out which elements are bad.
-- The ATTACHED_TO and ATTACHED_AREA attributes of the annotation
-- element(s) found reflect their positions within the ADA image.
function Create (From_Image : String) return Element;
function Create (From_Keyword : Keywords; With_Argument : Argument.Info)
return Element;
-- These can be used to create an annotation to be attached
-- to an Ada_Program.Element with the Insert call.
-- The ATTACHED_TO and ATTACHED_AREA attributes of the annotation
-- element(s) are nil.
procedure Insert (On_Element : Ada_Program.Element;
An_Annotation : Element;
Position : Positions := Before;
After_Annotation : Element := Nil_Element;
Leading_Blanks : Natural := 0);
procedure Insert (On_Element : Ada_Program.Element;
Annotations : in out Element_List;
Position : Positions := Before;
After_Annotation : Element := Nil_Element;
Leading_Blanks : Natural := 0);
-- For adding annotations to the PDL. Mainly used in COMPLETion.
-- The AFTER_ANNOTATION parameter can be used to indicate where
-- in the image the new annotations are to be inserted. If
-- the parameter is defaulted the new annotation(s) are inserted
-- in such a way that FIND (with the same POSITION parameter)
-- could locate them.
-- If AFTER_ANNOTATION is not nil (and its ATTACHED_TO attribute
-- is also not nil), it must be attached to ON_ELEMENT.
-- POSITION = ANY is the same as the default.
-- LEADING_BLANKS indicates how many blanks to put before the
-- comment indicator ('--').
procedure Mark_Error (On_Annotation : Element;
Message : String;
Mark_Restriction : Area := Default_Area);
procedure Mark_Warning (On_Annotation : Element;
Message : String;
Mark_Restriction : Area := Default_Area);
-- For marking error or warning messages on a particular annotations,
-- these will show up a underlined/annotated areas in the AOE.
\f
------------------------------------------
---- DESCRIPTION REGISTRATION GENERIC ----
------------------------------------------
-----------------------
-- Relevance Vectors --
-----------------------
type Element_Relevance is array (Elements) of Boolean;
type Rule_Relevance is array (Rules) of Boolean;
Nil_Elements : constant Element_Relevance := (others => False);
Nil_Rules : constant Rule_Relevance := (others => False);
generic
Pdl_Name : Pdl_Names;
Pdl_Id : Pdl_Ids;
Allow_Reregistration : Boolean := False;
type Traversal_State is private;
with procedure Get_Elements
(Associated_With : Ada_Program.Element;
State : in out Traversal_State;
Result : out Element_Relevance);
--
-- GET_ELEMENTS is invoked during Semanticize and PDL
-- Completion to determine whether ASSOCIATED_WITH adheres
-- to invariants defined for ELEMENTS in the
-- ELEMENT_DESCRIPTION_FILE. This operation provides the
-- mapping between Ada_Program Elements and the members of
-- the ELEMENTS enumeration. When ASSOCIATED_WITH is not
-- related to a corresponding Design Element, NIL_ELEMENTS should
-- be returned in RESULT.
--
-- This operation is used to perform the automatic insertion
-- of annotations during PDL Completion and for PDL semantic
-- error detection during Semanticize.
--
with procedure Get_Rules
(Associated_With : Ada_Program.Element;
State : in out Traversal_State;
Result : out Rule_Relevance);
--
-- GET_RULES is invoked during Semanticize to determine
-- whether ASSOCIATED_WITH adheres to invariants defined for
-- RULES in the RULE_DESCRIPTION_FILE. This operation
-- provides the mapping between Ada_Program Elements and the
-- members of the RULES enumeration. When ASSOCIATED_WITH
-- is not related to a corresponding Design Rule, NIL_RULES
-- should be returned in RESULT.
--
-- This operation is used to detect Design Rule violations
-- during Semanticize.
--
with procedure Argument_Check (For_Keyword : Keywords;
With_Argument : Argument.Info;
On_Element : Ada_Program.Element;
Status : out Analysis_Status;
Message : out Astring);
--
-- Invoked when a keyword argument is processed and the User_Check
-- bit is set for that keyword after passing the gross syntax
-- type checks. The MESSAGE is displayed in the Message window along
-- with a success/failure message.
--
with procedure Mapping_Link (For_Keyword : Keywords;
With_Argument : Argument.Info;
On_Element : Ada_Program.Element;
Operation : Mapping_Operation;
Parameters : Mapping_Parameters;
Status : out Mapping_Status);
--
-- Invoked on a front door Definition, Enclosing, Explain or
-- Show_Usage where a keyword is selected. The closest
-- Ada_Program.Element 'attached' to the selection is
-- provided for context.
--
with procedure Traversal_Pre_Op
(Current_State : Unit_State;
Goal_State : Unit_State;
Mode : Analysis_Mode;
Phase : in out Phases;
Root_Element : Ada_Program.Element;
Major_Elements_Only : out Boolean;
User_State : out Traversal_State);
--
-- Invoked at the start of PDL Analysis to provide the user with
-- various information about the Ada element to be analyzed and
-- the kind of analysis to be performed. If this information is
-- needed during the subsequent traversal, then the user should
-- store the information in the TRAVERSAL_STATE parameter for
-- subsequent availability.
with procedure Element_Pre_Op
(On_Element : Ada_Program.Element;
User_State : in out Traversal_State;
Control : out Traversal_Control);
with procedure Element_Post_Op
(On_Element : Ada_Program.Element;
User_State : in out Traversal_State;
Control : out Traversal_Control);
with procedure Traversal_Post_Op
(User_State : in out Traversal_State;
Status : out Analysis_Status;
Message : out Astring);
--
-- Invoked upon traversal of an ada program during
-- completion, semanticization, promotion, and demotion.
-- The traversal is depth first and may be controlled by the
-- CONTROL parameter, which determines at what level the
-- traversal should continue. See ADA_PROGRAM.TRAVERSAL_CONTROL
-- for a detailed explanation of the mechanisms for controlling
-- the traversal.
--
-- TRAVERSAL_PRE_OP is called once before traversal starts
-- and may be used to initialize user state.
--
-- TRAVERSAL_POST_OP is called once after the traversal is
-- done. If TRAVERSAL_POST_OP returns STATUS = ERROR or
-- WARNING, then the unit will not be Installed
-- and MESSAGE is displayed on the user's message window.
--
-- If STATUS = ERROR and MODE = SEMANTICIZE, then
-- the semanticize operation is considered a failure.
--
pragma Must_Be_Constrained (Yes => Traversal_State);
package Description is
--------------------------------------
-- Description Types and Operations --
--------------------------------------
-- KEYWORD DESCRIPTION INFORMATION
function Argument_Description
(Of_Keyword : Keywords) return Argument.Description;
procedure Set_Description (Of_Keyword : Keywords;
To : Argument.Description);
--
-- This operation is provided for backward compatibility to
-- previous releases.
-- ELEMENT DESCRIPTION INFORMATION
type Annotation_Presence is (Nil, Forbidden, Optional,
Required, Required_Non_Prompt);
type Presence_Vector is array (Keywords) of Annotation_Presence;
function Presence (Of_Keyword : Keywords;
On_Element : Elements;
At_Phase : Phases) return Annotation_Presence;
function Keyword_Presence
(For_Element : Elements;
At_Phase : Phases) return Presence_Vector;
-- RULE DESCRIPTION INFORMATION
type Rule_Enforcement is (Nil, Forbidden, Required);
function Enforcement (Of_Rule : Rules;
At_Phase : Phases) return Rule_Enforcement;
--------------------------
-- Description Analysis --
--------------------------
procedure Register
(Keyword_Description_File : String;
Element_Description_File : String;
Rule_Description_File : String;
Response : String := "<VERBOSE>");
--
-- REGISTER provides the vehicle for registering the
-- description of Design Elements and Design Rules of a given
-- PDL. This instantiation must be elaborated in order to
-- provide the connection between the Design Facility common
-- commands and the user specified PDL analysis operations.
--
-- The call to an instantiation of DESCRIPTION.REGISTER reads
-- the given Description Files and registers the Keyword,
-- Element, and Rule descriptions with the Design Facility PDL
-- Entry mechanisms.
--
-- If the all of the Description File parameters are the
-- empty string (""), then the NIL enumeral restriction is
-- not enforced. This is provided for backward compatibility
-- with clients which choose not to use the new PDL
-- Description mechanisms.
--
-- If any errors are detected in the Description Files,
-- diagnostic messages are generated into the job log and
-- the exception FAILED is raised. Otherwise, the call does
-- not return.
--
end Description;
--
-- Hide these ...
--
function Create (From_Image : String;
Use_Heap : System.Segment) return Element;
function Create (From_Keyword : Keywords;
With_Argument : Argument.Info;
Use_Heap : System.Segment) return Element;
procedure Field_Copy (From_List : Element_List;
To_List : in out Element_List);
-- if a data type contains an ELEMENT_LIST and that data type is
-- stored in a segmented heap and a selector on that pointed to
-- object returns an ELEMENT_LIST, use this to get the
-- ELEMENT_LIST out, it will un-normalize the internal segmented
-- heap pointers.
package Keyword_Utilities is
function Contains_Keyword (In_String : String) return Boolean;
type Keyword_Status is
(Valid_Keyword, Not_A_Comment, Not_An_Annotation,
Not_A_Keyword, Invalid_Keyword);
procedure Keyword_Value (In_String : String;
Keyword : out Keywords;
Argument_Start : out Natural;
Status : out Keyword_Status);
-- Find the keyword annotation in the string IN_STRING.
-- If a match is found, ARGUMENT_START is set to the char index
-- after the keyword image and KEYWORD is set to the match value.
-- STATUS is set to reflect success or the reason for failure.
-- If INVALID_KEYWORD is detected ARGUMENT_START is left set to
-- the char index of the keyword.
-- If NOT_A_KEYWORD is detected ARGUMENT_START is left set to
-- the char index of the first non-blank characters after the
-- annotation indication (if there are no non-blanks, then
-- IN_STRING'last + 1 is returned).
end Keyword_Utilities;
function Debug_Image (Of_Element : Element;
Level : Natural;
Prefix : String;
Expand_Pointers : Boolean) return String;
function Debug_Image (Of_List : Element_List;
Level : Natural;
Prefix : String;
Expand_Pointers : Boolean) return String;
private
type Element_Data;
type Element is access Element_Data;
pragma Segmented_Heap (Element);
Nil_Element : constant Element := null;
type List_Data;
type List_Data_Pointer is access List_Data;
pragma Segmented_Heap (List_Data_Pointer);
type Element_List is
record
Root, Tail : List_Data_Pointer;
Current : List_Data_Pointer;
end record;
Nil_List : constant Element_List := (null, null, null);
end Annotation;
----- HIDE THESE ...
--
function Debug_Image (Of_Area : Area;
Level : Natural;
Prefix : String;
Expand_Pointers : Boolean) return String;
subtype Pdl_Keys is System.Package_Type;
procedure Kill (Pdl_Key : Pdl_Keys; Status : in out Errors.Condition);
pragma Subsystem (Design_Facility, Closed);
pragma Module_Name (4, 3598);
pragma Bias_Key (27);
private
type Area is new Ada_Text.Area;
Default_Area : constant Area := Area (Ada_Text.Nil_Area);
end Pdl;with Abstract_Document;
package Preview is
procedure Examine (Document_Name : String := "<CURSOR>";
Form : String := "";
In_Place : Boolean := False);
procedure Find (Node : Abstract_Document.Node;
Document_Name : String;
Form : String := "";
In_Place : Boolean := False);
pragma Subsystem (Design_Facility, Closed);
pragma Module_Name (4, 3591);
pragma Bias_Key (27);
end Preview;with Ada_Text;
with Directory_Tools;
with Object_Editor;
with Mapping;
with Ada_Program;
with Document;
package Traversal_Utilities is
----------------------------------------------------------------------------
-- Bring up a window on an object, Highlight a particular element
-- in that object (unless the element IS the object, as in the last call)
-- If the definition fails, and the FAIL_MESSAGE /= NO_MESSAGE the the
-- Message will be put into the message window (with a beep) with a
-- diagnosis for failure appended (in parens).
----------------------------------------------------------------------------
Default_Message : constant String := "Definition Failed ";
No_Message : constant String := "";
procedure Def (On_Element : Ada_Program.Element;
In_Place : Boolean := False;
Edit : Boolean := False;
Success : out Boolean;
Fail_Message : String := Default_Message);
procedure Def (On_Element_List : Ada_Program.Element_List;
In_Place : Boolean := False;
Edit : Boolean := False;
Success : out Boolean;
Fail_Message : String := Default_Message);
procedure Def (On_Document : Document.Element;
In_Place : Boolean := False;
Edit : Boolean := False;
Success : out Boolean;
Fail_Message : String := Default_Message);
procedure Def (On_Document_List : Document.Element_List;
In_Place : Boolean := False;
Edit : Boolean := False;
Success : out Boolean;
Fail_Message : String := Default_Message);
procedure Def (On_Target : Mapping.Target_Info;
In_Place : Boolean := False;
Edit : Boolean := False;
Success : out Boolean;
Fail_Message : String := Default_Message);
-- This operation can be used to obtain selections on arbitrary
-- AREAs of an Ada image. (e.g. Annotations and Arguments)
subtype Area is Ada_Text.Area;
procedure Def (On_Element : Ada_Program.Element;
In_Area : Area;
In_Place : Boolean := False;
Edit : Boolean := False;
Success : out Boolean;
Fail_Message : String := Default_Message);
procedure Cursor_Info (Line, Column : out Natural;
Focus : out Object_Editor.Focus;
Handle : out Directory_Tools.Object.Handle);
function Line_Image (Line : Positive) return String;
pragma Subsystem (Design_Facility, Closed);
pragma Module_Name (4, 3588);
pragma Bias_Key (27);
end Traversal_Utilities;with Action;
with Directory_Tools;
with Diana;
with Errors;
with Ada_Text;
package Ada_Program is
--
-- The use of this system is subject to the software license terms and
-- conditions agreed upon between Rational and the Customer.
--
-- Copyright 1987, 1988, 1989, 1990 by Rational.
--
-- RESTRICTED RIGHTS LEGEND
--
-- Use, duplication, or disclosure by the Government is subject to
-- restrictions as set forth in subdivision (b)(3)(ii) of the Rights in
-- Technical Data and Computer Software clause at 52.227-7013.
--
--
-- Rational
-- 3320 Scott Boulevard
-- Santa Clara, California 95054
--
-- PROPRIETARY AND CONFIDENTIAL INFORMATION OF RATIONAL;
-- USE OR COPYING WITHOUT EXPRESS WRITTEN AUTHORIZATION
-- IS STRICTLY PROHIBITED. THIS MATERIAL IS PROTECTED AS
-- AN UNPUBLISHED WORK UNDER THE U.S. COPYRIGHT ACT OF
-- 1976. CREATED 1987, 1988, 1989, 1990. ALL RIGHTS RESERVED.
--
package Object renames Directory_Tools.Object;
type Element is private;
Nil_Element : constant Element;
-- Ada programs are composed of a hierarchical structure
-- of elements. Operations are defined to determine what
-- kind a particular element is and to decompose elements
-- into sub-elements (children).
--
-- Each element may also have attributes that provide information
-- about that element. For example, all declaration elements will
-- have a name (identifier) associated with them. Certain static
-- expressions may have a value associated with them. Operations
-- are defined to provide this information for specific kinds of
-- elements.
--
-- If a query for a specific attribute is made to an inappropriate
-- kind of element the Inappropriate_Program_Element exception is raised.
--
-- Some elements "make reference to" other elements.
-- Declarations, for example, define named elements.
-- Other elements such as statements and expressions may make
-- reference to declarations.
--
-- Operations are available to find defining elements from
-- the elements that use those definitions.
--
-- All elements have an image, that is, a pretty printing of
-- that fragment of the program. Images of elements other than
-- top level kinds and IDs may not be very meaningful.
-- The images of these elements may be locked, or inaccessible
-- and so these operations may fail.
--
-- Comments may be isolated, adjacent to or attached to an element.
-- Comments that stand alone or are adjacent to an element
-- are generally intended to be related to some program element such
-- as a declaration or statement. This relation must be derived from the
-- convention established in the program using this interface and is not
-- captured in the semantics of this interface.
--
-- Many operations in this interface traverse from one program tree to
-- another. If in this traversal a new Ada object must be opened, the
-- traversal may fail due to a lock or access error. In this case
-- the FAILED exception is raised.
--
-- When an operation fails for any reason (a defined exception
-- propagates out of the operation) the DIAGNOSIS and STATUS calls
-- may be made to find out why the operation failed.
pragma Page;
function Is_Nil (Program_Element : Element) return Boolean;
-- Some program elements have optional attributes or sub-elements.
-- In the case where an attribute or sub-element could, but does
-- does not actually exist, a nil element will be returned.
function Parent (Program_Element : Element) return Element;
-- Returns the immediate parent element of the specified element.
-- If the element is a compilation_unit, (see definition below and
-- package Compilation_Unit) a nil element is returned.
function Line_Number (Of_Element : Element) return Natural;
-- Returns the line number on which the element resides.
-- A nil element returns 0.
-- This operation uses the element's image.
procedure Definition (Of_Element : Element;
In_Place : Boolean := False;
Edit : Boolean := False;
Status : in out Errors.Condition);
--
-- Brings up an Ada object editor on the unit containing OF_ELEMENT.
------------------------------------------------------------------
type Element_Iterator is private; -- A (read only) ordered set of Elements.
Nil_Iterator : constant Element_Iterator;
procedure Next (Iter : in out Element_Iterator);
function Done (Iter : Element_Iterator) return Boolean;
function Value (Iter : Element_Iterator) return Element;
procedure Reset (Iter : in out Element_Iterator);
-- Resets the iterator to the beginning of the list.
------------------------------------------------------------------
type Element_List is private; -- A (read/write) ordered list of Elements.
Nil_List : constant Element_List;
-- Elements lists are used for collecting together lists of elements
-- during traversal.
-- Assignment on LISTs DOES NOT CAUSE A COPY TO BE MADE!
-- Use COPY to do that.
procedure Copy (From_Iter : Element_Iterator; To_List : out Element_List);
procedure Copy (From_List : Element_List; To_List : out Element_List);
-- The entire contents of FROM_xxx is copied regardless of the current
-- 'position' of FROM_xxx or TO_LIST.
-- The contents of TO_LIST are lost.
procedure Append (Program_Element : Element;
To_List : in out Element_List);
procedure Prepend (Program_Element : Element;
To_List : in out Element_List);
procedure Append (From_List : Element_List;
To_List : in out Element_List);
-- Append/Prepend to the end/beginning of TO_LIST. The current position
-- of the list is undefined after these calls.
generic
with function Discard (Program_Element : Element) return Boolean;
procedure Filter (Source_List : Element_List;
Target_List : out Element_List);
generic
with function Discard (Program_Element : Element) return Boolean;
procedure Filter_Iterator (Source_Iterator : Element_Iterator;
Target_List : out Element_List);
procedure Next (List : in out Element_List);
function Done (List : Element_List) return Boolean;
function Value (List : Element_List) return Element;
procedure Reset (List : in out Element_List);
-- Resets the list to the beginning.
procedure Invert (List : in out Element_List);
-- Reverse the ordering of the given element list.
------------------------------------------------------------------
type Traversal_Control is (Continue,
Abandon_Children,
Abandon_Siblings,
Terminate_Immediately);
generic
type State_Record is private;
with procedure Pre_Operation (Program_Element : Element;
State : in out State_Record;
Control : in out Traversal_Control);
with procedure Post_Operation (Program_Element : Element;
State : in out State_Record;
Control : in out Traversal_Control);
procedure Depth_First_Traversal (Root_Element : Element;
State : in out State_Record;
Major_Elements_Only : Boolean := True);
-- Performs a depth-first traversal of Ada_Program elements rooted at
-- the given element. If Major_Elements_Only is True, then only
-- MAJOR Ada_Program elements are visited (see ELEMENT_KINDS enumeration
-- below)
--
-- For each element:
-- The formal procedure Pre_Operation is called when first visiting
-- the element. All sub-elements are then visited and then the
-- Post_Operation procedure is called when returning from visiting all
-- sub_elements. The State variable is passed from call to call.
--
-- Traversal can be controlled with the Control parameter.
-- The Abandon_Children option prevents traversal to the current element's
-- children, but picks up with the next sibling.
-- The Abandon_Sibling option abandons traversal through the
-- remaining siblings but continues traversal at the parent.
-- The Terminate_Immediately option does the obvious.
--
-- NOTES:
-- Abandon_Children in a POST_OPERATION is the same as CONTINUE (all
-- the children have already been visited).
-- Abandon_Siblings in a PRE_OPERATION skips the associated
-- POST_OPERATION.
------------------------------------------------------------------
type Line_Iterator is private;
subtype Line is String;
function Done (Iter : Line_Iterator) return Boolean;
function Value (Iter : Line_Iterator) return Line;
procedure Next (Iter : in out Line_Iterator);
function Image (Program_Element : Element) return Line_Iterator;
-- The image of a program element is made up of some number of lines.
-- Images can be iterated over to get each individual line.
function Image (Program_Element : Element) return String;
-- The image of a program element in a single string. Lines are separated
-- by Ascii.Lf characters.
function Preceding_Comments (An_Element : Element) return Line_Iterator;
function Following_Comments (An_Element : Element) return Line_Iterator;
-- Returns the comments, if any, that appear before or after the specified
-- element (including blank lines) Non blank comment lines include "--"s.
-- This function is appropriate for major elements such as statements,
-- declarations, context clauses, and generally things that can appear on
-- on a line by themselves. If no comments are present, a nil iterator is
-- returned.
function Internal_Comments (An_Element : Element) return Line_Iterator;
-- Returns the comments, if any, that appear attached to the internal
-- structure of an element. Examples of elements that have internal
-- structure are: Package Specs, Procedure Bodies.
function Attached_Comments (An_Element : Element) return Line_Iterator;
-- Returns the comments, if any, that are directly attached to
-- an element. In the case that no comments exist, a "Done"
-- iterator will be returned.
------------------------------------------------------------------
-- MAJOR program elements:
type Element_Kinds is (A_Compilation_Unit,
A_Context_Clause,
A_Declaration,
A_Statement,
A_Pragma,
A_Representation_Clause,
Not_A_Major_Element);
function Kind (Program_Element : Element) return Element_Kinds;
-- Once the KIND of an element is determined, further decomposition
-- or selection can be done by calling functions in the package that
-- deals with a specific element kind. (e.g. the COMPILATION_UNITS
-- package for kind A_COMPILATION_UNIT)
subtype Association is Element;
subtype Choice is Element;
subtype Compilation_Unit is Element;
subtype Context_Clause is Element;
subtype Declaration is Element;
subtype Expression is Element;
subtype Name is Element;
subtype Pragma_Usage is Element;
subtype Representation_Clause is Element;
subtype Statement is Element;
subtype Type_Definition is Element;
subtype Association_Iterator is Element_Iterator;
subtype Choice_Iterator is Element_Iterator;
subtype Compilation_Unit_Iterator is Element_Iterator;
subtype Context_Clause_Or_Pragma_Iterator is Element_Iterator;
subtype Declaration_Or_Context_Clause_Or_Representation_Clause_Or_Pragma_Iterator
is Element_Iterator;
subtype Expression_Iterator is Element_Iterator;
subtype Name_Iterator is Element_Iterator;
subtype Pragma_Iterator is Element_Iterator;
subtype Representation_Clause_Iterator is Element_Iterator;
subtype Statement_Or_Pragma_Iterator is Element_Iterator;
subtype Type_Definition_Iterator is Element_Iterator;
-- Note that some of the iterators can mix items of different major
-- kinds. Their name attempts to convey this information. For
-- instance a declarative part can contain, besides declarations,
-- context clauses (viz. use clauses), representation clauses or
-- pragmas.
------------------------------------------------------------------
-- IDENTIFIERS: -- LRM 2.3
subtype Identifier_Definition is Element;
subtype Identifier_Reference is Element;
-- The image of all Identifier_Definitions and Identifier_References
-- will provide the string name.
type Id_Kinds is (An_Identifier_Definition,
An_Identifier_Reference,
Not_An_Identifier);
function Id_Kind (An_Identifier : Element) return Id_Kinds;
function Definition (Reference : Element; Visible : Boolean := True)
return Identifier_Definition;
-- This call follows the ADA OBJECT EDITOR definition model. The
-- parameter VISIBLE indicates a preference. It may be that the
-- returned definition is not visible.
function Usage (Reference : Element;
Global : Boolean := True;
Limit : String := "<ALL_WORLDS>";
Closure : Boolean := False) return Element_List;
-- This call follows the ADA OBJECT EDITOR show usage model.
function Other_Part (Reference : Element) return Identifier_Definition;
-- Returns the other part of the given reference. If the given
-- reference has no other part, it returns Nil_Element. This call
-- follows the ADA OBJECT EDITOR other part model.
function String_Name (An_Identifier : Element) return String;
------------------------------------------------------------------
-- PROMPTS:
--
subtype Prompt is Element;
function Is_Prompt (An_Element : Element) return Boolean;
type Prompt_Kinds is (An_Alternative_Prompt,
A_Compilation_Unit_Prompt,
A_Context_Clause_Prompt,
A_Declaration_Prompt,
An_Expression_Prompt,
A_Generic_Parameter_Prompt,
An_Identifier_Prompt,
A_Pragma_Prompt,
A_Statement_Prompt,
Not_A_Prompt);
function Prompt_Kind (A_Prompt : Element) return Prompt_Kinds;
------------------------------------------------------------------
package Conversion is
function Normalize (Tree : Diana.Tree) return Element;
-- Given an arbitrary diana tree find the closest corresponding
-- ELEMENT. (This routine may walk UP a diana tree);
function Convert (A_Tree : Diana.Tree) return Element;
function Convert (An_Element : Element) return Diana.Tree;
procedure Register_Action (Action_Id : Action.Id);
-- Once an action is registered, all "opens" will be performed
-- under the specified action. Opens can be implicitly performed
-- when one traverses to definitions located in other objects
-- or if one accesses the element's image.
procedure Close_All_Objects;
--
-- Closes all objects opened by the current job. This operation
-- DOES NOT affect the Actions associated with the current job.
procedure Finish_Action;
-- Closes all objects opened under the previously registered
-- action or under the default action. This operation is similar
-- to CLOSE_ALL_OBJECTS except that the currently registered
-- action is also committed.
-- Construction of iterators:
function Build_Element_Iterator
(Sequence : Diana.Sequence) return Element_Iterator;
function Build_Element_Iterator
(Seq_Type : Diana.Seq_Type) return Element_Iterator;
-- Conversion functions to and from directory object handles and names.
function To_Directory_Object
(Comp_Unit : Compilation_Unit) return Object.Handle;
function To_Compilation_Unit (Directory_Object : Object.Handle;
Action_Id : Action.Id := Action.Null_Id)
return Compilation_Unit;
-- If the default Null_Id is provided, the currently registered
-- action will be used for this and all subsequent opens.
-- If no action has previously been registered, then one will be
-- constructed.
-- If a non-null action is specified it will be used for this open
-- and registered for all subsequent opens.
function Resolve (Element_Name : String)
return Element;
-- Does the best it can to resolve an unambiguous name of an
-- element to it's internal form. See notes below for GET_NAME.
function Resolve (Element_Names : String;
Visible : Boolean := True;
Look_Through_Stubs : Boolean := True)
return Element_List;
--
-- Resolves any name to a list of one or more Ada_Program
-- Elements. This form of RESOLVE behaves in a way similar to
-- COMMON.DEFINITION. When ELEMENT_NAMES resolves to multiple
-- units/declarations, the VISIBLE parameter has no effect. If
-- the name resolves to a subunit, the stub is returned if
-- Look_Through_Stubs is False, and the subunit if it is True.
-- This procedure is declared at the end of this package
-- to maintain compatibility.
--
-- procedure Resolve (Element_Names : String;
-- Result : out Element_List;
-- Status : in out Errors.Condition;
-- Context : Directory_Tools.Naming.Context :=
-- Directory_Tools.Naming.Default_Context;
-- Objects_Only : Boolean := False);
--
-- Resolves (ambiguous) naming expression in the given context.
-- This operation is similar in behavior to
-- Directory_Tools.Naming.Resolution'N(2). If Objects_Only is
-- true, only library level objects that match the name will be
-- included; when false, Ada_Program Elements will be included
-- in RESULT even if no separate directory object is associated
-- with them.
function Get_Name (Of_Element : Element) return String;
-- Does the best it can to give a fully resolved name of the
-- element, this works well for declarations and comp_units but
-- may not give useful results for other kinds of elements.
-- If it succeeds, the string may be used in RESOLVE to convert back
-- to the originating ELEMENT
------------------------------------
function Handle_Of (The_Element : Element) return Ada_Text.Handle;
-- Returns the currently open handle for the Ada image containing
-- THE_ELEMENT. If no handle exists, one will be opened and
-- future calls will return that handle.
-- ELEMENTs cannot be stored in permanent objects
-- like files. Use the following operations to generate an external
-- representation that can be saved and converted.
type Element_Permanent_Representation is new String;
function Convert (An_Element : Element;
Within : String := "<SUBSYSTEM>")
return Element_Permanent_Representation;
-- The WITHIN parameter specifies how fully qualified the
-- representation is (or should be resolved). When converting from
-- an element to a permanent representation, the values can be :
-- <FULL> - The element's fully qualified resolution is
-- returned.
-- <SUBSYSTEM> - The resolution of the element is subsystem
-- relative. Subsystem name and spec or load origin
-- is preserved.
-- <VIEW> - The resolution of the element is view relative.
-- No origin information is preserved.
--
-- Storage for <SUBSYSTEM> or <VIEW> representation are less than
-- <FULL> but some origin information is lost.
--
procedure Convert (An_Element_Rep : Element_Permanent_Representation;
Result : out Element;
Status : in out Errors.Condition;
Within : String := "<DEFAULT>");
-- When converting from a permanent representation to an element,
-- an attempt is made to fill in any missing information in the
-- permanent representation from the WITHIN parameter. So, in all
-- cases, if the permanent representation was FULLy resolved the
-- WITHIN parameter is ignored, otherwise :
-- <DEFAULT> - For <SUBSYSTEM>, the view selected by
-- the current activity for the stored subsystem is
-- used as the origin. The spec or load origin of the
-- representation is used to pick the specific view.
-- For <VIEW>, the current view context is used as
-- the origin.
-- subsystem name - For <SUBSYSTEM>, same as <DEFAULT>.
-- For <VIEW>, the view selected by the current
-- activity for the specified subsystem is used.
-- The subsystem name can be followed by "'SPEC" or
-- "'LOAD" to force use of the spec view or load
-- view from the activity. (Defaults to Spec View)
-- view name - For <SUBSYSTEM>, if the subsystem containing the
-- specified view matches the representation's
-- subsystem, the specified view is used.
-- If no match, same as <DEFAULT>.
-- For <VIEW> the specified view is used.
function Unique_Id (For_Element : Element) return Long_Integer;
-- Generates a unique number for any element.
-- Useful for building maps for elements.
-- This procedure is provided here to maintain compatibility.
--
procedure Resolve (Element_Names : String;
Result : out Element_List;
Status : in out Errors.Condition;
Context : Directory_Tools.Naming.Context :=
Directory_Tools.Naming.Default_Context;
Objects_Only : Boolean := False);
--
-- Resolves (ambiguous) naming expression in the given context.
-- This operation is similar in behavior to
-- Directory_Tools.Naming.Resolution'N(2). If Objects_Only is
-- true, only library level objects that match the name will be
-- included; when false, Ada_Program Elements will be included
-- in RESULT even if no separate directory object is associated
-- with them.
end Conversion;
Inappropriate_Program_Element : exception;
-- Raised when an operation is applied to an inappropriate
-- program element.
-- Use the DIAGNOSIS or STATUS calls to get more info.
Failed : exception;
-- Catch-all exception raised when an operation fails for reasons other
-- than the above inappropriate element reason.
-- Use the DIAGNOSIS or STATUS calls to get more info.
function Diagnosis return String;
function Status return Errors.Condition;
-- Whenever an error condition is detected (and exception is raised)
-- a diagnostic message/status is stored. These functions retrieve the
-- diagnostic for the most recent error.
-- The following provide debugger image functions for the
-- private types defined in this package.
function Debug_Image (Of_Element : Element;
Level : Natural;
Prefix : String;
Expand_Pointers : Boolean) return String;
function Debug_Image (Of_Iterator : Element_Iterator;
Level : Natural;
Prefix : String;
Expand_Pointers : Boolean) return String;
function Debug_Image (Of_List : Element_List;
Level : Natural;
Prefix : String;
Expand_Pointers : Boolean) return String;
function Debug_Image (Of_Lines : Line_Iterator;
Level : Natural;
Prefix : String;
Expand_Pointers : Boolean) return String;
--
-- Hide these interfaces ...
--
procedure Field_Copy (From_List : Element_List;
To_List : in out Element_List);
-- if a data type contains a LIST and that data type is
-- stored in a segmented heap and a selector on that pointed
-- to object returns a LIST, use this to get the LIST out, it
-- will un-normalize the internal segmented heap pointers.
pragma Subsystem (Design_Facility, Closed);
pragma Module_Name (4, 3570);
pragma Bias_Key (27);
private
type Element is new Diana.Tree;
Nil_Element : constant Element := Element (Diana.Empty);
-- ELEMENT_ITERATORs are read only
type Iterator_Kinds is (Sequence, Seq_Type);
type Element_Iterator is
record
Kind : Iterator_Kinds;
Sequence_Root, Sequence_Current : Diana.Sequence;
Seq_Type_Root, Seq_Type_Current : Diana.Seq_Type;
end record;
Nil_Iterator : constant Element_Iterator :=
Element_Iterator'(Kind => Sequence,
Sequence_Root => Diana.Sequence'(Diana.Make),
Sequence_Current => Diana.Sequence'(Diana.Make),
Seq_Type_Root => Diana.Seq_Type'(Diana.Make),
Seq_Type_Current => Diana.Seq_Type'(Diana.Make));
-- ELEMENT_LISTs are read/write
type Element_List is
record
First, Current, Last : Diana.Temp_Seq;
end record;
Nil_List : constant Element_List :=
Element_List'(First => Diana.Temp_Seq'(Diana.Make),
Current => Diana.Temp_Seq'(Diana.Make),
Last => Diana.Temp_Seq'(Diana.Make));
type Line_Iterator is new Ada_Text.Iterator;
end Ada_Program;with Ada_Program;
package Associations is
--
-- The use of this system is subject to the software license terms and
-- conditions agreed upon between Rational and the Customer.
--
-- Copyright 1987, 1988, 1989, 1990 by Rational.
--
-- RESTRICTED RIGHTS LEGEND
--
-- Use, duplication, or disclosure by the Government is subject to
-- restrictions as set forth in subdivision (b)(3)(ii) of the Rights in
-- Technical Data and Computer Software clause at 52.227-7013.
--
--
-- Rational
-- 3320 Scott Boulevard
-- Santa Clara, California 95054
--
-- PROPRIETARY AND CONFIDENTIAL INFORMATION OF RATIONAL;
-- USE OR COPYING WITHOUT EXPRESS WRITTEN AUTHORIZATION
-- IS STRICTLY PROHIBITED. THIS MATERIAL IS PROTECTED AS
-- AN UNPUBLISHED WORK UNDER THE U.S. COPYRIGHT ACT OF
-- 1976. CREATED 1987, 1988, 1989, 1990. ALL RIGHTS RESERVED.
--
-- LRM 3.7.2, 6.4.1 and 12.3
-- This package provides operations on argument associations,
-- generic associations and parameter associations.
-- Local Renamings:
subtype Association is Ada_Program.Association;
subtype Identifier_Definition is Ada_Program.Identifier_Definition;
subtype Name_Expression is Ada_Program.Expression;
-------------------------------------------------------------------
type Association_Kinds is (Named_Association,
Positional_Association,
Defaulted,
Not_An_Association);
function Association_Kind
(An_Association : Association) return Association_Kinds;
-- Returns the kind of an association.
function Formal_Parameter (An_Association : Association)
return Identifier_Definition;
-- Returns the identifier of the formal name for the given
-- association. This function tries hard to return an identifier
-- definition. However, in the case of a pragma argument, only a
-- reference can be returned.
function Actual_Parameter
(An_Association : Association) return Name_Expression;
-- Returns the actual name or expression for the given association.
pragma Subsystem (Design_Facility, Closed);
pragma Module_Name (4, 3578);
pragma Bias_Key (27);
end Associations;with Ada_Program;
package Compilation_Units is
--
-- The use of this system is subject to the software license terms and
-- conditions agreed upon between Rational and the Customer.
--
-- Copyright 1987, 1988, 1989, 1990 by Rational.
--
-- RESTRICTED RIGHTS LEGEND
--
-- Use, duplication, or disclosure by the Government is subject to
-- restrictions as set forth in subdivision (b)(3)(ii) of the Rights in
-- Technical Data and Computer Software clause at 52.227-7013.
--
--
-- Rational
-- 3320 Scott Boulevard
-- Santa Clara, California 95054
--
-- PROPRIETARY AND CONFIDENTIAL INFORMATION OF RATIONAL;
-- USE OR COPYING WITHOUT EXPRESS WRITTEN AUTHORIZATION
-- IS STRICTLY PROHIBITED. THIS MATERIAL IS PROTECTED AS
-- AN UNPUBLISHED WORK UNDER THE U.S. COPYRIGHT ACT OF
-- 1976. CREATED 1987, 1988, 1989, 1990. ALL RIGHTS RESERVED.
--
-- LRM 10.1
--
-- Compilation units are composed of two distinct parts:
-- A context clause part and a declarative part.
-- The context clause part may contain actual context clauses
-- (with and use clauses) and pragmas.
-- The declaration associated with a compilation unit can either
-- be a package, procedure, function, or subunit.
-- Local Renamings:
subtype Compilation_Unit is Ada_Program.Compilation_Unit;
subtype Context_Clause is Ada_Program.Context_Clause;
subtype Declaration is Ada_Program.Declaration;
subtype Context_Clause_Or_Pragma_Iterator is
Ada_Program.Context_Clause_Or_Pragma_Iterator;
subtype Name_Iterator is Ada_Program.Name_Iterator;
subtype Pragma_Iterator is Ada_Program.Pragma_Iterator;
---------------------------------------------------------------
function Unit_Declaration
(A_Compilation_Unit : Compilation_Unit) return Declaration;
-- Returns the package, procedure, or function declaration of the
-- compilation unit. (Library and Secondary units as defined in the
-- LRM. The operations on declarations can be used to further
-- decompose these elements.
function Context_Clause_Elements (Of_Compilation_Unit : Compilation_Unit)
return Context_Clause_Or_Pragma_Iterator;
-- Returns a list of context clauses and pragmas that
-- reside in the context part of the compilation unit.
-- Context clauses are made up of one or more unit references.
--
-- ie with Bar; -- has one unit reference
-- use Foo, Bar; -- has two named unit references
--
-- All context clauses have an Image but only their elements
-- have a name.
type Context_Clause_Kinds is
(A_With_Clause, A_Use_Clause, Not_A_Context_Clause);
function Context_Clause_Kind
(A_Context_Clause : Context_Clause) return Context_Clause_Kinds;
function Referenced_Units
(A_Context_Clause : Context_Clause) return Name_Iterator;
-- Returns a list of identifier references in a context clause
function Parent_Compilation_Unit (Of_Program_Element : Ada_Program.Element)
return Compilation_Unit;
-- Returns the compilation unit that contains a particular
-- program element. If the PROGRAM_ELEMENT in question is a
-- compilation unit then this is an identity function.
function Is_Subunit (A_Compilation_Unit : Compilation_Unit) return Boolean;
-- Returns true if the compilation unit is a package, subprogram, or task
-- subunit.
function Subunit_Parent (Of_Subunit : Compilation_Unit)
return Compilation_Unit;
-- Returns the compilation unit that is the parent unit of the subunit.
function Body_Stub (Of_Subunit : Compilation_Unit) return Declaration;
-- Returns the subunit declaration in the parent.
function Attached_Pragmas
(To_Compilation_Unit : Compilation_Unit) return Pragma_Iterator;
-- Returns the list of pragmas attached to a compilation unit. Only
-- those pragmas that follow the compilation unit are returned here.
-- Pragmas that precede the compilation unit are part of the context
-- clause.
function Is_Main_Program
(Procedure_Or_Function : Compilation_Unit) return Boolean;
-- Returns true if the unit has a pragma Main attached.
subtype Name_Expression is Ada_Program.Expression;
function Parent_Unit_Name
(Of_Subunit : Compilation_Unit) return Name_Expression;
-- Returns a name expression describing the parent unit.
pragma Subsystem (Design_Facility, Closed);
pragma Module_Name (4, 3571);
pragma Bias_Key (27);
end Compilation_Units;with Ada_Program;
package Declarations is
--
-- The use of this system is subject to the software license terms and
-- conditions agreed upon between Rational and the Customer.
--
-- Copyright 1987, 1988, 1989, 1990 by Rational.
--
-- RESTRICTED RIGHTS LEGEND
--
-- Use, duplication, or disclosure by the Government is subject to
-- restrictions as set forth in subdivision (b)(3)(ii) of the Rights in
-- Technical Data and Computer Software clause at 52.227-7013.
--
--
-- Rational
-- 3320 Scott Boulevard
-- Santa Clara, California 95054
--
-- PROPRIETARY AND CONFIDENTIAL INFORMATION OF RATIONAL;
-- USE OR COPYING WITHOUT EXPRESS WRITTEN AUTHORIZATION
-- IS STRICTLY PROHIBITED. THIS MATERIAL IS PROTECTED AS
-- AN UNPUBLISHED WORK UNDER THE U.S. COPYRIGHT ACT OF
-- 1976. CREATED 1987, 1988, 1989, 1990. ALL RIGHTS RESERVED.
--
-- LRM Chapter 3
-- Local Renaming:
subtype Compilation_Unit is Ada_Program.Compilation_Unit;
subtype Declaration is Ada_Program.Declaration;
subtype Expression is Ada_Program.Expression;
subtype Name_Expression is Ada_Program.Name;
subtype Statement is Ada_Program.Statement;
subtype Type_Definition is Ada_Program.Type_Definition;
subtype Association_Iterator is Ada_Program.Association_Iterator;
subtype Declarative_Part_Iterator is
Ada_Program.
Declaration_Or_Context_Clause_Or_Representation_Clause_Or_Pragma_Iterator;
---------------------------------------------------------------
type Declaration_Kinds is (A_Variable_Declaration,
A_Constant_Declaration,
A_Deferred_Constant_Declaration,
An_Integer_Number_Declaration,
A_Real_Number_Declaration,
A_Type_Declaration,
An_Incomplete_Type_Declaration,
A_Subtype_Declaration,
A_Package_Declaration,
A_Package_Body_Declaration,
A_Procedure_Declaration,
A_Procedure_Body_Declaration,
A_Function_Declaration,
A_Function_Body_Declaration,
A_Package_Rename_Declaration,
A_Procedure_Rename_Declaration,
A_Function_Rename_Declaration,
An_Object_Rename_Declaration,
An_Exception_Rename_Declaration,
A_Generic_Package_Declaration,
A_Generic_Procedure_Declaration,
A_Generic_Function_Declaration,
A_Package_Instantiation,
A_Procedure_Instantiation,
A_Function_Instantiation,
A_Task_Declaration,
A_Task_Body_Declaration,
A_Task_Type_Declaration,
An_Entry_Declaration,
An_Exception_Declaration,
A_Procedure_Subunit,
A_Function_Subunit,
A_Package_Subunit,
A_Task_Subunit,
A_Subprogram_Formal_Parameter,
A_Generic_Formal_Parameter,
A_Discriminant,
A_Record_Component,
Not_A_Declaration);
function Kind (A_Declaration : Declaration) return Declaration_Kinds;
subtype Object_Declaration is Declaration; -- LRM 3.2.1
subtype Type_Declaration is Declaration; -- LRM 3.3.1
subtype Subtype_Declaration is Declaration; -- LRM 3.3.2
subtype Package_Declaration is Declaration; -- LRM 7.1
subtype Procedure_Declaration is Declaration; -- LRM 6.1
subtype Function_Declaration is Declaration; -- LRM 6.1
subtype Task_Declaration is Declaration; -- LRM 9.1
subtype Task_Specification is Type_Definition; -- LRM 9.2
subtype Entry_Declaration is Declaration; -- LRM 9.5
subtype Exception_Declaration is Declaration; -- LRM 11.1
function Is_Visible (A_Declaration : Declaration) return Boolean;
-- Returns True for units that are library level package or subprogram
-- specs, and for declarations inside library level package specs.
function Is_In_Private_Part (A_Declaration : Declaration) return Boolean;
-- Returns true is the declaration appears in the private part
-- of a package.
function Is_Generic_Formal (Element : Ada_Program.Element) return Boolean;
-- Returns true if a subprogram, type or object declaration is
-- a generic formal parameter or was derived from the GENERIC_PARAMETERS
-- selector.
function Is_Subprogram_Formal
(Element : Ada_Program.Element) return Boolean;
-- Returns true if the element was derived from the
-- SUBPROGRAM_PARAMETERS selector.
function Identifiers (A_Declaration : Declaration)
return Ada_Program.Element_List;
-- Returns a list of the identifier(s) introduced by the declaration.
function Name (A_Declaration : Declaration) return String;
-- Returns the identifier(s) image. Basically the same as calling
-- ADA_PROGRAM.STRING_NAME on the result of IDENTIFIERS for a
-- declaration.
function Enclosing_Declaration
(Element : Ada_Program.Element) return Declaration;
-- Returns the enclosing declaration for any element.
-- NOTE: This is the identity function if given a declaration.
---------------------------------------------------------------
-- OBJECT DECLARATIONS - LRM 3.2.1
-- The following operations apply to object declarations, component
-- declarations and discriminant specifications.
function Is_Initialized (Object_Decl : Object_Declaration) return Boolean;
-- Determines whether the object declaration includes an initial
-- value.
function Initial_Value (Object_Decl : Object_Declaration) return Expression;
-- Returns the optional expression that initializes an object or number
-- declaration, NIL_ELEMENT is otherwise returned.
function Object_Type (Object_Declaration_Or_Id : Object_Declaration)
return Type_Definition;
-- Returns the subtype indication following the colon in the object
-- declaration. This function will take either a declaration element
-- or identifier definition associated with the declaration.
function Type_Mark (Subprogram_Formal_Or_Deferred_Constant : Declaration)
return Name_Expression;
-- Returns the type mark associated with Subprogram Formal
-- parameters and Deferred Constants. Selectors in
-- NAMES_AND_EXPRESSIONS can then be used to extract more information.
-----------------------------------------------------------------
-- TYPE DECLARATIONS - LRM 3.3
function Is_Private (Type_Decl : Type_Declaration) return Boolean;
function Is_Limited (Type_Decl : Type_Declaration) return Boolean;
function Is_Incomplete (Type_Decl : Type_Declaration) return Boolean;
function Type_Specification
(Type_Declaration_Or_Id : Declaration) return Type_Definition;
-- Returns the type definition for a given type or subtype declaration
-- or the identifier definition associated with the declaration.
-- See the enumeration TYPE_INFORMATION.TYPE_DEFINITION_KINDS for
-- the various kinds of type definitions.
function Full_Type_Declaration
(Type_Declaration_Or_Id : Declaration) return Type_Declaration;
-- Given the declaration of an incomplete type, returns the
-- corresponding full type declaration. A nil element is returned
-- if the full type declaration is not yet compiled. NOTE: this is
-- the identity function if given a non-incomplete type declaration.
---------------------------------------------------------------
-- PROGRAM UNIT DECLARATIONS
-- LRM Chapters 5, 6, 9
-- Program units are package, subprogram, and task specifications
-- and bodies.
function Is_Spec (Program_Unit : Declaration) return Boolean;
-- Determines whether a package, procedure, function, or task
-- is a specification.
function Is_Package (A_Declaration : Declaration) return Boolean;
function Is_Task (A_Declaration : Declaration) return Boolean;
function Is_Procedure (A_Declaration : Declaration) return Boolean;
function Is_Function (A_Declaration : Declaration) return Boolean;
function Is_Subprogram (A_Declaration : Declaration) return Boolean;
-- Determines if a declaration is a particular kind of program unit
-- declaration regardless if it is generic, an instantiation, rename,
-- spec or body.
function Specification (Decl_Or_Id : Declaration) return Declaration;
-- Returns the specification of a program unit declaration or identifier.
-- If a specification is provided the same element is returned. If no
-- specification exists a nil element is returned.
function Unit_Body (Decl_Or_Id : Declaration) return Declaration;
-- Returns the body for a given program unit declaration or identifier
-- definition associated with the declaration. If a body is input,
-- the same element is returned. If no body exists a nil element is
-- returned. If a stub is given, the subunit is returned.
---------------------------------------------------------------
-- PACKAGES
-- LRM Chapter 7
function Visible_Part_Declarations
(Package_Specification : Package_Declaration)
return Declarative_Part_Iterator;
-- Returns a list of all declarations, representation
-- specifications, and pragmas in the visible part of a package in
-- the order of appearance. When applied to a package
-- instantiation, this operation yields the instance's visible
-- declarations.
function Private_Part_Declarations
(Package_Specification : Package_Declaration)
return Declarative_Part_Iterator;
-- Returns a list of all declarations, representation
-- specifications, and pragmas in the private part of the package in
-- order of appearance. When applied to a package instantiation,
-- this operation yields the instance's private declarations.
function Package_Body_Block
(Package_Body : Package_Declaration) return Statement;
-- Returns the block statement for a package body including
-- the declarative part, any elaboration statements, and
-- exception handler if any. The selectors for blocks in STATEMENTS
-- can then be used for further decomposition.
---------------------------------------------------------------
-- SUBPROGRAMS
subtype Subprogram_Formal_Parameter is Ada_Program.Element;
subtype Subprogram_Formal_Parameter_Iterator is
Ada_Program.Element_Iterator;
type Subprogram_Parameter_Kinds is (Default_In_Parameter, In_Parameter,
Out_Parameter,
In_Out_Parameter,
Not_A_Parameter);
function Subprogram_Parameter_Kind
(Of_Parameter : Subprogram_Formal_Parameter)
return Subprogram_Parameter_Kinds;
function Subprogram_Parameters (Subprogram_Or_Entry : Declaration)
return Subprogram_Formal_Parameter_Iterator;
-- Returns an ordered list of formal parameter declarations.
-- Use IS_INITIALIZED and INITIAL_VALUE to query
-- the information related to the presence of the default parameter
-- initialization, and use TYPE_MARK to obtain the parameter type mark.
-- When applied to a subprogram instantiation, this operation yields
-- the instance's parameters.
function Return_Type (Of_Function : Function_Declaration)
return Name_Expression;
-- Returns the name expression of the return type, selectors in
-- NAMES_AND_EXPRESSIONS can then be used to extract more information.
-- When applied to a function instantiation, this operation yields
-- the instance's return type.
function Is_Operator_Definition
(Function_Declaration : Declaration) return Boolean;
function Subprogram_Block (Subprogram_Body : Declaration) return Statement;
-- Returns the block statement for the body including
-- the declarative part, any elaboration statements, and
-- exception handler if any. The selectors for blocks in STATEMENTS
-- can then be used for further decomposition.
---------------------------------------------------------------
-- RENAMINGS
-- LRM Chapter 8.5
function Is_Renaming_Declaration
(A_Declaration : Declaration) return Boolean;
function Renamed_Name (A_Declaration : Declaration) return Name_Expression;
-- Returns the name of the entity being renamed. It can be a simple
-- name, an operator symbol, an indexed component, a slice, a
-- selected component or an attribute.
function Renamed_Declaration
(A_Declaration : Declaration) return Declaration;
-- If applied to the renaming of a simple name, an operator symbol
-- or an expanded name, returns the name's declaration. Returns nil
-- element otherwise. Use of this function is discouraged.
---------------------------------------------------------------
-- GENERIC PACKAGE and SUBPROGRAM SPECIFICATIONS
-- LRM Chapter 12
function Is_Generic
(Package_Or_Subprogram_Decl : Declaration) return Boolean;
subtype Generic_Formal_Parameter is Ada_Program.Element;
subtype Generic_Formal_Parameter_Or_Pragma_Iterator is
Ada_Program.Element_Iterator;
type Generic_Parameter_Kinds is (Subprogram,
Object,
Private_Type,
Limited_Private_Type,
Discrete_Type,
Integer_Type,
Floating_Point_Type,
Fixed_Point_Type,
Array_Type,
Access_Type,
Not_A_Generic_Parameter);
function Generic_Parameter_Kind
(Generic_Parameter : Generic_Formal_Parameter)
return Generic_Parameter_Kinds;
function Generic_Parameters
(Generic_Decl : Declaration)
return Generic_Formal_Parameter_Or_Pragma_Iterator;
-- Returns a list of formal parameters to the generic in order of
-- appearance.
-- Object parameters can be decomposed with subprogram formal parameter
-- and object declaration operations.
-- Array and access type declarations can be decomposed with the
-- operations corresponding to their types.
-- Subprogram parameters can be queried by the following operations and
-- can be further decomposed with subprogram declaration operations.
type Generic_Formal_Subprogram_Default_Kinds is
(Box, Name, None, Not_A_Generic_Formal_Subprogram);
function Generic_Formal_Subprogram_Default_Kind
(A_Generic_Formal_Subprogram : Generic_Formal_Parameter)
return Generic_Formal_Subprogram_Default_Kinds;
function Generic_Formal_Subprogram_Default
(A_Generic_Formal_Subprogram : Generic_Formal_Parameter)
return Name_Expression;
function Is_Generic_Instantiation
(Package_Or_Subprogram_Decl : Declaration) return Boolean;
function Generic_Unit_Declaration
(Generic_Instantiation_Or_Unit_Declaration : Declaration)
return Declaration;
-- Returns the declaration of the generic unit being instantiated.
function Generic_Instantiation_Parameters
(Generic_Instantiation : Declaration)
return Association_Iterator;
-- Returns an ordered list of parameter associations of a generic
-- instantiation. The operations defined in package ASSOCIATIONS
-- can be used to decompose them.
function Generic_Actual_Parameters (Generic_Instantiation : Declaration)
return Association_Iterator
renames Generic_Instantiation_Parameters;
-- Use of this form is discouraged.
---------------------------------------------------------------
-- TASK DECLARATIONS
-- LRM Chapter 9
function Task_Type_Specification
(Task_Decl : Task_Declaration) return Task_Specification;
-- Returns a task specification for a given task declaration.
function Entry_Declarations (Task_Decl : Task_Declaration)
return Declarative_Part_Iterator;
-- Returns a list of entry declarations associated with a TASK declaration.
function Task_Body_Block (Task_Body : Task_Declaration) return Statement;
-- Returns the block statement for the body including
-- the declarative part, any elaboration statements, and
-- exception handler if any.
---------------------------------------------------------------
-- ENTRY DECLARATIONS
-- LRM Chapter 9.5
-- The operations available for decomposing subprograms will
-- also work for entry declarations.
subtype Family_Index_Range is Ada_Program.Element;
function Family_Index (Entry_Family : Entry_Declaration)
return Family_Index_Range;
-- Returns the index range for the entry family. If the entry is not
-- a family, a nil element is returned.
-- Use operations on discrete ranges in TYPE_INFORMATION to analyze
-- the family index range.
---------------------------------------------------------------
-- EXCEPTION DECLARATIONS
-- LRM Chapter 11
-- The selector IDENTIFIERS can be used to get a list of identifier
-- definitions introduced by an exception declaration.
---------------------------------------------------------------
-- SUBUNIT STUBS
-- LRM Chapter 10.2
function Subunit (Of_Body_Stub : Declaration) return Compilation_Unit;
-- Returns the compilation unit corresponding to the subunit stub.
pragma Subsystem (Design_Facility, Closed);
pragma Module_Name (4, 3572);
pragma Bias_Key (27);
end Declarations;with Ada_Program;
package Names_And_Expressions is
--
-- The use of this system is subject to the software license terms and
-- conditions agreed upon between Rational and the Customer.
--
-- Copyright 1987, 1988, 1989, 1990 by Rational.
--
-- RESTRICTED RIGHTS LEGEND
--
-- Use, duplication, or disclosure by the Government is subject to
-- restrictions as set forth in subdivision (b)(3)(ii) of the Rights in
-- Technical Data and Computer Software clause at 52.227-7013.
--
--
-- Rational
-- 3320 Scott Boulevard
-- Santa Clara, California 95054
--
-- PROPRIETARY AND CONFIDENTIAL INFORMATION OF RATIONAL;
-- USE OR COPYING WITHOUT EXPRESS WRITTEN AUTHORIZATION
-- IS STRICTLY PROHIBITED. THIS MATERIAL IS PROTECTED AS
-- AN UNPUBLISHED WORK UNDER THE U.S. COPYRIGHT ACT OF
-- 1976. CREATED 1987, 1988, 1989, 1990. ALL RIGHTS RESERVED.
--
-- LRM Chapter 4
-- This chapter contains operations for manipulating names and
-- expressions.
-- Local Renamings:
subtype Declaration is Ada_Program.Declaration;
subtype Expression is Ada_Program.Expression;
subtype Name_Expression is Ada_Program.Name;
subtype Name is Ada_Program.Name;
subtype Subtype_Indication is Ada_Program.Element;
subtype Type_Definition is Ada_Program.Type_Definition;
subtype Association_Iterator is Ada_Program.Association_Iterator;
subtype Choice_Iterator is Ada_Program.Choice_Iterator;
subtype Expression_Iterator is Ada_Program.Expression_Iterator;
---------------------------------------------------------------------
function Expression_Type
(An_Expression : Expression) return Type_Definition;
-- Returns the type specification for the expression.
type Expression_Kinds is
(A_Simple_Name, An_Operator_Symbol, -- LRM 4.1
An_Indexed_Component, -- LRM 4.1.1
A_Slice, -- LRM 4.1.2
A_Selected_Component, -- LRM 4.1.3
An_Attribute, -- LRM 4.1.4
A_Character_Literal, An_Integer_Literal, A_Real_Literal,
An_Enumeration_Literal, A_Null_Literal, A_String_Literal,-- LRM 4.2
An_Aggregate, -- LRM 4.3
A_Type_Conversion, -- LRM 4.6
A_Qualified_Expression, -- LRM 4.7
An_Allocator, -- LRM 4.8
A_Complex_Expression, -- LRM 4.4/5
A_Function_Call,
Not_An_Expression);
function Kind (An_Expression : Expression) return Expression_Kinds;
function Is_Constant (A_Name : Name) return Boolean;
-- Returns True if the given name is constant. The name must be
-- of a syntactic form suitable for the left hand side of an
-- assignment (ie. not an attribute, a character, etc.).
function Is_Static (An_Expression : Expression) return Boolean;
function Static_Value
(An_Integer_Expression : Expression) return Long_Integer;
function Static_Value
(A_Character_Expression : Expression) return Character;
function Static_Value (A_Real_Expression : Expression) return Float;
function Static_Value (A_String_Expression : Expression) return String;
-- Note that STATIC_VALUE for strings will not return the quotes around
-- a string literal.
function Used_Names (An_Expression : Expression)
return Ada_Program.Element_List;
-- Returns a list of names of objects/types and operators in an expression.
-- EG. the expression (A + B.D (Q'(4))) would return the list :
-- A : A_SIMPLE_NAME
-- + : AN_OPERATOR_SYMBOL
-- B.D : A_SELECTED_COMPONENT
-- Q : A_SIMPLE_NAME
-- 4 : A_NUMERIC_LITERAL
---------------------------------------------------------------------
-- NAMES LRM 4.1
--
-- Simple_Names and operator symbols are instances of identifier references
-- The Ada_program.Definition function will return the defining Id.
subtype Discrete_Range is Ada_Program.Element;
function Prefix (Of_Name : Name) return Name;
-- Returns the prefix (the construct to the left of the rightmost
-- left paren in indexed or sliced objects, the rightmost 'dot' for
-- selected components or the rightmost tick for attributes).
-- LRM 4.1.1 -- Array component
function Index_Expressions (An_Indexed_Component : Name)
return Expression_Iterator;
-- Returns a list of expressions (possibly only one) within the parens.
-- LRM 4.1.2
function Slice_Range (A_Slice : Name) return Discrete_Range;
-- LRM 4.1.3
type Selection_Kinds is (Record_Discriminant, -- LRM 4.1.3 (a)
Record_Component, -- LRM 4.1.3 (b)
Task_Entry, -- LRM 4.1.3 (c)
Access_Object, -- LRM 4.1.3 (d)
Expanded_Name -- LRM 4.1.3 (e,f)
);
function Selection_Kind (Selected_Component : Name) return Selection_Kinds;
function Selector (Selected_Component : Name) return Name;
-- Returns the selector (the construct to the right of the rightmost
-- 'dot' in the selected component). Fails on selections of kind
-- Access_Object.
-- LRM 4.1.3 (a,b)
function Record_Object
(Discriminant_Or_Component_Selection : Name) return Declaration;
-- Returns the record object declaration for the selected object.
function Selected_Component (Discriminant_Or_Component_Selection : Name)
return Ada_Program.Element;
-- Returns the component declaration or discriminant in the record type
-- declaration. Operations in the package Declarations can be used to
-- manipulate record components.
-- LRM 4.1.3 (c)
function Selected_Task_Entry
(Task_Entry_Selection : Name) return Declaration;
-- Returns the entry declaration within the task type.
-- LRM 4.1.3 (d)
function Selected_Access_Type
(Access_Object_Selection : Name) return Declaration;
-- Returns the access type declaration.
-- LRM 4.1.3 (f)
function Named_Declaration (Expanded_Name : Name) return Declaration;
-- Returns the named declaration.
-- LRM 4.1.4
type Attribute_Designator_Kinds is (Address_Attribute,
Aft_Attribute,
Base_Attribute,
Callable_Attribute,
Constrained_Attribute,
Count_Attribute,
Delta_Attribute,
Digits_Attribute,
Emax_Attribute,
Epsilon_Attribute,
First_Attribute,
First_Bit_Attribute,
Fore_Attribute,
Image_Attribute,
Large_Attribute,
Last_Attribute,
Last_Bit_Attribute,
Length_Attribute,
Machine_Emax_Attribute,
Machine_Emin_Attribute,
Machine_Mantissa_Attribute,
Machine_Overflows_Attribute,
Machine_Radix_Attribute,
Machine_Rounds_Attribute,
Mantissa_Attribute,
Pos_Attribute,
Position_Attribute,
Pred_Attribute,
Range_Attribute,
Safe_Emax_Attribute,
Safe_Large_Attribute,
Safe_Small_Attribute,
Size_Attribute,
Small_Attribute,
Storage_Size_Attribute,
Succ_Attribute,
Terminated_Attribute,
Val_Attribute,
Value_Attribute,
Width_Attribute,
Not_A_Predefined_Attribute);
function Attribute_Designator_Kind
(Attribute : Name) return Attribute_Designator_Kinds;
-- Returns the kind of an attribute. If the attribute is
-- implementation-specific, Not_A_Predefined_Attribute is returned.
function Attribute_Designator_Name (Attribute : Name) return String;
-- This is the preferred way to analyze an implementation-specific
-- attribute. It returns an uppercase string for the attribute
-- simple name.
function Attribute_Designator_Name (Attribute : Name) return Name;
-- The Simple_Name returned here is only intended for use by
-- ADA_PROGRAM.STRING_NAME. Use of this function is discouraged.
function Attribute_Designator_Argument (Attribute : Name) return Expression;
-- Returns the static expression associated with the optional argument
-- of the attribute designator if one exists, Nil_Element otherwise.
---------------------------------------------------------------------
-- LITERALS LRM 4.2
--
-- The value of literals can be determined by using the
-- STATIC_VALUE selectors.
function Is_Literal (An_Expression : Expression) return Boolean;
function Position_Number (An_Enumeration_Or_Character_Literal : Expression)
return Long_Integer;
-- Returns the cardinality of the enumeration literal within the base type
-- of the enumeration type. (same as "'POS")
function Representation_Value
(An_Enumeration_Or_Character_Literal : Expression)
return Long_Integer;
-- Returns the internal representation of the enumeration literal.
-- (same as "'POS" if no rep spec defined for the enumeration type)
function Enumeration_Definition
(An_Enumeration_Or_Character_Literal : Expression)
return Declaration;
-- Since characters are enumerations, both regular enumeration and
-- character literals have enumeration root type declarations. The
-- operations in DECLARATIONS can be used to further analyze these
-- declarations.
---------------------------------------------------------------------
-- AGGREGATES LRM 4.3
subtype Aggregate_Component is Ada_Program.Element;
subtype Aggregate_Component_Iterator is Ada_Program.Element_Iterator;
function Components (An_Aggregate : Expression;
Normalized : Boolean := False)
return Aggregate_Component_Iterator;
-- Returns a list of the components of an aggregate.
-- If NORMALIZED is true a normalized list of the components of
-- an aggregate is returned (using positional notation).
-- NOTE THAT NORMALIZED INFO IS NOT AVAILIABLE FOR ARRAY AGGREGATES.
function Component_Choices
(Component : Aggregate_Component) return Choice_Iterator;
-- Returns the list of choices in the aggregate component.
-- May be a nil list if positional notation is used.
-- Use the CHOICE operations in TYPE_INFORMATION for further analysis.
function Component_Expression
(Component : Aggregate_Component) return Expression;
-- Returns the expression for the component association.
function Aggregate_Range (An_Aggregate : Expression) return Discrete_Range;
-- For an array aggregate, returns a range specifying the bounds of
-- the aggregate.
---------------------------------------------------------------------
-- TYPE CONVERSIONS and QUALIFIED EXPRESSIONS
-- LRM 4.6, 4.7
function Type_Mark (Type_Conversion_Or_Qualified_Expression : Expression)
return Name;
-- Returns the name of the type to which the expression is
-- being converted or the qualifying type. Use DEFINITION to get
-- the the defining type id.
function Converted_Or_Qualified_Expression
(Type_Conversion_Or_Qualified_Expression : Expression)
return Expression;
-- Returns the expression being converted or qualified.
---------------------------------------------------------------------
-- ALLOCATORS LRM 4.8
type Allocation_Kinds is (Allocation_From_Subtype,
Allocation_From_Qualified_Expression);
function Allocator_Kind (An_Allocator : Expression) return Allocation_Kinds;
function Allocation_Type (An_Allocator : Expression)
return Subtype_Indication;
-- Returns the subtype indication for the object being allocated.
function Qualified_Object_Expression
(An_Allocator : Expression) return Expression;
-- Returns the qualified expression for the object being allocated.
-- (in other words the KIND of the returned expression will be
-- A_QUALIFIED_EXPRESSION)
---------------------------------------------------------------------
-- COMPLEX EXPRESSIONS - LRM 4.4
--
-- When an expression kind is A_COMPLEX_EXPRESSION the following
-- operations can be used to do more detailed analysis.
subtype Special_Operation is Expression;
subtype Parenthesized_Expression is Expression;
subtype Range_Info is Ada_Program.Element;
type Complex_Expression_Kinds is (A_Parenthesized_Expression,
A_Special_Operation,
Not_A_Complex_Expression);
function Complex_Expression_Kind
(An_Expression : Expression) return Complex_Expression_Kinds;
function Expression_Parenthesized
(A_Parenthesized_Expression : Parenthesized_Expression)
return Expression;
-- Returns the expression within the parenthesis.
type Special_Operation_Kinds is (In_Range, Not_In_Range,
In_Type, Not_In_Type,
And_Then, Or_Else,
Not_A_Special_Operation);
function Special_Operation_Kind (An_Operation : Special_Operation)
return Special_Operation_Kinds;
function Special_Operation_Left_Hand_Side
(For_Special_Operation : Special_Operation) return Expression;
-- All special operation left hand sides are expressions.
function In_Range_Operation_Right_Hand_Side
(For_In_Range_Operation : Special_Operation) return Range_Info;
-- The right hand side for an IN_RANGE operation is a range which can be
-- analyzed using the range operations in TYPE_INFORMATION.
function In_Type_Operation_Right_Hand_Side
(For_In_Type_Operation : Special_Operation) return Name;
-- The right hand side for an IN_TYPE operation is a type mark which is
-- a name and can be further analyzed using this package.
function Short_Circuit_Operation_Right_Hand_Side
(For_Short_Circuit_Operation : Special_Operation)
return Expression;
-- The right hand side for a short circuit operation can be any
-- expression kind which can be further analyzed using this package.
---------------------------------------------------------------------
-- FUNCTION CALLS
-- Note that references to enumeration literals renamed as functions
-- are treated as genuine function calls.
function Is_Prefix_Call (A_Function_Call : Expression) return Boolean;
-- Returns true if the function call is in prefix form.
-- EG. - Foo (A, B); -- Returns TRUE
-- "<" (A, B); -- Returns TRUE
-- ... A < B ... -- Returns FALSE
function Is_Predefined (A_Function_Call : Expression) return Boolean;
-- Returns true if the function call has no real declaration associated
-- with it. (EG. STANDARD."+")
function Called_Function (A_Function_Call : Expression) return Declaration;
-- Returns the declaration of the called function if it is not predefined,
-- NIL_ELEMENT otherwise.
function Function_Call_Parameters
(A_Function_Call : Expression;
Normalized : Boolean := False) return Association_Iterator;
-- Returns a list of actual parameters for the call. If Normalized
-- is set to true, the (unspecified) default parameters will also be
-- included in the iterator. Use the operations from package
-- ASSOCIATIONS to further decompose the associations.
pragma Subsystem (Design_Facility, Closed);
pragma Module_Name (4, 3573);
pragma Bias_Key (27);
end Names_And_Expressions;with Ada_Program;
package Pragmas is
--
-- The use of this system is subject to the software license terms and
-- conditions agreed upon between Rational and the Customer.
--
-- Copyright 1987, 1988, 1989, 1990 by Rational.
--
-- RESTRICTED RIGHTS LEGEND
--
-- Use, duplication, or disclosure by the Government is subject to
-- restrictions as set forth in subdivision (b)(3)(ii) of the Rights in
-- Technical Data and Computer Software clause at 52.227-7013.
--
--
-- Rational
-- 3320 Scott Boulevard
-- Santa Clara, California 95054
--
-- PROPRIETARY AND CONFIDENTIAL INFORMATION OF RATIONAL;
-- USE OR COPYING WITHOUT EXPRESS WRITTEN AUTHORIZATION
-- IS STRICTLY PROHIBITED. THIS MATERIAL IS PROTECTED AS
-- AN UNPUBLISHED WORK UNDER THE U.S. COPYRIGHT ACT OF
-- 1976. CREATED 1987, 1988, 1989, 1990. ALL RIGHTS RESERVED.
--
-- LRM 2.8
-- This package provides operations on pragma elements
-- Local Renamings:
subtype Pragma_Usage is Ada_Program.Pragma_Usage;
subtype Declaration is Ada_Program.Declaration;
subtype Association_Iterator is Ada_Program.Association_Iterator;
-------------------------------------------------------------------
function Is_Predefined (A_Pragma : Pragma_Usage) return Boolean;
type Pragma_Kinds is (Controlled,
Elaborate,
Inline,
Interface,
List,
Memory_Size,
Optimize,
Pack,
Page,
Priority,
Shared,
Storage_Unit,
Suppress,
System_Name,
Not_A_Predefined_Pragma);
Unknown : constant Pragma_Kinds := Not_A_Predefined_Pragma;
function Kind (A_Pragma : Pragma_Usage) return Pragma_Kinds;
-- Returns the kind of a pragma. Returns Not_A_Predefined_Pragma on
-- implementation-specific pragmas.
function Name (A_Pragma : Pragma_Usage) return String;
-- Returns the uppercase simple name of any pragma. This is the way
-- to analyze implementation-specific pragmas.
function Arguments (A_Pragma : Pragma_Usage) return Association_Iterator;
-- Returns a list of the arguments to a pragma. Operations from
-- package ASSOCIATIONS can be used to decompose them.
pragma Subsystem (Design_Facility, Closed);
pragma Module_Name (4, 3574);
pragma Bias_Key (27);
end Pragmas;with Ada_Program;
package Representation_Clauses is
--
-- The use of this system is subject to the software license terms and
-- conditions agreed upon between Rational and the Customer.
--
-- Copyright 1987, 1988, 1989, 1990 by Rational.
--
-- RESTRICTED RIGHTS LEGEND
--
-- Use, duplication, or disclosure by the Government is subject to
-- restrictions as set forth in subdivision (b)(3)(ii) of the Rights in
-- Technical Data and Computer Software clause at 52.227-7013.
--
--
-- Rational
-- 3320 Scott Boulevard
-- Santa Clara, California 95054
--
-- PROPRIETARY AND CONFIDENTIAL INFORMATION OF RATIONAL;
-- USE OR COPYING WITHOUT EXPRESS WRITTEN AUTHORIZATION
-- IS STRICTLY PROHIBITED. THIS MATERIAL IS PROTECTED AS
-- AN UNPUBLISHED WORK UNDER THE U.S. COPYRIGHT ACT OF
-- 1976. CREATED 1987, 1988, 1989, 1990. ALL RIGHTS RESERVED.
--
-- LRM Chapter 13
-- Local Renamings:
subtype Declaration is Ada_Program.Declaration;
subtype Expression is Ada_Program.Expression;
subtype Identifier_Definition is Ada_Program.Identifier_Definition;
subtype Representation_Clause is Ada_Program.Representation_Clause;
subtype Type_Definition is Ada_Program.Element;
-------------------------------------------------------------------
type Representation_Clause_Kinds is (A_Length_Clause,
An_Enumeration_Representation_Clause,
A_Record_Representation_Clause,
An_Address_Clause,
Not_A_Representation_Clause);
function Kind (Clause : Representation_Clause)
return Representation_Clause_Kinds;
function Associated_Type
(Clause : Representation_Clause) return Type_Definition;
-- Returns the definition of the type specified in the length clause,
-- enumeration representation clause or record representation clause.
function Associated_Size (For_Type : Type_Definition) return Expression;
-- Returns the expression that describes the size associated with a type
-- definition if there is a rep spec associated with this type,
-- NIL_ELEMENT otherwise.
function Associated_Storage_Size
(For_Type : Type_Definition) return Expression;
-- Returns the expression that describes the size associated with a type
-- definition. Valid for access and task types and their derived types.
function Associated_Enumeration_Representation
(For_Enumeration_Literal : Identifier_Definition)
return Expression;
-- Returns the expression that describes the representation of
-- enumeration literal.
function Associated_Enumeration_Representation
(For_Enumeration_Literal : Identifier_Definition)
return Long_Integer;
-- Returns the representation value associated with
-- FOR_ENUMERATION_LITERAL.
function Associated_Record_Representation
(Record_Or_Component : Ada_Program.Element)
return Representation_Clause;
-- Returns the representation spec associated with the element.
function Associated_Address
(For_Element : Ada_Program.Element) return Ada_Program.Element;
-- Returns the element that defines the address value of FOR_ELEMENT,
-- valid for VARs, CONSTANTs, PACKAGEs, ENTRYs and TASK SPECs (or
-- their associated IDs).
-- For all the above routines, if no associated element exists
-- a NIL_ELEMENT is returned.
-------------------------------------------------------------------
-- LRM 13.2
type Length_Clause_Attribute_Kinds is (Size,
Collection_Storage_Size,
Task_Storage_Size,
Small);
function Attribute_Kind (A_Length_Clause : Representation_Clause)
return Length_Clause_Attribute_Kinds;
-------------------------------------------------------------------
-- LRM 13.3
function Representation_Aggregate
(Enumeration_Clause : Representation_Clause) return Expression;
-- Returns the aggregate of the representation clause.
-------------------------------------------------------------------
-- LRM 13.4
function Alignment_Expression
(Record_Clause : Representation_Clause) return Expression;
-- Returns the alignment expression for the representation clause.
-- If an alignment expression is not present, a nil element is
-- returned.
subtype A_Range is Ada_Program.Element;
subtype Record_Component_Clause is Ada_Program.Element;
subtype Record_Component_Clause_Or_Pragma_Iterator is
Ada_Program.Element_Iterator;
function Clause_Components
(Record_Clause : Representation_Clause)
return Record_Component_Clause_Or_Pragma_Iterator;
-- Returns a list of the components of the record clause in order
-- of appearance.
function Valid_Component
(Component_Clause : Record_Component_Clause) return Boolean;
-- Some components can be PRAGMAs, this return true if this component
-- is NOT a pragma.
function Component_Name
(Component_Clause : Record_Component_Clause) return String;
-- Returns the name of the component.
function Component_Offset
(Component_Clause : Record_Component_Clause) return Expression;
-- Returns the offset expression for the component.
function Component_Range
(Component_Clause : Record_Component_Clause) return A_Range;
-- Returns the range constraint for the component.
-------------------------------------------------------------------
-- LRM 13.5
function Addressed_Declaration
(Address_Clause : Representation_Clause) return Declaration;
-- Returns the declaration of the object, subprogram or entry
-- whose address is being specified.
function Address_Expression
(Address_Clause : Representation_Clause) return Expression;
-- Returns the expression for the address of the declaration.
pragma Subsystem (Design_Facility, Closed);
pragma Module_Name (4, 3575);
pragma Bias_Key (27);
end Representation_Clauses;with Ada_Program;
with Declarations;
package Statements is
--
-- The use of this system is subject to the software license terms and
-- conditions agreed upon between Rational and the Customer.
--
-- Copyright 1987, 1988, 1989, 1990 by Rational.
--
-- RESTRICTED RIGHTS LEGEND
--
-- Use, duplication, or disclosure by the Government is subject to
-- restrictions as set forth in subdivision (b)(3)(ii) of the Rights in
-- Technical Data and Computer Software clause at 52.227-7013.
--
--
-- Rational
-- 3320 Scott Boulevard
-- Santa Clara, California 95054
--
-- PROPRIETARY AND CONFIDENTIAL INFORMATION OF RATIONAL;
-- USE OR COPYING WITHOUT EXPRESS WRITTEN AUTHORIZATION
-- IS STRICTLY PROHIBITED. THIS MATERIAL IS PROTECTED AS
-- AN UNPUBLISHED WORK UNDER THE U.S. COPYRIGHT ACT OF
-- 1976. CREATED 1987, 1988, 1989, 1990. ALL RIGHTS RESERVED.
--
-- LRM Chapter 5
-- Local Renames:
subtype Association is Ada_Program.Association;
subtype Declaration is Ada_Program.Declaration;
subtype Expression is Ada_Program.Expression;
subtype Identifier_Reference is Ada_Program.Identifier_Reference;
subtype Name_Expression is Ada_Program.Name;
subtype Name is Ada_Program.Name;
subtype Statement is Ada_Program.Statement;
subtype Association_Iterator is Ada_Program.Association_Iterator;
subtype Choice_Iterator is Ada_Program.Choice_Iterator;
subtype Declarative_Part_Iterator is
Ada_Program.
Declaration_Or_Context_Clause_Or_Representation_Clause_Or_Pragma_Iterator;
subtype Expression_Iterator is Ada_Program.Expression_Iterator;
subtype Name_Iterator is Ada_Program.Name_Iterator;
subtype Statement_Part_Iterator is Ada_Program.Statement_Or_Pragma_Iterator;
-------------------------------------------------------------------
function Is_Labeled (A_Statement : Statement) return Boolean;
function Labels (A_Statement : Statement) return Name_Iterator;
-- Returns an iterator on the names of the labels of a statement. A
-- statement can have several labels.
function Label_Name (A_Statement : Statement) return String;
-- Returns the null string if no label is present. Use of this
-- function is discouraged.
function Is_Named_Statement (A_Statement : Statement) return Boolean;
-- Returns true if applied to a loop or block that has a name.
function Statement_Name (A_Statement : Statement) return Name;
-- Returns the name of a block or loop. Returns Nil_Element if not
-- a block or loop, or if no name is present.
type Statement_Kinds is
-- Simple statements:
(A_Null_Statement, An_Assignment_Statement, A_Procedure_Call_Statement,
An_Exit_Statement, A_Return_Statement, A_Goto_Statement,
An_Entry_Call_Statement, A_Delay_Statement,
An_Abort_Statement, A_Raise_Statement, A_Code_Statement,
-- compound statements:
An_If_Statement, A_Case_Statement, A_Loop_Statement,
A_Block_Statement, An_Accept_Statement,
A_Select_Statement, A_Conditional_Entry_Call_Statement,
A_Timed_Entry_Call_Statement, Not_A_Statement);
function Kind (A_Statement : Statement) return Statement_Kinds;
---------------------------------------------------------------------
-- ASSIGNMENT STATEMENTS - LRM 5.2
function Object_Assigned_To (Assignment_Statement : Statement) return Name;
-- Returns the name of object to which the assignment is being made.
function Assignment_Expression
(Assignment_Statement : Statement) return Expression;
-- Returns the expression on the right hand side of the assignment.
---------------------------------------------------------------------
-- EXIT STATEMENTS - LRM 5.7
function Exit_Label (Exit_Statement : Statement) return String;
-- Returns the name of the exited loop if present, "" if not present
function Exit_Condition (Exit_Statement : Statement) return Expression;
-- Returns the when condition of the exit statement if present;
-- returns a nil element if not present.
function Loop_Exited (Exit_Statement : Statement) return Statement;
-- Returns the loop statement exited by this exit statement.
---------------------------------------------------------------------
-- RETURN STATEMENTS - LRM 5.8
function Return_Expression (Return_Statement : Statement) return Expression;
-- Returns the expression returned in the statement.
-- If no expression exists, a nil element is returned.
---------------------------------------------------------------------
-- GOTO STATEMENTS - LRM 5.9
function Goto_Label (Goto_Statement : Statement) return String;
-- Returns the name of label to which the goto statement may go.
function Destination_Statement
(Goto_Statement : Statement) return Statement;
-- Returns the statement to which the goto statement may go.
---------------------------------------------------------------------
-- IF STATEMENTS - LRM 5.3
subtype If_Statement_Arm is Ada_Program.Element;
subtype If_Statement_Arm_Iterator is Ada_Program.Element_Iterator;
function If_Arm_List (If_Statement : Statement)
return If_Statement_Arm_Iterator;
-- returns a list of the arms of the if statement
function Is_Else_Arm (Arm : If_Statement_Arm) return Boolean;
-- Returns true if the arm is an 'ELSE' arm, false if the arm is an
-- 'IF' or 'ELSIF'. The function Condition_Expression below may be used
-- on the arm in the false case.
function Condition_Expression (If_Arm : If_Statement_Arm) return Expression;
-- Returns the condition expression for an if statement or elsif arm.
function If_Arm_Statements (Arm : If_Statement_Arm)
return Statement_Part_Iterator;
-- Returns a list of the statements and pragmas in an arm.
---------------------------------------------------------------------
-- CASE STATEMENTS - LRM 5.4
function Case_Expression (Case_Statement : Statement) return Expression;
-- Returns the expression of the case statement that determines
-- which alternative will be taken.
subtype Case_Statement_Alternative is Ada_Program.Element;
subtype Case_Statement_Alternative_Iterator is Ada_Program.Element_Iterator;
function Case_Arms_List (Case_Statement : Statement)
return Case_Statement_Alternative_Iterator;
-- Return a list of all alternatives of the case statement.
function Is_When_Others
(Case_Alternative : Case_Statement_Alternative) return Boolean;
function Case_Alternative_Choices
(Case_Alternative : Case_Statement_Alternative)
return Choice_Iterator;
-- Returns a list of the 'WHEN <choice> | <choice>' choices.
-- Use the TYPE_INFORMATION package's CHOICES queries to extract
-- further information about the <choice>s.
function Case_Alternative_Statements
(Case_Alternative : Case_Statement_Alternative)
return Statement_Part_Iterator;
-- Returns a list of the statements and pragmas in this alternative.
---------------------------------------------------------------------
-- LOOP STATEMENTS - LRM 5.5
subtype For_Loop_Range is Ada_Program.Element;
type Loop_Kinds is (A_For_Loop, A_While_Loop, A_Simple_Loop);
function Loop_Kind (Loop_Statement : Statement) return Loop_Kinds;
function While_Condition (Loop_Statement : Statement) return Expression;
-- Returns the condition expression associated with the while loop.
function For_Loop_Index (Loop_Statement : Statement) return For_Loop_Range;
-- Returns the range for the loop index.
-- Use the TYPE_INFORMATION package's operations for discrete ranges
-- for more information.
function For_Loop_Index_Variable (Loop_Statement : Statement) return String;
-- Returns the name of the loop index variable.
function Is_Reverse_Iterator (Loop_Statement : Statement) return Boolean;
function Loop_Statements (Loop_Statement : Statement)
return Statement_Part_Iterator;
-- Returns a list of the statements pragmas in the body part of
-- the loop statement.
---------------------------------------------------------------------
-- BLOCK STATEMENTS - LRM 5.6
function Declarative_Items (Block_Statement : Statement)
return Declarative_Part_Iterator;
-- Returns a list of the declarations, pragmas, representation
-- specifications, and use clauses in the declarative part of the block.
-- A "Done" iterator indicates that there are no declarations.
function Block_Body_Statements (Block_Statement : Statement)
return Statement_Part_Iterator;
-- Returns a list of the statements and pragmas in the body part of the
-- block.
subtype Exception_Handler_Arm is Ada_Program.Element;
subtype Exception_Handler_Arm_Iterator is Ada_Program.Element_Iterator;
function Block_Exception_Handler_Arms (Block_Statement : Statement)
return Exception_Handler_Arm_Iterator;
-- Returns a list of the exception handler arms of the block.
function Exception_Choices
(Exception_Arm : Exception_Handler_Arm) return Choice_Iterator;
-- Returns a list of exception choices in the handler arm.
-- Use the TYPE_INFORMATION package's CHOICES queries to extract
-- further information about the <choice>s.
function Handler_Statements (Exception_Arm : Exception_Handler_Arm)
return Statement_Part_Iterator;
-- Returns a list of the statements and pragmas in the body part of
-- the handler.
---------------------------------------------------------------------
-- PROCEDURE CALL STATEMENTS - LRM 6.4
function Called_Procedure (Procedure_Or_Entry_Call_Statement : Statement)
return Declaration;
-- Returns the declaration of the called procedure or entry.
function Procedure_Call_Parameters
(Procedure_Or_Entry_Call_Statement : Statement;
Normalized : Boolean := False) return Association_Iterator;
-- Returns a list of actual parameters for the call.
-- If Normalized is set to true, the (unspecified) default
-- parameters will also be included in the iterator.
function Parameter_Expression (Parameter : Association) return Expression;
-- Returns the expression passed in for the actual parameter. Use
-- of this function is discouraged. Operations from package
-- PARAMETER_ASSOCIATIONS should be used instead.
---------------------------------------------------------------------
-- RAISE STATEMENTS - LRM 11.3
function Raised_Exception (Raise_Statement : Statement) return Name;
-- Returns the name of the raised exception or NIL_ELEMENT if there is
-- none. The NAMES_AND_EXPRESSIONS package can be used to decompose
-- the name.
---------------------------------------------------------------------
-- CODE STATEMENTS - LRM 13.8
function Qualified_Expression
(Code_Statement : Statement) return Expression;
-- Returns the qualified expression representing the code statement.
---------------------------------------------------------------------
-- ENTRY CALL STATEMENTS - LRM 9.5
function Family_Index
(Entry_Call_Or_Accept_Statement : Statement) return Expression;
-- Returns NIL_ELEMENT if not a family call/accept.
-- The operations on procedure calls and actual parameters defined above
-- may be used to get more information about an entry calls.
---------------------------------------------------------------------
-- ACCEPT STATEMENTS - LRM 9.5
function Accepted_Entry (Accept_Statement : Statement)
return Declarations.Entry_Declaration;
-- Returns the declaration of the entry accepted in this statement.
function Accept_Body_Statements
(Accept_Statement : Statement) return Statement_Part_Iterator;
-- Returns a list of the statements and pragmas in the body part of
-- the accept statement.
---------------------------------------------------------------------
-- DELAY STATEMENTS - LRM 9.6
function Delay_Expression (Delay_Statement : Statement) return Expression;
-- Returns the expression for the time of the delay
---------------------------------------------------------------------
-- SELECT, CONDITIONAL ENTRY and TIMED ENTRY STATEMENTS - LRM 9.7
subtype Select_Alternative is Ada_Program.Element;
subtype Select_Alternative_Iterator is Ada_Program.Element_Iterator;
function Select_Alternatives (Selective_Wait : Statement)
return Select_Alternative_Iterator;
-- Returns a list of the alternatives in the selective_wait statement.
function Is_Guarded (Alternative : Select_Alternative) return Boolean;
-- Returns true if a select alternative has a guard.
function Guard (Alternative : Select_Alternative) return Expression;
-- Returns the conditional expression guarding the alternative.
-- May return a nil element if there is no guard.
type Select_Alternative_Kinds is (Accept_Alternative,
Delay_Alternative,
Terminate_Alternative,
Not_A_Select_Alternative);
function Select_Alternative_Kind (Alternative : Select_Alternative)
return Select_Alternative_Kinds;
function Select_Alternative_Statements
(Accept_Or_Delay_Alternative : Select_Alternative)
return Statement_Part_Iterator;
-- Returns a list of the statements and pragmas in the the accept or
-- delay alternative including the accept statement and delay statements
-- themselves.
function Else_Statements
(Selective_Wait_Or_Conditional_Entry_Call : Statement)
return Statement_Part_Iterator;
-- Returns a list of statements and pragmas contained in the else
-- part of a selective_wait or conditional_entry_call. If no else
-- part exists, a "DONE" iterator is returned.
function Timed_Statements (Timed_Entry_Call : Statement)
return Statement_Part_Iterator;
-- Returns a list of statements and pragmas contained in the or
-- part of a timed entry call, including the delay statement itself.
function Entry_Call_Statements (Conditional_Or_Timed_Entry_Call : Statement)
return Statement_Part_Iterator;
-- Returns the statement list associated with the conditional or
-- timed entry call, including the actual entry call statement. Use
-- the ELSE_STATEMENTS or TIMED_STATEMENTS selector functions the get
-- the rest of the information about the call.
---------------------------------------------------------------------
-- ABORT STATEMENTS - LRM 9.10
function Aborted_Tasks (Abort_Statement : Statement) return Name_Iterator;
-- Returns a list of NAME_EXPRESSIONS for the aborted tasks.
-- Use ADA_PROGRAM.DEFINITION to get to the task declaration, or
-- the NAMES_AND_EXPRESSIONS package to decompose the names.
pragma Subsystem (Design_Facility, Closed);
pragma Module_Name (4, 3576);
pragma Bias_Key (27);
end Statements;with Ada_Program;
package Type_Information is
--
-- The use of this system is subject to the software license terms and
-- conditions agreed upon between Rational and the Customer.
--
-- Copyright 1987, 1988, 1989, 1990 by Rational.
--
-- RESTRICTED RIGHTS LEGEND
--
-- Use, duplication, or disclosure by the Government is subject to
-- restrictions as set forth in subdivision (b)(3)(ii) of the Rights in
-- Technical Data and Computer Software clause at 52.227-7013.
--
--
-- Rational
-- 3320 Scott Boulevard
-- Santa Clara, California 95054
--
-- PROPRIETARY AND CONFIDENTIAL INFORMATION OF RATIONAL;
-- USE OR COPYING WITHOUT EXPRESS WRITTEN AUTHORIZATION
-- IS STRICTLY PROHIBITED. THIS MATERIAL IS PROTECTED AS
-- AN UNPUBLISHED WORK UNDER THE U.S. COPYRIGHT ACT OF
-- 1976. CREATED 1987, 1988, 1989, 1990. ALL RIGHTS RESERVED.
--
-- Local Renaming:
subtype Declaration is Ada_Program.Declaration;
subtype Name_Expression is Ada_Program.Expression;
subtype Expression is Ada_Program.Expression;
subtype Identifier_Reference is Ada_Program.Identifier_Reference;
subtype Statement is Ada_Program.Statement;
subtype Task_Specification is Ada_Program.Type_Definition;
subtype Type_Definition is Ada_Program.Type_Definition;
subtype Association_Iterator is Ada_Program.Association_Iterator;
subtype Choice_Iterator is Ada_Program.Choice_Iterator;
subtype Declarative_Part_Iterator is
Ada_Program.
Declaration_Or_Context_Clause_Or_Representation_Clause_Or_Pragma_Iterator;
subtype Name_Iterator is Ada_Program.Name_Iterator;
---------------------------------------------------------------
type Type_Definition_Kinds is (A_Subtype_Indication,
An_Enumeration_Type_Definition,
An_Integer_Type_Definition,
A_Float_Type_Definition,
A_Fixed_Type_Definition,
An_Array_Type_Definition,
A_Record_Type_Definition,
An_Access_Type_Definition,
A_Derived_Type_Definition,
A_Task_Type_Definition,
A_Private_Type_Definition,
A_Limited_Private_Type_Definition,
Not_A_Type_Definition);
function Kind (A_Type_Definition : Type_Definition)
return Type_Definition_Kinds;
function Parent_Declaration (Type_Def : Type_Definition) return Declaration;
-- Returns the declaration associated with the type definition, if
-- any is available. Anonymous types for example have no associated
-- declaration.
function Base_Type (Type_Def : Type_Definition) return Type_Definition;
-- Returns the base type of the specified type definition as per LRM 3.3.
-- All subtypes are constraints applied to some base type. This function
-- returns that base type.
function Type_Structure (Type_Def : Type_Definition) return Type_Definition;
-- Returns the type structure from which the specified type definition has
-- been derived. This function will unwind recursive derivations until the
-- type definition derives a new representation or is no longer derived.
-- This function is different from GROUND_TYPE only for enumerations or
-- records that have derivations with rep specs.
function Ground_Type (Type_Def : Type_Definition) return Type_Definition;
-- This function recursively unwinds all type derivations and subtyping
-- to arrive at a type definition which is neither a derived type or a
-- subtype.
function Last_Constraint
(Type_Def : Type_Definition) return Type_Definition;
-- This function recursively unwinds subtyping to arrive at a type
-- definition which is either the base_type or imposes constraints.
function Is_Predefined (Type_Def : Type_Definition) return Boolean;
-- returns true if the type definition is one of:
-- Boolean, Character, String, Integer, Natural, Positive, Float
function Is_Universal (Type_Def : Type_Definition) return Boolean;
-- returns true if the type definition is a universal integer,
-- universal fixed or universal float.
subtype Subtype_Indication is Type_Definition;
subtype Enumeration_Type_Definition is Type_Definition;
subtype Integer_Type_Definition is Type_Definition;
subtype Float_Type_Definition is Type_Definition;
subtype Fixed_Type_Definition is Type_Definition;
subtype Array_Type_Definition is Type_Definition;
subtype Record_Type_Definition is Type_Definition;
subtype Access_Type_Definition is Type_Definition;
subtype Derived_Type_Definition is Type_Definition;
subtype Task_Type_Definition is Type_Definition;
---------------------------------------------------------------
-- TYPE CONSTRAINTS:
subtype Type_Constraint is Ada_Program.Element;
subtype Discrete_Range_Iterator is Ada_Program.Element_Iterator;
subtype Discriminant_Association_Iterator is Ada_Program.Element_Iterator;
type Type_Constraint_Kinds is (A_Simple_Range,
A_Range_Attribute,
A_Floating_Point_Constraint,
A_Fixed_Point_Constraint,
An_Index_Constraint,
A_Discriminant_Constraint,
Not_A_Constraint);
function Constraint_Kind (A_Constraint : Type_Constraint)
return Type_Constraint_Kinds;
function Discrete_Ranges (Of_Index_Constraint : Type_Constraint)
return Discrete_Range_Iterator;
-- Returns the list of Discrete_Range components of an Index_Constraint
function Discriminant_Associations
(Of_Discriminant_Constraint : Type_Constraint)
return Discriminant_Association_Iterator;
-- Returns the list of discriminant associations of
-- a Discriminant_Constraint.
-------------------------------------------------------------------
-- DISCRETE RANGES:
subtype Discrete_Range is Ada_Program.Element; -- LRM 3.6
type Range_Kinds is (A_Simple_Range,
A_Range_Attribute,
A_Subtype_Indication,
Not_A_Range);
function Range_Kind (A_Discrete_Range : Discrete_Range) return Range_Kinds;
subtype Range_Info is Ada_Program.Element;
procedure Bounds (A_Range : Range_Info;
Lower, Upper : out Expression);
-- This procedure returns the simple expression for the
-- upper and lower bounds of a range if one is present
-- NIL_ELEMENTs otherwise.
-- Note that range attributes are expressions and can be analyzed
-- by using the attribute operations in NAMES_AND_EXPRESSIONS.
---------------------------------------------------------------
-- CHOICES:
subtype Choice is Ada_Program.Element;
type Choice_Kinds is (A_Simple_Expression,
A_Discrete_Range,
Others_Choice,
An_Identifier_Reference,
Not_A_Choice);
function Choice_Kind (A_Choice : Choice) return Choice_Kinds;
function Choice_Expression (A_Choice : Choice) return Expression;
function Choice_Range (A_Choice : Choice) return Discrete_Range;
function Choice_Identifier (A_Choice : Choice) return Identifier_Reference;
---------------------------------------------------------------
-- SUBTYPE_INDICATIONS & TYPE_MARKS - LRM 3.3.2
function Type_Mark (A_Subtype_Indication : Subtype_Indication)
return Name_Expression;
-- Returns the type mark of a subtype indication.
-- The NAMES_AND_EXPRESSION package provides selectors to do further
-- decomposition.
function Constraint (A_Subtype_Indication : Subtype_Indication)
return Type_Constraint;
-- Returns the constraint applied to the subtype indication. A nil
-- element is returned if no constraint is present.
---------------------------------------------------------------
-- ENUMERATION TYPES - LRM 3.5.1
function Enumeration_Literals
(Enumeration_Type : Enumeration_Type_Definition)
return Name_Iterator;
-- Returns a list of the literals declared an enumeration type
-- declaration. Each of these elements has a Name.
---------------------------------------------------------------
-- INTEGER TYPES - LRM 3.5.4
function Integer_Constraint
(Integer_Type : Integer_Type_Definition) return Range_Info;
-- Returns the range constraint on the integer type declaration.
---------------------------------------------------------------
-- REAL TYPES - LRM 3.5.6
function Digits_Accuracy_Definition
(Floating_Point_Type : Float_Type_Definition) return Expression;
-- Returns the digits accuracy definition of a floating point type
-- definition or floating point constraint.
function Floating_Point_Constraint
(Floating_Point_Type : Float_Type_Definition) return Range_Info;
-- Returns the range constraint of a floating point type declaration.
function Delta_Accuracy_Definition
(Fixed_Point_Type : Fixed_Type_Definition) return Expression;
-- Returns the delta accuracy definition of a fixed point type definition
-- or fixed point constraint.
function Fixed_Point_Constraint
(Fixed_Point_Type : Fixed_Type_Definition) return Range_Info;
-- Returns the range constraint of the fixed point type definition.
---------------------------------------------------------------
-- ARRAY TYPES - LRM 3.6
function Is_Constrained_Array
(Array_Type : Array_Type_Definition) return Boolean;
function Index_Constraints (Constrained_Array_Type : Array_Type_Definition)
return Discrete_Range_Iterator;
-- Returns a list of the discrete range constraints for an
-- constrained array type declaration.
function Index_Subtype_Definitions
(Unconstrained_Array_Type : Array_Type_Definition)
return Name_Iterator;
-- Returns a list of the Index_Subtypes (Type_Marks) for an
-- unconstrained array type declaration.
function Component_Type (Array_Type : Array_Type_Definition)
return Subtype_Indication;
-- Returns the specification of the array component type.
---------------------------------------------------------------
-- DISCRIMINANTS - LRM 3.7.1
subtype Type_Definition_Or_Declaration is Ada_Program.Element;
subtype Discriminant_Iterator is Ada_Program.Element_Iterator;
function Is_Discriminated
(A_Type : Type_Definition_Or_Declaration) return Boolean;
-- This function applies to private, limited private, incomplete or
-- record types. It returns True if this type has discriminants.
-- It may be applied to type declaration to handle the case of
-- incomplete types.
function Discriminants (A_Type : Type_Definition_Or_Declaration)
return Discriminant_Iterator;
-- Returns a list of discriminants of the type. These elements may
-- then be manipulated with the functions provided in package
-- Declarations.
---------------------------------------------------------------
-- RECORD TYPES - LRM 3.7
subtype Record_Component is Ada_Program.Element;
subtype Record_Component_Or_Pragma_Iterator is Ada_Program.Element_Iterator;
subtype Variant is Ada_Program.Element;
subtype Variant_Or_Pragma_Iterator is Ada_Program.Element_Iterator;
function Record_Components (Record_Type : Record_Type_Definition)
return Record_Component_Or_Pragma_Iterator;
-- Returns a list of the record components of the record declaration.
type Component_Kinds is (A_Null_Component,
A_Variable_Component,
A_Variant_Part_Component,
Not_A_Component);
-- A component can be a Variable, NULL or Variant_Part.
-- A Null_Component is a NIL_ELEMENT.
-- The operations on Variables can be used to decompose Variable_Components.
function Component_Kind
(Component : Record_Component) return Component_Kinds;
function Associated_Discriminant
(Variant_Part : Record_Component) return Identifier_Reference;
function Variant_Item_List (Variant_Part : Record_Component)
return Variant_Or_Pragma_Iterator;
-- Returns a list of variants that make up the record component.
function Variant_Choices (Variant_Item : Variant) return Choice_Iterator;
-- Returns a list of the 'WHEN <choice> | <choice>' choices.
-- Use the above CHOICES queries to extract further information.
function Inner_Record_Components (Variant_Item : Variant)
return Record_Component_Or_Pragma_Iterator;
-- Returns a list of the record components of the inner record declaration.
-- Use Component_Kind to analyze further.
---------------------------------------------------------------
-- ACCESS TYPES - LRM 3.8
function Access_To (Access_Type : Access_Type_Definition)
return Subtype_Indication;
-- Returns the subtype indication associated with the access type.
---------------------------------------------------------------
-- DERIVED TYPES - LRM 3.4
function Derived_From (Derived_Type : Derived_Type_Definition)
return Subtype_Indication;
-- Returns the subtype indication associated with the derived type.
---------------------------------------------------------------
-- TASK TYPE DEFINITIONS
-- LRM Chapter 9
function Task_Components (Task_Spec : Task_Specification)
return Declarative_Part_Iterator;
-- Returns a list of entry declarations, representation clauses
-- and pragmas in a task specification. The list is in order of appearance.
-- The operations on subprogram declarations can be used to
-- decompose task entries.
pragma Subsystem (Design_Facility, Closed);
pragma Module_Name (4, 3577);
pragma Bias_Key (27);
end Type_Information