Weird in more ways than one

To illustrate an annoying limitation of Delphi generics regarding typed pointers, Lars Fosdal has recently posted some code that provides a half-working generic double linked list implementation (link). The fact it only half works is at least half the point (so to speak), but I’m not sure the limitations of Delphi generics are the only thing making the code ‘weird’ as Lars calls it.

To illustrate, here’s how I would write it – I’ve tried to keep the code as similar to Lars’ version as possible, though the semantics are inevitably slightly different:

program Project1;

{$APPTYPE CONSOLE}

type
  TLinkVisitor<T> = reference to procedure(const Item: T);

  TDoubleLinked<T> = record
    Prev: ^TDoubleLinked<T>;
    Next: ^TDoubleLinked<T>;
    Value: T;
    class function Create(const aValue: T): Pointer; static;
    function Add(const aValue: T): Pointer;
    procedure Delete;
    procedure DeleteAll;
    function First: Pointer;
    function Last: Pointer;
    procedure ForEach(const Proc: TLinkVisitor<T>);
  end;

{ TDoubleLinked<T> }

class function TDoubleLinked<T>.Create(const aValue: T): Pointer;
var
  Node: ^TDoubleLinked<T>;
begin
  Node := AllocMem(SizeOf(TDoubleLinked<T>));
  Node.Value := aValue;
  Result := Node;
end;

function TDoubleLinked<T>.Add(const aValue: T): Pointer;
var
  NewNode: ^TDoubleLinked<T>;
begin
  NewNode := AllocMem(SizeOf(TDoubleLinked<T>));
  NewNode.Value := aValue;
  NewNode.Prev := @Self;
  if Next <> nil then
  begin
    NewNode.Next := Next;
    Next.Prev := Pointer(NewNode);
  end;
  Result := NewNode;
  Next := Result;
end;

procedure TDoubleLinked<T>.Delete;
begin
  if Prev <> nil then Prev.Next := Next;
  if Next <> nil then Next.Prev := Prev;
  Finalize(Self);
  FreeMem(@Self);
end;

procedure TDoubleLinked<T>.DeleteAll;
var
  Node, Next: ^TDoubleLinked<T>;
begin
  Node := First;
  repeat
    Next := Pointer(Node.Next);
    Finalize(Node^);
    FreeMem(Node);
    Node := Next;
  until Node = nil;
end;

function TDoubleLinked<T>.First: Pointer;
var
  Node: ^TDoubleLinked<T>;
begin
  Node := @Self;
  while Node.Prev <> nil do Node := Pointer(Node.Prev);
  Result := Node;
end;

function TDoubleLinked<T>.Last: Pointer;
var
  Node: ^TDoubleLinked<T>;
begin
  Node := @Self;
  while Node.Next <> nil do Node := Pointer(Node.Next);
  Result := Node;
end;

procedure TDoubleLinked<T>.ForEach(const Proc: TLinkVisitor<T>);
var
  Node: ^TDoubleLinked<T>;
begin
  Node := First;
  repeat
    Proc(Node.Value);
    Node := Pointer(Node.Next);
  until Node = nil;
end;

var
  List, Node, SavedNode: ^TDoubleLinked<String>;
begin
  List := TDoubleLinked<String>.Create('One');
  Node := List.Add('Two');
  Node := Node.Add('Three');
  SavedNode := Node;
  Node := Node.Add('Four');
  SavedNode.Add('ThreeAndAHalf');

  List.ForEach(
    procedure(const Value:String)
    begin
      WriteLn('List: ' + Value)
    end);

  Node.ForEach(
    procedure(const Value:String)
    begin
      WriteLn('Node: ' + Value)
    end);

  List.DeleteAll;
  Write('Press ENTER to exit...');
  ReadLn;
end.

OK, so there are some workarounds here that shouldn’t be necessary. In particular, we have to return a raw Pointer for Create, Add, First and Last, and since New and Dispose don’t work correctly with generic record types (that’s an outright bug BTW), AllocMem and Finalize/FreeMem pairs must be used instead. Despite that, the code isn’t radically different to how you would write a non-generic equivalent.