From c67629bc976f4fbdf8f50346763914947c4a5117 Mon Sep 17 00:00:00 2001
From: Siddhartha <sid@countvajhula.com>
Date: Tue, 5 Mar 2024 12:38:41 -0700
Subject: [PATCH 1/2] Minor improvements discussed last time

Keep the rule parsers distinct from the compiler pass which applies
these parsers using strategies including tree traversal and fixed
point finding.
---
 qi-lib/flow/core/deforest.rkt  |  84 +++++++++----------
 qi-lib/flow/core/normalize.rkt | 143 +++++++++++++++++----------------
 qi-lib/flow/core/passes.rkt    |   6 +-
 3 files changed, 118 insertions(+), 115 deletions(-)

diff --git a/qi-lib/flow/core/deforest.rkt b/qi-lib/flow/core/deforest.rkt
index 2f6bf8ee..1f2c25a2 100644
--- a/qi-lib/flow/core/deforest.rkt
+++ b/qi-lib/flow/core/deforest.rkt
@@ -284,50 +284,52 @@
                      '#,(build-source-location-vector
                          (syntax-srcloc ctx)))))]))
 
+  (define (deforest-rewrite stx)
+    (syntax-parse stx
+      [((~datum thread) _0:non-fusable ...
+                        p:fusable-stream-producer
+                        ;; There can be zero transformers here:
+                        t:fusable-stream-transformer ...
+                        c:fusable-stream-consumer
+                        _1 ...)
+       #:with fused (generate-fused-operation
+                     (syntax->list #'(p t ... c))
+                     stx)
+       #'(thread _0 ... fused _1 ...)]
+      [((~datum thread) _0:non-fusable ...
+                        t1:fusable-stream-transformer0
+                        t:fusable-stream-transformer ...
+                        c:fusable-stream-consumer
+                        _1 ...)
+       #:with fused (generate-fused-operation
+                     (syntax->list #'(list->cstream t1 t ... c))
+                     stx)
+       #'(thread _0 ... fused _1 ...)]
+      [((~datum thread) _0:non-fusable ...
+                        p:fusable-stream-producer
+                        ;; Must be 1 or more transformers here:
+                        t:fusable-stream-transformer ...+
+                        _1 ...)
+       #:with fused (generate-fused-operation
+                     (syntax->list #'(p t ... cstream->list))
+                     stx)
+       #'(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 #'(list->cstream f1 f ... cstream->list))
+                     stx)
+       #'(thread _0 ... fused _1 ...)]
+      ;; return the input syntax unchanged if no rules
+      ;; are applicable
+      [_ stx]))
+
   ;; Performs deforestation rewrite on the whole syntax tree.
   (define-and-register-pass 100 (deforest-pass stx)
     (find-and-map/qi
-     (lambda (stx)
-       (syntax-parse stx
-         [((~datum thread) _0:non-fusable ...
-                           p:fusable-stream-producer
-                           ;; There can be zero transformers here:
-                           t:fusable-stream-transformer ...
-                           c:fusable-stream-consumer
-                           _1 ...)
-          #:with fused (generate-fused-operation
-                        (syntax->list #'(p t ... c))
-                        stx)
-          #'(thread _0 ... fused _1 ...)]
-         [((~datum thread) _0:non-fusable ...
-                           t1:fusable-stream-transformer0
-                           t:fusable-stream-transformer ...
-                           c:fusable-stream-consumer
-                           _1 ...)
-          #:with fused (generate-fused-operation
-                        (syntax->list #'(list->cstream t1 t ... c))
-                        stx)
-          #'(thread _0 ... fused _1 ...)]
-         [((~datum thread) _0:non-fusable ...
-                           p:fusable-stream-producer
-                           ;; Must be 1 or more transformers here:
-                           t:fusable-stream-transformer ...+
-                           _1 ...)
-          #:with fused (generate-fused-operation
-                        (syntax->list #'(p t ... cstream->list))
-                        stx)
-          #'(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 #'(list->cstream f1 f ... cstream->list))
-                        stx)
-          #'(thread _0 ... fused _1 ...)]
-         ;; return the input syntax unchanged if no rules
-         ;; are applicable
-         [_ stx]))
+     deforest-rewrite
      stx)))
 
 (begin-encourage-inline
diff --git a/qi-lib/flow/core/normalize.rkt b/qi-lib/flow/core/normalize.rkt
index 13325d51..59c31218 100644
--- a/qi-lib/flow/core/normalize.rkt
+++ b/qi-lib/flow/core/normalize.rkt
@@ -10,78 +10,79 @@
 
 ;; 0. "Qi-normal form"
 (begin-for-syntax
+  (define (normalize-rewrite stx)
+    (syntax-parse stx
+      #:datum-literals (#%host-expression
+                        #%blanket-template
+                        #%fine-template
+                        esc
+                        gen
+                        thread
+                        pass
+                        if
+                        amp
+                        relay
+                        tee
+                        sep
+                        collect
+                        __)
+
+      ;; "deforestation" for values
+      ;; (~> (pass f) (>< g)) → (>< (if f g ⏚))
+      [(thread _0 ... (pass f) (amp g) _1 ...)
+       #'(thread _0 ... (amp (if f g ground)) _1 ...)]
+      ;; merge pass filters in sequence
+      [(thread _0 ... (pass f) (pass g) _1 ...)
+       #'(thread _0 ... (pass (and f g)) _1 ...)]
+      ;; collapse deterministic conditionals
+      [(if (gen (#%host-expression (~datum #t)))
+           f
+           g)
+       #'f]
+      [(if (gen (#%host-expression (~datum #f)))
+           f
+           g)
+       #'g]
+      ;; trivial threading form
+      [(thread f)
+       #'f]
+      ;; associative laws for ~>
+      [(thread _0 ... (thread f ...) _1 ...) ; note: greedy matching
+       #'(thread _0 ... f ... _1 ...)]
+      ;; left and right identity for ~>
+      [(thread _0 ... (~datum _) _1 ...)
+       #'(thread _0 ... _1 ...)]
+      ;; composition of identity flows is the identity flow
+      [(thread (~datum _) ...)
+       #'_]
+      ;; amp and identity
+      [(amp (~datum _))
+       #'_]
+      ;; trivial tee junction
+      [(tee f)
+       #'f]
+      ;; merge adjacent gens in a tee junction
+      [(tee _0 ... (gen a ...) (gen b ...) _1 ...)
+       #'(tee _0 ... (gen a ... b ...) _1 ...)]
+      ;; dead gen elimination
+      [(thread _0 ... (gen a ...) (gen b ...) _1 ...)
+       #'(thread _0 ... (gen b ...) _1 ...)]
+      ;; prism identities
+      ;; Note: (~> ... △ ▽ ...) can't be rewritten to `values` since that's
+      ;; only valid if the input is in fact a list, and is an error otherwise,
+      ;; and we can only know this at runtime.
+      [(thread _0 ... collect sep _1 ...)
+       #'(thread _0 ... _1 ...)]
+      ;; collapse `values` inside a threading form
+      [(thread _0 ... (esc (#%host-expression (~literal values))) _1 ...)
+       #'(thread _0 ... _1 ...)]
+      [(#%blanket-template (hex __))
+       #'(esc hex)]
+      ;; return syntax unchanged if there are no applicable normalizations
+      [_ stx]))
+
   (define-and-register-pass 10 (normalize-pass stx)
     (attach-form-property
      (find-and-map/qi
-      (fix
-       (lambda (stx)
-         (syntax-parse stx
-           #:datum-literals (#%host-expression
-                             #%blanket-template
-                             #%fine-template
-                             esc
-                             gen
-                             thread
-                             pass
-                             if
-                             amp
-                             relay
-                             tee
-                             sep
-                             collect
-                             __)
-
-           ;; "deforestation" for values
-           ;; (~> (pass f) (>< g)) → (>< (if f g ⏚))
-           [(thread _0 ... (pass f) (amp g) _1 ...)
-            #'(thread _0 ... (amp (if f g ground)) _1 ...)]
-           ;; merge pass filters in sequence
-           [(thread _0 ... (pass f) (pass g) _1 ...)
-            #'(thread _0 ... (pass (and f g)) _1 ...)]
-           ;; collapse deterministic conditionals
-           [(if (gen (#%host-expression (~datum #t)))
-                f
-                g)
-            #'f]
-           [(if (gen (#%host-expression (~datum #f)))
-                f
-                g)
-            #'g]
-           ;; trivial threading form
-           [(thread f)
-            #'f]
-           ;; associative laws for ~>
-           [(thread _0 ... (thread f ...) _1 ...) ; note: greedy matching
-            #'(thread _0 ... f ... _1 ...)]
-           ;; left and right identity for ~>
-           [(thread _0 ... (~datum _) _1 ...)
-            #'(thread _0 ... _1 ...)]
-           ;; composition of identity flows is the identity flow
-           [(thread (~datum _) ...)
-            #'_]
-           ;; amp and identity
-           [(amp (~datum _))
-            #'_]
-           ;; trivial tee junction
-           [(tee f)
-            #'f]
-           ;; merge adjacent gens in a tee junction
-           [(tee _0 ... (gen a ...) (gen b ...) _1 ...)
-            #'(tee _0 ... (gen a ... b ...) _1 ...)]
-           ;; dead gen elimination
-           [(thread _0 ... (gen a ...) (gen b ...) _1 ...)
-            #'(thread _0 ... (gen b ...) _1 ...)]
-           ;; prism identities
-           ;; Note: (~> ... △ ▽ ...) can't be rewritten to `values` since that's
-           ;; only valid if the input is in fact a list, and is an error otherwise,
-           ;; and we can only know this at runtime.
-           [(thread _0 ... collect sep _1 ...)
-            #'(thread _0 ... _1 ...)]
-           ;; collapse `values` inside a threading form
-           [(thread _0 ... (esc (#%host-expression (~literal values))) _1 ...)
-            #'(thread _0 ... _1 ...)]
-           [(#%blanket-template (hex __))
-            #'(esc hex)]
-           ;; return syntax unchanged if there are no applicable normalizations
-           [_ stx])))
+      (fix normalize-rewrite)
       stx))))
diff --git a/qi-lib/flow/core/passes.rkt b/qi-lib/flow/core/passes.rkt
index 6d01b336..acc2be42 100644
--- a/qi-lib/flow/core/passes.rkt
+++ b/qi-lib/flow/core/passes.rkt
@@ -33,15 +33,15 @@
   ;; passes. Should be used by modules implementing passes.
   (define-syntax-rule (define-and-register-pass prio (name stx) expr ...)
     (begin
-      (define name (lambda (stx) expr ...))
+      (define (name stx) expr ...)
       (register-pass #'name prio name)
       ))
 
   ;; Runs registered passes on given syntax object - should be used by
   ;; the actual compiler.
   (define (run-passes stx)
-    (for/fold ((stx stx))
-              ((pass (in-list (unbox registered-passes))))
+    (for/fold ([stx stx])
+              ([pass (in-list (unbox registered-passes))])
       (define stx1 ((passdef-parser pass) stx))
       (emit-local-step stx stx1 #:id (passdef-name pass))
       stx1))

From 5e5e8eb96cfff1ee435b2af284e95294e100414f Mon Sep 17 00:00:00 2001
From: Siddhartha <sid@countvajhula.com>
Date: Tue, 5 Mar 2024 12:45:02 -0700
Subject: [PATCH 2/2] =?UTF-8?q?Rename=20pass.rkt=20=E2=86=92=20strategy.rk?=
 =?UTF-8?q?t=20as=20discussed=20last=20time?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 qi-lib/flow/core/compiler.rkt                     | 2 +-
 qi-lib/flow/core/deforest.rkt                     | 2 +-
 qi-lib/flow/core/normalize.rkt                    | 2 +-
 qi-lib/flow/core/{pass.rkt => strategy.rkt}       | 0
 qi-test/tests/compiler.rkt                        | 4 ++--
 qi-test/tests/compiler/{pass.rkt => strategy.rkt} | 2 +-
 6 files changed, 6 insertions(+), 6 deletions(-)
 rename qi-lib/flow/core/{pass.rkt => strategy.rkt} (100%)
 rename qi-test/tests/compiler/{pass.rkt => strategy.rkt} (99%)

diff --git a/qi-lib/flow/core/compiler.rkt b/qi-lib/flow/core/compiler.rkt
index 50ade752..964da3b4 100644
--- a/qi-lib/flow/core/compiler.rkt
+++ b/qi-lib/flow/core/compiler.rkt
@@ -8,7 +8,7 @@
                      (only-in racket/list make-list)
                      "syntax.rkt"
                      "../aux-syntax.rkt"
-                     "pass.rkt"
+                     "strategy.rkt"
                      "debug.rkt"
                      "private/form-property.rkt")
          "impl.rkt"
diff --git a/qi-lib/flow/core/deforest.rkt b/qi-lib/flow/core/deforest.rkt
index 1f2c25a2..f333db53 100644
--- a/qi-lib/flow/core/deforest.rkt
+++ b/qi-lib/flow/core/deforest.rkt
@@ -16,7 +16,7 @@
                      racket/syntax-srcloc
                      syntax/srcloc
                      "../extended/util.rkt"
-                     "pass.rkt")
+                     "strategy.rkt")
          "passes.rkt"
          racket/performance-hint
          racket/match
diff --git a/qi-lib/flow/core/normalize.rkt b/qi-lib/flow/core/normalize.rkt
index 59c31218..387aac0a 100644
--- a/qi-lib/flow/core/normalize.rkt
+++ b/qi-lib/flow/core/normalize.rkt
@@ -4,7 +4,7 @@
 
 (require (for-syntax racket/base
                      syntax/parse
-                     "pass.rkt"
+                     "strategy.rkt"
                      "private/form-property.rkt")
          "passes.rkt")
 
diff --git a/qi-lib/flow/core/pass.rkt b/qi-lib/flow/core/strategy.rkt
similarity index 100%
rename from qi-lib/flow/core/pass.rkt
rename to qi-lib/flow/core/strategy.rkt
diff --git a/qi-test/tests/compiler.rkt b/qi-test/tests/compiler.rkt
index 8e6f191c..a132f4f9 100644
--- a/qi-test/tests/compiler.rkt
+++ b/qi-test/tests/compiler.rkt
@@ -6,7 +6,7 @@
          rackunit/text-ui
          (prefix-in semantics: "compiler/semantics.rkt")
          (prefix-in rules: "compiler/rules.rkt")
-         (prefix-in pass: "compiler/pass.rkt")
+         (prefix-in strategy: "compiler/strategy.rkt")
          (prefix-in impl: "compiler/impl.rkt"))
 
 (define tests
@@ -15,7 +15,7 @@
 
    semantics:tests
    rules:tests
-   pass:tests
+   strategy:tests
    impl:tests))
 
 (module+ main
diff --git a/qi-test/tests/compiler/pass.rkt b/qi-test/tests/compiler/strategy.rkt
similarity index 99%
rename from qi-test/tests/compiler/pass.rkt
rename to qi-test/tests/compiler/strategy.rkt
index 082da686..dc823115 100644
--- a/qi-test/tests/compiler/pass.rkt
+++ b/qi-test/tests/compiler/strategy.rkt
@@ -2,7 +2,7 @@
 
 (provide tests)
 
-(require qi/flow/core/pass
+(require qi/flow/core/strategy
          rackunit
          rackunit/text-ui
          syntax/parse