Assign values when deriving a record type in Ada without using discriminants

Question

I'm trying to model three entities in Ada: Person, Woman and Man. I want Person to have one field that is Gender, that must be Unknown for Person, Male for Man and Female for Woman.

I want to implement Man and Woman as Person derived types whose Gender field is Male and Female respectively.

In addition, I want that the only allowed value for Person's Gender is Unknown, and likewise Male for Man and Female for Woman.

I have tried the following but of course it does not compile:

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;

I don't want to declare Person as a parametric type because, in that way, Person would be allowed to be Male, Female or Unknown, and I don't want to allow this.

Is it possible to do what I want to to do?

Answer 1

I know you said no discriminants, but the reason you gave is to prevent assignment between them. Would you be willing to consider hiding the discriminant behind a private type? That would prevent client code from doing assignments and if you use type derivation, it would prevent you from accidentally assigning them in the package's internal code. Below are two different examples where you can hide the discriminant, preventing assignment. EDIT: Added a third option using generics.

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 2

Using plain Ada 95 (except for a bit of cheating to avoid having to provide a body for the packages Man and 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 3

Ada 2012 solution:

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);

I am unsure whether this works with non-tagged types.