prescheme-demo/prime-sum.scm

;;; prime-sum --- Sieve of Eratosthenes in Pre-Scheme

(define string->integer
  (external "atol" (=> ((^ char)) integer)))

(define (make-sieve limit)
  (let ((sieve (make-vector (+ limit 1) #t)))
    (vector-fill! sieve #t 0 (+ limit 1))
    (vector-set! sieve 0 #f)
    (vector-set! sieve 1 #f)
    (letrec ((update-squares!
              (lambda (i)
                (let ((j (* i i)))
                  (unless (> j limit)
                    (when (vector-ref sieve i)
                      (update-multiples! i j))
                    (update-squares! (+ i 1))))))
             (update-multiples!
              (lambda (i j)
                (unless (> j limit)
                  (vector-set! sieve j #f)
                  (update-multiples! i (+ j i))))))
      (update-squares! 2))
    sieve))

(define (sum-sieve sieve limit)
  (vector-fold (lambda (x result prime?)
                 (if prime?
                     (+ result x)
                     result))
               0 sieve (+ limit 1)))

(define (sum-of-primes limit)
  (if (< limit 2)
      0
      (let* ((sieve (make-sieve limit))
             (result (sum-sieve sieve limit)))
        (deallocate sieve)
        result)))

(define (main argc argv)
  (define out (current-output-port))
  (define err (current-error-port))
  (cond ((not (= argc 2))
         (write-string "usage: " err)
         (write-string (vector-ref argv 0) err)
         (write-string " <limit>" err)
         (newline err)
         1)
        (else
         (let ((limit (string->integer (vector-ref argv 1))))
           (cond ((< limit 0)
                  (write-string "Limit must be non-negative" err)
                  (newline err)
                  1)
                 (else
                  (let ((result (sum-of-primes limit)))
                    (write-string "Sum of primes up to " out)
                    (write-integer limit out)
                    (write-string " is " out)
                    (write-integer result out)
                    (newline out)
                    0)))))))