codepad
[
create a new paste
]
login
|
about
Language:
C
C++
D
Haskell
Lua
OCaml
PHP
Perl
Plain Text
Python
Ruby
Scheme
Tcl
; unbounded spigots (define-syntax define-generator (lambda (x) (syntax-case x (lambda) ((stx name (lambda formals e0 e1 ...)) (with-syntax ((yield (datum->syntax-object (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 (take-gen n gen) (let loop ((n n) (xs (list))) (if (zero? n) (reverse xs) (loop (- n 1) (cons (gen) xs))))) (define-generator (make-spigot f lo hi) (define (split v) (values (vector-ref v 0) (vector-ref v 1) (vector-ref v 2))) (define (approx abc n) (let-values (((a b c) (split abc))) (quotient (+ (* a n) b) c))) (define (mul abc def) (let-values (((a b c) (split abc)) ((d e f) (split def))) (vector (* a d) (+ (* a e) (* b f)) (* c f)))) (define (g k) (let-values (((n d a) (f k))) (vector n (* a d) d))) (let loop ((z (vector 1 0 1)) (k 1)) (let ((lbound (approx z lo))) (cond ((= lbound (approx z hi)) (yield lbound) (loop (mul (vector 10 (* -10 lbound) 1) z) k)) (else (loop (mul z (g k)) (+ k 1))))))) (define pi-spigot (make-spigot (lambda (k) (values k (+ k k 1) 2)) 3 4)) (define e-spigot (make-spigot (lambda (k) (values 1 k 1)) 1 2)) (display (take-gen 30 pi-spigot)) (newline) (display (take-gen 30 e-spigot)) (newline)
Private
[
?
]
Run code
Submit