fork download
copy 
  1. ; generator push-back
  2.  
  3. (import (rnrs hashtables (6)))
  4.  
  5. (define (identity x) x)
  6.  
  7. (define-syntax while
  8.   (syntax-rules ()
  9.     ((while pred? body ...)
  10.       (do () ((not pred?)) body ...))))
  11.  
  12. (define-syntax define-generator
  13.   (lambda (x)
  14.     (syntax-case x (lambda)
  15.       ((stx name (lambda formals e0 e1 ...))
  16.          (with-syntax ((yield (datum->syntax (syntax stx) 'yield)))
  17.            (syntax (define name
  18.              (lambda formals
  19.                (let ((resume #f) (return #f))
  20.                  (define yield
  21.                    (lambda args
  22.                      (call-with-current-continuation
  23.                       (lambda (cont)
  24.                         (set! resume cont)
  25.                         (apply return args)))))
  26.                  (lambda ()
  27.                    (call-with-current-continuation
  28.                     (lambda (cont)
  29.                       (set! return cont)
  30.                       (cond (resume (resume))
  31.                       (else (let () e0 e1 ...)
  32.                             (error 'name "unexpected return"))))))))))))
  33.         ((stx (name . formals) e0 e1 ...)
  34.           (syntax (stx name (lambda formals e0 e1 ...)))))))
  35.  
  36. (define-generator (primegen)
  37.   (yield 2) (yield 3)
  38.     (let* ((ps (primegen))
  39.          (p (and (ps) (ps)))
  40.          (q (* p p))
  41.          (d (make-eq-hashtable)))
  42.     (define (add m s)
  43.       (while (hashtable-contains? d m)
  44.         (set! m (+ m s)))
  45.       (hashtable-set! d m s))
  46.     (do ((c (+ p 2) (+ c 2))) (#f)
  47.       (cond ((hashtable-contains? d c)
  48.               (let ((s (hashtable-ref d c #f)))
  49.                 (hashtable-delete! d c)
  50.                 (add (+ c s) s)))
  51.             ((< c q) (yield c))
  52.             (else (add (+ c p p) (+ p p))
  53.                   (set! p (ps))
  54.                   (set! q (* p p)))))))
  55.  
  56. (define-generator (pushback val gen)
  57.   (yield val) (while #t (yield (gen))))
  58.  
  59. (define ps (primegen))
  60. (display (ps)) (newline)
  61. (display (ps)) (newline)
  62. (display (ps)) (newline)
  63. (display (ps)) (newline)
  64. (display (ps)) (newline)
  65. (display (ps)) (newline)
  66. (display (ps)) (newline)
  67. (set! ps (pushback 17 ps))
  68. (display (ps)) (newline)
  69. (display (ps)) (newline)
  70. (display (ps)) (newline)
  71. (display (ps)) (newline)
  72. (display (ps)) (newline)
Success #stdin #stdout 0.02s 45296KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
2
3
5
7
11
13
17
17
19
23
29
31
https://ideone.com/buBHPn
language:
Scheme (guile 2.2.4)
created:
6 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!