summaryrefslogtreecommitdiffstats
path: root/share
diff options
context:
space:
mode:
authorKaz Kylheku <kaz@kylheku.com>2020-06-02 19:02:09 -0700
committerKaz Kylheku <kaz@kylheku.com>2020-06-02 19:02:09 -0700
commit91c85dc6a85bef1c62743bd278ebeb8914bf8b4b (patch)
tree94ca0f512f5303dfd4c93b4c8be3c1a051d4d3f1 /share
parentdcd0c4e0485ad5f8cf571bffa99add57c8aed183 (diff)
downloadtxr-91c85dc6a85bef1c62743bd278ebeb8914bf8b4b.tar.gz
txr-91c85dc6a85bef1c62743bd278ebeb8914bf8b4b.tar.bz2
txr-91c85dc6a85bef1c62743bd278ebeb8914bf8b4b.zip
Convert each-family operators to use iter-begin.
With this change we can do (each ((x vec)) ...) with reasonable efficiency, because we are no longer marching through the vector with cdr, copying the suffix. * eval.c (get_iter_f): New global variable. (op_each): Obtain iterators for all the objects with iter_begin, instead of treating them as lists. Probe the iterators for termination with iter_more, get the items with iter_item instead of car and step with iter_step instead of cdr. (eval_init): gc-protect the get_iter_f function and initialize it. * share/txr/stdlib/compiler.tl (expand-each): Replace the car/cdr and null testing with iter-init, iter-more, iter-item and iter-step.
Diffstat (limited to 'share')
-rw-r--r--share/txr/stdlib/compiler.tl9
1 files changed, 5 insertions, 4 deletions
diff --git a/share/txr/stdlib/compiler.tl b/share/txr/stdlib/compiler.tl
index 3b5caffe..36e33007 100644
--- a/share/txr/stdlib/compiler.tl
+++ b/share/txr/stdlib/compiler.tl
@@ -1385,12 +1385,13 @@
(out (if (member each-type '(collect-each append-each))
(gensym)))
(accum (if out (gensym))))
- ^(let* (,*(zip gens vars) ,*(if accum ^((,out (cons nil nil)) (,accum ,out))))
+ ^(let* (,*(mapcar (ret ^(,@1 (iter-begin ,@2))) gens vars)
+ ,*(if accum ^((,out (cons nil nil)) (,accum ,out))))
(block nil
(sys:for-op ()
- ((and ,*gens) ,*(if accum ^((cdr ,out))))
- (,*(mapcar (ret ^(sys:setq ,@1 (cdr ,@1))) gens))
- ,*(mapcar (ret ^(sys:setq ,@1 (car ,@2))) vars gens)
+ ((and ,*(mapcar (op list 'iter-more) gens)) ,*(if accum ^((cdr ,out))))
+ (,*(mapcar (ret ^(sys:setq ,@1 (iter-step ,@1))) gens))
+ ,*(mapcar (ret ^(sys:setq ,@1 (iter-item ,@2))) vars gens)
,*(caseq each-type
(collect-each ^((rplacd ,accum (cons (progn ,*body) nil))
(sys:setq ,accum (cdr ,accum))))