'Truncate for tagged types, for casting an instance to an ancestor's type.

[joshua-c-fletcher]

If we have a tagged type hierarchy, it is always possible to cast an instance of a descendent type to any of it's ancestors... so long as you know in the code exactly what type you want to cast it to.

But it's possible to have a situation that doesn't fit that scenario, for example, suppose you have the following,
where 'Truncate operates on an instance of a tagged type, takes as a parameter the tag of an ancestor type, and returns the value as it would be cast to the ancestor's type.

-- we want assign all the parts of D that are part of Object's type, even if they're not part of type T.
--
procedure Update (Object : in out T'Class, D : in T'Class) is
begin
  if Ada.Tags.Is_Descendant_At_Same_Level(Descendant => D'Tag, Ancestor => Object'Tag) then
    Object := D'Truncate (Object'Tag);
  else
    raise Constraint_Error with "R should be a descendant type of L's type";
  end if;
end Copy;

or

-- this returns True if D matches Object, if D is cast to the type of Object.
-- where Object is a descendant of T and D is a descendant of Object.
-- we want to compare all the parts of D with Object that are part of Object's type; if those match, we want 'True'.
--
function Match (Object, D : in T'Class) return Boolean is
begin
  if Ada.Tags.Is_Descendant_At_Same_Level(Descendant => D'Tag, Ancestor => Object'Tag) then
    return Object = D'Truncate (Object'Tag);
  else
    return False;
  end if;
end Match;

It's possible to accomplish this using the Generic_Dispatching_Constructor if T'Class has a dispatching conversion function that converts any T'Class into its own type, but that's quite a bit of overhead.

This would be another place where 'Subtype (discussed in Issue #15 and AI22-0071-1) would be useful, since then we could just do this:

Object := Object'Subtype (D); and:
return Object = Object'Subtype (D);
In the absence of 'Subtype, though,
'Truncate (Anscestor : Ada.Tags.Tag) would work for these cases.

[joshua-c-fletcher]

Actually, 'Subtype would be perfect for this use case, and simpler to understand intuitively.

• Useful for comparison with a value of an ancestor type, or assignment to a variable of an ancestor type when we have a value of the ansestor type, but the name of the type isn't available in the subprogram.

'Truncate would provide an additional ability to cast (for example) to a parent type in the absence of an instance of the type you're wanting to cast to.
For example:
V : T'Class := Deeper'Truncate (Ada.Tags.Parent_Tag (Deeper'Tag));

I'm not sure if the latter use would have a purpose (casting a type to its own parent type) .. it could, but 'Subtype wouldn't provide the opportunity for that.

The other use would definitely be handy to be able to do, and they could be accomplished with 'Subtype or by the proposed 'Truncate from this issue.

[CKWG]

I'm not quite sure what you are trying to do. Is it this?

  type T0 is tagged record
    I0: Integer;
  end record;

  -- The Nearest Common Ancestor
  type T1 is new T0 with record
    I1: Integer;
  end record;

  type T11 is new T1 with record
    I11: Integer;
  end record;

  type T12 is new T11 with record
    I12: Integer;
  end record;

  type T21 is new T1 with record
    I21: Integer;
  end record;

  --              ...Common part...
  Source: T12 := (I0 =>  0, I1 => +1, I11 => +11, I12 => +12);
  Target: T21 := (I0 => <>, I1 => -1, I21 => -21);

  -- Try to assign the value of the common part of Source to Target
  -- Target := (Target with delta T1 (Source));  delta aggregate does not work
  
  T1 (Target) := T1 (Source);  -- view conversion

Do you want to do the assignment without knowing or caring for the NCA T1?

[joshua-c-fletcher]

@CKWG wrote:

Do you want to do the assignment without knowing or caring for the NCA T1?
T1 (Target) := T1 (Source); -- view conversion

That's a little more complex than what I had in mind.
In my assignment example the type of the LHS was the NCA, so only the RHS needed to be cast to the type of the LHS.

The comparison use case is really the driving consideration, rather than assignment, but the principle would apply equally to assignment as well.

To use your example records to illustrate the idea with respect to assignment, suppose there is a subprogram that takes two parameters of type T0'Class. The extending types are not known where this subprogram is defined; T0 is indented to be extended, and this procedure expects two values of type T0'Class for its parameters. For this example, the procedure might be called with the first parameter of type T1 and the second of type T11.

Without visibility of the specific descendent types, we can see the tags, and we can use the Is_Descendant_At_Same_Level function to confirm that the second parameter could be cast to the type of the first parameter (because we can confirm those criteria)... But we can't actually do the cast, because the only type we can name is T0. This procedure and the T0 type might be in a library, whereas T1 and T11 might be defined in an application using the library.

We haven't with'd the packages where T1 and T11 are defined, and indeed should not, where this procedure is defined.
... but we have all the information available to know that the T11 parameter is a descendent type of the T1 parameter's type, and we can see the tags, but we can't currently cast and assign like this:
LHS := RHS'Truncate (LHS'Tag); -- 'Truncate expects an Ancestor's tag.
or like this:
LHS := LHS'Subtype (RHS);
(where LHS is the NCA of LHS and RHS, but the name of the NCA type not visible; it is a descendent of the visible class wide type.)

I'll give an example for the comparison use case.

Suppose you an abstract type called Root_Event_Type - it might be an interface or an abstract tagged type meant to be at the root of a hierarchy.

Suppose you can register events with some behaviour that you want to happen associated with those events: when an event is "posted" you want to compare the "posted" event with the "registered" event to determine if the behaviour should proceed.

The Root_Event_Type, the ability to register events and behaviour, etc., are all part of a library, but it's up to the application using the library to define the events to register for and the events to post, so the code that evaluates whether or not to proceed with the behaviour can't see the specific types that might be registered or posted.

... but the posted events might extend what was registered....
so if you have a null type representing a keyboard press (any keyboard press) - type K,
a descendent type with a character, representing a keyboard press with a specific character - type KC
and a further descendent type with a character and modifier data... - type KCM

Then you could register some behaviour for when any keyboard Is pressed, with an instance of that type (K).
You could register additional behaviour for when a specific character is pressed (KC),
and you could also register behaviour when a specific character is pressed with specific modifier data (KCM).

... but if the posted event has a specific character and modifier data (KCM),
and we're considering a registration for that specific character press (regardless of modifier data) (type KC),
and these are different types in the same hierarchy,
we want to compare the posted event (type KCM) with the registered event (type KC) and consider it a match if the portion of data the types have in common matches. We could do that if we could cast the posted event to the type of the registered event and compare for equality... but even though we can determine the relationship (yes the posted event is descended from the registered event)... we can't convert the posted event into it's ancestor (or parent) type for comparison.

The only way we can do that right now is by adding an additional abstract dispatching function to Root_Event_Type and implementing it at all the descendants.

Whereas, it would be nice if we could say:
Match : constant Boolean := Registered_Event = Posted_Event'Truncate (Registered_Event'Tag);
or
Match : constant Boolean := Registered_Event = Registered_Event'Subtype (Posted_Event);
-- where Posted_Event is confirmed to be of a type descended from Registered_Event, even though neither type is visible where the enclosing subprogram is defined.