Присваивать значения при получении типа записи в Ada без использования дискриминантов

Question

Я пытаюсь смоделировать три сущности в Аде: Person, Woman и Man.Я хочу, чтобы у Person было одно поле Gender, которое должно быть Unknown для Person, Male для Man и Female для Woman.

Я хочуреализовать Man и Woman как Person производные типы, чьи поля Gender равны Male и Female соответственно.

Кроме того, я хочу, чтобы единственное допустимое значение для Person'sGender равно Unknown, а также Male для Man и Female для Woman.

Я пробовал следующее, но, конечно, оно не компилируется:

package Persons is

   type Genders is (Male, Female, Unknown);

   type Person is private;
   type Man is private;
   type Woman is private;

   function Get_Age    (Self : Person) return Integer;
   function Get_Name   (Self : Person) return String;
   function Get_Weight (Self : Person) return Float;
   function Get_Height (Self : Person) return Float;
   function Get_gender (Self : Person) return Genders;

private

   type Person is
      record
         Age            : Integer := 0;
         Name           : String (1..256) := (others => Character'Val(0)); -- '
         Height, Weight : Float := 0.0;
         Gender         : Genders := Unknown;
      end record;

   type Man   is new Person with Gender => Male;            
   type Woman is new Person with Gender => Female;

end Persons;

Я не хочу объявлять Person как параметрический тип, потому что, таким образом, Person будет разрешено быть Male, Female или Unknown, и я не хочу этого делать.

Можно ли делать то, что я хочу делать?

Answer 1

Использование простой Ады 95 (за исключением небольшого обмана, чтобы не предоставлять тело для пакетов Man и Woman):

private with Ada.Strings.Unbounded;

package Person is

   type Age_In_Years is range 0 .. 200;
   type Weight_In_kg is delta 0.1 range 0.0 .. 300.0;
   type Height_In_m  is delta 0.01 range 0.0 .. 3.0;
   type Genders      is (Male, Female);

   type Instance is abstract tagged private;
   subtype Class is Instance'Class; -- '

   function Age    (Self : in Instance) return Age_In_Years;
   function Name   (Self : in Instance) return String;
   function Weight (Self : in Instance) return Weight_In_kg;
   function Height (Self : in Instance) return Height_In_m;
   function Gender (Self : in Instance) return Genders is abstract;

private

   type Instance is abstract tagged
      record
         Age    : Age_In_Years;
         Name   : Ada.Strings.Unbounded.Unbounded_String;
         Weight : Weight_In_kg;
         Height : Height_In_m;
      end record;

end Person;

with Person;

package Man is

   subtype Parent is Person.Instance;
   type Instance is new Parent with null record;
   subtype Class is Instance'Class; -- '

   overriding
   function Gender (Self : in Instance) return Person.Genders is (Person.Male);

end Man;

with Person;

package Woman is

   subtype Parent is Person.Instance;
   type Instance is new Parent with null record;
   subtype Class is Instance'Class; -- '

   overriding
   function Gender (Self : in Instance) return Person.Genders is (Person.Female);

end Woman;

Answer 2

Я знаю, что вы сказали, что нет дискриминантов, но причина, по которой вы указали, состоит в том, чтобы предотвратить распределение между ними. Хотели бы вы спрятать дискриминанта за закрытым типом? Это не позволит клиентскому коду выполнять присваивания, а если вы используете вывод типов, это предотвратит случайное присваивание их во внутреннем коде пакета. Ниже приведены два разных примера, где вы можете скрыть дискриминант, предотвращая присвоение. РЕДАКТИРОВАТЬ: Добавлен третий вариант с использованием дженериков.

procedure jdoodle is

    package Persons1 is

       type Genders is (Male, Female, Unknown);

       type Person is private;
       type Man is private;
       type Woman is private;

    private

       type Implementation(Gender : Genders) is
          record
             Age            : Integer := 0;
             Name           : String (1..256) := (others => Character'Val(0)); -- '
             Height, Weight : Float := 0.0;
          end record;

       type Person is new Implementation(Unknown);
       type Man    is new Implementation(Male);         
       type Woman  is new Implementation(Female);

    end Persons1;

    package Persons2 is

       type Genders is (Male, Female, Unknown);

       type Person is private;
       type Man is private;
       type Woman is private;

    private

       type Person(Gender : Genders := Unknown) is
          record
             Age            : Integer := 0;
             Name           : String (1..256) := (others => Character'Val(0)); -- '
             Height, Weight : Float := 0.0;
          end record;

       type Man    is new Person(Male);         
       type Woman  is new Person(Female);

    end Persons2;

    package Persons3 is

       type Genders is (Male, Female, Unknown);

       type Person is private;
       type Man is private;
       type Woman is private;

    private

       generic
           The_Gender : Genders := Unknown;
       package Generic_Persons is
           type Person is record
               Age            : Integer := 0;
               Name           : String (1..256) := (others => Character'Val(0)); -- '
               Height, Weight : Float := 0.0;
               Gender         : Genders := The_Gender;
           end record;
       end Generic_Persons;

       package Person_Pkg is new Generic_Persons(Unknown);
       package Man_Pkg is new Generic_Persons(Male);
       package Woman_Pkg is new Generic_Persons(Female);

       type Person is new Person_Pkg.Person;
       type Man    is new Man_Pkg.Person;         
       type Woman  is new Woman_Pkg.Person;

    end Persons3;

begin
    null;
end jdoodle;

Answer 3

Решение Ada 2012:

type Person is tagged record
   -- ...
   Gender : Genders := Unknown;
end record with Type_Invariant => (Person.Gender = Unknown);

type Man is new Person with null record
  with Type_Invariant => (Man.Gender = Male);
type Woman is new Person with null record
  with Type_Invariant => (Woman.Gender = Female);

Я не уверен, работает ли это с типами без тегов.