A linguagem

Genéricos

Tipos e rotinas genéricos, restrições, monomorfização e escolha de caminho por tipo com {$if}.

Genérico em Fenner é monomorfização: a declaração fica guardada como texto, e cada combinação de argumentos a reanalisa com o parâmetro trocado pelo tipo real. O resultado é código comum e rápido para cada instanciação, sem dicionário de tipos em execução.

generics.fxp

program Generics;

type
  // genérico de tipo
  TStack<T> = class(TObject)
  private
    FItems: array of T;
    FCount: Int32;
  public
    procedure Push(const AItem: T);
    function Pop: T;
    property Count: Int32 read FCount;
  end class;

  TBox = class(TObject)
  public
    Value: Int32;
  end class;

  // restrições: T tem de ser classe e ter construtor sem argumentos
  TFactory<T: class, constructor> = class(TObject)
  public
    class function Make: T;
  end class;

procedure TStack<T>.Push(const AItem: T);
begin
  if FCount = Length(FItems) then
    SetLength(FItems, FCount * 2 + 4);
  FItems[FCount] := AItem;
  Inc(FCount);
end procedure;

function TStack<T>.Pop: T;
begin
  Dec(FCount);
  Exit(FItems[FCount]);
end function;

class function TFactory<T>.Make: T;
begin
  Exit(T.Create);
end function;

// genérico de rotina: um par (nome, argumentos) gera uma única cópia
function Larger<T>(const A, B: T): T;
begin
  if A > B then
    Exit(A);
  Exit(B);
end function;

var
  Numbers: TStack<Int32>;
  Words: TStack<UString>;
  Box: TBox;
begin
  Numbers := TStack<Int32>.Create;
  Numbers.Push(10);
  Numbers.Push(20);
  Numbers.Push(30);
  WriteLn('Pop: ', Numbers.Pop, ', sobraram ', Numbers.Count);

  Words := TStack<UString>.Create;
  Words.Push('um');
  Words.Push('dois');
  WriteLn('Pop: ', Words.Pop);

  Box := TFactory<TBox>.Make;
  Box.Value := 5;
  WriteLn('Box.Value = ', Box.Value);

  WriteLn(Larger<Int32>(3, 9), ' ', Larger<UString>('abc', 'abd'));
end.

Saída

Pop: 30, sobraram 2
Pop: dois
Box.Value = 5
9 abd

Genéricos de tipo#

Fenner

type
  TStack<T> = class(TObject)
  private
    FItems: array of T;
    FCount: Int32;
  public
    procedure Push(const AItem: T);
    function Pop: T;
  end class;

procedure TStack<T>.Push(const AItem: T);
...
var
  Numbers: TStack<Int32>;

Os corpos dos métodos escrevem-se como TStack<T>.Push. Um genérico pode ser uma classe ou um record (o ?T é um record genérico da RTL), e um genérico pode servir de argumento a outro (TArray<T>).

Genéricos de rotina#

Fenner

function Larger<T>(const A, B: T): T;
begin
  if A > B then
    Exit(A);
  Exit(B);
end function;

Larger<Int32>(3, 9);

Cada par (nome, argumentos) produz uma rotina, guardada numa tabela: citar Larger<Int32> duas vezes não gera duas cópias. Daí em diante é uma rotina comum. Também existem métodos de classe genéricos (class function TFab<T>.Nova: T).

Restrições#

Fenner

TFactory<T: class, constructor> = class(TObject)

Restrição	Exige que `T` seja…
`class`	uma classe
`record`	um record
`constructor`	construível sem argumentos (permite `T.Create` no corpo)
`IFoo`	uma classe que implementa a interface
`TBase`	a classe ou um descendente dela

Depois de :, a vírgula pertence à lista de restrições (T: class, constructor é um parâmetro com duas restrições); o parâmetro seguinte vem depois de ;. Sem :, os dois separadores valem.

Escolhendo o caminho pelo tipo#

Dentro de um genérico, o {$if} é reavaliado na instanciação, com o T já trocado pelo tipo real. As funções de tipo disponíveis:

Função	Responde
`Is(T, X)`	é o mesmo tipo?
`SizeOf(T)`	o tamanho, comparável com `=` `<>` `<` `>`
`IsManaged`, `IsString`, `IsDynArray`, `IsRecord`, `IsManagedRecord`	a espécie do tipo
`IsObject(T)` / `IsClass(T)`	instância (`class`) / referência (`class of`)
`Defined(X)`	existe o símbolo de `{$define}`?
`Declared(X)`	a declaração existe (e, num late module, sobreviveu à eliminação)?

conditional.fxp

program Conditional;

{$define TRACE}

type
  TInfo<T> = class(TObject)
  public
    class function Describe: UString;
  end class;

// dentro de um genérico, o {$if} é reavaliado na instanciação, com o T já trocado
class function TInfo<T>.Describe: UString;
begin
  {$if Is(T, UInt8)}
  Exit('um byte');
  {$elseif IsString(T)}
  Exit('um texto');
  {$elseif SizeOf(T) < 8}
  Exit('pequeno (' + IntToUStr(SizeOf(T)) + ' bytes)');
  {$else}
  Exit('grande (' + IntToUStr(SizeOf(T)) + ' bytes)');
  {$endif}
end function;

begin
  WriteLn(TInfo<UInt8>.Describe);
  WriteLn(TInfo<UString>.Describe);
  WriteLn(TInfo<Int32>.Describe);
  WriteLn(TInfo<Int128>.Describe);

  {$ifdef TRACE}
  WriteLn('TRACE está ligado');
  {$endif}
  {$ifdef MSWin64}
  WriteLn('compilado para Windows 64 bits');
  {$endif}
end.

Saída

um byte
um texto
pequeno (4 bytes)
grande (16 bytes)
TRACE está ligado
compilado para Windows 64 bits

Veja mais em Diretivas e em Metaprogramação.