fork download
  1. ; incremental sieve of eratosthenes
  2.  
  3. (define-syntax while
  4. (syntax-rules ()
  5. ((while pred? body ...)
  6. (do () ((not pred?)) body ...))))
  7.  
  8. (define (identity x) x)
  9.  
  10. (define-syntax define-generator
  11. (lambda (x)
  12. (syntax-case x (lambda)
  13. ((stx name (lambda formals e0 e1 ...))
  14. (with-syntax ((yield (datum->syntax (syntax stx) 'yield)))
  15. (syntax (define name
  16. (lambda formals
  17. (let ((resume #f) (return #f))
  18. (define yield
  19. (lambda args
  20. (call-with-current-continuation
  21. (lambda (cont)
  22. (set! resume cont)
  23. (apply return args)))))
  24. (lambda ()
  25. (call-with-current-continuation
  26. (lambda (cont)
  27. (set! return cont)
  28. (cond (resume (resume))
  29. (else (let () e0 e1 ...)
  30. (error 'name "unexpected return"))))))))))))
  31. ((stx (name . formals) e0 e1 ...)
  32. (syntax (stx name (lambda formals e0 e1 ...)))))))
  33.  
  34. (define-generator (primegen)
  35. (yield 2) (yield 3)
  36. (let* ((ps (primegen))
  37. (p (and (ps) (ps)))
  38. (q (* p p))
  39. (d (make-hashtable identity =)))
  40. (define (add x s)
  41. (while (hashtable-contains? d x)
  42. (set! x (+ x s)))
  43. (hashtable-set! d x s))
  44. (do ((c (+ p 2) (+ c 2))) (#f)
  45. (cond ((hashtable-contains? d c)
  46. (let ((s (hashtable-ref d c #f)))
  47. (hashtable-delete! d c)
  48. (add (+ c s) s)))
  49. ((< c q) (yield c))
  50. (else (add (+ c p p) (+ p p))
  51. (set! p (ps))
  52. (set! q (* p p)))))))
  53.  
  54. (let ((ps (primegen)))
  55. (do ((i 0 (+ i 1)) (p 0 (ps)))
  56. ((= i 10000) (display p) (newline))))
Runtime error #stdin #stdout #stderr 0.01s 8032KB
stdin
Standard input is empty
stdout
Standard output is empty
stderr
Error: during expansion of (lambda ...) - in `lambda' - pair expected: (lambda)

	Call history:

	<syntax>	  (##core#begin (##sys#syntax-rules-mismatch input5))
	<syntax>	  (##sys#syntax-rules-mismatch input5)
	<syntax>	  (##sys#cdr input5)
	<eval>	  (##sys#er-transformer (lambda8 (input5 rename14 compare2) (let9 ((tail15 (##sys#cdr input5))) (cond3......
	<syntax>	  (##core#undefined)
	<syntax>	  (define (identity x) x)
	<syntax>	  (##core#set! identity (##core#lambda (x) x))
	<syntax>	  (##core#lambda (x) x)
	<syntax>	  [identity] (##core#begin x)
	<syntax>	  (define-syntax define-generator (lambda (x) (syntax-case x (lambda) ((stx name (lambda formals e0 e1...
	<syntax>	  (##core#define-syntax define-generator (lambda (x) (syntax-case x (lambda) ((stx name (lambda formal......
	<syntax>	  (lambda (x) (syntax-case x (lambda) ((stx name (lambda formals e0 e1 ...)) (with-syntax ((yield (dat......
	<syntax>	  (##core#lambda (x) (syntax-case x (lambda) ((stx name (lambda formals e0 e1 ...)) (with-syntax ((yie......
	<syntax>	  (##core#begin (syntax-case x (lambda) ((stx name (lambda formals e0 e1 ...)) (with-syntax ((yield (d......
	<syntax>	  (syntax-case x (lambda) ((stx name (lambda formals e0 e1 ...)) (with-syntax ((yield (datum->syntax (......
	<syntax>	  (lambda)	<--