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.

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))