; sieve of euler

(define (primes n) ; sieve of eratosthenes
  (let* ((max-index (quotient (- n 3) 2))
         (v (make-vector (+ 1 max-index) #t)))
    (let loop ((i 0) (ps '(2)))
      (let ((p (+ i i 3)) (startj (+ (* 2 i i) (* 6 i) 3)))
        (cond ((>= (* p p) n)
               (let loop ((j i) (ps ps))
                  (cond ((> j max-index) (reverse ps))
                        ((vector-ref v j) (loop (+ j 1) (cons (+ j j 3) ps)))
                        (else (loop (+ j 1) ps)))))
              ((vector-ref v i)
                (let loop ((j startj))
                  (if (<= j max-index)
                      (begin (vector-set! v j #f) (loop (+ j p)))))
                      (loop (+ 1 i) (cons p ps)))
              (else (loop (+ 1 i) ps)))))))

(define (range . args)
  (case (length args)
    ((1) (range 0 (car args) (if (negative? (car args)) -1 1)))
    ((2) (range (car args) (cadr args) (if (< (car args) (cadr args)) 1 -1)))
    ((3) (let ((le? (if (negative? (caddr args)) >= <=)))
           (let loop ((x(car args)) (xs '()))
             (if (le? (cadr args) x)
                 (reverse xs)
                 (loop (+ x (caddr args)) (cons x xs))))))
    (else (error 'range "unrecognized arguments"))))

(define (minus lt? xs ys)
  (let loop ((xs xs) (ys ys) (zs '()))
    (cond ((null? xs) (reverse zs))
          ((null? ys) (reverse (append (reverse xs) zs)))
          ((lt? (car xs) (car ys)) (loop (cdr xs) ys (cons (car xs) zs)))
          ((lt? (car ys) (car xs)) (loop xs (cdr ys) zs))
          (else (loop (cdr xs) (cdr ys) zs)))))

(define (sub-list n p xs)
  (let loop ((xs xs) (zs '()))
    (let ((px (* p (car xs))))
      (if (< n px) (reverse zs)
        (loop (cdr xs) (cons px zs))))))

(define (times p) (lambda (x) (* p x)))

(define (euler n)
    (let loop ((xs (range 3 n 2)) (ps '(2)))
      (let ((p (car xs)))
        (if (< n (* p p))
            (append (reverse ps) xs)
            (loop (minus < (cdr xs)
                    (sub-list n p xs))
                  (cons p ps))))))

(time (display (length (primes 500000))))
(time (display (length (euler 500000))))

41538cpu time: 40 real time: 214 gc time: 10
41538cpu time: 1040 real time: 5732 gc time: 180