diff options
Diffstat (limited to 'stdlib/each-prod.tl')
| -rw-r--r-- | stdlib/each-prod.tl | 22 |
1 files changed, 14 insertions, 8 deletions
diff --git a/stdlib/each-prod.tl b/stdlib/each-prod.tl index 1393b80a..d48263f6 100644 --- a/stdlib/each-prod.tl +++ b/stdlib/each-prod.tl @@ -37,13 +37,16 @@ (defun sys:expand-each-prod (form vars body) (sys:vars-check form vars) (let ((syms [mapcar car vars]) - (inits [mapcar cadr vars])) + (inits [mapcar cadr vars]) + (gens [mapcar (ret (gensym)) vars])) (sys:bindable-check form syms) (let ((fun (caseq (car form) (each-prod 'maprodo) (collect-each-prod 'maprod) (append-each-prod 'maprend)))) - ^(,fun (lambda (,*syms) ,*body) ,*inits)))) + ^(let ,(zip gens inits) + (block nil + (,fun (lambda (,*syms) ,*body) ,*gens)))))) (defun sys:expand-each-prod* (form vars body) (sys:vars-check form vars) @@ -61,17 +64,20 @@ (defun sys:expand-arith-each-prod (form vars body) (sys:vars-check form vars) (let ((syms [mapcar car vars]) - (inits [mapcar cadr vars])) + (inits [mapcar cadr vars]) + (gens [mapcar (ret (gensym)) vars])) (sys:bindable-check form syms) (let ((op-iv (caseq (car form) (sum-each-prod '(+ . 0)) (mul-each-prod '(* . 1))))) (with-gensyms (acc) - ^(let ((,acc ,(cdr op-iv))) - (maprodo (lambda (,*syms) - (set ,acc (,(car op-iv) ,acc (progn ,*body)))) - ,*inits) - ,acc))))) + ^(let ((,acc ,(cdr op-iv)) + ,*(zip gens inits)) + (block nil + (maprodo (lambda (,*syms) + (set ,acc (,(car op-iv) ,acc (progn ,*body)))) + ,*gens) + ,acc)))))) (defmacro each-prod (:form f vars . body) (sys:expand-each-prod f vars body)) |