Re: Looping over a tagged record?

["Pat Rogers" <progers@classwide.com>]

"M. A. Alves" <maa@liacc.up.pt> wrote in message
news:mailman.993114925.4754.comp.lang.ada@ada.eu.org...
> > > Often I also want to merge record and array i.e. have named _and_
> > > iteratable "components". Theoretically this comes down to "types as
> > > objects", which Ada doesn't have. Practically, a "standard" Ada idiom
for
> > > this is an heterogenous array indexed on an enumeration e.g. (not
tested):
> >
> > Could you please elaborate on exactly what you mean by "types as
objects"?
>
> Essentialy that you can manipulate types as you do objects.  A language
> with less basic semantic devices.  Types would be an elaboration of the
> programmer.  A reflexive tower of 2 or 3 levels.  Hardly a software
> engineering language.  Roughly approximative model in Ada:
>
>   type Object is ...
>   procedure Add_Property(O: Object; Name: String);
>   procedure Add_Property(O: Object; Name, Value: String);
>   procedure Add_Property(O: Object; Name: String; Value: Object);
>   ...


Reflection is indeed the right approach for doing this in general.  A
working interface looks like this:

package OpenAda.MOP is

  type Class is tagged limited private;
    -- The idea is to represent the abstraction of a class, rather
    -- than just a (tagged) type: a class is a tagged type with
    -- an encapsulating package and primitive operations declared
    -- within that package.

  type Class_Reference is access all Class;

  type Any_Class is access all Class'Class;


-- Introspection
--     Note these should be class-wide or otherwise non-primitive
--     since they are not intended to be overridden.

  Introspection_Failure : exception;


  function Class_For( Package_Name, Type_Name : Wide_String )
    return Class_Reference;
    -- Package_Name is that of a library package declaration.
    -- Type_Name is that of a visibly tagged or extended type
    -- exported by the package indicated by Package_Name.


  -- Note the term 'primitive operation' is that of the Ada RM: the
  -- primitive operations of a type are those subprograms that are
  -- declared with the type in the same package and mention the type
  -- in the parameter and result-type profile.  See the RM Glossary.

  function Visible_Primitives( This : access Class'Class )
    return OpenAda.Syntax.Sequence.Reference;
    -- Returns a list of pointers to either procedure or function
declarations
    -- occurring in the visible part of the enclosing package declaration


  function Hidden_Primitives( This : access Class'Class )
    return OpenAda.Syntax.Sequence.Reference;
    -- Returns a list of pointers to either procedure or function
declarations
    -- occurring in the private part of the enclosing package declaration


  function All_Primitives( This : access Class'Class )
    return OpenAda.Syntax.Sequence.Reference;
    -- Returns a list of pointers to either procedure or function
declarations
    -- occurring anywhere in the enclosing package declaration


  function Visible_Primitives( This  : access Class'Class;
                               Named : Wide_String )
    return OpenAda.Syntax.Sequence.Reference;
    -- Returns a list of pointers to either procedure or function
declarations;
    -- one for every primitive named 'Named' declared in the visible part of
    -- the enclosing package declaration


  function Hidden_Primitives( This  : access Class'Class;
                              Named : Wide_String )
    return OpenAda.Syntax.Sequence.Reference;
    -- Returns a list of pointers to either procedure or function
declarations;
    -- one for every primitive named 'Named' declared in the private part of
    -- the enclosing package declaration


  function Is_Primitive( This            : access Class'Class;
                         Subprogram_Name : Wide_String )
    return Boolean;
    -- Returns True iff Subprogram_Name exists and is primitive, false
otherwise


  function Is_Primitive( This       : access Class'Class;
                         Subprogram : access
OpenAda.Syntax.Subprogram_Declaration.Node'Class )
    return Boolean;
    -- Returns True iff designated Subprogram is primitive, false otherwise


  function Is_Primitive_Call( This : access Class'Class;
                              Call : access
OpenAda.Syntax.Procedure_Call.Node'Class )
    return Boolean;


  function Declared_Components( This : access Class'Class )
    return OpenAda.Syntax.Sequence.Reference;
    -- Returns a list of Component_Declaration.Reference or
    -- Discriminant_Specification.Reference values, but not for
    -- those components inhertied from ancestors (if any).


  function Declared_Component( This  : access Class'Class;
                               Named : Wide_String )
    return OpenAda.Syntax.Any;
    -- Returns null if no such component, otherwise returns either
    -- a Component_Declaration.Reference or
Discriminant_Specification.Reference


  function Is_Declared_Component( This           : access Class'Class;
                                  Component_Name : Wide_String )
    return Boolean;


  function Direct_Ancestor( This : access Class'Class )
    return OpenAda.Syntax.Name.Any;
    -- Returns null if not a derived type


  function Is_Abstract( This : access Class'Class )
    return Boolean;


  function Is_Declared_Limited( This : access Class'Class )
    return Boolean;
    -- returns True iff the reserved word 'limited' appears in
    -- the declaration of this type.  Hence the type might be
    -- limited if any ancestry is limited but we won't know.


  function Primary_Type_Declaration( This : access Class'Class )
    return OpenAda.Syntax.Type_Declaration.Any;


  function Enclosing_Package( This : access Class'Class )
    return OpenAda.Syntax.Package_Declaration.Any;


  function Enclosing_Compilation_Unit( This : access Class'Class )
    return OpenAda.Syntax.Compilation_Unit.Any;


  function Corresponding_Body( This : access Class'Class )
    return OpenAda.Syntax.Package_Body.Any;


  function Corresponding_Body_Compilation_Unit( This : access Class'Class )
    return OpenAda.Syntax.Compilation_Unit.Any;


  function Corresponding_Body( This      : access Class'Class;
                               Primitive :
OpenAda.Syntax.Subprogram_Declaration.Any )
    return OpenAda.Syntax.Subprogram_Body.Any;


  function Corresponding_Body( This      : access Class'Class;
                               Primitive :
OpenAda.Syntax.Procedure_Declaration.Any )
    return OpenAda.Syntax.Procedure_Body.Any;


  function Corresponding_Body( This      : access Class'Class;
                               Primitive :
OpenAda.Syntax.Function_Declaration.Any )
    return OpenAda.Syntax.Function_Body.Any;


  function Subject_Package_Name( This : access Class'Class )
    return Wide_String;


  function Subject_Type_Name( This : access Class'Class )
    return Wide_String;


  function Pragma_Metaclass_Parameters( This : access Class'Class )
    return OpenAda.Pragma_Metaclass.Any_Content;
    -- Only meaningful (non-null) when 'This' is set during translation.
    -- Returns null if 'This' is loaded manually via function Class_For.


-- Intercession

  Intercession_Failure : exception;

  function Parsed_Input( This : access Class'Class )
    return OpenAda.Syntax.Compilation.Any;
    -- returns the parsed input from the input file, ie the sequence of
compilation items


and so forth....