From 94886860b0b344f2eee93b29d9f31e09c1a1f3af Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?=
 <dominik.pantucek@trustica.cz>
Date: Sat, 11 Nov 2023 10:31:59 +0100
Subject: [PATCH 1/4] Move the current deforestation (both syntax and
 implementation parts) into a separate module.

---
 qi-lib/flow/core/compiler.rkt | 184 +-----------------------
 qi-lib/flow/core/deforest.rkt | 255 ++++++++++++++++++++++++++++++++++
 qi-lib/flow/core/impl.rkt     |  72 +---------
 3 files changed, 258 insertions(+), 253 deletions(-)
 create mode 100644 qi-lib/flow/core/deforest.rkt

diff --git a/qi-lib/flow/core/compiler.rkt b/qi-lib/flow/core/compiler.rkt
index b37ce538..77312969 100644
--- a/qi-lib/flow/core/compiler.rkt
+++ b/qi-lib/flow/core/compiler.rkt
@@ -17,7 +17,8 @@
          racket/function
          racket/undefined
          (prefix-in fancy: fancy-app)
-         racket/list)
+         racket/list
+         "deforest.rkt")
 
 ;; "Composes" higher-order functions inline by directly applying them
 ;; to the result of each subsequent application, with the last argument
@@ -48,144 +49,6 @@
   (define (compile-flow stx)
     (process-bindings (optimize-flow stx)))
 
