; the recaman sequence

(import (rnrs (6)))

(define-syntax define-generator
  (lambda (x)
    (syntax-case x (lambda)
      ((stx name (lambda formals e0 e1 ...))
         (with-syntax ((yield (datum->syntax (syntax stx) 'yield)))
           (syntax (define name
             (lambda formals
               (let ((resume #f) (return #f))
                 (define yield
                   (lambda args
                     (call-with-current-continuation
                      (lambda (cont)
                        (set! resume cont)
                        (apply return args)))))
                 (lambda ()
                   (call-with-current-continuation
                    (lambda (cont)
                      (set! return cont)
                      (cond (resume (resume))
                      (else (let () e0 e1 ...)
                            (error 'name "unexpected return"))))))))))))
        ((stx (name . formals) e0 e1 ...)
          (syntax (stx name (lambda formals e0 e1 ...)))))))

(define (gen-drop n gen)
    (do ((n (- n 1) (- n 1))
         (_ (gen) (gen)))
        ((zero? n) gen)))

(define (gen-take n gen)
  (do ((n n (- n 1))
       (xs (list) (cons (gen) xs)))
      ((zero? n) (reverse xs))))

(define (gen-ref gen n)
  (do ((n n (- n 1)) (x #f (gen)))
      ((negative? n) x)))

(define-generator (recaman)
  (let ((bits (vector 0)) (len 8))
    (define (bit-set! n)
      (when (<= len n)
        (let ((new-bits (make-vector (/ len 4) 0)))
          (do ((i 0 (+ i 1))) ((= i (/ len 8)))
            (vector-set! new-bits i (vector-ref bits i)))
          (set! len (+ len len))
          (set! bits new-bits)))
      (let ((index (quotient n 8)) (offset (modulo n 8)))
        (vector-set! bits index
          (bitwise-ior (bitwise-arithmetic-shift-left 1 offset)
                       (vector-ref bits index)))))
    (define (bit-get n)
      (let ((index (quotient n 8)) (offset (modulo n 8)))
        (bitwise-and
          (bitwise-arithmetic-shift-right
            (vector-ref bits index)
            offset)
          1)))
    (let loop ((pos 0) (gap 1))
      (bit-set! pos) (yield pos)
      (let ((t (if (and (not (negative? (- pos gap)))
                        (zero? (bit-get (- pos gap))))
                   (- pos gap)
                   (+ pos gap))))
        (loop t (+ gap 1))))))

(display (gen-take 25 (recaman))) (newline)
(display (gen-ref (recaman) 1000)) (newline)