summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKaz Kylheku <kaz@kylheku.com>2025-01-17 07:05:03 -0800
committerKaz Kylheku <kaz@kylheku.com>2025-01-17 07:05:03 -0800
commit13ded878369cdc4a5973228112cf74ce37cca1db (patch)
tree63181b50e734286297f8aaca29a153710593c20b
parent895c236f70ecc3b0fbb04eab7d1330796e0610e6 (diff)
downloadtxr-13ded878369cdc4a5973228112cf74ce37cca1db.tar.gz
txr-13ded878369cdc4a5973228112cf74ce37cca1db.tar.bz2
txr-13ded878369cdc4a5973228112cf74ce37cca1db.zip
lflow/lopip: optimize one argument situations via lop1.
In an opip pipeline, only the first pipeline element can receive multiple arguments. The subsequent elements receive the single return value from the previous element. Therefore if it is a left-inserting pipeline created by lopip, only the first element needs to use lop. The others can use lop1, resulting in an optimization. Furthermore in the flow/lflow macros, even the first function in the pipeline is called with one argument: the result of the input expression. So the case of lflow, every element of the pipe that would translate to lop can go to lop1 instead. * stdlib/opt.tl (sys:opip-expand): Calculate a local variable called opsym-rest which determines which op symbol we use for the recursive call. This is the same as the incoming opsym, except in the case when opsym is lop, in which case we substitute lop1. (sys:lopip1): New macro, like lopip but uses lop1 for the first element also. (lflow): Expand to sys:lopip1 rather than lopip.
-rw-r--r--stdlib/op.tl46
1 files changed, 25 insertions, 21 deletions
diff --git a/stdlib/op.tl b/stdlib/op.tl
index b443a2d2..bd5b7a2f 100644
--- a/stdlib/op.tl
+++ b/stdlib/op.tl
@@ -246,26 +246,27 @@
(t nil)))
(defun sys:opip-expand (e opsym dosym clauses)
- (tree-case clauses
- (nil nil)
- ((c . rest)
- (if (atom c)
- (cons c (sys:opip-expand e opsym dosym rest))
- (let ((sym (car c)))
- (cond
- ((memq sym '(dwim uref qref op do lop lop1 ldo ap ip ado ido ret aret))
- (cons c (sys:opip-expand e opsym dosym rest)))
- ((sys:opip-single-let-p c)
- (tree-bind (t sym) c
- (sys:opip-expand e opsym dosym ^((let (,sym @1)) ,*rest))))
- ((sys:opip-let-p c)
- (tree-bind (t . vars) c
- ^((do let* ,vars
- [(opip ,*(sys:opip-expand e opsym dosym rest)) @1]))))
- (t (let ((opdo (if (or (special-operator-p (car c))
- (macro-form-p c e)) dosym opsym)))
- (cons ^(,opdo ,*c) (sys:opip-expand e opsym dosym
- rest))))))))))
+ (let ((opsym-rest (if (eq 'lop opsym) 'lop1 opsym)))
+ (tree-case clauses
+ (nil nil)
+ ((c . rest)
+ (if (atom c)
+ (cons c (sys:opip-expand e opsym-rest dosym rest))
+ (let ((sym (car c)))
+ (cond
+ ((memq sym '(dwim uref qref op do lop lop1 ldo ap ip ado ido ret aret))
+ (cons c (sys:opip-expand e opsym-rest dosym rest)))
+ ((sys:opip-single-let-p c)
+ (tree-bind (t sym) c
+ (sys:opip-expand e opsym-rest dosym ^((let (,sym @1)) ,*rest))))
+ ((sys:opip-let-p c)
+ (tree-bind (t . vars) c
+ ^((do let* ,vars
+ [(opip ,*(sys:opip-expand e opsym-rest dosym rest)) @1]))))
+ (t (let ((opdo (if (or (special-operator-p (car c))
+ (macro-form-p c e)) dosym opsym)))
+ (cons ^(,opdo ,*c) (sys:opip-expand e opsym-rest dosym
+ rest)))))))))))
(defmacro opip (:env e . clauses)
^[chain ,*(sys:opip-expand e 'op 'do clauses)])
@@ -276,6 +277,9 @@
(defmacro lopip (:env e . clauses)
^[chain ,*(sys:opip-expand e 'lop 'ldo clauses)])
+(defmacro sys:lopip1 (:env e . clauses)
+ ^[chain ,*(sys:opip-expand e 'lop1 'ldo clauses)])
+
(defmacro loand (:env e . clauses)
^[chand ,*(sys:opip-expand e 'lop 'ldo clauses)])
@@ -289,7 +293,7 @@
^(call (opip ,*opip-args) ,val))
(defmacro lflow (val . opip-args)
- ^(call (lopip ,*opip-args) ,val))
+ ^(call (lopip1 ,*opip-args) ,val))
(defmacro tap (. args)
^(prog1 @1 ,args))