diff options
| -rw-r--r-- | modules/language/python/for.scm | 140 |
1 files changed, 140 insertions, 0 deletions
diff --git a/modules/language/python/for.scm b/modules/language/python/for.scm new file mode 100644 index 0000000..47f6992 --- /dev/null +++ b/modules/language/python/for.scm @@ -0,0 +1,140 @@ +(define-module (language python for) + #:use-module (oop pf-objects) + #:use-module (ice-9 control) + #:export (for break)) + +(eval-when (compile eval load) + (define (generate-temporaries2 x) + (map (lambda (x) (generate-temporaries x)) x))) + +(define-syntax-parameter break (lambda (x) #f)) + +(define-syntax for + (lambda (x) + (syntax-case x (:) + ((for ((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 + (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 + (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 ...)) + 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 ...)) + lp))) + (lambda q (values))))))))))) + + +#; +(pk + (for c ((x : (gen '(1 2 3)))) ((s 0)) + (pk x) + (if (> x 2) (c s)) + (+ s x) + + #:final + s)) |