diff options
Diffstat (limited to 'modules/language/python/yield.scm')
| -rw-r--r-- | modules/language/python/yield.scm | 97 |
1 files changed, 66 insertions, 31 deletions
diff --git a/modules/language/python/yield.scm b/modules/language/python/yield.scm index 569775d..d32ff4b 100644 --- a/modules/language/python/yield.scm +++ b/modules/language/python/yield.scm @@ -5,7 +5,7 @@ #:use-module (ice-9 control) #:use-module (ice-9 match) #:replace (send) - #:export (<yield> + #:export (<yield> in-yield define-generator make-generator sendException sendClose)) @@ -28,38 +28,73 @@ (fluid-set! in-yield #t) ((apply abort-to-prompt YIELD x))))))) -(define (make-generator closure) - (lambda args - (let () - (define obj (make <yield>)) - (define ab (make-prompt-tag)) - (syntax-parameterize ((YIELD (lambda x #'ab))) - (slot-set! obj 'k #f) - (slot-set! obj 'closed #f) - (slot-set! obj 's - (lambda () - (call-with-prompt - ab +(define-syntax make-generator + (syntax-rules () + ((_ (args ...) closure) + (lambda (args ...) + (let () + (define obj (make <yield>)) + (define ab (make-prompt-tag)) + (syntax-parameterize ((YIELD (lambda x #'ab))) + (slot-set! obj 'k #f) + (slot-set! obj 'closed #f) + (slot-set! obj 's (lambda () - (apply closure yield args) - (slot-set! obj 'closed #t) - (throw StopIteration)) - (letrec ((lam - (lambda (k . l) - (fluid-set! in-yield #f) - (slot-set! obj 'k - (lambda (a) - (call-with-prompt - ab - (lambda () - (k a)) - lam))) - (apply values l)))) - lam)))) - obj)))) + (call-with-prompt + ab + (lambda () + (closure yield args ...) + (slot-set! obj 'closed #t) + (throw StopIteration)) + (letrec ((lam + (lambda (k . l) + (fluid-set! in-yield #f) + (slot-set! obj 'k + (lambda (a) + (call-with-prompt + ab + (lambda () + (k a)) + lam))) + (apply values l)))) + lam)))) + obj)))) -(define-syntax-rule (define-generator (f . args) code ...) - (define f (make-generator args (lambda args code ...)))) + ((_ (args ... . ***) closure) + (lambda (args ... . ***) + (let () + (define obj (make <yield>)) + (define ab (make-prompt-tag)) + (syntax-parameterize ((YIELD (lambda x #'ab))) + (slot-set! obj 'k #f) + (slot-set! obj 'closed #f) + (slot-set! obj 's + (lambda () + (call-with-prompt + ab + (lambda () + (apply closure yield args ... ***) + (slot-set! obj 'closed #t) + (throw StopIteration)) + (letrec ((lam + (lambda (k . l) + (fluid-set! in-yield #f) + (slot-set! obj 'k + (lambda (a) + (call-with-prompt + ab + (lambda () + (k a)) + lam))) + (apply values l)))) + lam)))) + obj)))))) + +(define-syntax define-generator + (lambda (x) + (syntax-case x () + ((_ (f y . args) code ...) + #'(define f (make-generator args (lambda (y . args) code ...))))))) (define-class <yield> () s k closed) |