Disriminant question

Disriminant question

[prashna]

Hi all,
How to change discriminant value dynamically?

For ex, Have look at following program,

procedure DISCRIMINANT1 is
type DISC(some_disc : integer) is
record
  case some_disc is
  when 1 | 2 =>
     int1 : integer;
  when others =>
     flt : float;
  end case;
end record;

DISC1 : DISC(3);
begin
  disc1.some_disc := 1;
  ^^^^^^^^ I have to change the discriminant.Is there any way to do
this.Any tips will be appriciated.
end;

Thanks

Re: Disriminant question

[tmoran]

> How to change discriminant value dynamically?
  Look under "Default discriminants" in your Ada text/reference.
If the type is declared with a default value for the discriminant,
and a particular object is declared with no discriminant specified,
then the object has the default value, and it can be replaced by
an aggregate assignment giving a new discriminant value and all the
fields appropriate to that value.

Re: Disriminant question

[Lutz Donnerhacke]

* tmoran@acm.org wrote:
> If the type is declared with a default value for the discriminant,
> and a particular object is declared with no discriminant specified,
> then the object has the default value, and it can be replaced by
> an aggregate assignment giving a new discriminant value and all the
> fields appropriate to that value.

That's interesting:
$ cat t.adb
with Ada.Text_IO;
use Ada.Text_IO;

procedure t is
   type DISC(some_disc : integer := 0) is
     record
      case some_disc is
	 when 1 | 2 =>
	    int1, int2, int3 : integer;
	 when others =>
	    flt : float;
      end case;
   end record;
   
   function f (i : Integer) return DISC is
   begin
      declare
	 d : DISC(i);
      begin
	 return d;
      end;
   end f;
   
   disk1 : DISC(1);
   disk3 : DISC(3);
   disk : DISC;
begin
   Put_Line ("disk1'Size =" & Natural'Image (disk1'Size));
   Put_Line ("disk3'Size =" & Natural'Image (disk3'Size));
   disk := DISC'(some_disc => 1, others => 0);
   Put_Line ("disk'Size =" & Natural'Image (disk'Size));
   disk := DISC'(some_disc => 3, others => 0.0);
   Put_Line ("disk'Size =" & Natural'Image (disk'Size));
   for i in 1 .. 5 loop
      declare
	 d : DISC(i);
      begin
	 Put_Line ("d'Size =" & Natural'Image (d'Size));
      end;
   end loop;
   for i in 1 .. 5 loop
      declare
	 e : DISC := f (i);
      begin
	 Put_Line ("e'Size =" & Natural'Image (e'Size));
      end;
   end loop;
end t;
$ t
disk1'Size = 128
disk3'Size = 64
disk'Size = 128
disk'Size = 128
d'Size = 128
d'Size = 128
d'Size = 64
d'Size = 64
d'Size = 64
e'Size = 128
e'Size = 128
e'Size = 128
e'Size = 128
e'Size = 128

Re: Disriminant question

[tmoran]

>  Put_Line ("disk1'Size =" & Natural'Image (disk1'Size));
The original question was whether you could change the discriminant.
Replacing all occurrences of "'Size" with ".some_disc" in program t
results in:
disk1.some_disc = 1
disk3.some_disc = 3
disk.some_disc = 1
disk.some_disc = 3
d.some_disc = 1
d.some_disc = 2
d.some_disc = 3
d.some_disc = 4
d.some_disc = 5
e.some_disc = 1
e.some_disc = 2
e.some_disc = 3
e.some_disc = 4
e.some_disc = 5
  So the discriminant does change correctly.  If you want to change
the 'Size of a record, that's a different question.

Re: Disriminant question

[Lutz Donnerhacke]

* tmoran@acm.org wrote:
>>  Put_Line ("disk1'Size =" & Natural'Image (disk1'Size));
> The original question was whether you could change the discriminant.
> Replacing all occurrences of "'Size" with ".some_disc" in program t
> results in:
> disk1.some_disc = 1
> disk3.some_disc = 3
> disk.some_disc = 1
> disk.some_disc = 3
> d.some_disc = 1
> d.some_disc = 2
> d.some_disc = 3
> d.some_disc = 4
> d.some_disc = 5
> e.some_disc = 1
> e.some_disc = 2
> e.some_disc = 3
> e.some_disc = 4
> e.some_disc = 5
>   So the discriminant does change correctly.  If you want to change
> the 'Size of a record, that's a different question.

