Implement foldl as a stream

Fix the syntax class to retain a reference to the input syntax in both
foldl as well as foldr. Add a WIP tests for `foldl`.

(WIP from today's meeting)

qi-lib/flow/core/compiler.rkt

@@ -54,13 +54,22 @@
   (define-syntax-class fusable-fold-operation
     #:attributes (op init end)
     #:datum-literals (#%host-expression #%partial-application)
-    (pattern (#%partial-application
-              ((#%host-expression (~literal foldr))
-               (#%host-expression op)
-               (#%host-expression init)))
+    (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 #'(foldr-cstream op init)))
+      #:attr end #'(foldl-cstream op init)))
 
   (define-syntax-class non-fusable
     (pattern (~not _:fusable-list-operation)))

qi-lib/flow/core/impl.rkt

@@ -24,7 +24,8 @@
          list->cstream-next
          map-cstream-next
          filter-cstream-next
-         foldr-cstream)
+         foldr-cstream
+         foldl-cstream)
 
 (require racket/match
          (only-in racket/function
@@ -264,6 +265,15 @@
                  (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)]

qi-test/tests/compiler.rkt

@@ -57,6 +57,29 @@
                           list->cstream-next))
                         lst)))
                     values)
+                  "deforestation in arbitrary positions")
+    (check-equal? (syntax->datum
+                   (deforest-rewrite
+                     #'(thread (#%partial-application
+                                ((#%host-expression map)
+                                 (#%host-expression string-upcase)))
+                               (#%partial-application
+                                ((#%host-expression foldl)
+                                 (#%host-expression string-append)
+                                 (#%host-expression "I"))))))
+                  '(thread
+                    values
+                    (esc
+                     (λ (lst)
+                       ((cstream->list
+                         (inline-compose1
+                          (map-cstream-next
+                           sqr)
+                          (filter-cstream-next
+                           odd?)
+                          list->cstream-next))
+                        lst)))
+                    values)
                   "deforestation in arbitrary positions"))
    (test-suite
     "fixed point"

qi-test/tests/flow.rkt

@@ -1540,7 +1540,13 @@
                    35)
      (check-equal? ((☯ (~>> (filter odd?) (map sqr) (foldl + 0)))
                     (list 1 2 3 4 5))
-                   35)))))
+                   35)
+     (check-equal? ((☯ (~>> (map string-upcase) (foldr string-append "I")))
+                    (list "a" "b" "c"))
+                   "ABCI")
+     (check-equal? ((☯ (~>> (map string-upcase) (foldl string-append "I")))
+                    (list "a" "b" "c"))
+                   "CBAI")))))
 
 (module+ main
   (void (run-tests tests)))