Linked Lists, Stacks, Queues & Trees

A pointer type may refer to a record type declared later in the same type section:

19.1 Singly linked list as a stack

A pointer type may refer to a record type declared later in the same type section:

program LinkedStack;
{$mode objfpc}

type
  PNode = ^TNode;
  TNode = record
    Value: Integer;
    Next: PNode;
  end;

procedure Push(var Top: PNode; V: Integer);
var
  N: PNode;
begin
  New(N);
  N^.Value := V;
  N^.Next := Top;
  Top := N;
end;

function Pop(var Top: PNode): Integer;
var
  N: PNode;
begin
  if Top = nil then
  begin
    Writeln('Stack underflow');
    Halt(1);
  end;
  N := Top;
  Result := N^.Value;
  Top := N^.Next;
  Dispose(N);
end;

procedure PrintList(P: PNode);
begin
  while P <> nil do
  begin
    Write(P^.Value, ' ');
    P := P^.Next;
  end;
  Writeln;
end;

procedure FreeList(var Top: PNode);
var
  N: PNode;
begin
  while Top <> nil do
  begin
    N := Top;
    Top := Top^.Next;
    Dispose(N);
  end;
end;

var
  Stack: PNode = nil;
begin
  Push(Stack, 1);
  Push(Stack, 2);
  Push(Stack, 3);
  PrintList(Stack);          // 3 2 1
  Writeln(Pop(Stack));       // 3
  PrintList(Stack);          // 2 1
  FreeList(Stack);
end.

19.2 Queue with head and tail pointers

type
  TQueue = record
    Head, Tail: PNode;
  end;

procedure Enqueue(var Q: TQueue; V: Integer);
var
  N: PNode;
begin
  New(N);
  N^.Value := V;
  N^.Next := nil;
  if Q.Tail = nil then
    Q.Head := N
  else
    Q.Tail^.Next := N;
  Q.Tail := N;
end;

function Dequeue(var Q: TQueue; out V: Integer): Boolean;
var
  N: PNode;
begin
  Result := Q.Head <> nil;
  if not Result then Exit;
  N := Q.Head;
  V := N^.Value;
  Q.Head := N^.Next;
  if Q.Head = nil then Q.Tail := nil;
  Dispose(N);
end;

19.3 Binary search tree

In modern Object Pascal, prefer library containers (TList<T>, TDictionary<K,V>, TObjectList<T>, TStack<T>, TQueue<T>) or classes for nodes — but implementing these structures by hand is the best way to master pointers.

program BST;
{$mode objfpc}

type
  PTree = ^TTreeNode;
  TTreeNode = record
    Key: Integer;
    Left, Right: PTree;
  end;

procedure Insert(var Root: PTree; K: Integer);
begin
  if Root = nil then
  begin
    New(Root);
    Root^.Key := K;
    Root^.Left := nil;
    Root^.Right := nil;
  end
  else if K < Root^.Key then
    Insert(Root^.Left, K)
  else if K > Root^.Key then
    Insert(Root^.Right, K);   // duplicates ignored
end;

function Contains(Root: PTree; K: Integer): Boolean;
begin
  while Root <> nil do
  begin
    if K = Root^.Key then Exit(True);
    if K < Root^.Key then Root := Root^.Left else Root := Root^.Right;
  end;
  Result := False;
end;

procedure InOrder(Root: PTree);
begin
  if Root = nil then Exit;
  InOrder(Root^.Left);
  Write(Root^.Key, ' ');
  InOrder(Root^.Right);
end;

function Height(Root: PTree): Integer;
var
  L, R: Integer;
begin
  if Root = nil then Exit(0);
  L := Height(Root^.Left);
  R := Height(Root^.Right);
  if L > R then Result := L + 1 else Result := R + 1;
end;

procedure FreeTree(var Root: PTree);
begin
  if Root = nil then Exit;
  FreeTree(Root^.Left);
  FreeTree(Root^.Right);
  Dispose(Root);
  Root := nil;
end;

var
  Root: PTree =
…