tests/mzscheme/common/src/heapsort.mzscheme

;; END COMMENT
(define IM   139968)
(define IA     3877)
(define IC    29573)

(define LAST 42)
(define (gen_random max)
  (set! LAST (modulo (+ (* LAST IA) IC) IM))
  (/ (* max LAST) IM))

(define (ash int count) (inexact->exact (floor (* int (expt 2 count)))))

(define (heapsort n ra)
  (let ((ir n)
	(l (+ (ash n -1) 1))
	(i 0)
	(j 0)
	(rra 0.0))
    (call-with-current-continuation (lambda (return)
	       (do ((bar #t))
		   ((= 1 0))
		 (cond ((> l 1)
			(set! l (- l 1))
			(set! rra (vector-ref ra l)))
		       (else
			(set! rra (vector-ref ra ir))
			(vector-set! ra ir (vector-ref ra 1))
			(set! ir (- ir 1))
			(cond ((= ir 1)
			       (vector-set! ra 1 rra)
			       (return #t)))))
		 (set! i l)
		 (set! j (ash l 1))
		 (do ((foo #t))
		     ((> j ir))
		   (cond ((and (< j ir) (< (vector-ref ra j) (vector-ref ra (+ j 1))))
			  (set! j (+ j 1))))
		   (cond ((< rra (vector-ref ra j))
			  (vector-set! ra i (vector-ref ra j))
			  (set! i j)
			  (set! j (+ j i)))
			 (else
			  (set! j (+ ir 1)))))
		 (vector-set! ra i rra)))) ))

(define (main args)
  (let* ((n (or (and (= (length args) 1) (string->number (car args))) 1))
	 (last (+ n 1))
	 (ary (make-vector last 0)))
    (do ((i 1 (+ i 1)))
	((= i last))
      (vector-set! ary i (gen_random 1.0)))
    (heapsort n ary)
    (display (format "~a\n" (vector-ref ary n)))))