// IfsHeapSort.bcpl // Copyright Xerox Corporation 1979 // Last modified June 6, 1979 8:09 PM by Taft external [ // outgoing procedures HeapSort ] //---------------------------------------------------------------------------- let HeapSort(array, length, Compare) be //---------------------------------------------------------------------------- // Knuth vol. 3 section 5.2.3 algorithm H. // array!0 to array!(length-1) is an array of keys. // Compare(key1, key2) returns -1 if key1<key2, 0 if =, 1 if >. // Returns with array sorted in increasing order of keys. [ if length le 1 return let l, r = length rshift 1, length-1 [ let key = nil test l gr 0 ifso [ l = l-1; key = array!l ] ifnot [ key = array!r; array!r = array!0 r = r-1 if r eq 0 then [ array!0 = key; break ] ] let j = l let i = nil [ i = j j = j lshift 1 +1 if j gr r break if j ls r then if Compare(array!j, array!(j+1)) ls 0 then j = j+1 if Compare(key, array!j) ge 0 break array!i = array!j ] repeat array!i = key ] repeat ]