|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - downloadIndex: ┃ T V ┃
Length: 44520 (0xade8)
Types: TextFile
Names: »V«
└─⟦d10a02448⟧ Bits:30000409 8mm tape, Rational 1000, ENVIRONMENT, D_12_7_3
└─ ⟦fc9b38f02⟧ »DATA«
└─⟦9b46a407a⟧
└─⟦c84a2ac9b⟧
└─⟦this⟧
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;