fork download
copy 
  1. ; the recaman sequence
  2.  
  3. (import (rnrs (6)))
  4.  
  5. (define-syntax define-generator
  6.   (lambda (x)
  7.     (syntax-case x (lambda)
  8.       ((stx name (lambda formals e0 e1 ...))
  9.          (with-syntax ((yield (datum->syntax (syntax stx) 'yield)))
  10.            (syntax (define name
  11.              (lambda formals
  12.                (let ((resume #f) (return #f))
  13.                  (define yield
  14.                    (lambda args
  15.                      (call-with-current-continuation
  16.                       (lambda (cont)
  17.                         (set! resume cont)
  18.                         (apply return args)))))
  19.                  (lambda ()
  20.                    (call-with-current-continuation
  21.                     (lambda (cont)
  22.                       (set! return cont)
  23.                       (cond (resume (resume))
  24.                       (else (let () e0 e1 ...)
  25.                             (error 'name "unexpected return"))))))))))))
  26.         ((stx (name . formals) e0 e1 ...)
  27.           (syntax (stx name (lambda formals e0 e1 ...)))))))
  28.  
  29. (define (gen-drop n gen)
  30.     (do ((n (- n 1) (- n 1))
  31.          (_ (gen) (gen)))
  32.         ((zero? n) gen)))
  33.  
  34. (define (gen-take n gen)
  35.   (do ((n n (- n 1))
  36.        (xs (list) (cons (gen) xs)))
  37.       ((zero? n) (reverse xs))))
  38.  
  39. (define (gen-ref gen n)
  40.   (do ((n n (- n 1)) (x #f (gen)))
  41.       ((negative? n) x)))
  42.  
  43. (define-generator (recaman)
  44.   (let ((bits (vector 0)) (len 8))
  45.     (define (bit-set! n)
  46.       (when (<= len n)
  47.         (let ((new-bits (make-vector (/ len 4) 0)))
  48.           (do ((i 0 (+ i 1))) ((= i (/ len 8)))
  49.             (vector-set! new-bits i (vector-ref bits i)))
  50.           (set! len (+ len len))
  51.           (set! bits new-bits)))
  52.       (let ((index (quotient n 8)) (offset (modulo n 8)))
  53.         (vector-set! bits index
  54.           (bitwise-ior (bitwise-arithmetic-shift-left 1 offset)
  55.                        (vector-ref bits index)))))
  56.     (define (bit-get n)
  57.       (let ((index (quotient n 8)) (offset (modulo n 8)))
  58.         (bitwise-and
  59.           (bitwise-arithmetic-shift-right
  60.             (vector-ref bits index)
  61.             offset)
  62.           1)))
  63.     (let loop ((pos 0) (gap 1))
  64.       (bit-set! pos) (yield pos)
  65.       (let ((t (if (and (not (negative? (- pos gap)))
  66.                         (zero? (bit-get (- pos gap))))
  67.                    (- pos gap)
  68.                    (+ pos gap))))
  69.         (loop t (+ gap 1))))))
  70.  
  71. (display (gen-take 25 (recaman))) (newline)
  72. (display (gen-ref (recaman) 1000)) (newline)
Success #stdin #stdout 0.15s 57992KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
(0 1 3 6 2 7 13 20 12 21 11 22 10 23 9 24 8 25 43 62 42 63 41 18 42)
3686
https://ideone.com/WqasCC
language:
Scheme (guile 2.2.4)
created:
4 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!