From 1bd05653fd7e656a62583b7be0c662b78c8c6fb2 Mon Sep 17 00:00:00 2001
From: NoahStoryM <noahstorym@gmail.com>
Date: Sat, 27 Aug 2022 18:51:58 +0800
Subject: [PATCH 01/10] =?UTF-8?q?[=3D=3D*]=20Extend=20`=3D=3D*`=20to=20rep?=
 =?UTF-8?q?resent=20`=C3=97`.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 qi-lib/flow/compiler.rkt |  5 ++-
 qi-lib/flow/impl.rkt     | 70 +++++++++++++++++++++++++++++++++++++++-
 qi-test/tests/flow.rkt   | 40 ++++++++++++++++-------
 3 files changed, 99 insertions(+), 16 deletions(-)

diff --git a/qi-lib/flow/compiler.rkt b/qi-lib/flow/compiler.rkt
index 823452eb4..e3271e9fd 100644
--- a/qi-lib/flow/compiler.rkt
+++ b/qi-lib/flow/compiler.rkt
@@ -101,9 +101,8 @@
      #'(qi0->racket (~> ▽ reverse △))]
     [((~or* (~datum ==) (~datum relay)) onex:clause ...)
      #'(relay (qi0->racket onex) ...)]
-    [((~or* (~datum ==*) (~datum relay*)) onex:clause ... rest-onex:clause)
-     (with-syntax ([len #`#,(length (syntax->list #'(onex ...)))])
-       #'(qi0->racket (group len (== onex ...) rest-onex) ))]
+    [((~or* (~datum ==*) (~datum relay*)) onex:clause ...)
+     #'(relay* (qi0->racket onex) ...)]
     [((~or* (~datum -<) (~datum tee)) onex:clause ...)
      #'(λ args
          (apply values
diff --git a/qi-lib/flow/impl.rkt b/qi-lib/flow/impl.rkt
index 16df7327c..a69ceadd4 100644
--- a/qi-lib/flow/impl.rkt
+++ b/qi-lib/flow/impl.rkt
@@ -11,6 +11,7 @@
          filter-values
          partition-values
          relay
+         relay*
          loom-compose
          parity-xor
          arg
@@ -27,7 +28,8 @@
 (require racket/match
          (only-in racket/function
                   const
-                  negate)
+                  negate
+                  arity-includes?)
          racket/bool
          racket/list
          racket/format
@@ -198,6 +200,56 @@
         (append (values->list (apply op vs))
                 (apply zip-with op (map rest seqs))))))
 
+(define split-input
+  (λ (n arity*)
+    (define report-arity-error
+      (λ ()
+        (raise-arguments-error
+         'split-input
+         (string-append
+          "arity mismatch;\n"
+          " the expected number of arguments does not match the given number")
+         "given" n)))
+    (define-values (m a*)
+      (for/fold ([m n]
+                 [a* '()]
+                 #:result
+                 (match a*
+                   [`([,n 1 ,(arity-at-least 2)] . ,a*)
+                    (values (add1 m) `([,n 0 ,(arity-at-least 1)] . ,a*))]
+                   [_ (values m a*)]))
+                ([arity (in-list arity*)]
+                 [n (in-naturals)])
+        (match arity
+          [(? exact-nonnegative-integer? i)
+           (values (- m i) a*)]
+          [(arity-at-least 0)
+           (values (- m 1) `([,n  1 ,(arity-at-least 2)] . ,a*))]
+          [(or (arity-at-least i) (list* 0 (arity-at-least i)))
+           (values (- m i) `([,n ,i ,(arity-at-least (add1 i))] . ,a*))]
+          [(or (list* 0 i j) (list* i j))
+           (values (- m i) `([,n ,i ,j] . ,a*))])))
+    (unless (>= m 0)
+      (report-arity-error))
+    (apply list-set*
+      arity*
+      (for/fold ([m m] [pairs '()] #:result pairs)
+                ([a (in-list a*)])
+        (define-values (n i j) (apply values a))
+        (cond
+          [(or (zero? m) (null? j))
+           (values m (list* n i pairs))]
+          [(arity-includes? j m)
+           (values 0 (list* n (+ i m) pairs))]
+          [(arity-at-least? j)
+           (report-arity-error)]
+          [(list? j)
+           (match (last j)
+             [(? arity-at-least?)
+              (report-arity-error)]
+             [(? exact-nonnegative-integer? j)
+              (values (- m j) (list* n (+ i j) pairs))])])))))
+
 ;; from mischief/function - requiring it runs aground
 ;; of some "name is protected" error while building docs, not sure why;
 ;; so including the implementation directly here for now
@@ -210,6 +262,22 @@
   (λ args
     (apply values (zip-with call fs args))))
 
+(define (relay* . fs)
+  (λ args
+    (define args*
+      (for/fold ([a '()] [a* args] #:result (reverse a))
+                ([n (in-list (split-input (length args) (map procedure-arity fs)))])
+        (define-values (v v*) (split-at a* n))
+        (values (cons v a) v*)))
+    (apply values
+      (for/list ([f (in-list fs)]
+                 [args (in-list args*)])
+        (match* ((procedure-arity f) args)
+          [(0 (list)) (f)]
+          [(1 (list v0)) (f v0)]
+          [(2 (list v0 v1)) (f v0 v1)]
+          [(_ _) (apply f args)])))))
+
 (define (~all? . args)
   (match args
     ['() #t]
diff --git a/qi-test/tests/flow.rkt b/qi-test/tests/flow.rkt
index 7f41fe490..650222d95 100644
--- a/qi-test/tests/flow.rkt
+++ b/qi-test/tests/flow.rkt
@@ -484,18 +484,34 @@
                     5 7)
                    (list 25 8)
                    "named relay form"))
-    (test-suite
-     "==*"
-     (check-equal? ((☯ (~> (==* add1 sub1 +) ▽))
-                    1 1 1 1 1)
-                   (list 2 0 3))
-     (check-equal? ((☯ (~> (==* add1 sub1 +) ▽))
-                    1 1)
-                   (list 2 0 0))
-     (check-equal? ((☯ (~> (relay* add1 sub1 +) ▽))
-                    1 1 1 1 1)
-                   (list 2 0 3)
-                   "named relay* form"))
+    (let ([add (procedure-reduce-arity + 2)]
+          [mul (procedure-reduce-arity * 2)]
+          [id  (procedure-reduce-arity values 1)])
+      (test-suite
+       "==*"
+       (check-equal? ((☯ (~> (==* add1 sub1 +) ▽))
+                      1 1 1 1 1)
+                     (list 2 0 3))
+       (check-equal? ((☯ (~> (==* add1 + sub1) ▽))
+                      1 1 1 1 1)
+                     (list 2 3 0))
+       (check-equal? ((☯ (~> (==* add1 + + sub1) ▽))
+                      1 1 1 1 1)
+                     (list 2 1 2 0))
+       (check-equal? ((☯ (~> (==* add1 sub1 +) ▽))
+                      1 1)
+                     (list 2 0 0))
+       (check-equal? ((☯
+                        (~> (-< 1> 1> 1> 2> 3)  ; x x x y 3
+                            (==* mul  mul   id) ; x*x x*y 3
+                            (==* id   mul)      ; x*x x*y*3
+                            (==* add)))
+                      3 4)
+                     45)
+       (check-equal? ((☯ (~> (relay* add1 sub1 +) ▽))
+                      1 1 1 1 1)
+                     (list 2 0 3)
+                     "named relay* form")))
     (test-suite
      "ground"
      (check-equal? ((☯ (-< ⏚ add1))

From 62824278265f1f8ab848bc5e6050829dbc377d9a Mon Sep 17 00:00:00 2001
From: NoahStoryM <noahstorym@gmail.com>
Date: Sat, 27 Aug 2022 20:01:02 +0800
Subject: [PATCH 02/10] fix a bug.

---
 qi-lib/flow/impl.rkt | 16 +++++++++-------
 1 file changed, 9 insertions(+), 7 deletions(-)

diff --git a/qi-lib/flow/impl.rkt b/qi-lib/flow/impl.rkt
index a69ceadd4..b7ec370ab 100644
--- a/qi-lib/flow/impl.rkt
+++ b/qi-lib/flow/impl.rkt
@@ -270,13 +270,15 @@
         (define-values (v v*) (split-at a* n))
         (values (cons v a) v*)))
     (apply values
-      (for/list ([f (in-list fs)]
-                 [args (in-list args*)])
-        (match* ((procedure-arity f) args)
-          [(0 (list)) (f)]
-          [(1 (list v0)) (f v0)]
-          [(2 (list v0 v1)) (f v0 v1)]
-          [(_ _) (apply f args)])))))
+      (append*
+       (for/list ([f (in-list fs)]
+                  [args (in-list args*)])
+         (values->list
+          (match* ((procedure-arity f) args)
+            [(0 (list)) (f)]
+            [(1 (list v0)) (f v0)]
+            [(2 (list v0 v1)) (f v0 v1)]
+            [(_ _) (apply f args)])))))))
 
 (define (~all? . args)
   (match args

From 600a4fa81daf31e2e46fcdff897cf104b2556de9 Mon Sep 17 00:00:00 2001
From: NoahStoryM <noahstorym@gmail.com>
Date: Sat, 27 Aug 2022 23:01:38 +0800
Subject: [PATCH 03/10] Fix `split-input`.

---
 qi-lib/flow/impl.rkt | 47 +++++++++++++++++++++++---------------------
 1 file changed, 25 insertions(+), 22 deletions(-)

diff --git a/qi-lib/flow/impl.rkt b/qi-lib/flow/impl.rkt
index b7ec370ab..fc12fda9b 100644
--- a/qi-lib/flow/impl.rkt
+++ b/qi-lib/flow/impl.rkt
@@ -210,41 +210,44 @@
           "arity mismatch;\n"
           " the expected number of arguments does not match the given number")
          "given" n)))
+    (define len (length arity*))
     (define-values (m a*)
-      (for/fold ([m n]
-                 [a* '()]
-                 #:result
-                 (match a*
-                   [`([,n 1 ,(arity-at-least 2)] . ,a*)
-                    (values (add1 m) `([,n 0 ,(arity-at-least 1)] . ,a*))]
-                   [_ (values m a*)]))
+      (for/fold ([m n] [a* '()])
                 ([arity (in-list arity*)]
                  [n (in-naturals)])
-        (match arity
-          [(? exact-nonnegative-integer? i)
-           (values (- m i) a*)]
-          [(arity-at-least 0)
-           (values (- m 1) `([,n  1 ,(arity-at-least 2)] . ,a*))]
-          [(or (arity-at-least i) (list* 0 (arity-at-least i)))
-           (values (- m i) `([,n ,i ,(arity-at-least (add1 i))] . ,a*))]
-          [(or (list* 0 i j) (list* i j))
-           (values (- m i) `([,n ,i ,j] . ,a*))])))
+        (if (= 1 (- len n))
+            (match arity
+              [(? exact-nonnegative-integer? i)
+               (values (- m i) a*)]
+              [(or (arity-at-least i)
+                   (list* i _))
+               (values (- m i) `([,n ,i ,arity] . ,a*))])
+            (match arity
+              [(? exact-nonnegative-integer? i)
+               (values (- m i) a*)]
+              [(arity-at-least 0)
+               (values (- m 1) `([,n  1 ,arity] . ,a*))]
+              [(or (arity-at-least i)
+                   (list* 0 (arity-at-least i))
+                   (list* 0 i _)
+                   (list* i _))
+               (values (- m i) `([,n ,i ,arity] . ,a*))]))))
     (unless (>= m 0)
       (report-arity-error))
     (apply list-set*
       arity*
       (for/fold ([m m] [pairs '()] #:result pairs)
                 ([a (in-list a*)])
-        (define-values (n i j) (apply values a))
+        (define-values (n i arity) (apply values a))
         (cond
-          [(or (zero? m) (null? j))
+          [(zero? m)
            (values m (list* n i pairs))]
-          [(arity-includes? j m)
+          [(arity-includes? arity (+ i m))
            (values 0 (list* n (+ i m) pairs))]
-          [(arity-at-least? j)
+          [(arity-at-least? arity)
            (report-arity-error)]
-          [(list? j)
-           (match (last j)
+          [(list? arity)
+           (match (last arity)
              [(? arity-at-least?)
               (report-arity-error)]
              [(? exact-nonnegative-integer? j)

From a0ebef3378a6e02708f73df236ac5f0908173d95 Mon Sep 17 00:00:00 2001
From: NoahStoryM <noahstorym@gmail.com>
Date: Sat, 27 Aug 2022 23:11:56 +0800
Subject: [PATCH 04/10] Rename some local variables.

---
 qi-lib/flow/impl.rkt | 44 ++++++++++++++++++++++----------------------
 1 file changed, 22 insertions(+), 22 deletions(-)

diff --git a/qi-lib/flow/impl.rkt b/qi-lib/flow/impl.rkt
index fc12fda9b..df5ed4798 100644
--- a/qi-lib/flow/impl.rkt
+++ b/qi-lib/flow/impl.rkt
@@ -214,36 +214,36 @@
     (define-values (m a*)
       (for/fold ([m n] [a* '()])
                 ([arity (in-list arity*)]
-                 [n (in-naturals)])
-        (if (= 1 (- len n))
+                 [i (in-naturals)])
+        (if (= 1 (- len i))
             (match arity
-              [(? exact-nonnegative-integer? i)
-               (values (- m i) a*)]
-              [(or (arity-at-least i)
-                   (list* i _))
-               (values (- m i) `([,n ,i ,arity] . ,a*))])
+              [(? exact-nonnegative-integer? n)
+               (values (- m n) a*)]
+              [(or (arity-at-least n)
+                   (list* n _))
+               (values (- m n) `([,i ,n ,arity] . ,a*))])
             (match arity
-              [(? exact-nonnegative-integer? i)
-               (values (- m i) a*)]
+              [(? exact-nonnegative-integer? n)
+               (values (- m n) a*)]
               [(arity-at-least 0)
-               (values (- m 1) `([,n  1 ,arity] . ,a*))]
-              [(or (arity-at-least i)
-                   (list* 0 (arity-at-least i))
-                   (list* 0 i _)
-                   (list* i _))
-               (values (- m i) `([,n ,i ,arity] . ,a*))]))))
+               (values (- m 1) `([,i  1 ,arity] . ,a*))]
+              [(or (arity-at-least n)
+                   (list* 0 (arity-at-least n))
+                   (list* 0 n _)
+                   (list* n _))
+               (values (- m n) `([,i ,n ,arity] . ,a*))]))))
     (unless (>= m 0)
       (report-arity-error))
     (apply list-set*
       arity*
       (for/fold ([m m] [pairs '()] #:result pairs)
                 ([a (in-list a*)])
-        (define-values (n i arity) (apply values a))
+        (define-values (i n arity) (apply values a))
         (cond
           [(zero? m)
-           (values m (list* n i pairs))]
-          [(arity-includes? arity (+ i m))
-           (values 0 (list* n (+ i m) pairs))]
+           (values m (list* i n pairs))]
+          [(arity-includes? arity (+ n m))
+           (values 0 (list* i (+ n m) pairs))]
           [(arity-at-least? arity)
            (report-arity-error)]
           [(list? arity)
@@ -251,7 +251,7 @@
              [(? arity-at-least?)
               (report-arity-error)]
              [(? exact-nonnegative-integer? j)
-              (values (- m j) (list* n (+ i j) pairs))])])))))
+              (values (- m j) (list* i (+ n j) pairs))])])))))
 
 ;; from mischief/function - requiring it runs aground
 ;; of some "name is protected" error while building docs, not sure why;
@@ -269,8 +269,8 @@
   (λ args
     (define args*
       (for/fold ([a '()] [a* args] #:result (reverse a))
-                ([n (in-list (split-input (length args) (map procedure-arity fs)))])
-        (define-values (v v*) (split-at a* n))
+                ([i (in-list (split-input (length args) (map procedure-arity fs)))])
+        (define-values (v v*) (split-at a* i))
         (values (cons v a) v*)))
     (apply values
       (append*

From 19a092026209f7e97365ce383d853f1cac0c8303 Mon Sep 17 00:00:00 2001
From: NoahStoryM <noahstorym@gmail.com>
Date: Sat, 27 Aug 2022 23:17:13 +0800
Subject: [PATCH 05/10] Update.

---
 qi-lib/flow/impl.rkt | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/qi-lib/flow/impl.rkt b/qi-lib/flow/impl.rkt
index df5ed4798..e9a35af90 100644
--- a/qi-lib/flow/impl.rkt
+++ b/qi-lib/flow/impl.rkt
@@ -241,7 +241,7 @@
         (define-values (i n arity) (apply values a))
         (cond
           [(zero? m)
-           (values m (list* i n pairs))]
+           (values 0 (list* i n pairs))]
           [(arity-includes? arity (+ n m))
            (values 0 (list* i (+ n m) pairs))]
           [(arity-at-least? arity)

From e918d49dd63021f41789f39e311d17dc02114590 Mon Sep 17 00:00:00 2001
From: NoahStoryM <noahstorym@gmail.com>
Date: Sun, 28 Aug 2022 12:05:12 +0800
Subject: [PATCH 06/10] Update test.

---
 qi-test/tests/flow.rkt | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/qi-test/tests/flow.rkt b/qi-test/tests/flow.rkt
index 650222d95..0fc4cd633 100644
--- a/qi-test/tests/flow.rkt
+++ b/qi-test/tests/flow.rkt
@@ -501,11 +501,11 @@
        (check-equal? ((☯ (~> (==* add1 sub1 +) ▽))
                       1 1)
                      (list 2 0 0))
-       (check-equal? ((☯
+       (check-equal? ((☯                        ; x y
                         (~> (-< 1> 1> 1> 2> 3)  ; x x x y 3
                             (==* mul  mul   id) ; x*x x*y 3
                             (==* id   mul)      ; x*x x*y*3
-                            (==* add)))
+                            add))               ; x*x+x*y*3
                       3 4)
                      45)
        (check-equal? ((☯ (~> (relay* add1 sub1 +) ▽))

From 62d8dc4821e69dd9fd5589735be5b7d889f13976 Mon Sep 17 00:00:00 2001
From: NoahStoryM <noahstorym@gmail.com>
Date: Mon, 29 Aug 2022 14:04:13 +0800
Subject: [PATCH 07/10] Check redundant parameters.

---
 qi-lib/flow/impl.rkt | 36 +++++++++++++++++++-----------------
 1 file changed, 19 insertions(+), 17 deletions(-)

diff --git a/qi-lib/flow/impl.rkt b/qi-lib/flow/impl.rkt
index e9a35af90..fa225d250 100644
--- a/qi-lib/flow/impl.rkt
+++ b/qi-lib/flow/impl.rkt
@@ -236,7 +236,7 @@
       (report-arity-error))
     (apply list-set*
       arity*
-      (for/fold ([m m] [pairs '()] #:result pairs)
+      (for/fold ([m m] [pairs '()] #:result (if (zero? m) pairs (report-arity-error)))
                 ([a (in-list a*)])
         (define-values (i n arity) (apply values a))
         (cond
@@ -266,22 +266,24 @@
     (apply values (zip-with call fs args))))
 
 (define (relay* . fs)
-  (λ args
-    (define args*
-      (for/fold ([a '()] [a* args] #:result (reverse a))
-                ([i (in-list (split-input (length args) (map procedure-arity fs)))])
-        (define-values (v v*) (split-at a* i))
-        (values (cons v a) v*)))
-    (apply values
-      (append*
-       (for/list ([f (in-list fs)]
-                  [args (in-list args*)])
-         (values->list
-          (match* ((procedure-arity f) args)
-            [(0 (list)) (f)]
-            [(1 (list v0)) (f v0)]
-            [(2 (list v0 v1)) (f v0 v1)]
-            [(_ _) (apply f args)])))))))
+  (if (null? fs)
+      (λ () (values))
+      (λ args
+        (define args*
+          (for/fold ([a '()] [a* args] #:result (reverse a))
+                    ([i (in-list (split-input (length args) (map procedure-arity fs)))])
+            (define-values (v v*) (split-at a* i))
+            (values (cons v a) v*)))
+        (apply values
+          (append*
+           (for/list ([f (in-list fs)]
+                      [args (in-list args*)])
+             (values->list
+              (match* ((procedure-arity f) args)
+                [(0 (list)) (f)]
+                [(1 (list v0)) (f v0)]
+                [(2 (list v0 v1)) (f v0 v1)]
+                [(_ _) (apply f args)]))))))))
 
 (define (~all? . args)
   (match args

From 376759f646e25a7631c8074bf3ea8aa0b9869b9e Mon Sep 17 00:00:00 2001
From: NoahStoryM <noahstorym@gmail.com>
Date: Mon, 29 Aug 2022 14:10:29 +0800
Subject: [PATCH 08/10] Name identity element of `==*`.

---
 qi-lib/flow/impl.rkt | 40 ++++++++++++++++++++++------------------
 1 file changed, 22 insertions(+), 18 deletions(-)

diff --git a/qi-lib/flow/impl.rkt b/qi-lib/flow/impl.rkt
index fa225d250..80b5b2545 100644
--- a/qi-lib/flow/impl.rkt
+++ b/qi-lib/flow/impl.rkt
@@ -253,6 +253,8 @@
              [(? exact-nonnegative-integer? j)
               (values (- m j) (list* i (+ n j) pairs))])])))))
 
+(define terminal (λ () (values)))
+
 ;; from mischief/function - requiring it runs aground
 ;; of some "name is protected" error while building docs, not sure why;
 ;; so including the implementation directly here for now
@@ -262,28 +264,30 @@
      (keyword-apply f ks vs xs))))
 
 (define (relay . fs)
-  (λ args
-    (apply values (zip-with call fs args))))
+  (if (null? fs)
+      terminal
+      (λ args (apply values (zip-with call fs args)))))
 
 (define (relay* . fs)
   (if (null? fs)
-      (λ () (values))
+      terminal
       (λ args
-        (define args*
-          (for/fold ([a '()] [a* args] #:result (reverse a))
-                    ([i (in-list (split-input (length args) (map procedure-arity fs)))])
-            (define-values (v v*) (split-at a* i))
-            (values (cons v a) v*)))
-        (apply values
-          (append*
-           (for/list ([f (in-list fs)]
-                      [args (in-list args*)])
-             (values->list
-              (match* ((procedure-arity f) args)
-                [(0 (list)) (f)]
-                [(1 (list v0)) (f v0)]
-                [(2 (list v0 v1)) (f v0 v1)]
-                [(_ _) (apply f args)]))))))))
+        (let ([fs (remq* (list terminal) fs)])
+          (define args*
+            (for/fold ([a '()] [a* args] #:result (reverse a))
+                      ([i (in-list (split-input (length args) (map procedure-arity fs)))])
+              (define-values (v v*) (split-at a* i))
+              (values (cons v a) v*)))
+          (apply values
+            (append*
+             (for/list ([f (in-list fs)]
+                        [args (in-list args*)])
+               (values->list
+                (match* ((procedure-arity f) args)
+                  [(0 (list)) (f)]
+                  [(1 (list v0)) (f v0)]
+                  [(2 (list v0 v1)) (f v0 v1)]
+                  [(_ _) (apply f args)])))))))))
 
 (define (~all? . args)
   (match args

From f78cff4fd80d5e3b53b7233096f1689de917f9f3 Mon Sep 17 00:00:00 2001
From: NoahStoryM <noahstorym@gmail.com>
Date: Mon, 29 Aug 2022 14:15:55 +0800
Subject: [PATCH 09/10] Update.

---
 qi-lib/flow/impl.rkt | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/qi-lib/flow/impl.rkt b/qi-lib/flow/impl.rkt
index 80b5b2545..7d0d83bed 100644
--- a/qi-lib/flow/impl.rkt
+++ b/qi-lib/flow/impl.rkt
@@ -269,10 +269,10 @@
       (λ args (apply values (zip-with call fs args)))))
 
 (define (relay* . fs)
-  (if (null? fs)
-      terminal
-      (λ args
-        (let ([fs (remq* (list terminal) fs)])
+  (let ([fs (remq* (list terminal) fs)])
+    (if (null? fs)
+        terminal
+        (λ args
           (define args*
             (for/fold ([a '()] [a* args] #:result (reverse a))
                       ([i (in-list (split-input (length args) (map procedure-arity fs)))])

From 8cc17feee0092bf0d285a54a7198b9002be06ac1 Mon Sep 17 00:00:00 2001
From: NoahStoryM <noahstorym@gmail.com>
Date: Mon, 29 Aug 2022 18:24:19 +0800
Subject: [PATCH 10/10] Add `1->1` and `*->1`.

---
 qi-lib/flow/compiler.rkt | 16 +++++-----------
 qi-lib/flow/impl.rkt     | 28 +++++++++++++++++++++-------
 2 files changed, 26 insertions(+), 18 deletions(-)

diff --git a/qi-lib/flow/compiler.rkt b/qi-lib/flow/compiler.rkt
index e3271e9fd..733041501 100644
--- a/qi-lib/flow/compiler.rkt
+++ b/qi-lib/flow/compiler.rkt
@@ -91,7 +91,7 @@
     ;;; Core routing elements
 
     [(~or* (~datum ⏚) (~datum ground))
-     #'(qi0->racket (select))]
+     #'*->1]
     [((~or* (~datum ~>) (~datum thread)) onex:clause ...)
      #`(compose . #,(reverse
                      (syntax->list
@@ -104,11 +104,7 @@
     [((~or* (~datum ==*) (~datum relay*)) onex:clause ...)
      #'(relay* (qi0->racket onex) ...)]
     [((~or* (~datum -<) (~datum tee)) onex:clause ...)
-     #'(λ args
-         (apply values
-                (append (values->list
-                         (apply (qi0->racket onex) args))
-                        ...)))]
+     #'(tee (qi0->racket onex) ...)]
     [e:select-form (select-parser #'e)]
     [e:block-form (block-parser #'e)]
     [((~datum bundle) (n:number ...)
@@ -307,6 +303,7 @@ the DSL.
 
   (define (select-parser stx)
     (syntax-parse stx
+      [(_) #'*->1]
       [(_ n:number ...) #'(qi0->racket (-< (esc (arg n)) ...))]
       [(_ arg ...) ; error handling catch-all
        (report-syntax-error 'select
@@ -487,17 +484,14 @@ the DSL.
   (define (fanout-parser stx)
     (syntax-parse stx
       [_:id #'repeat-values]
+      [(_ 0) #'*->1]
       [(_ n:number)
        ;; a slightly more efficient compile-time implementation
        ;; for literally indicated N
        #`(λ args
            (apply values
                   (append #,@(make-list (syntax->datum #'n) 'args))) )]
-      [(_ n:expr)
-       #'(lambda args
-           (apply values
-                  (apply append
-                         (make-list n args))))]))
+      [(_ e:expr) #`(let ([n e]) (#,fanout-parser n))]))
 
   (define (feedback-parser stx)
     (syntax-parse stx
diff --git a/qi-lib/flow/impl.rkt b/qi-lib/flow/impl.rkt
index 7d0d83bed..ce9c1f37c 100644
--- a/qi-lib/flow/impl.rkt
+++ b/qi-lib/flow/impl.rkt
@@ -10,8 +10,11 @@
          map-values
          filter-values
          partition-values
+         1->1
+         *->1
          relay
          relay*
+         tee
          loom-compose
          parity-xor
          arg
@@ -253,7 +256,8 @@
              [(? exact-nonnegative-integer? j)
               (values (- m j) (list* i (+ n j) pairs))])])))))
 
-(define terminal (λ () (values)))
+(define 1->1 (λ () (values)))
+(define *->1 (λ _ (values)))
 
 ;; from mischief/function - requiring it runs aground
 ;; of some "name is protected" error while building docs, not sure why;
@@ -265,13 +269,13 @@
 
 (define (relay . fs)
   (if (null? fs)
-      terminal
+      1->1
       (λ args (apply values (zip-with call fs args)))))
 
 (define (relay* . fs)
-  (let ([fs (remq* (list terminal) fs)])
+  (let ([fs (remq* (list 1->1) fs)])
     (if (null? fs)
-        terminal
+        1->1
         (λ args
           (define args*
             (for/fold ([a '()] [a* args] #:result (reverse a))
@@ -284,11 +288,21 @@
                         [args (in-list args*)])
                (values->list
                 (match* ((procedure-arity f) args)
-                  [(0 (list)) (f)]
-                  [(1 (list v0)) (f v0)]
-                  [(2 (list v0 v1)) (f v0 v1)]
+                  [(0 '()) (f)]
+                  [(1 `(,v0)) (f v0)]
+                  [(2 `(,v0 ,v1)) (f v0 v1)]
                   [(_ _) (apply f args)])))))))))
 
+(define (tee . fs)
+  (let ([fs (remq* (list *->1) fs)])
+    (if (null? fs)
+        *->1
+        (λ args
+          (apply values
+            (append*
+             (for/list ([f (in-list fs)])
+               (values->list (apply f args)))))))))
+
 (define (~all? . args)
   (match args
     ['() #t]