No, it did not change beside the case "disk". The other line comes from
different variables.

Re: Disriminant question

[Lutz Donnerhacke]

* prashna wrote:
> How to change discriminant value dynamically?

This is impossible. You can't change the discriminant, because the
instantiated variables does occupy different space. But you can set the
discriminant dynamically.

$ cat t.adb
with Ada.Text_IO;
use Ada.Text_IO;

procedure t is
   type DISC(some_disc : integer) is
     record
      case some_disc is
	 when 1 | 2 =>
	    int1, int2, int3 : integer;
	 when others =>
	    flt : float;
      end case;
   end record;
   
   function f (i : Integer) return DISC is
   begin
      declare
	 d : DISC(i);
      begin
	 return d;
      end;
   end f;
   
   disk1 : DISC(1);
   disk3 : DISC(3);

begin
   Put_Line ("disk1'Size =" & Natural'Image (disk1'Size));
   Put_Line ("disk3'Size =" & Natural'Image (disk3'Size));
   for i in 1 .. 5 loop
      declare
	 d : DISC(i);
      begin
	 Put_Line ("d'Size =" & Natural'Image (d'Size));
      end;
   end loop;
   for i in 1 .. 5 loop
      declare
	 e : DISC := f (i);
      begin
	 Put_Line ("e'Size =" & Natural'Image (e'Size));
      end;
   end loop;
end t;
$ t
disk1'Size = 128
disk3'Size = 64
d'Size = 128
d'Size = 128
d'Size = 64
d'Size = 64
d'Size = 64
e'Size = 128
e'Size = 128
e'Size = 64
e'Size = 64
e'Size = 64

Re: Disriminant question

[Matthew Heaney]

Lutz Donnerhacke <lutz@iks-jena.de> wrote in message news:<slrnb6gvth.nt.lutz@taranis.iks-jena.de>...
> * prashna wrote:
> > How to change discriminant value dynamically?
> 
> This is impossible. You can't change the discriminant, because the
> instantiated variables does occupy different space. But you can set the
> discriminant dynamically.

The rule is that you can't change the discriminant if the object was
declared with an explicit discriminant value.