-  ;; Used for producing the stream from particular
-  ;; expressions. Implicit producer is list->cstream-next and it is
-  ;; not created by using this class but rather explicitly used when
-  ;; no syntax class producer is matched.
-  (define-syntax-class fusable-stream-producer
-    #:attributes (next prepare)
-    #:datum-literals (#%host-expression #%partial-application esc)
-    (pattern (~and (esc (#%host-expression (~literal range)))
-                   stx)
-      #:attr next #'range->cstream-next
-      #:attr prepare #'range->cstream-prepare)
-    (pattern (~and (#%partial-application
-                    ((#%host-expression (~literal range))
-                     (#%host-expression arg) ...))
-                   stx)
-      #:do [(define chirality (syntax-property #'stx 'chirality))]
-      #:with vindaloo (if (and chirality (eq? chirality 'right))
-                          #'curry
-                          #'curryr)
-      #:attr next #'range->cstream-next
-      #:attr prepare #'(vindaloo range->cstream-prepare arg ...)))
-
-  ;; Matches any stream transformer that can be in the head position
-  ;; of the fused sequence even when there is no explicit
-  ;; producer. Procedures accepting variable number of arguments like
-  ;; `map` cannot be in this class.
-  (define-syntax-class fusable-stream-transformer0
-    #:attributes (f next)
-    #:datum-literals (#%host-expression #%partial-application)
-    (pattern (~and (#%partial-application
-                    ((#%host-expression (~literal filter))
-                     (#%host-expression f)))
-                   stx)
-      #:do [(define chirality (syntax-property #'stx 'chirality))]
-      #:when (and chirality (eq? chirality 'right))
-      #:attr next #'filter-cstream-next))
-
-  ;; All implemented stream transformers - within the stream, only
-  ;; single value is being passed and therefore procedures like `map`
-  ;; can (and should) be matched.
-  (define-syntax-class fusable-stream-transformer
-    #:attributes (f next)
-    #:datum-literals (#%host-expression #%partial-application)
-    (pattern (~and (#%partial-application
-                    ((#%host-expression (~literal map))
-                     (#%host-expression f)))
-                   stx)
-             #:do [(define chirality (syntax-property #'stx 'chirality))]
-             #:when (and chirality (eq? chirality 'right))
-             #:attr next #'map-cstream-next)
-    (pattern (~and (#%partial-application
-                    ((#%host-expression (~literal filter))
-                     (#%host-expression f)))
-                   stx)
-             #:do [(define chirality (syntax-property #'stx 'chirality))]
-             #:when (and chirality (eq? chirality 'right))
-             #:attr next #'filter-cstream-next))
-
-  ;; Terminates the fused sequence (consumes the stream) and produces
-  ;; an actual result value. The implicit consumer is cstream->list is
-  ;; not part of this class as it is added explicitly when generating
-  ;; the fused operation.
-  (define-syntax-class fusable-stream-consumer
-    #:attributes (op init end)
-    #:datum-literals (#%host-expression #%partial-application)
-    (pattern (~and (#%partial-application
-                    ((#%host-expression (~literal foldr))
-                     (#%host-expression op)
-                     (#%host-expression init)))
-                   stx)
-      #:do [(define chirality (syntax-property #'stx 'chirality))]
-      #:when (and chirality (eq? chirality 'right))
-      #:attr end #'(foldr-cstream op init))
-    (pattern (~and (#%partial-application
-                    ((#%host-expression (~literal foldl))
-                     (#%host-expression op)
-                     (#%host-expression init)))
-                   stx)
-      #:do [(define chirality (syntax-property #'stx 'chirality))]
-      #:when (and chirality (eq? chirality 'right))
-      #:attr end #'(foldl-cstream op init)))
-
-  (define-syntax-class non-fusable
-    (pattern (~not (~or _:fusable-stream-transformer
-                        _:fusable-stream-producer
-                        _:fusable-stream-consumer))))
-
-  ;; Generates a syntax for the fused operation for given
-  ;; sequence. The syntax list must already conform to the rule that
-  ;; if the first operation is a fusable-stream-transformer, it must
-  ;; be a fusable-stream-transformer0 as well!
-  (define (generate-fused-operation ops)
-    (syntax-parse (reverse ops)
-      [(g:fusable-stream-consumer
-        op:fusable-stream-transformer ...
-        p:fusable-stream-producer)
-       ;; Contract probably not needed (prepare should produce
-       ;; meaningful error messages)
-       #`(esc (λ args
-                ((#,@#'g.end
-                  (inline-compose1 [op.next op.f] ...
-                                   p.next))
-                 (apply p.prepare args))))]
-      [(g:fusable-stream-consumer
-        p:fusable-stream-producer)
-       ;; dtto
-       #`(esc (λ args
-                ((#,@#'g.end p.next)
-                 (apply p.prepare args))))]
-      ;; The list must contain fusable-stream-transformer0 as the last element!
-      [(g:fusable-stream-consumer
-        op:fusable-stream-transformer ...)
-       ;; TODO: Add contract
-       #`(esc (λ (lst)
-                ((#,@#'g.end
-                  (inline-compose1 [op.next op.f] ...
-                                   list->cstream-next))
-                 lst)))]
-      [(op:fusable-stream-transformer ...
-        p:fusable-stream-producer)
-       ;; dtto
-       #`(esc (λ args
-                ((cstream->list
-                  (inline-compose1 [op.next op.f] ...
-                                   p.next))
-                 (apply p.prepare args))))]
-      ;; dtto
-      [(op:fusable-stream-transformer ...)
-       #'(esc (λ (lst)
-                ;; have a contract here for the input
-                ;; validate it's a list, and error message
-                ;; can include the op syntax object
-                ((cstream->list
-                  (inline-compose1 [op.next op.f] ...
-                                   list->cstream-next))
-                 lst)))]
-      ))
-
   (define-qi-expansion-step (normalize-rewrite stx)
     ;; TODO: the "active" components of the expansions should be
     ;; optimized, i.e. they should be wrapped with a recursive
@@ -241,49 +104,6 @@
       ;; return syntax unchanged if there are no known optimizations
       [_ stx]))
 
-  ;; 0. "Qi-normal form"
-  ;; 1. deforestation pass
-  ;; 2. other passes ...
-  ;; e.g.:
-  ;; changing internal representation to lists from values - may affect passes
-  ;; passes as distinct stages is safe and interesting, a conservative start
-  ;; one challenge: traversing the syntax tree
-  (define (deforest-rewrite stx)
-    (syntax-parse stx
-      [((~datum thread) _0:non-fusable ...
-                        p:fusable-stream-producer
-                        f:fusable-stream-transformer ...+
-                        g:fusable-stream-consumer
-                        _1 ...)
-       #:with fused (generate-fused-operation (syntax->list #'(p f ... g)))
-       #'(thread _0 ... fused _1 ...)]
-      [((~datum thread) _0:non-fusable ...
-                        p:fusable-stream-producer
-                        g:fusable-stream-consumer
-                        _1 ...)
-       #:with fused (generate-fused-operation (syntax->list #'(p g)))
-       #'(thread _0 ... fused _1 ...)]
-      [((~datum thread) _0:non-fusable ...
-                        f1:fusable-stream-transformer0
-                        f:fusable-stream-transformer ...+
-                        g:fusable-stream-consumer
-                        _1 ...)
-       #:with fused (generate-fused-operation (syntax->list #'(f1 f ... g)))
-       #'(thread _0 ... fused _1 ...)]
-      [((~datum thread) _0:non-fusable ...
-                        p:fusable-stream-producer
-                        f:fusable-stream-transformer ...+
-                        _1 ...)
-       #:with fused (generate-fused-operation (syntax->list #'(p f ...)))
-       #'(thread _0 ... fused _1 ...)]
-      [((~datum thread) _0:non-fusable ...
-                        f1:fusable-stream-transformer0
-                        f:fusable-stream-transformer ...+
-                        _1 ...)
-       #:with fused (generate-fused-operation (syntax->list #'(f1 f ...)))
-       #'(thread _0 ... fused _1 ...)]
-      [_ this-syntax]))
-
   ;; Applies f repeatedly to the init-val terminating the loop if the
   ;; result of f is #f or the new syntax object is eq? to the previous
   ;; (possibly initial) one.
diff --git a/qi-lib/flow/core/deforest.rkt b/qi-lib/flow/core/deforest.rkt
new file mode 100644
index 00000000..56de4656
--- /dev/null
+++ b/qi-lib/flow/core/deforest.rkt
@@ -0,0 +1,255 @@
+#lang racket/base
+
+(provide (for-syntax deforest-rewrite))
+
+(require (for-syntax racket/base
+                     syntax/parse)
+         racket/performance-hint
+         racket/match)
+
+(begin-for-syntax
+
+  ;; Used for producing the stream from particular
+  ;; expressions. Implicit producer is list->cstream-next and it is
+  ;; not created by using this class but rather explicitly used when
+  ;; no syntax class producer is matched.
+  (define-syntax-class fusable-stream-producer
+    #:attributes (next prepare)
+    #:datum-literals (#%host-expression #%partial-application esc)
+    (pattern (~and (esc (#%host-expression (~literal range)))
+                   stx)
+             #:attr next #'range->cstream-next
+             #:attr prepare #'range->cstream-prepare)
+    (pattern (~and (#%partial-application
+                    ((#%host-expression (~literal range))
+                     (#%host-expression arg) ...))
+                   stx)
+             #:do [(define chirality (syntax-property #'stx 'chirality))]
+             #:with vindaloo (if (and chirality (eq? chirality 'right))
+                                 #'curry
+                                 #'curryr)
+             #:attr next #'range->cstream-next
+             #:attr prepare #'(vindaloo range->cstream-prepare arg ...)))
+
+  ;; Matches any stream transformer that can be in the head position
+  ;; of the fused sequence even when there is no explicit
+  ;; producer. Procedures accepting variable number of arguments like
+  ;; `map` cannot be in this class.
+  (define-syntax-class fusable-stream-transformer0
+    #:attributes (f next)
+    #:datum-literals (#%host-expression #%partial-application)
+    (pattern (~and (#%partial-application
+                    ((#%host-expression (~literal filter))
+                     (#%host-expression f)))
+                   stx)
+             #:do [(define chirality (syntax-property #'stx 'chirality))]
+             #:when (and chirality (eq? chirality 'right))
+             #:attr next #'filter-cstream-next))
+
+  ;; All implemented stream transformers - within the stream, only
+  ;; single value is being passed and therefore procedures like `map`
+  ;; can (and should) be matched.
+  (define-syntax-class fusable-stream-transformer
+    #:attributes (f next)
+    #:datum-literals (#%host-expression #%partial-application)
+    (pattern (~and (#%partial-application
+                    ((#%host-expression (~literal map))
+                     (#%host-expression f)))
+                   stx)
+             #:do [(define chirality (syntax-property #'stx 'chirality))]
+             #:when (and chirality (eq? chirality 'right))
+             #:attr next #'map-cstream-next)
+    (pattern (~and (#%partial-application
+                    ((#%host-expression (~literal filter))
+                     (#%host-expression f)))
+                   stx)
+             #:do [(define chirality (syntax-property #'stx 'chirality))]
+             #:when (and chirality (eq? chirality 'right))
+             #:attr next #'filter-cstream-next))
+
+  ;; Terminates the fused sequence (consumes the stream) and produces
+  ;; an actual result value. The implicit consumer is cstream->list is
+  ;; not part of this class as it is added explicitly when generating
+  ;; the fused operation.
+  (define-syntax-class fusable-stream-consumer
+    #:attributes (op init end)
+    #:datum-literals (#%host-expression #%partial-application)
+    (pattern (~and (#%partial-application
+                    ((#%host-expression (~literal foldr))
+                     (#%host-expression op)
+                     (#%host-expression init)))
+                   stx)
+             #:do [(define chirality (syntax-property #'stx 'chirality))]
+             #:when (and chirality (eq? chirality 'right))
+             #:attr end #'(foldr-cstream op init))
+    (pattern (~and (#%partial-application
+                    ((#%host-expression (~literal foldl))
+                     (#%host-expression op)
+                     (#%host-expression init)))
+                   stx)
+             #:do [(define chirality (syntax-property #'stx 'chirality))]
+             #:when (and chirality (eq? chirality 'right))
+             #:attr end #'(foldl-cstream op init)))
+
+  (define-syntax-class non-fusable
+    (pattern (~not (~or _:fusable-stream-transformer
+                        _:fusable-stream-producer
+                        _:fusable-stream-consumer))))
+
+  ;; Generates a syntax for the fused operation for given
+  ;; sequence. The syntax list must already conform to the rule that
+  ;; if the first operation is a fusable-stream-transformer, it must
+  ;; be a fusable-stream-transformer0 as well!
+  (define (generate-fused-operation ops)
+    (syntax-parse (reverse ops)
+      [(g:fusable-stream-consumer
+        op:fusable-stream-transformer ...
+        p:fusable-stream-producer)
+       ;; Contract probably not needed (prepare should produce
+       ;; meaningful error messages)
+       #`(esc (λ args
+                ((#,@#'g.end
+                  (inline-compose1 [op.next op.f] ...
+                                   p.next))
+                 (apply p.prepare args))))]
+      [(g:fusable-stream-consumer
+        p:fusable-stream-producer)
+       ;; dtto
+       #`(esc (λ args
+                ((#,@#'g.end p.next)
+                 (apply p.prepare args))))]
+      ;; The list must contain fusable-stream-transformer0 as the last element!
+      [(g:fusable-stream-consumer
+        op:fusable-stream-transformer ...)
+       ;; TODO: Add contract
+       #`(esc (λ (lst)
+                ((#,@#'g.end
+                  (inline-compose1 [op.next op.f] ...
+                                   list->cstream-next))
+                 lst)))]
+      [(op:fusable-stream-transformer ...
+                                      p:fusable-stream-producer)
+       ;; dtto
+       #`(esc (λ args
+                ((cstream->list
+                  (inline-compose1 [op.next op.f] ...
+                                   p.next))
+                 (apply p.prepare args))))]
+      ;; dtto
+      [(op:fusable-stream-transformer ...)
+       #'(esc (λ (lst)
+                ;; have a contract here for the input
+                ;; validate it's a list, and error message
+                ;; can include the op syntax object
+                ((cstream->list
+                  (inline-compose1 [op.next op.f] ...
+                                   list->cstream-next))
+                 lst)))]
+      ))
+
+  ;; 0. "Qi-normal form"
+  ;; 1. deforestation pass
+  ;; 2. other passes ...
+  ;; e.g.:
+  ;; changing internal representation to lists from values - may affect passes
+  ;; passes as distinct stages is safe and interesting, a conservative start
+  ;; one challenge: traversing the syntax tree
+  (define (deforest-rewrite stx)
+    (syntax-parse stx
+      [((~datum thread) _0:non-fusable ...
+                        p:fusable-stream-producer
+                        f:fusable-stream-transformer ...+
+                        g:fusable-stream-consumer
+                        _1 ...)
+       #:with fused (generate-fused-operation (syntax->list #'(p f ... g)))
+       #'(thread _0 ... fused _1 ...)]
+      [((~datum thread) _0:non-fusable ...
+                        p:fusable-stream-producer
+                        g:fusable-stream-consumer
+                        _1 ...)
+       #:with fused (generate-fused-operation (syntax->list #'(p g)))
+       #'(thread _0 ... fused _1 ...)]
+      [((~datum thread) _0:non-fusable ...
+                        f1:fusable-stream-transformer0
+                        f:fusable-stream-transformer ...+
+                        g:fusable-stream-consumer
+                        _1 ...)
+       #:with fused (generate-fused-operation (syntax->list #'(f1 f ... g)))
+       #'(thread _0 ... fused _1 ...)]
+      [((~datum thread) _0:non-fusable ...
+                        p:fusable-stream-producer
+                        f:fusable-stream-transformer ...+
+                        _1 ...)
+       #:with fused (generate-fused-operation (syntax->list #'(p f ...)))
+       #'(thread _0 ... fused _1 ...)]
+      [((~datum thread) _0:non-fusable ...
+                        f1:fusable-stream-transformer0
+                        f:fusable-stream-transformer ...+
+                        _1 ...)
+       #:with fused (generate-fused-operation (syntax->list #'(f1 f ...)))
+       #'(thread _0 ... fused _1 ...)]
+      [_ this-syntax]))
+
+  )
+
+;; Stream fusion
+(define-inline (cstream->list next)
+  (λ (state)
+    (let loop ([state state])
+      ((next (λ () null)
+             (λ (state) (loop state))
+             (λ (value state)
+               (cons value (loop state))))
+       state))))
+
+(define-inline (foldr-cstream op init next)
+  (λ (state)
+    (let loop ([state state])
+      ((next (λ () init)
+             (λ (state) (loop state))
+             (λ (value state)
+               (op value (loop state))))
+       state))))
+
+(define-inline (foldl-cstream op init next)
+  (λ (state)
+    (let loop ([acc init] [state state])
+      ((next (λ () acc)
+             (λ (state) (loop acc state))
+             (λ (value state)
+               (loop (op value acc) state)))
+       state))))
+
+(define-inline (list->cstream-next done skip yield)
+  (λ (state)
+    (cond [(null? state) (done)]
+          [else (yield (car state) (cdr state))])))
+
+(define-inline (range->cstream-next done skip yield)
+  (λ (state)
+    (match-define (list l h s) state)
+    (cond [(< l h)
+           (yield l (cons (+ l s) (cdr state)))]
+          [else (done)])))
+
+(define range->cstream-prepare
+  (case-lambda
+    [(h) (list 0 h 1)]
+    [(l h) (list l h 1)]
+    [(l h s) (list l h s)]))
+
+(define-inline (map-cstream-next f next)
+  (λ (done skip yield)
+    (next done
+          skip
+          (λ (value state)
+            (yield (f value) state)))))
+
+(define-inline (filter-cstream-next f next)
+  (λ (done skip yield)
+    (next done
+          skip
+          (λ (value state)
+            (if (f value)
+                (yield value state)
+                (skip state))))))
diff --git a/qi-lib/flow/core/impl.rkt b/qi-lib/flow/core/impl.rkt
index c0306a83..8cfc523a 100644
--- a/qi-lib/flow/core/impl.rkt
+++ b/qi-lib/flow/core/impl.rkt
@@ -19,15 +19,7 @@
          values->list
          feedback-times
          feedback-while
-         kw-helper
-         cstream->list
-         list->cstream-next
-         range->cstream-next
-         range->cstream-prepare
-         map-cstream-next
-         filter-cstream-next
-         foldr-cstream
-         foldl-cstream)
+         kw-helper)
 
 (require racket/match
          (only-in racket/function
@@ -246,65 +238,3 @@
           (loop (values->list
                  (apply f args)))
           (apply then-f args)))))
-
-;; Stream fusion
-(define-inline (cstream->list next)
-  (λ (state)
-    (let loop ([state state])
-      ((next (λ () null)
-             (λ (state) (loop state))
-             (λ (value state)
-               (cons value (loop state))))
-       state))))
-
-(define-inline (foldr-cstream op init next)
-  (λ (state)
-    (let loop ([state state])
-      ((next (λ () init)
-             (λ (state) (loop state))
-             (λ (value state)
-               (op value (loop state))))
-       state))))
-
-(define-inline (foldl-cstream op init next)
-  (λ (state)
-    (let loop ([acc init] [state state])
-      ((next (λ () acc)
-             (λ (state) (loop acc state))
-             (λ (value state)
-               (loop (op value acc) state)))
-       state))))
-
-(define-inline (list->cstream-next done skip yield)
-  (λ (state)
-    (cond [(null? state) (done)]
-          [else (yield (car state) (cdr state))])))
-
-(define-inline (range->cstream-next done skip yield)
-  (λ (state)
-    (match-define (list l h s) state)
-    (cond [(< l h)
-           (yield l (cons (+ l s) (cdr state)))]
-          [else (done)])))
-
-(define range->cstream-prepare
-  (case-lambda
-    [(h) (list 0 h 1)]
-    [(l h) (list l h 1)]
-    [(l h s) (list l h s)]))
-
-(define-inline (map-cstream-next f next)
-  (λ (done skip yield)
-    (next done
-          skip
-          (λ (value state)
-            (yield (f value) state)))))
-
-(define-inline (filter-cstream-next f next)
-  (λ (done skip yield)
-    (next done
-          skip
-          (λ (value state)
-            (if (f value)
-                (yield value state)
-                (skip state))))))

From bb596295984aaaf2fb1f56bd1ee37bf376b299f4 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?=
 <dominik.pantucek@trustica.cz>
Date: Sat, 11 Nov 2023 19:09:29 +0100
Subject: [PATCH 2/4] Fix missing requires (for ~literal matching), streamline
 procedures naming in implementation, move inline-compose1 too.

---
 qi-lib/flow/core/compiler.rkt |  10 --
 qi-lib/flow/core/deforest.rkt | 167 ++++++++++++++++------------------
 2 files changed, 80 insertions(+), 97 deletions(-)

diff --git a/qi-lib/flow/core/compiler.rkt b/qi-lib/flow/core/compiler.rkt
index 77312969..102ea12e 100644
--- a/qi-lib/flow/core/compiler.rkt
+++ b/qi-lib/flow/core/compiler.rkt
@@ -20,16 +20,6 @@
          racket/list
          "deforest.rkt")
 
-;; "Composes" higher-order functions inline by directly applying them
-;; to the result of each subsequent application, with the last argument
-;; being passed to the penultimate application as a (single) argument.
-;; This is specialized to our implementation of stream fusion in the
-;; arguments it expects and how it uses them.
-(define-syntax inline-compose1
-  (syntax-rules ()
-    [(_ f) f]
-    [(_ [op f] rest ...) (op f (inline-compose1 rest ...))]))
-
 (begin-for-syntax
 
   ;; currently does not distinguish substeps of a parent expansion step
diff --git a/qi-lib/flow/core/deforest.rkt b/qi-lib/flow/core/deforest.rkt
index 56de4656..a03ae77a 100644
--- a/qi-lib/flow/core/deforest.rkt
+++ b/qi-lib/flow/core/deforest.rkt
@@ -5,7 +5,24 @@
 (require (for-syntax racket/base
                      syntax/parse)
          racket/performance-hint
-         racket/match)
+         racket/match
+         racket/function
+         racket/list)
+
+;; These bindings are used for ~literal matching to introduce implicit
+;; producer/consumer when none is explicitly given in the flow.
+(define-syntax cstream->list #'-cstream->list)
+(define-syntax list->cstream #'-list->cstream)
+
+;; "Composes" higher-order functions inline by directly applying them
+;; to the result of each subsequent application, with the last argument
+;; being passed to the penultimate application as a (single) argument.
+;; This is specialized to our implementation of stream fusion in the
+;; arguments it expects and how it uses them.
+(define-syntax inline-compose1
+  (syntax-rules ()
+    [(_ f) f]
+    [(_ [op f] rest ...) (op f (inline-compose1 rest ...))]))
 
 (begin-for-syntax
 
@@ -29,7 +46,10 @@
                                  #'curry
                                  #'curryr)
              #:attr next #'range->cstream-next
-             #:attr prepare #'(vindaloo range->cstream-prepare arg ...)))
+             #:attr prepare #'(vindaloo range->cstream-prepare arg ...))
+    (pattern (~literal list->cstream)
+             #:attr next #'list->cstream-next
+             #:attr prepare #'identity))
 
   ;; Matches any stream transformer that can be in the head position
   ;; of the fused sequence even when there is no explicit
@@ -72,7 +92,7 @@
   ;; not part of this class as it is added explicitly when generating
   ;; the fused operation.
   (define-syntax-class fusable-stream-consumer
-    #:attributes (op init end)
+    #:attributes (end)
     #:datum-literals (#%host-expression #%partial-application)
     (pattern (~and (#%partial-application
                     ((#%host-expression (~literal foldr))
@@ -81,7 +101,7 @@
                    stx)
              #:do [(define chirality (syntax-property #'stx 'chirality))]
              #:when (and chirality (eq? chirality 'right))
-             #:attr end #'(foldr-cstream op init))
+             #:attr end #'(foldr-cstream-next op init))
     (pattern (~and (#%partial-application
                     ((#%host-expression (~literal foldl))
                      (#%host-expression op)
@@ -89,7 +109,9 @@
                    stx)
              #:do [(define chirality (syntax-property #'stx 'chirality))]
              #:when (and chirality (eq? chirality 'right))
-             #:attr end #'(foldl-cstream op init)))
+             #:attr end #'(foldl-cstream-next op init))
+    (pattern (~literal cstream->list)
+             #:attr end #'(cstream-next->list)))
 
   (define-syntax-class non-fusable
     (pattern (~not (~or _:fusable-stream-transformer
@@ -102,50 +124,16 @@
   ;; be a fusable-stream-transformer0 as well!
   (define (generate-fused-operation ops)
     (syntax-parse (reverse ops)
-      [(g:fusable-stream-consumer
-        op:fusable-stream-transformer ...
+      [(c:fusable-stream-consumer
+        t:fusable-stream-transformer ...
         p:fusable-stream-producer)
        ;; Contract probably not needed (prepare should produce
        ;; meaningful error messages)
        #`(esc (λ args
-                ((#,@#'g.end
-                  (inline-compose1 [op.next op.f] ...
+                ((#,@#'c.end
+                  (inline-compose1 [t.next t.f] ...
                                    p.next))
-                 (apply p.prepare args))))]
-      [(g:fusable-stream-consumer
-        p:fusable-stream-producer)
-       ;; dtto
-       #`(esc (λ args
-                ((#,@#'g.end p.next)
-                 (apply p.prepare args))))]
-      ;; The list must contain fusable-stream-transformer0 as the last element!
-      [(g:fusable-stream-consumer
-        op:fusable-stream-transformer ...)
-       ;; TODO: Add contract
-       #`(esc (λ (lst)
-                ((#,@#'g.end
-                  (inline-compose1 [op.next op.f] ...
-                                   list->cstream-next))
-                 lst)))]
-      [(op:fusable-stream-transformer ...
-                                      p:fusable-stream-producer)
-       ;; dtto
-       #`(esc (λ args
-                ((cstream->list
-                  (inline-compose1 [op.next op.f] ...
-                                   p.next))
-                 (apply p.prepare args))))]
-      ;; dtto
-      [(op:fusable-stream-transformer ...)
-       #'(esc (λ (lst)
-                ;; have a contract here for the input
-                ;; validate it's a list, and error message
-                ;; can include the op syntax object
-                ((cstream->list
-                  (inline-compose1 [op.next op.f] ...
-                                   list->cstream-next))
-                 lst)))]
-      ))
+                 (apply p.prepare args))))]))
 
   ;; 0. "Qi-normal form"
   ;; 1. deforestation pass
@@ -158,67 +146,41 @@
     (syntax-parse stx
       [((~datum thread) _0:non-fusable ...
                         p:fusable-stream-producer
-                        f:fusable-stream-transformer ...+
-                        g:fusable-stream-consumer
-                        _1 ...)
-       #:with fused (generate-fused-operation (syntax->list #'(p f ... g)))
-       #'(thread _0 ... fused _1 ...)]
-      [((~datum thread) _0:non-fusable ...
-                        p:fusable-stream-producer
-                        g:fusable-stream-consumer
+                        ;; There can be zero transformers here:
+                        t:fusable-stream-transformer ...
+                        c:fusable-stream-consumer
                         _1 ...)
-       #:with fused (generate-fused-operation (syntax->list #'(p g)))
+       #:with fused (generate-fused-operation
+                     (syntax->list #'(p t ... c)))
        #'(thread _0 ... fused _1 ...)]
       [((~datum thread) _0:non-fusable ...
-                        f1:fusable-stream-transformer0
-                        f:fusable-stream-transformer ...+
-                        g:fusable-stream-consumer
+                        t1:fusable-stream-transformer0
+                        t:fusable-stream-transformer ...
+                        c:fusable-stream-consumer
                         _1 ...)
-       #:with fused (generate-fused-operation (syntax->list #'(f1 f ... g)))
+       #:with fused (generate-fused-operation
+                     (syntax->list #'(list->cstream t1 t ... c)))
        #'(thread _0 ... fused _1 ...)]
       [((~datum thread) _0:non-fusable ...
                         p:fusable-stream-producer
-                        f:fusable-stream-transformer ...+
+                        ;; Must be 1 or more transformers here:
+                        t:fusable-stream-transformer ...+
                         _1 ...)
-       #:with fused (generate-fused-operation (syntax->list #'(p f ...)))
+       #:with fused (generate-fused-operation
+                     (syntax->list #'(p t ... cstream->list)))
        #'(thread _0 ... fused _1 ...)]
       [((~datum thread) _0:non-fusable ...
                         f1:fusable-stream-transformer0
                         f:fusable-stream-transformer ...+
                         _1 ...)
-       #:with fused (generate-fused-operation (syntax->list #'(f1 f ...)))
+       #:with fused (generate-fused-operation
+                     (syntax->list #'(list->cstream f1 f ... cstream->list)))
        #'(thread _0 ... fused _1 ...)]
       [_ this-syntax]))
 
   )
 
-;; Stream fusion
-(define-inline (cstream->list next)
-  (λ (state)
-    (let loop ([state state])
-      ((next (λ () null)
-             (λ (state) (loop state))
-             (λ (value state)
-               (cons value (loop state))))
-       state))))
-
-(define-inline (foldr-cstream op init next)
-  (λ (state)
-    (let loop ([state state])
-      ((next (λ () init)
-             (λ (state) (loop state))
-             (λ (value state)
-               (op value (loop state))))
-       state))))
-
-(define-inline (foldl-cstream op init next)
-  (λ (state)
-    (let loop ([acc init] [state state])
-      ((next (λ () acc)
-             (λ (state) (loop acc state))
-             (λ (value state)
-               (loop (op value acc) state)))
-       state))))
+;; Producers
 
 (define-inline (list->cstream-next done skip yield)
   (λ (state)
@@ -238,6 +200,8 @@
     [(l h) (list l h 1)]
     [(l h s) (list l h s)]))
 
+;; Transformers
+
 (define-inline (map-cstream-next f next)
   (λ (done skip yield)
     (next done
@@ -253,3 +217,32 @@
             (if (f value)
                 (yield value state)
                 (skip state))))))
+
+;; Consumers
+
+(define-inline (cstream-next->list next)
+  (λ (state)
+    (let loop ([state state])
+      ((next (λ () null)
+             (λ (state) (loop state))
+             (λ (value state)
+               (cons value (loop state))))
+       state))))
+
+(define-inline (foldr-cstream-next op init next)
+  (λ (state)
+    (let loop ([state state])
+      ((next (λ () init)
+             (λ (state) (loop state))
+             (λ (value state)
+               (op value (loop state))))
+       state))))
+
+(define-inline (foldl-cstream-next op init next)
+  (λ (state)
+    (let loop ([acc init] [state state])
+      ((next (λ () acc)
+             (λ (state) (loop acc state))
+             (λ (value state)
+               (loop (op value acc) state)))
+       state))))

From 6531cb56f53a38ad7415717739791d93b6d8dcf1 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?=
 <dominik.pantucek@trustica.cz>
Date: Sat, 11 Nov 2023 20:23:03 +0100
Subject: [PATCH 3/4] Cleanup unused pattern variable, implement car
 deforestation.

---
 qi-lib/flow/core/deforest.rkt | 15 ++++++++++++---
 1 file changed, 12 insertions(+), 3 deletions(-)

diff --git a/qi-lib/flow/core/deforest.rkt b/qi-lib/flow/core/deforest.rkt
index a03ae77a..28bb785c 100644
--- a/qi-lib/flow/core/deforest.rkt
+++ b/qi-lib/flow/core/deforest.rkt
@@ -33,8 +33,7 @@
   (define-syntax-class fusable-stream-producer
     #:attributes (next prepare)
     #:datum-literals (#%host-expression #%partial-application esc)
-    (pattern (~and (esc (#%host-expression (~literal range)))
-                   stx)
+    (pattern (esc (#%host-expression (~literal range)))
              #:attr next #'range->cstream-next
              #:attr prepare #'range->cstream-prepare)
     (pattern (~and (#%partial-application
@@ -111,7 +110,9 @@
              #:when (and chirality (eq? chirality 'right))
              #:attr end #'(foldl-cstream-next op init))
     (pattern (~literal cstream->list)
-             #:attr end #'(cstream-next->list)))
+             #:attr end #'(cstream-next->list))
+    (pattern (esc (#%host-expression (~literal car)))
+             #:attr end #'(car-cstream-next)))
 
   (define-syntax-class non-fusable
     (pattern (~not (~or _:fusable-stream-transformer
@@ -246,3 +247,11 @@
              (λ (value state)
                (loop (op value acc) state)))
        state))))
+
+(define-inline (car-cstream-next next)
+  (λ (state)
+    (let loop ([state state])
+      ((next (λ () (error 'car "Empty list!"))
+             (λ (state) (loop state))
+             (λ (value state)
+               value))))))

From 9f0f940ce6daf3e1bf9cb65947a2786f7ebf0ab8 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?=
 <dominik.pantucek@trustica.cz>
Date: Fri, 17 Nov 2023 20:56:30 +0100
Subject: [PATCH 4/4] Re-add begin-encourage-inline based on the benchmarks.

---
 qi-lib/flow/core/deforest.rkt | 130 ++++++++++++++++++----------------
 1 file changed, 67 insertions(+), 63 deletions(-)

diff --git a/qi-lib/flow/core/deforest.rkt b/qi-lib/flow/core/deforest.rkt
index 28bb785c..92a880b0 100644
--- a/qi-lib/flow/core/deforest.rkt
+++ b/qi-lib/flow/core/deforest.rkt
@@ -181,77 +181,81 @@
 
   )
 
-;; Producers
+(begin-encourage-inline
 
-(define-inline (list->cstream-next done skip yield)
-  (λ (state)
-    (cond [(null? state) (done)]
-          [else (yield (car state) (cdr state))])))
+  ;; Producers
 
-(define-inline (range->cstream-next done skip yield)
-  (λ (state)
-    (match-define (list l h s) state)
-    (cond [(< l h)
-           (yield l (cons (+ l s) (cdr state)))]
-          [else (done)])))
+  (define-inline (list->cstream-next done skip yield)
+    (λ (state)
+      (cond [(null? state) (done)]
+            [else (yield (car state) (cdr state))])))
 
-(define range->cstream-prepare
-  (case-lambda
-    [(h) (list 0 h 1)]
-    [(l h) (list l h 1)]
-    [(l h s) (list l h s)]))
+  (define-inline (range->cstream-next done skip yield)
+    (λ (state)
+      (match-define (list l h s) state)
+      (cond [(< l h)
+             (yield l (cons (+ l s) (cdr state)))]
+            [else (done)])))
 
-;; Transformers
+  (define range->cstream-prepare
+    (case-lambda
+      [(h) (list 0 h 1)]
+      [(l h) (list l h 1)]
+      [(l h s) (list l h s)]))
 
-(define-inline (map-cstream-next f next)
-  (λ (done skip yield)
-    (next done
-          skip
-          (λ (value state)
-            (yield (f value) state)))))
+  ;; Transformers
 
-(define-inline (filter-cstream-next f next)
-  (λ (done skip yield)
-    (next done
-          skip
-          (λ (value state)
-            (if (f value)
-                (yield value state)
-                (skip state))))))
+  (define-inline (map-cstream-next f next)
+    (λ (done skip yield)
+      (next done
+            skip
+            (λ (value state)
+              (yield (f value) state)))))
 
-;; Consumers
+  (define-inline (filter-cstream-next f next)
+    (λ (done skip yield)
+      (next done
+            skip
+            (λ (value state)
+              (if (f value)
+                  (yield value state)
+                  (skip state))))))
 
-(define-inline (cstream-next->list next)
-  (λ (state)
-    (let loop ([state state])
-      ((next (λ () null)
-             (λ (state) (loop state))
-             (λ (value state)
-               (cons value (loop state))))
-       state))))
+  ;; Consumers
 
-(define-inline (foldr-cstream-next op init next)
-  (λ (state)
-    (let loop ([state state])
-      ((next (λ () init)
-             (λ (state) (loop state))
-             (λ (value state)
-               (op value (loop state))))
-       state))))
+  (define-inline (cstream-next->list next)
+    (λ (state)
+      (let loop ([state state])
+        ((next (λ () null)
+               (λ (state) (loop state))
+               (λ (value state)
+                 (cons value (loop state))))
+         state))))
 
-(define-inline (foldl-cstream-next op init next)
-  (λ (state)
-    (let loop ([acc init] [state state])
-      ((next (λ () acc)
-             (λ (state) (loop acc state))
-             (λ (value state)
-               (loop (op value acc) state)))
-       state))))
+  (define-inline (foldr-cstream-next op init next)
+    (λ (state)
+      (let loop ([state state])
+        ((next (λ () init)
+               (λ (state) (loop state))
+               (λ (value state)
+                 (op value (loop state))))
+         state))))
 
-(define-inline (car-cstream-next next)
-  (λ (state)
-    (let loop ([state state])
-      ((next (λ () (error 'car "Empty list!"))
-             (λ (state) (loop state))
-             (λ (value state)
-               value))))))
+  (define-inline (foldl-cstream-next op init next)
+    (λ (state)
+      (let loop ([acc init] [state state])
+        ((next (λ () acc)
+               (λ (state) (loop acc state))
+               (λ (value state)
+                 (loop (op value acc) state)))
+         state))))
+
+  (define-inline (car-cstream-next next)
+    (λ (state)
+      (let loop ([state state])
+        ((next (λ () (error 'car "Empty list!"))
+               (λ (state) (loop state))
+               (λ (value state)
+                 value))))))
+
+  )