; 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 xs ys)
  (let loop ((xs xs) (ys ys) (zs '()))
    (cond ((null? ys) (append (reverse zs) xs))
          ((equal? (car xs) (car ys))
            (loop (cdr xs) (cdr ys) zs))
          (else (loop (cdr xs) ys (cons (car xs) 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))))))

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

(2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97)
(2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97)
41538cpu time: 30 real time: 217 gc time: 0
41538cpu time: 670 real time: 3618 gc time: 130