; semi-primes

(define (primes n) ; list of primes not exceeding n
  (let* ((len (quotient (- n 1) 2)) (bits (make-vector len #t)))
    (let loop ((i 0) (p 3) (ps (list 2)))
      (cond ((< n (* p p))
              (do ((i i (+ i 1)) (p p (+ p 2))
                   (ps ps (if (vector-ref bits i) (cons p ps) ps)))
                  ((= i len) (reverse ps))))
            ((vector-ref bits i)
              (do ((j (+ (* 2 i i) (* 6 i) 3) (+ j p)))
                  ((<= len j) (loop (+ i 1) (+ p 2) (cons p ps)))
                (vector-set! bits j #f)))
            (else (loop (+ i 1) (+ p 2) ps))))))

(define (semi-primes n)
  (let ((ps (primes (quotient n 2))))
    (let loop ((ps ps) (qs (cdr ps)) (ss (list)))
      (cond ((< n (* (car ps) (cadr ps))) (sort ss <))
            ((or (null? qs) (< n (* (car ps) (car qs))))
              (loop (cdr ps) (cddr ps) ss))
            (else (loop ps (cdr qs) (cons (* (car ps) (car qs)) ss)))))))

(do ((k 1 (+ k 1))) ((= k 8))
  (display k) (display #\tab)
  (display (length (semi-primes (expt 10 k))))
  (newline))