(use srfi-1 binary-heap test)

(define (key< x y) (- x y))

(define (make-heap alst apred)
  (let ((h (make-binary-heap apred)))
    (fold (lambda (x h) ((h 'put) x x)) h alst)))

(define (heap-sort alst apred)
  (define (extract-until lst aheap)
    (if (zero? (aheap 'size)) lst
        (extract-until (cons ((aheap 'get-max)) lst) ((aheap 'delete-max)))))
  (extract-until (list) (make-heap alst apred)))

(test-group "heap-sort"

	    (test (map car (heap-sort '(3 5 7 0 6 5 34 3 6 9 67 5 4 4 3 1 2 3) key<))
		  '(0 1 2 3 3 3 3 4 4 5 5 5 6 6 7 9 34 67)))

(test-exit)