diff options
| author | Stefan Israelsson Tampe <stefan.itampe@gmail.com> | 2017-09-15 00:41:57 +0200 |
|---|---|---|
| committer | Stefan Israelsson Tampe <stefan.itampe@gmail.com> | 2017-09-15 00:41:57 +0200 |
| commit | 1fa1e4ddcf166524bb3471b7f68990a5da9c7eb7 (patch) | |
| tree | a68ea4ebeb6c01074e0a3714d758b12dddd561b5 /modules | |
| parent | f3f0828d3dda8045d538eaacc4e5384e9c835c56 (diff) | |
simplified for
Diffstat (limited to 'modules')
| -rw-r--r-- | modules/language/python/for.scm | 117 |
1 files changed, 24 insertions, 93 deletions
diff --git a/modules/language/python/for.scm b/modules/language/python/for.scm index f23ce6e..bc0dfbf 100644 --- a/modules/language/python/for.scm +++ b/modules/language/python/for.scm @@ -15,72 +15,33 @@ (define-syntax-parameter break (lambda (x) #f)) (define-syntax for + (syntax-rules (:) + ((for ((x ... : E) ...) ((c n) ...) code ... #:final fin) + (for-work #f ((x ... : E) ...) ((c n) ...) (code ...) fin)) + + ((for lp ((x ... : E) ...) ((c n) ...) code ... #:final fin) + (for-work lp ((x ... : E) ...) ((c n) ...) (code ...) fin)) + + ((for ((x ... : E) ...) ((c n) ...) code ...) + (for-work #f ((x ... : E) ...) ((c n) ...) (code ...) (values))) + + ((for lp ((x ... : E) ...) ((c n) ...) code ...) + (for-work lp ((x ... : E) ...) ((c n) ...) (code ...) (values))))) + +(define-syntax for-work (lambda (x) - (syntax-case x (:) - ((for ((x ... : E) ...) ((c n) ...) code ... #:final fin) + (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) (with-syntax (((It ...) (generate-temporaries #'(E ...))) ((cc ...) (generate-temporaries #'(c ...))) (((x1 ...) ...) (generate-temporaries2 #'((x ...) ...))) (((x2 ...) ...) (generate-temporaries2 #'((x ...) ...)))) - #'(let/ec lp-break - (syntax-parameterize ((break (lambda (z) - (syntax-case z () - ((_ . l) - #'(lp-break . l)) - (_ #'lp-break))))) - - (let ((It E) ... (c n) ... (x 'None) ... ... (x1 #f) ... ...) - (catch StopIteration - (lambda () - (let lp ((cc c) ...) - (set! c cc) ... - (call-with-values - (lambda () (next It)) - (lambda (x2 ...) - (set! x1 x2) ...)) - ... - (set! x x1) - ... ... - (call-with-values - (lambda () code ...) - lp))) - (lambda q fin))))))) - - ((for ((x ... : E) ...) ((c n) ...) code ...) - (with-syntax (((It ...) (generate-temporaries #'(E ...))) - ((cc ...) (generate-temporaries #'(c ...))) - (((x1 ...) ...) (generate-temporaries2 #'((x ...) ...))) - (((x2 ...) ...) (generate-temporaries2 #'((x ...) ...)))) - #'(let/ec lp-break - (syntax-parameterize ((break (lambda (z) - (syntax-case z () - ((_ . l) - #'(lp-break . l)) - (_ #'lp-break))))) - - (let ((It E) ... (c n) ... (x 'None) ... ... (x1 #f) ... ...) - (catch StopIteration - (lambda () - (let lp ((cc c) ...) - (set! c cc) ... - (call-with-values - (lambda () (next It)) - (lambda (x2 ...) - (set! x1 x2) ...)) - ... - (set! x x1) - ... ... - (call-with-values - (lambda () code ...) - lp))) - (lambda q (values)))))))) - - ((for lp ((x ... : E) ...) ((c n) ...) code ... #:final fin) - (with-syntax (((It ...) (generate-temporaries #'(E ...))) - ((cc ...) (generate-temporaries #'(c ...))) - (((x1 ...) ...) (generate-temporaries2 #'((x ...) ...))) - (((x2 ...) ...) (generate-temporaries2 #'((x ...) ...)))) - #'(let/ec lp-break + #`(let/ec lp-break (syntax-parameterize ((break (lambda (z) (syntax-case z () ((_ . l) @@ -100,39 +61,9 @@ (set! x x1) ... ... (call-with-values - (lambda () (let/ec lp code ...)) - lp))) - (lambda q fin))))))) - - ((for lp ((x ... : E) ...) ((c n) ...) code ...) - (with-syntax (((It ...) (generate-temporaries #'(E ...))) - ((cc ...) (generate-temporaries #'(c ...))) - (((x1 ...) ...) (generate-temporaries2 #'((x ...) ...))) - (((x2 ...) ...) (generate-temporaries2 #'((x ...) ...)))) - #'(let/ec lp-break - (syntax-parameterize ((break (lambda (z) - (syntax-case z () - ((_ . l) - #'(lp-break . l)) - (_ #'lp-break))))) - - (let ((It E) ... (c n) ... (x 'None) ... ... (x1 #f) ... ...) - (catch StopIteration - (lambda () - (let lp ((cc c) ...) - (set! c cc) ... - (call-with-values - (lambda () (next It)) - (lambda (x2 ...) - (set! x1 x2) ...)) - ... - (set! x x1) - ... ... - (call-with-values - (lambda () (let/ec lp code ...)) + #,(wrap-continue #'lp #'(code ...)) lp))) - (lambda q (values))))))))))) - + (lambda q fin)))))))))) (define-class <scm-list> () l) (define-class <scm-string> () s i) |