DataMuseum.dk

Presents historical artifacts from the history of:

Rational R1000/400 Tapes

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about Rational R1000/400 Tapes

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download
Index: ┃ D R T V

⟦c84a2ac9b⟧ R1K_ARCHIVE_DATA, TextFile

    Length: 232113 (0x38ab1)
    Types: R1K_ARCHIVE_DATA, TextFile
    Names: »DATA«

Derivation

└─⟦d10a02448⟧ Bits:30000409 8mm tape, Rational 1000, ENVIRONMENT, D_12_7_3
    └─ ⟦fc9b38f02⟧ »DATA« 
        └─⟦9b46a407a⟧ 
            └─⟦this⟧ 

TextFile

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;

ARCHIVE PAIR

INDEX: ⟦35606d003⟧ R1K_ARCHIVE_INDEX
DATA:  ⟦c84a2ac9b⟧ R1K_ARCHIVE_DATA, TextFile

OctetView

0x00000…00529 ⟦d4aff944a⟧
0x00529…075e7 ⟦3e17c6d76⟧
0x075e7…07916 ⟦692090554⟧
0x07916…0a0ee ⟦757cfcf0d⟧
0x0a0ee…0d0a6 ⟦81c2eb6c4⟧
0x0d0a6…0f20c ⟦8a23a3ff0⟧
0x0f20c…0fa76 ⟦2d8ba7723⟧
0x0fa76…11756 ⟦36073e9de⟧
0x11756…1c53e ⟦b0c8701fb⟧
0x1c53e…1c763 ⟦50115c09d⟧
0x1c763…1d374 ⟦a9045c62a⟧
0x1d374…23f26 ⟦dc07a56b5⟧
0x23f26…248d9 ⟦219cc9f29⟧
0x248d9…25bea ⟦2e72372d5⟧
0x25bea…2a6ec ⟦586db1ac5⟧
0x2a6ec…2ecd4 ⟦65988495f⟧
0x2ecd4…2f7be ⟦a8b99c4cf⟧
0x2f7be…311af ⟦0748edd6f⟧
0x311af…35006 ⟦c3f863d32⟧
0x35006…38ab1 ⟦2ce3a0b71⟧