diff options
| author | Stefan Israelsson Tampe <stefan.itampe@gmail.com> | 2018-03-19 16:19:13 +0100 |
|---|---|---|
| committer | Stefan Israelsson Tampe <stefan.itampe@gmail.com> | 2018-03-19 16:19:13 +0100 |
| commit | d71244f5cb87a4a61a6b341e4838a38e50142815 (patch) | |
| tree | 0fc87b68017a98dd32341ac62fba7efba5df48d3 /modules/language/python/for.scm | |
| parent | 4e5352b2349eb41ddeb972696cfd2b41c6e4b20d (diff) | |
| parent | 2050e8565493ca0491ae4b4c44764eda56626427 (diff) | |
Merge branch 'master' of https://gitlab.com/python-on-guile/python-on-guile
Diffstat (limited to 'modules/language/python/for.scm')
| -rw-r--r-- | modules/language/python/for.scm | 39 |
1 files changed, 25 insertions, 14 deletions
diff --git a/modules/language/python/for.scm b/modules/language/python/for.scm index 4541df2..fcd562b 100644 --- a/modules/language/python/for.scm +++ b/modules/language/python/for.scm @@ -18,44 +18,55 @@ (define-syntax for (syntax-rules (:) ((for ((x ... : E) ...) ((c n) ...) code ... #:final fin) - (for-work #f ((x ... : E) ...) ((c n) ...) (code ...) fin)) + (for-work #f ((x ... : E) ...) ((c n) ...) (code ...) fin values)) + + ((for ((x ... : E) ...) ((c n) ...) code ... #:else fin) + (for-work #f ((x ... : E) ...) ((c n) ...) (code ...) (values) + (lambda () fin))) ((for lp ((x ... : E) ...) ((c n) ...) code ... #:final fin) - (for-work lp ((x ... : E) ...) ((c n) ...) (code ...) fin)) + (for-work lp ((x ... : E) ...) ((c n) ...) (code ...) fin values)) + + ((for lp ((x ... : E) ...) ((c n) ...) code ... #:else fin) + (for-work lp ((x ... : E) ...) ((c n) ...) (code ...) (values) + (lambda () fin))) ((for ((x ... : E) ...) ((c n) ...) code ...) - (for-work #f ((x ... : E) ...) ((c n) ...) (code ...) (values))) + (for-work #f ((x ... : E) ...) ((c n) ...) (code ...) (values) values)) ((for lp ((x ... : E) ...) ((c n) ...) code ...) - (for-work lp ((x ... : E) ...) ((c n) ...) (code ...) (values))))) + (for-work lp ((x ... : E) ...) ((c n) ...) (code ...) (values) values)))) (define-syntax for-work - (lambda (x) + (lambda (z) (define (wrap-continue lp code) (if (syntax->datum lp) #`(lambda () (let/ec #,lp #,@code)) #`(lambda () #,@code))) - (syntax-case x () - ((for lp ((x ... : E) ...) ((c n) ...) (code ...) fin) + (syntax-case z () + ((for lp ((x ... : E) ...) ((c n) ...) (code ...) fin er) (with-syntax (((It ...) (generate-temporaries #'(E ...))) ((cc ...) (generate-temporaries #'(c ...))) (((x1 ...) ...) (generate-temporaries2 #'((x ...) ...))) (((x2 ...) ...) (generate-temporaries2 #'((x ...) ...))) ((N ...) (map length #'((x ...) ...))) + (else- (datum->syntax #'for 'else-)) (llp (if (syntax->datum #'lp) #'lp #'lpu))) - #`(let/ec lp-break + #`(let/ec lp-break0 + (let ((It (wrap-in E)) ... + (c n ) ... + (x 'None ) ... ... + (x1 #f ) ... ...) + (let* ((else- er ) + (lp-break (lambda q (else-) (apply lp-break0 q)))) (syntax-parameterize ((break (lambda (z) (syntax-case z () ((_ . l) #'(lp-break . l)) (_ #'lp-break))))) - - (let ((It (wrap-in E)) ... - (c n ) ... - (x 'None ) ... ... - (x1 #f ) ... ...) + (catch StopIteration (lambda () (let llp ((cc c) ...) @@ -81,7 +92,7 @@ #'lp #'((let ((x x) ... ...) code ...))) (lambda (cc ... . q) (llp cc ...))))) - (lambda q fin)))))))))) + (lambda q (else-) fin))))))))))) (define-class <scm-list> () l) (define-class <scm-string> () s i) |