type RT (D : DT := DT'First) is 
   record
      case D is
         when DT'First =>
            null;

         when others =>
            null;
      end case;
   end record;

declare
  R1 : RT; --yes, can be changed

  R2 : RT := (D => DT'Last);  --yes, can be changed

  R3 : RT (DT'First); --no, cannot be changed

  R4 : RT (DT'First) := (D => DT'First); --no, can't be changed
begin
  R1 := (D => DT'Last);    --OK
  R2 := (D => DT'First);   --OK
end;

Basically, whenever you explicitly specify the discrimiant value in
the declaration (i.e. the "subtype mark"), then that constrains the
object, so that its discriminant cannot be changed.

This allows the compiler to allocate only as much stack space as is
needed for those components that apply to that discriminant value.

Note that in the case of R3 and R4 above, it doesn't matter that the
type has a default discriminant.  The fact that the object was
declared with an explicit value constrains the (sub)type.

Re: Disriminant question - Waiting desperately for solution :-(

[prashna]

> 
> The rule is that you can't change the discriminant if the object was
> declared with an explicit discriminant value.
> 

Thanks all for helping.

Here is my original code(which I should I have posted earlier but
could not because this is highly confidential and hence I am showing
only part of the code.Hope u ppl understand.) and a runtime error
(discriminant error) is raising.

procedure CLEAR_DISCON (PRIMARY_FPLN_PARAM  : in out       
SERVER_TYPES.T_PRIMARY_FPLN;
                        DISCON              : in
SERVER_TYPES.T_LEG_INDEX;
                        REQUEST_STATUS      : out
SERVER_TYPES.T_REQUEST_STATUS;
                        MODIFICATION_REPORT : out
SERVER_TYPES.T_FPLN_MODIF_ORIGIN) is
   L_TERM : SERVER_TYPES.T_TERM;
...
...
 begin
....
....
      L_TERM := (LEG_TYPE => SERVER_TYPES.TF, 
                 FIX =>
PRIMARY_FPLN_PARAM.LEGS.LEGS_ARRAY(0).TERM.FIX);

                        ^^^ exception discriminat error is raised here
     --PRIMARY_FPLN_PARAM.LEGS.LEGS_ARRAY(DISCON+1).TERM := L_TERM;
      PRIMARY_FPLN_PARAM.LEGS.LEGS_ARRAY(DISCON+1).TERM := 
             (LEG_TYPE => SERVER_TYPES.TF,
              FIX => ( IDENT     => L_TERM.FIX.IDENT,
                       B_OVERFLY => L_TERM.FIX.B_OVERFLY,
                       POS       => ( LAT => L_TERM.FIX.POS.LAT,
                                      LON => L_TERM.FIX.POS.LON)));
                        ^^^ Is this OK if I correct the previous
error?
....
....

end CLEAR_DISCON;

package  SERVER_TYPES is 
......
......
   type T_FIX is
      record
         IDENT     : FMS_TYPES.T_IDENT (1 .. 7);
         B_OVERFLY : BOOLEAN;
         POS       : FMS_TYPES.T_POSITION;
      end record;

   type T_TERM (LEG_TYPE : T_LEG_TYPE := NONE) is
      record
         case LEG_TYPE is
            when DF | TF | LIF | TP =>
               FIX : T_FIX;
            when PPOS | NONE =>
               null;
         end case;
      end record;
   type T_LEG (LEG_TYPE : T_LEG_TYPE := NONE) is
      record
         MARK              : T_LEG_INDEX := 0;
         TERM              : T_TERM (LEG_TYPE);
         TURN_DIR          : FMS_TYPES.T_TURN_DIR := FMS_TYPES.NONE;
         B_DISC_AHEAD      : BOOLEAN              := FALSE;
         STATIC_PARAMETERS : T_LEG_STATIC_PARAMETERS_C;
         DISTANCE_CUMUL    : FMS_TYPES.T_DISTANCE_NM_C;
      end record;

.....
.....
end SERVER_TYPES;

package FMS_TYPES is
.....
.....
  subtype T_ANG_REL_DEG is T_DEGREE range -179.99999 .. +180.0;
  subtype T_LATITUDE is T_ANG_REL_DEG range -90.0 .. +90.0;
  subtype T_LONGITUDE is T_ANG_REL_DEG;

  type T_IDENT_INDEX is range 0 .. 30;
  type T_CHAR is
     (
      PROG,
      ....
      ....
      LOZENGE);
  type T_IDENT is array (T_IDENT_INDEX range <>) of T_ISO5_CHAR;

  type T_POSITION is record
    LAT    : T_LATITUDE;
    LON   : T_LONGITUDE;
  end record;
...
...
end FMS_TYPES;

I am using gnat compiler on AIX machine.

Hope this information is enough.

Thanks

Re: Disriminant question - Waiting desperately for solution :-(

[Gautier]

type T_TERM (LEG_TYPE : T_LEG_TYPE := NONE) is
      record
         case LEG_TYPE is
            when DF | TF | LIF | TP =>
               FIX : T_FIX;
            when PPOS | NONE =>
               null;
         end case;
      end record;
...
   L_TERM : SERVER_TYPES.T_TERM;

Well, L_TERM has the discriminant LEG_TYPE = NONE.
Then L_TERM.FIX is a nonsense. This is why...

      L_TERM := (LEG_TYPE => SERVER_TYPES.TF, 
                 FIX =>

...bombs with a "discriminant error". Fun, isn't it ?
________________________________________________________
Gautier  --  http://www.mysunrise.ch/users/gdm/gsoft.htm

NB: For a direct answer, e-mail address on the Web site!