Weird code snippet #2: Generic Double Linked List

They say Generics and pointers don't mix.

type
  PMyThing<T> = ^TMyThing<T> // [DCC Error] E2508 type parameters not allowed on this type
  TMyThing<T> = record
     Thing: T;
  end;

Ok, they don't. But there is a loophole!

type
  TMyThing<T> = record
    Thing: T;
    NextThing: ^TMyThing<T>;
  end;

Why this is allowed, I don't know. Just like I don't really understand why the first one is forbidden. There is probably some good explanation for it.

Still - it can be fun breaking the rules!

unit GenericDoubleLinkedList;

interface
uses
  Classes, Generics.Defaults;

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

  TDoubleLinked<T> = record
    Value: T;
    PrevLink: ^TDoubleLinked<T>; // Hey, it compiles!
    NextLink: ^TDoubleLinked<T>;
    constructor Create(aValue:T);
    function Add(aValue:T): TDoubleLinked<T>;
    function HasNext:Boolean;
    function Next: TDoubleLinked<T>;
    function HasPrev:Boolean;
    function Prev: TDoubleLinked<T>;
    function First: TDoubleLinked<T>;
    function Last: TDoubleLinked<T>;
    procedure ForEach(const Proc: TLinkVisitor<T>);
  end;

  procedure Test(const Log:TStrings);

implementation

{ TDoubleLinked<T> }

constructor TDoubleLinked<T>.Create(aValue: T);
begin
  Value := aValue;
  NextLink := nil;
  PrevLink := nil;
end;

function TDoubleLinked<T>.Add(aValue: T): TDoubleLinked<T>;
var
  p: ^TDoubleLinked<T>; // But this one is not assignment compatible
begin
  p := AllocMem(SizeOf(TDoubleLinked<T>)); // Make space
  p^ := Self;      // Copy current value to allocated block
  Value := aValue; // Set self to new value
  p.NextLink := @Self;
  if Assigned(p.PrevLink) // Fix up previous nextlink
   then Pointer(p.PrevLink.NextLink) := Pointer(p);
  Pointer(PrevLink) := Pointer(p);  // Point back to old value
  Result := Self;
end;

function TDoubleLinked<T>.HasPrev: Boolean;
begin
  Result := PrevLink <> nil;
end;

function TDoubleLinked<T>.Prev: TDoubleLinked<T>;
begin
  Result := TDoubleLinked<T>(PrevLink^)
end;

function TDoubleLinked<T>.HasNext: Boolean;
begin
  Result := NextLink <> nil;
end;

function TDoubleLinked<T>.Next: TDoubleLinked<T>;
begin
  Result := TDoubleLinked<T>(NextLink^)
end;

function TDoubleLinked<T>.First: TDoubleLinked<T>;
begin
  Result := Self;
  while Result.HasPrev
   do Result := Result.Prev;
end;

function TDoubleLinked<T>.Last: TDoubleLinked<T>;
begin
  Result := Self;
  while Result.HasNext
   do Result := Result.Next;
end;

procedure TDoubleLinked<T>.ForEach(const Proc: TLinkVisitor<T>);
var
  Node: TDoubleLinked<T>;
begin
  Node := First;
  Proc(Node.Value);
  while Node.HasNext
  do begin
    Node := Node.Next;
    Proc(Node.Value);
  end;
end;

procedure Test(const Log:TStrings);
var
  List, Node : TDoubleLinked<String>;
begin
  List.Create('One');
  List.Add('Two');
  List.Add('Three');
  Node := List;  // Bad idea
  List.Add('Four');
  Node.Add('ThreeAndAHalf');

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

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

end.

The problem is that "List" is not a pointer, but the tail item of the list. Hence, a Delete procedure needs to take this into consideration.

Even worse, if you add a second Node variable to point to something in the list, that reference will not be fixed up after adding 'Four', and hence it will take the tail place of the list - for both references, effectively forgetting the 'Four' item.

So, although this was somewhat entertaining, a mix of Generics and pointers probably isn't something we should make use of.

Exercise for the reader: Implement the TDoubleLinked<T>.Delete; procedure.

End question: Why are we not allowed to declare pointers to generic types?

Weird code snippet #1: Pseudobinary case statement

Curt Carpenter suggested a language addition for handing binary case logic.

That gave me this idea. Chalk it up as another weird code snippet from yours truly.

///<summary>> Convert array of booleans to a pseudobinary integer. 
///Good for up to 12 bits.</summary>
function BoolToInt(B: Array of Boolean):Integer;
var
  x : Boolean;
begin
  Result := 0;
  for x in B
  do begin
    Result := Result * 10;
    if x then Inc(Result);
  end;
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
  ch : Char;
begin
  ch := Lowercase(Char(Key));
  case BoolToInt([ssShift in Shift, ssCtrl in Shift, ch='a', ch='x', ch='c', ch='v']) of
    011000: SelectAll;
    010100: Cut;
    010010: Copy;
    110010: Clone;
    010001: Paste;
  end;
end;

A slightly more tongue in cheek example:

procedure SexistTestLogic(const Cute, Funny, Smart: boolean);
begin
  case BoolToInt([Cute, Funny, Smart]) of
     000: Avoid;
     001: Admire;
     010,
     011: Befriend;
     100: Tolerate;
     101: HandleWithCare;
     110: Adore;
     111: Marry;
  end;
end;