⟦dc07a56b5⟧

TextFile

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;
DataMuseum.dk

Rational R1000/400 Tapes

⟦dc07a56b5⟧ TextFile

Derivation

TextFile
