procedure delete( var pq : tree );
	var	le, ri : tree;

	begin
	if pq=nil then Error {*** deletion on empty queue ***}
	else	begin
		{*** find left descendant of root ***}
		if pq^.left = pq then le := nil
			else begin
				le := pq^.left;
				while le^.left <> pq do le := le^.left;
				le^.left := pq^.left
				end;
		{*** find right descendant of root ***}
		if pq^.right = pq then ri := nil
			else begin
				ri := pq^.right;
				while ri^.right <> pq do ri := ri^.right;
				ri^.right := pq^.right
				end;
		{*** merge descendants ***}
		pq := merge( le, ri )
		end
	end;