Array of discriminated tasks

Hello,

I would like to create an array of tasks in a declare block. The tasks require discriminants which are unique to each task. I am not sure what the best solution is for this but I would prefer that I don’t have to dynamically allocate the task objects.

I have provided an example below which hopefully illustrates what I desire to achieve.

Thanks,
N

with Ada.Text_IO; use Ada.Text_IO;

procedure Show_Task_Type_Array is
   task type TT (Uppercase : Boolean) is
      entry Start (N : Integer);
   end TT;

   task body TT is
      Task_N : Integer;
   begin
      accept Start (N : Integer) do
         Task_N := N;
      end Start;
      if Uppercase then
        Put_Line ("IN TASK T: " & Integer'Image (Task_N));
      else
        Put_Line ("In task T: " & Integer'Image (Task_N));
      end if;
   end TT;

   type Task_Range is range 1 .. 5;

   Inputs : array (Task_Range) of Boolean := (True, False, False, True, True);

   -- [1] Doesn't work
   My_Tasks_1 : array (Task_Range) of TT (Inputs (I in Task_Range => I));
   
   -- [2] Doesn't work
   My_Tasks_2 : array (Task_Range) of TT (Inputs);
begin
   Put_Line ("In main");

   for I in My_Tasks'Range loop
      My_Tasks (I).Start (Natural (I));
   end loop;
end Show_Task_Type_Array;

Just to be certain, sending this data in the entry call isn’t an option, right?

After a quick review of my Barnes book, one way to do this with definite discriminated types is to write out the literal or to use functions returning values of the type, of course, but neither of these are options for a limited type like tasks, now are they? I’m not certain there’s a good way to do this without using access types, since that allows for sidestepping the problem posed by limited types.

The way to do this a bit interesting. I actually asked a similar question to this on comp.lang.ada many many years ago. The trick is to use a combination of a default discriminant and a constructing function. See the example tested on the jdoodle online Ada compiler:

with Ada.Text_IO; use Ada.Text_IO;

procedure jdoodle is

   -- Make the discriminant defaulted, so that Ada will allow
   -- you to store TT objects of any discriminant together
   task type TT (Uppercase : Boolean := False) is
      entry Start (N : Integer);
   end TT;

   task body TT is
      Task_N : Integer;
   begin
      accept Start (N : Integer) do
         Task_N := N;
      end Start;
      if Uppercase then
        Put_Line ("IN TASK T: " & Integer'Image (Task_N));
      else
        Put_Line ("In task T: " & Integer'Image (Task_N));
      end if;
   end TT;

   type Task_Range is range 1 .. 5;

   Inputs : array (Task_Range) of Boolean := (True, False, False, True, True);
   
   -- This is required because you cannot assign a task via an aggregate.
   -- Using a constructing function bypasses this issue.
   function New_Task(Uppercase : Boolean) return TT is
   begin
      return Result : TT(Uppercase);
   end New_Task;

   --Does work
   My_Tasks_3 : array (Task_Range) of TT := 
    (New_Task(True),
     New_Task(False),
     New_Task(False),
     New_Task(True),
     New_Task(True));
     
begin
   Put_Line ("In main");

   for I in My_Tasks_3'Range loop
      My_Tasks_3 (I).Start (Natural (I));
   end loop;
end jdoodle;

The reasons for this:
Default discriminant: In general, discriminated record generate logically different types when they have different discriminants. So TT(False) is a completely different type than TT(True). Arrays can only contain groups of the same type. If you give the discriminant a default value however, it tells Ada that the compiler will ensure there is enough memory to hold all variants regardless of the discriminant (GNAT reserves the space needed to create the largest variant, Janus Ada uses dynamic memory allocation instead, etc.). This allows you to store all types TT variants in the same array as long as you don’t specify a discriminant value in the array type definition.

The next challenge is how do you initialize the array components since you cannot provide the discriminant in the array type definition? With normal records, you just assign them using aggregate initialization, but Tasks cannot be created that way. However, you can create a task in a function and pass it out as a result (this will use build in place mechanics. To you create a function that takes the discriminant you want as a parameter, create the specific variant of TT in that funciton and return it. You can then use that function to assign initial values to the array components.

1 Like

Out of curiosity, this wouldn’t work in Ada 1995 because it didn’t have extended return statements, so is there any way to do it under those constraints?

You could potentially wrap the task types inside a discriminated record instead and do an array of those:

with Ada.Text_IO; use Ada.Text_IO;

procedure jdoodle is

   -- Make the discriminant defaulted, so that Ada will allow
   -- you to store TT objects of any discriminant together
   task type TT (Uppercase : Boolean := False) is
      entry Start (N : Integer);
   end TT;

   task body TT is
      Task_N : Integer;
   begin
      accept Start (N : Integer) do
         Task_N := N;
      end Start;
      if Uppercase then
        Put_Line ("IN TASK T: " & Integer'Image (Task_N));
      else
        Put_Line ("In task T: " & Integer'Image (Task_N));
      end if;
   end TT;
   
   type TT_Record(Uppercase : Boolean := False) is limited record
      Impl : TT(Uppercase);
   end record;

   type Task_Range is range 1 .. 5;

   Inputs : array (Task_Range) of Boolean := (True, False, False, True, True);
   
   -- This is required because you cannot assign a task via an aggregate.
   -- Using a constructing function bypasses this issue.
   function New_Task(Uppercase : Boolean) return TT is
   begin
      return Result : TT(Uppercase);
   end New_Task;

   --Does work
   My_Tasks_3 : array (Task_Range) of TT := 
    (New_Task(True),
     New_Task(False),
     New_Task(False),
     New_Task(True),
     New_Task(True));
     
   My_Tasks_4 : array (Task_Range) of TT_Record :=
    ((Uppercase => True, others => <>),
     (Uppercase => False, others => <>),
     (Uppercase => False, others => <>),
     (Uppercase => True, others => <>),
     (Uppercase => True, others => <>));
     
begin
   Put_Line ("In main");

   for I in My_Tasks_3'Range loop
      My_Tasks_3 (I).Start (Natural (I));
   end loop;

   for I in My_Tasks_4'Range loop
      My_Tasks_4 (I).Impl.Start (Natural (I));
   end loop;
end jdoodle;

I haven’t tried to see if there are any other Ada 95 related issues with that, but that is what I would try.

Unfortunately, the box for type aggregates was also added in Ada 2005.

Regardless, this is interesting. When I first learned about extended return statements, I was still green to the language, and, since I don’t use them anyway, I’d forgotten their use for exactly this task.

Thanks for the ideas Verisimilitude and jere.

I decided to allocate the tasks on the heap like this:

pragma Ada_2022;                                                                                                                  
with Ada.Text_IO; use Ada.Text_IO;                                                 
with Ada.Unchecked_Deallocation;                                                   
                                                                                     
procedure Main is                                                                  
   task type TT (input : Boolean) is                                                                              
      entry Start (N : Integer);                                                                                  
   end TT;                                                                                                        
                                                                                                                    
   task body TT is                                                                                                
      Task_N : Integer;                                                                                           
   begin                                                                                                          
      accept Start (N : Integer) do                                                                               
         Task_N := N;                                                                                             
      end Start;                                                                                                  
      if Input then                                                                                               
      Put_Line ("In task T: "                                                                                     
                & Integer'Image (Task_N));                                                                        
      else                                                                                                        
      Put_Line ("In TASK T: "                                                                                     
                & Integer'Image (Task_N));                                                                        
      end if;                                                                                                     
   end TT;                                                                                                        
                                                                                                                    
    type Span is range 1 .. 5;                                                                                    
    type TT_Ptr is access TT;                                                                                      

    procedure Free is new Ada.Unchecked_Deallocation (TT, TT_Ptr);                                                 
                                                                                                                    
    Input : array (Span) of Boolean := (True, False, False, True, True);                                           
    My_Tasks : array (Span) of TT_Ptr := (for I in Span => new TT (Input (I)));                                    
                                                                                                                    
begin                                                                              
   Put_Line ("In main");                                                                                          
                                                                                                                    
   for I in My_Tasks'Range loop                                                    
      My_Tasks (I).Start (Integer(I));                                                                            
   end loop;

  -- Do something important
                                                                                                                    
   for T of My_Tasks loop                                                                                         
      Free (T);                                                                                                   
   end loop;                                                                                                      
                                                                                    
  end Main;

I could use entries but I need to pass in access types so the tasks need unique discriminants.

N

function New_Task (Uppercase : Boolean) return TT is
   Result : TT (Uppercase => Uppercase);
begin -- New_Task
   return Result;
end New_Task;

Returning limited types has gone through a number of changes through the various Ada versions. In Ada-12 and later, you cannot return a local object; in earlier versions, you could.

1 Like