; 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)