BST in pascal

bst.pas

program BinarySearhTree;

type
    Tree = ^TreeNode;
    TreeIndex = ^Tree;

    TreeNode = record
        value      : integer;
        leftChild  : Tree;
        rightChild : Tree;
    end;

    Functor = procedure (node : Tree);

function createTree() : Tree;
begin
    createTree := nil;
end;

function search(value : integer; var _tree : Tree) : TreeIndex;
begin
    search := @_tree;
    while (search^ <> nil) and (search^^.value <> value) do
        if value < search^^.value then
            search := @search^^.leftChild
        else
            search := @search^^.rightChild;
end;

function has(value : integer; _tree : Tree) : boolean;
begin
    has := search(value, _tree)^ <> nil;
end;

procedure add(value : integer; var _tree : Tree);
var
    index : TreeIndex;
begin
    index := search(value, _tree);
    if index^ = nil then
    begin
        new(index^);
        index^^.value      := value;
        index^^.leftChild  := nil;
        index^^.rightChild := nil;
    end;
end;

procedure addFromArray(_array : array of integer; var _tree : Tree);
var
    i : integer;
begin
    for i := low(_array) to high(_array) do
        add(_array[i], _tree);
end;

procedure remove(index : TreeIndex);
var
    toRemove : Tree;
    cursor   : TreeIndex;
begin
    toRemove := index^;
    if toRemove = nil then
        exit;

    if (toRemove^.leftChild = nil) or (toRemove^.rightChild = nil) then
    begin
        if toRemove^.leftChild <> nil then
            index^ := toRemove^.leftChild
        else
            index^ := toRemove^.rightChild;
        dispose(toRemove);
    end
    else
    begin
        cursor := @toRemove^.rightChild;
        while cursor^^.leftChild <> nil do
            cursor := @cursor^^.leftChild;
        
        toRemove^.value := cursor^^.value;
        remove(cursor);
    end;
end;

procedure remove(value : integer; var _tree : Tree);
begin
    remove(search(value, _tree));
end;

procedure traversal(action : Functor; _tree : Tree);
var
    rightChild : Tree;
begin
    if _tree <> nil then
    begin
        traversal(action, _tree^.leftChild);
        rightChild := _tree^.rightChild;
        action(_tree);
        traversal(action, rightChild);
    end;
end;

procedure printAction(node : Tree);
begin
    write(node^.value, ' ');
end;

procedure printTree(_tree : Tree);
begin
    write('Tree( ');
    traversal(@printAction, _tree);
    writeln(')');
end;

procedure disposeAction(node : Tree);
begin
    dispose(node);
end;

procedure eraseTree(var _tree : Tree);
begin
    traversal(@disposeAction, _tree);
    _tree := nil;
end;

procedure incAction(node : Tree);
begin
    inc(node^.value);
end;

procedure incTree(_tree : Tree);
begin
    traversal(@incAction, _tree);
end;


var
    _tree : Tree;

const
    items : array[1..7] of integer = (20, 10, 40, 30, 50, 35, 37);

begin
    _tree := createTree();
    addFromArray(items, _tree);
    add(33, _tree);
    printTree(_tree);

    writeln('Tree has 20? : ', has(20, _tree));
    writeln('Tree has 33? : ', has(33, _tree));

    remove(20, _tree);
    remove(33, _tree);

    writeln;
    printTree(_tree);
    writeln('Tree has 20? : ', has(20, _tree));
    writeln('Tree has 33? : ', has(33, _tree));

    writeln(#10, 'Incrementing tree...');
    incTree(_tree);
    printTree(_tree);
    writeln('Tree has 51? : ', has(51, _tree));
    
    writeln;
    eraseTree(_tree);
    printTree(_tree);
end.