diff --git a/qi-doc/scribblings/list-operations.scrbl b/qi-doc/scribblings/list-operations.scrbl
new file mode 100644
index 00000000..2b70c118
--- /dev/null
+++ b/qi-doc/scribblings/list-operations.scrbl
@@ -0,0 +1,118 @@
+#lang scribble/doc
+@require[scribble/manual
+	 (for-label racket/list
+	 	    racket/base)]
+
+@title{List Operations}
+
+@defmodule[qi/list]
+
+This module defines bindings that can leverage stream fusion /
+deforestation optimization when found in succession within a
+flow. When not part of optimized flow, their behavior is identical to
+the bindings of the same name from @racketmodname[racket/base] and
+@racketmodname[racket/list].
+
+The bindings are categorized based on their intended usage inside the
+deforested pipeline.
+
+@section{Producers}
+
+@defproc*[(((range (end real?)) list?)
+           ((range (start real?) (end real?) (step real? 1)) list?))]{
+
+Deforestable version of @racket[range] from @racketmodname[racket/list].
+
+}
+
+@section{Transformers}
+
+@defproc[(filter (pred procedure?) (lst list?)) list?]{
+
+Deforestable version of @racket[filter] from @racketmodname[racket/base].
+
+}
+
+@defproc[(map (proc procedure?) (lst list?) ...+) list?]{
+
+Deforestable version of @racket[map] from @racketmodname[racket/base].
+
+}
+
+@defproc[(filter-map (proc procedure?) (lst list?) ...+) list?]{
+
+Deforestable version of @racket[filter-map] from @racketmodname[racket/list].
+
+}
+
+@defproc*[(((take (lst list?) (pos exact-nonnegative-integer?)) list?)
+           ((take (lst any/c) (pos exact-nonnegative-integer?)) list?))]{
+
+Deforestable version of @racket[take] from @racketmodname[racket/list].
+
+}
+
+@section{Consumers}
+
+@defproc[(foldl (proc procedure?) (init any/c) (lst list?) ...+) any/c]{
+
+Deforestable version of @racket[foldl] from @racketmodname[racket/base].
+
+}
+
+@defproc[(foldr (proc procedure?) (init any/c) (lst list?) ...+) any/c]{
+
+Deforestable version of @racket[foldr] from @racketmodname[racket/base].
+
+}
+
+@defproc[(car (p pair?)) any/c]{
+
+Deforestable version of @racket[car] from @racketmodname[racket/base].
+
+}
+
+@defproc[(cadr (v (cons/c any/c pair?))) any/c]{
+
+Deforestable version of @racket[cadr] from @racketmodname[racket/base].
+
+}
+
+@defproc[(caddr (v (cons/c any/c (cons/c any/c pair?)))) any/c]{
+
+Deforestable version of @racket[caddr] from @racketmodname[racket/base].
+
+}
+
+@defproc[(cadddr (v (cons/c any/c (cons/c any/c (cons/c any/c pair?))))) any/c]{
+
+Deforestable version of @racket[cadddr] from @racketmodname[racket/base].
+
+}
+
+@defproc*[(((list-ref (lst list?) (pos exact-nonnegative-integer?)) any/c)
+ 	   ((list-ref (lst pair?) (pos exact-nonnegative-integer?)) any/c))]{
+
+Deforestable version of @racket[list-ref] from @racketmodname[racket/base].
+
+}
+
+@defproc[(length (lst list?)) exact-nonnegative-integer?]{
+
+Deforestable version of @racket[length] from @racketmodname[racket/base].
+
+}
+
+@defproc[(empty? (v any/c)) boolean?]{
+
+Deforestable version of @racket[empty?] from @racketmodname[racket/list].
+
+}
+
+@defproc[(null? (v any/c)) boolean?]{
+
+Deforestable version of @racket[null?] from @racketmodname[racket/base].
+
+}
+
+
diff --git a/qi-doc/scribblings/qi.scrbl b/qi-doc/scribblings/qi.scrbl
index dc7384f3..c76c7f85 100644
--- a/qi-doc/scribblings/qi.scrbl
+++ b/qi-doc/scribblings/qi.scrbl
@@ -40,6 +40,7 @@ This site hosts @emph{user} documentation. If you are interested in contributing
 @include-section["tutorial.scrbl"]
 @include-section["interface.scrbl"]
 @include-section["forms.scrbl"]
+@include-section["list-operations.scrbl"]
 @include-section["macros.scrbl"]
 @include-section["field-guide.scrbl"]
 @include-section["principles.scrbl"]
diff --git a/qi-lib/flow/core/compiler.rkt b/qi-lib/flow/core/compiler.rkt
index 85edd46c..27ab3799 100644
--- a/qi-lib/flow/core/compiler.rkt
+++ b/qi-lib/flow/core/compiler.rkt
@@ -3,497 +3,15 @@
 (provide (for-syntax compile-flow normalize-pass))
 
 (require (for-syntax racket/base
-                     syntax/parse
-                     racket/match
-                     (only-in racket/list make-list)
-                     "syntax.rkt"
-                     "../aux-syntax.rkt"
-                     "strategy.rkt"
-                     "private/form-property.rkt")
-         "impl.rkt"
-         "passes.rkt"
-         "normalize.rkt"
-         (only-in racket/list make-list)
-         racket/function
-         racket/undefined
-         (prefix-in fancy: fancy-app)
-         racket/list)
+                     syntax/parse)
+         "compiler/1000-qi0.rkt"
+         "compiler/2000-bindings.rkt"
+         "compiler/0010-normalize.rkt"
+         "passes.rkt")
 
 (begin-for-syntax
 
   ;; note: this does not return compiled code but instead,
   ;; syntax whose expansion compiles the code
   (define (compile-flow stx)
-    (run-passes stx))
-
-  (define-and-register-pass 1000 (qi0-wrapper stx)
-    (syntax-parse stx
-      (ex #'(qi0->racket ex))))
-
-  )
-
-;; Transformation rules for the `as` binding form:
-;;
-;; 1. escape to wrap outermost ~> with let and re-enter
-;;
-;;   (~> flo ... (... (as name) ...))
-;;   ...
-;;    ↓
-;;   ...
-;;   (esc (let ([name (void)])
-;;          (☯ original-flow)))
-;;
-;; 2. as → set!
-;;
-;;   (as name)
-;;   ...
-;;    ↓
-;;   ...
-;;   (~> (esc (λ (x) (set! name x))) ⏚)
-;;
-;; 3. Overall transformation:
-;;
-;;   (~> flo ... (... (as name) ...))
-;;   ...
-;;    ↓
-;;   ...
-;;   (esc (let ([name (void)])
-;;          (☯ (~> flo ... (... (~> (esc (λ (x) (set! name x))) ⏚) ...)))))
-
-(begin-for-syntax
-
-  ;; (as name) → (~> (esc (λ (x) (set! name x))) ⏚)
-  ;; TODO: use a box instead of set!
-  (define (rewrite-all-bindings stx)
-    (find-and-map/qi (syntax-parser
-                       [((~datum as) x ...)
-                        #:with (x-val ...) (generate-temporaries (attribute x))
-                        #'(thread (esc (λ (x-val ...) (set! x x-val) ...)) ground)]
-                       [_ this-syntax])
-                     stx))
-
-  (define (bound-identifiers stx)
-    (let ([ids null])
-      (find-and-map/qi (syntax-parser
-                         [((~datum as) x ...)
-                          (begin
-                            (set! ids (append (attribute x) ids))
-                            ;; we don't need to traverse further
-                            #f)]
-                         [_ this-syntax])
-                       stx)
-      ids))
-
-  ;; wrap stx with (let ([v undefined] ...) stx) for v ∈ ids
-  (define (wrap-with-scopes stx ids)
-    (with-syntax ([(v ...) ids])
-      #`(let ([v undefined] ...) #,stx)))
-
-  (define-and-register-pass 2000 (bindings stx)
-    ;; TODO: use syntax-parse and match ~> specifically.
-    ;; Since macros are expanded "outside in," presumably
-    ;; it will naturally wrap the outermost ~>
-    (wrap-with-scopes (rewrite-all-bindings stx)
-                      (bound-identifiers stx))))
-
-(define-syntax (qi0->racket stx)
-  ;; this is a macro so it receives the entire expression
-  ;; (qi0->racket ...). We use cadr here to parse the
-  ;; contained expression.
-  (syntax-parse (cadr (syntax->list stx))
-
-    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-    ;;;; Core language forms ;;;;
-    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-    [((~datum gen) ex:expr ...)
-     #'(λ _ (values ex ...))]
-    ;; pass-through (identity flow)
-    [(~datum _) #'values]
-    ;; routing
-    [(~or* (~datum ⏚) (~datum ground)) ; NOTE: technically not core
-     #'(qi0->racket (select))]
-    [((~or* (~datum ~>) (~datum thread)) onex:clause ...)
-     #`(compose . #,(reverse
-                     (syntax->list
-                      #'((qi0->racket onex) ...))))]
-    [e:relay-form (relay-parser #'e)]
-    [e:tee-form (tee-parser #'e)]
-    ;; map and filter
-    [e:amp-form (amp-parser #'e)] ; NOTE: technically not core
-    [e:pass-form (pass-parser #'e)] ; NOTE: technically not core
-    ;; prisms
-    [e:sep-form (sep-parser #'e)]
-    [(~or* (~datum ▽) (~datum collect))
-     #'list]
-    ;; predicates
-    [(~or* (~datum NOT) (~datum !))
-     #'not]
-    [(~datum XOR)
-     #'parity-xor]
-    [((~datum and) onex:clause ...)
-     #'(conjoin (qi0->racket onex) ...)]
-    [((~datum or) onex:clause ...)
-     #'(disjoin (qi0->racket onex) ...)]
-    [((~datum not) onex:clause) ; NOTE: technically not core
-     #'(negate (qi0->racket onex))]
-    [((~datum all) onex:clause)
-     #`(give (curry andmap (qi0->racket onex)))]
-    [((~datum any) onex:clause)
-     #'(give (curry ormap (qi0->racket onex)))]
-
-    ;; selection
-    [e:select-form (select-parser #'e)]
-    [e:block-form (block-parser #'e)]
-    [e:group-form (group-parser #'e)]
-    ;; conditionals
-    [e:if-form (if-parser #'e)]
-    [e:sieve-form (sieve-parser #'e)]
-    [e:partition-form (partition-parser #'e)]
-    ;; exceptions
-    [e:try-form (try-parser #'e)]
-    ;; folds
-    [e:fold-left-form (fold-left-parser #'e)]
-    [e:fold-right-form (fold-right-parser #'e)]
-    ;; high-level routing
-    [e:fanout-form (fanout-parser #'e)]
-    ;; looping
-    [e:feedback-form (feedback-parser #'e)]
-    [e:loop-form (loop-parser #'e)]
-    [((~datum loop2) pred:clause mapex:clause combex:clause)
-     #'(letrec ([loop2 (qi0->racket (if pred
-                                        (~> (== (-< (esc cdr)
-                                                    (~> (esc car) mapex)) _)
-                                            (group 1 _ combex)
-                                            (esc loop2))
-                                        (select 2)))])
-         loop2)]
-    ;; towards universality
-    [(~datum appleye)
-     #'call]
-    [e:clos-form (clos-parser #'e)]
-    ;; escape hatch for racket expressions or anything
-    ;; to be "passed through"
-    [((~datum esc) ex:expr)
-     #'ex]
-
-    ;;; Miscellaneous
-
-    ;; Partial application with syntactically pre-supplied arguments
-    ;; in a blanket template
-    ;; Note: at this point it's already been parsed/validated
-    ;; by the expander and we don't need to worry about checking
-    ;; the syntax at the compiler level
-    [((~datum #%blanket-template) e)
-     (blanket-template-form-parser this-syntax)]
-
-    ;; Fine-grained template-based application
-    ;; This handles templates that indicate a specific number of template
-    ;; variables (i.e. expected arguments). The semantics of template-based
-    ;; application here is fulfilled by the fancy-app module. In order to use
-    ;; it, we simply use the #%app macro provided by fancy-app instead of the
-    ;; implicit one used for function application in racket/base.
-    ;; "prarg" = "pre-supplied argument"
-    [((~datum #%fine-template) (prarg-pre ... (~datum _) prarg-post ...))
-     #'(fancy:#%app prarg-pre ... _ prarg-post ...)]
-
-    ;; If in the course of optimization we ever end up with a fully
-    ;; simplified host expression, the compiler would a priori reject it as
-    ;; not being a core Qi expression. So we add this extra rule here
-    ;; to simply pass this expression through.
-    ;; TODO: should `#%host-expression` be formally declared as being part
-    ;; of the core language by including it in the syntax-spec grammar
-    ;; in extended/expander.rkt?
-    [((~datum #%host-expression) hex)
-     this-syntax]))
-
-;; The form-specific parsers, which are delegated to from
-;; the qi0->racket macro:
-
-#|
-A note on error handling:
-
-Some forms, in addition to handling legitimate syntax, also have
-catch-all versions that exist purely to provide a helpful message
-indicating a syntax error. We do this since a priori the qi0->racket macro
-would ignore syntax that doesn't match any pattern. Yet, for all of
-these named forms, we know that (or at least, it is prudent to assume
-that) the user intended to employ that particular form of the DSL. So
-instead of allowing it to fall through for interpretation as Racket
-code, which would yield potentially inscrutable errors, the catch-all
-forms allow us to provide appropriate error messages at the level of
-the DSL.
-
-|#
-
-(begin-for-syntax
-
-  (define (sep-parser stx)
-    (syntax-parse stx
-      [_:id
-       #'(qi0->racket (if (esc list?)
-                          (#%fine-template (apply values _))
-                          (#%fine-template (raise-argument-error '△
-                                                                 "list?"
-                                                                 _))))]
-      [(_ onex:clause)
-       #'(λ (v . vs)
-           ((qi0->racket (~> △ (>< (#%fine-template (apply (qi0->racket onex) _ vs))))) v))]))
-
-  (define (select-parser stx)
-    (syntax-parse stx
-      [(_ n:number ...) #'(qi0->racket (-< (esc (arg n)) ...))]))
-
-  (define (block-parser stx)
-    (syntax-parse stx
-      [(_ n:number ...)
-       #'(qi0->racket (~> (esc (except-args n ...))
-                          △))]))
-
-  (define (group-parser stx)
-    (syntax-parse stx
-      [(_ n:expr
-          selection-onex:clause
-          remainder-onex:clause)
-       #'(loom-compose (qi0->racket selection-onex)
-                       (qi0->racket remainder-onex)
-                       n)]
-      [_:id
-       #'(λ (n selection-flo remainder-flo . vs)
-           (apply (qi0->racket (group n
-                                      (esc selection-flo)
-                                      (esc remainder-flo))) vs))]))
-
-  (define (sieve-parser stx)
-    (syntax-parse stx
-      [(_ condition:clause
-          sonex:clause
-          ronex:clause)
-       #'(qi0->racket (-< (~> (pass condition) sonex)
-                          (~> (pass (not condition)) ronex)))]
-      [_:id
-       ;; sieve can be a core form once bindings
-       ;; are introduced into the language
-       #'(λ (condition sonex ronex . args)
-           (apply (qi0->racket (-< (~> (pass (esc condition)) (esc sonex))
-                                   (~> (pass (not (esc condition))) (esc ronex))))
-                  args))]))
-
-  (define (partition-parser stx)
-    (syntax-parse stx
-      [(_:id)
-       #'(qi0->racket ground)]
-      [(_ [cond:clause body:clause])
-       #'(qi0->racket (~> (pass cond) body))]
-      [(_ [cond:clause body:clause]  ...+)
-       #:with c+bs #'(list (cons (qi0->racket cond) (qi0->racket body)) ...)
-       #'(qi0->racket (#%blanket-template (partition-values c+bs __)))]))
-
-  (define (try-parser stx)
-    (syntax-parse stx
-      [(_ flo
-          [error-condition-flo error-handler-flo]
-          ...+)
-       #'(λ args
-           (with-handlers ([(qi0->racket error-condition-flo)
-                            (λ (e)
-                              ;; TODO: may be good to support reference to the
-                              ;; error via a binding / syntax parameter
-                              (apply (qi0->racket error-handler-flo) args))]
-                           ...)
-             (apply (qi0->racket flo) args)))]))
-
-  (define (if-parser stx)
-    (syntax-parse stx
-      [(_ consequent:clause
-          alternative:clause)
-       #'(λ (f . args)
-           (if (apply f args)
-               (apply (qi0->racket consequent) args)
-               (apply (qi0->racket alternative) args)))]
-      [(_ condition:clause
-          consequent:clause
-          alternative:clause)
-       #'(λ args
-           (if (apply (qi0->racket condition) args)
-               (apply (qi0->racket consequent) args)
-               (apply (qi0->racket alternative) args)))]))
-
-  (define (fanout-parser stx)
-    (syntax-parse stx
-      [_:id #'repeat-values]
-      [(_ n:number)
-       ;; a slightly more efficient compile-time implementation
-       ;; for literally indicated N
-       ;; TODO: implement this as an optimization instead
-       #`(λ args
-           (apply values
-                  (append #,@(make-list (syntax->datum #'n) #'args))) )]
-      [(_ n:expr)
-       #'(lambda args
-           (apply values
-                  (apply append
-                         (make-list n args))))]))
-
-  (define (feedback-parser stx)
-    (syntax-parse stx
-      [(_ ((~datum while) tilex:clause)
-          ((~datum then) thenex:clause)
-          onex:clause)
-       #'(feedback-while (qi0->racket onex)
-                         (qi0->racket tilex)
-                         (qi0->racket thenex))]
-      [(_ ((~datum while) tilex:clause)
-          ((~datum then) thenex:clause))
-       #'(λ (f . args)
-           (apply (qi0->racket (feedback (while tilex) (then thenex) (esc f)))
-                  args))]
-      [(_ ((~datum while) tilex:clause) onex:clause)
-       #'(qi0->racket (feedback (while tilex) (then _) onex))]
-      [(_ ((~datum while) tilex:clause))
-       #'(qi0->racket (feedback (while tilex) (then _)))]
-      [(_ n:expr
-          ((~datum then) thenex:clause)
-          onex:clause)
-       #'(lambda args
-           (apply (feedback-times (qi0->racket onex) n (qi0->racket thenex))
-                  args))]
-      [(_ n:expr
-          ((~datum then) thenex:clause))
-       #'(λ (f . args)
-           (apply (qi0->racket (feedback n (then thenex) (esc f))) args))]
-      [(_ n:expr onex:clause)
-       #'(qi0->racket (feedback n (then _) onex))]
-      [(_ onex:clause)
-       #'(λ (n . args)
-           (apply (qi0->racket (feedback n onex)) args))]
-      [_:id
-       #'(λ (n flo . args)
-           (apply (qi0->racket (feedback n (esc flo)))
-                  args))]))
-
-  (define (tee-parser stx)
-    (syntax-parse stx
-      [((~or* (~datum -<) (~datum tee)) onex:clause ...)
-       #'(λ args
-           (apply values
-                  (append (values->list
-                           (apply (qi0->racket onex) args))
-                          ...)))]
-      [(~or* (~datum -<) (~datum tee))
-       #'repeat-values]))
-
-  (define (relay-parser stx)
-    (syntax-parse stx
-      [((~or* (~datum ==) (~datum relay)) onex:clause ...)
-       #'(relay (qi0->racket onex) ...)]
-      [(~or* (~datum ==) (~datum relay))
-       ;; review this – this "map" behavior may not be natural
-       ;; for relay. And map-values should probably end up being
-       ;; used in a compiler optimization
-       #'map-values]))
-
-  (define (amp-parser stx)
-    (syntax-parse stx
-      [_:id
-       #'(qi0->racket ==)]
-      [(_ onex:clause)
-       #'(curry map-values (qi0->racket onex))]))
-
-  (define (pass-parser stx)
-    (syntax-parse stx
-      [_:id
-       #'filter-values]
-      [(_ onex:clause)
-       #'(curry filter-values (qi0->racket onex))]))
-
-  (define (fold-left-parser stx)
-    (syntax-parse stx
-      [_:id
-       #'foldl-values]
-      [(_ fn init)
-       #'(qi0->racket (~> (-< (gen (qi0->racket fn)
-                                   (qi0->racket init))
-                              _)
-                          >>))]
-      [(_ fn)
-       #'(qi0->racket (>> fn (gen ((qi0->racket fn)))))]))
-
-  (define (fold-right-parser stx)
-    (syntax-parse stx
-      [_:id
-       #'foldr-values]
-      [(_ fn init)
-       #'(qi0->racket (~> (-< (gen (qi0->racket fn)
-                                   (qi0->racket init))
-                              _)
-                          <<))]
-      [(_ fn)
-       #'(qi0->racket (<< fn (gen ((qi0->racket fn)))))]))
-
-  (define (loop-parser stx)
-    (syntax-parse stx
-      [(_ pred:clause mapex:clause combex:clause retex:clause)
-       #'(letrec ([loop (qi0->racket (if pred
-                                         (~> (group 1 mapex (esc loop))
-                                             combex)
-                                         retex))])
-           loop)]
-      [(_ pred:clause mapex:clause combex:clause)
-       #'(qi0->racket (loop pred mapex combex ⏚))]
-      [(_ pred:clause mapex:clause)
-       #'(qi0->racket (loop pred mapex _ ⏚))]
-      [(_ mapex:clause)
-       #'(qi0->racket (loop (gen #t) mapex _ ⏚))]
-      [_:id #'(λ (predf mapf combf retf . args)
-                (apply (qi0->racket (loop (esc predf)
-                                          (esc mapf)
-                                          (esc combf)
-                                          (esc retf)))
-                       args))]))
-
-  (define (clos-parser stx)
-    (syntax-parse stx
-      [_:id
-       #:do [(define chirality (syntax-property stx 'chirality))]
-       (if (and chirality (eq? chirality 'right))
-           #'(λ (f . args) (apply curryr f args))
-           #'(λ (f . args) (apply curry f args)))]
-      [(_ onex:clause)
-       #:do [(define chirality (syntax-property stx 'chirality))]
-       (if (and chirality (eq? chirality 'right))
-           #'(λ args
-               (qi0->racket (~> (-< _ (~> (gen args) △))
-                                onex)))
-           #'(λ args
-               (qi0->racket (~> (-< (~> (gen args) △) _)
-                                onex))))]))
-
-  (define (blanket-template-form-parser stx)
-    (syntax-parse stx
-      ;; "prarg" = "pre-supplied argument"
-      ;; Note: use of currying here doesn't play well with bindings
-      ;; because curry / curryr immediately evaluate their arguments
-      ;; and resolve any references to bindings at compile time.
-      ;; That's why we use a lambda which delays evaluation until runtime
-      ;; when the reference is actually resolvable. See "anaphoric references"
-      ;; in the compiler meeting notes,
-      ;; "The Artist Formerly Known as Bindingspec"
-      [((~datum #%blanket-template)
-        (natex prarg-pre ...+ (~datum __) prarg-post ...+))
-       ;; "(curry (curryr ...) ...)"
-       #'(lambda largs
-           (apply
-            (lambda rargs
-              ((kw-helper natex rargs) prarg-post ...))
-            prarg-pre ...
-            largs))]
-      [((~datum #%blanket-template) (natex prarg-pre ...+ (~datum __)))
-       ;; "curry"
-       #'(lambda args
-           (apply natex prarg-pre ... args))]
-      [((~datum #%blanket-template)
-        (natex (~datum __) prarg-post ...+))
-       ;; "curryr"
-       #'(lambda args
-           ((kw-helper natex args) prarg-post ...))])))
+    (run-passes stx)))
diff --git a/qi-lib/flow/core/normalize.rkt b/qi-lib/flow/core/compiler/0010-normalize.rkt
similarity index 95%
rename from qi-lib/flow/core/normalize.rkt
rename to qi-lib/flow/core/compiler/0010-normalize.rkt
index 387aac0a..fce732c0 100644
--- a/qi-lib/flow/core/normalize.rkt
+++ b/qi-lib/flow/core/compiler/0010-normalize.rkt
@@ -4,9 +4,9 @@
 
 (require (for-syntax racket/base
                      syntax/parse
-                     "strategy.rkt"
-                     "private/form-property.rkt")
-         "passes.rkt")
+                     "../strategy.rkt"
+                     "../private/form-property.rkt")
+         "../passes.rkt")
 
 ;; 0. "Qi-normal form"
 (begin-for-syntax
diff --git a/qi-lib/flow/core/compiler/0100-deforest.rkt b/qi-lib/flow/core/compiler/0100-deforest.rkt
new file mode 100644
index 00000000..6ab99823
--- /dev/null
+++ b/qi-lib/flow/core/compiler/0100-deforest.rkt
@@ -0,0 +1,5 @@
+#lang racket/base
+
+(provide (for-syntax deforest-pass))
+
+(require "deforest/cps.rkt")
diff --git a/qi-lib/flow/core/compiler/1000-qi0.rkt b/qi-lib/flow/core/compiler/1000-qi0.rkt
new file mode 100644
index 00000000..656b7358
--- /dev/null
+++ b/qi-lib/flow/core/compiler/1000-qi0.rkt
@@ -0,0 +1,423 @@
+#lang racket/base
+
+(require "../passes.rkt"
+         (prefix-in fancy: fancy-app)
+         "../impl.rkt"
+         racket/function
+         (only-in racket/list make-list)
+         (for-syntax racket/base
+                     syntax/parse
+                     "../syntax.rkt"
+                     "../../aux-syntax.rkt"
+                     (only-in racket/list make-list)
+                     ))
+
+(begin-for-syntax
+  
+  (define-and-register-pass 1000 (qi0-wrapper stx)
+    (syntax-parse stx
+      (ex #'(qi0->racket ex))))
+
+  )
+
+(define-syntax (qi0->racket stx)
+  ;; this is a macro so it receives the entire expression
+  ;; (qi0->racket ...). We use cadr here to parse the
+  ;; contained expression.
+  (syntax-parse (cadr (syntax->list stx))
+
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    ;;;; Core language forms ;;;;
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+    [((~datum gen) ex:expr ...)
+     #'(λ _ (values ex ...))]
+    ;; pass-through (identity flow)
+    [(~datum _) #'values]
+    ;; routing
+    [(~or* (~datum ⏚) (~datum ground)) ; NOTE: technically not core
+     #'(qi0->racket (select))]
+    [((~or* (~datum ~>) (~datum thread)) onex:clause ...)
+     #`(compose . #,(reverse
+                     (syntax->list
+                      #'((qi0->racket onex) ...))))]
+    [e:relay-form (relay-parser #'e)]
+    [e:tee-form (tee-parser #'e)]
+    ;; map and filter
+    [e:amp-form (amp-parser #'e)] ; NOTE: technically not core
+    [e:pass-form (pass-parser #'e)] ; NOTE: technically not core
+    ;; prisms
+    [e:sep-form (sep-parser #'e)]
+    [(~or* (~datum ▽) (~datum collect))
+     #'list]
+    ;; predicates
+    [(~or* (~datum NOT) (~datum !))
+     #'not]
+    [(~datum XOR)
+     #'parity-xor]
+    [((~datum and) onex:clause ...)
+     #'(conjoin (qi0->racket onex) ...)]
+    [((~datum or) onex:clause ...)
+     #'(disjoin (qi0->racket onex) ...)]
+    [((~datum not) onex:clause) ; NOTE: technically not core
+     #'(negate (qi0->racket onex))]
+    [((~datum all) onex:clause)
+     #`(give (curry andmap (qi0->racket onex)))]
+    [((~datum any) onex:clause)
+     #'(give (curry ormap (qi0->racket onex)))]
+
+    ;; selection
+    [e:select-form (select-parser #'e)]
+    [e:block-form (block-parser #'e)]
+    [e:group-form (group-parser #'e)]
+    ;; conditionals
+    [e:if-form (if-parser #'e)]
+    [e:sieve-form (sieve-parser #'e)]
+    [e:partition-form (partition-parser #'e)]
+    ;; exceptions
+    [e:try-form (try-parser #'e)]
+    ;; folds
+    [e:fold-left-form (fold-left-parser #'e)]
+    [e:fold-right-form (fold-right-parser #'e)]
+    ;; high-level routing
+    [e:fanout-form (fanout-parser #'e)]
+    ;; looping
+    [e:feedback-form (feedback-parser #'e)]
+    [e:loop-form (loop-parser #'e)]
+    [((~datum loop2) pred:clause mapex:clause combex:clause)
+     #'(letrec ([loop2 (qi0->racket (if pred
+                                        (~> (== (-< (esc cdr)
+                                                    (~> (esc car) mapex)) _)
+                                            (group 1 _ combex)
+                                            (esc loop2))
+                                        (select 2)))])
+         loop2)]
+    ;; towards universality
+    [(~datum appleye)
+     #'call]
+    [e:clos-form (clos-parser #'e)]
+    ;; escape hatch for racket expressions or anything
+    ;; to be "passed through"
+    [((~datum esc) ex:expr)
+     #'ex]
+
+    ;;; Miscellaneous
+
+    ;; Partial application with syntactically pre-supplied arguments
+    ;; in a blanket template
+    ;; Note: at this point it's already been parsed/validated
+    ;; by the expander and we don't need to worry about checking
+    ;; the syntax at the compiler level
+    [((~datum #%blanket-template) e)
+     (blanket-template-form-parser this-syntax)]
+
+    ;; Fine-grained template-based application
+    ;; This handles templates that indicate a specific number of template
+    ;; variables (i.e. expected arguments). The semantics of template-based
+    ;; application here is fulfilled by the fancy-app module. In order to use
+    ;; it, we simply use the #%app macro provided by fancy-app instead of the
+    ;; implicit one used for function application in racket/base.
+    ;; "prarg" = "pre-supplied argument"
+    [((~datum #%fine-template) (prarg-pre ... (~datum _) prarg-post ...))
+     #'(fancy:#%app prarg-pre ... _ prarg-post ...)]
+
+    ;; If in the course of optimization we ever end up with a fully
+    ;; simplified host expression, the compiler would a priori reject it as
+    ;; not being a core Qi expression. So we add this extra rule here
+    ;; to simply pass this expression through.
+    ;; TODO: should `#%host-expression` be formally declared as being part
+    ;; of the core language by including it in the syntax-spec grammar
+    ;; in extended/expander.rkt?
+    [((~datum #%host-expression) hex)
+     this-syntax]))
+
+;; The form-specific parsers, which are delegated to from
+;; the qi0->racket macro:
+
+#|
+A note on error handling:
+
+Some forms, in addition to handling legitimate syntax, also have
+catch-all versions that exist purely to provide a helpful message
+indicating a syntax error. We do this since a priori the qi0->racket macro
+would ignore syntax that doesn't match any pattern. Yet, for all of
+these named forms, we know that (or at least, it is prudent to assume
+that) the user intended to employ that particular form of the DSL. So
+instead of allowing it to fall through for interpretation as Racket
+code, which would yield potentially inscrutable errors, the catch-all
+forms allow us to provide appropriate error messages at the level of
+the DSL.
+
+|#
+
+(begin-for-syntax
+
+  (define (sep-parser stx)
+    (syntax-parse stx
+      [_:id
+       #'(qi0->racket (if (esc list?)
+                          (#%fine-template (apply values _))
+                          (#%fine-template (raise-argument-error '△
+                                                                 "list?"
+                                                                 _))))]
+      [(_ onex:clause)
+       #'(λ (v . vs)
+           ((qi0->racket (~> △ (>< (#%fine-template (apply (qi0->racket onex) _ vs))))) v))]))
+
+  (define (select-parser stx)
+    (syntax-parse stx
+      [(_ n:number ...) #'(qi0->racket (-< (esc (arg n)) ...))]))
+
+  (define (block-parser stx)
+    (syntax-parse stx
+      [(_ n:number ...)
+       #'(qi0->racket (~> (esc (except-args n ...))
+                          △))]))
+
+  (define (group-parser stx)
+    (syntax-parse stx
+      [(_ n:expr
+          selection-onex:clause
+          remainder-onex:clause)
+       #'(loom-compose (qi0->racket selection-onex)
+                       (qi0->racket remainder-onex)
+                       n)]
+      [_:id
+       #'(λ (n selection-flo remainder-flo . vs)
+           (apply (qi0->racket (group n
+                                      (esc selection-flo)
+                                      (esc remainder-flo))) vs))]))
+
+  (define (sieve-parser stx)
+    (syntax-parse stx
+      [(_ condition:clause
+          sonex:clause
+          ronex:clause)
+       #'(qi0->racket (-< (~> (pass condition) sonex)
+                          (~> (pass (not condition)) ronex)))]
+      [_:id
+       ;; sieve can be a core form once bindings
+       ;; are introduced into the language
+       #'(λ (condition sonex ronex . args)
+           (apply (qi0->racket (-< (~> (pass (esc condition)) (esc sonex))
+                                   (~> (pass (not (esc condition))) (esc ronex))))
+                  args))]))
+
+  (define (partition-parser stx)
+    (syntax-parse stx
+      [(_:id)
+       #'(qi0->racket ground)]
+      [(_ [cond:clause body:clause])
+       #'(qi0->racket (~> (pass cond) body))]
+      [(_ [cond:clause body:clause]  ...+)
+       #:with c+bs #'(list (cons (qi0->racket cond) (qi0->racket body)) ...)
+       #'(qi0->racket (#%blanket-template (partition-values c+bs __)))]))
+
+  (define (try-parser stx)
+    (syntax-parse stx
+      [(_ flo
+          [error-condition-flo error-handler-flo]
+          ...+)
+       #'(λ args
+           (with-handlers ([(qi0->racket error-condition-flo)
+                            (λ (e)
+                              ;; TODO: may be good to support reference to the
+                              ;; error via a binding / syntax parameter
+                              (apply (qi0->racket error-handler-flo) args))]
+                           ...)
+             (apply (qi0->racket flo) args)))]))
+
+  (define (if-parser stx)
+    (syntax-parse stx
+      [(_ consequent:clause
+          alternative:clause)
+       #'(λ (f . args)
+           (if (apply f args)
+               (apply (qi0->racket consequent) args)
+               (apply (qi0->racket alternative) args)))]
+      [(_ condition:clause
+          consequent:clause
+          alternative:clause)
+       #'(λ args
+           (if (apply (qi0->racket condition) args)
+               (apply (qi0->racket consequent) args)
+               (apply (qi0->racket alternative) args)))]))
+
+  (define (fanout-parser stx)
+    (syntax-parse stx
+      [_:id #'repeat-values]
+      [(_ n:number)
+       ;; a slightly more efficient compile-time implementation
+       ;; for literally indicated N
+       ;; TODO: implement this as an optimization instead
+       #`(λ args
+           (apply values
+                  (append #,@(make-list (syntax->datum #'n) #'args))) )]
+      [(_ n:expr)
+       #'(lambda args
+           (apply values
+                  (apply append
+                         (make-list n args))))]))
+
+  (define (feedback-parser stx)
+    (syntax-parse stx
+      [(_ ((~datum while) tilex:clause)
+          ((~datum then) thenex:clause)
+          onex:clause)
+       #'(feedback-while (qi0->racket onex)
+                         (qi0->racket tilex)
+                         (qi0->racket thenex))]
+      [(_ ((~datum while) tilex:clause)
+          ((~datum then) thenex:clause))
+       #'(λ (f . args)
+           (apply (qi0->racket (feedback (while tilex) (then thenex) (esc f)))
+                  args))]
+      [(_ ((~datum while) tilex:clause) onex:clause)
+       #'(qi0->racket (feedback (while tilex) (then _) onex))]
+      [(_ ((~datum while) tilex:clause))
+       #'(qi0->racket (feedback (while tilex) (then _)))]
+      [(_ n:expr
+          ((~datum then) thenex:clause)
+          onex:clause)
+       #'(lambda args
+           (apply (feedback-times (qi0->racket onex) n (qi0->racket thenex))
+                  args))]
+      [(_ n:expr
+          ((~datum then) thenex:clause))
+       #'(λ (f . args)
+           (apply (qi0->racket (feedback n (then thenex) (esc f))) args))]
+      [(_ n:expr onex:clause)
+       #'(qi0->racket (feedback n (then _) onex))]
+      [(_ onex:clause)
+       #'(λ (n . args)
+           (apply (qi0->racket (feedback n onex)) args))]
+      [_:id
+       #'(λ (n flo . args)
+           (apply (qi0->racket (feedback n (esc flo)))
+                  args))]))
+
+  (define (tee-parser stx)
+    (syntax-parse stx
+      [((~or* (~datum -<) (~datum tee)) onex:clause ...)
+       #'(λ args
+           (apply values
+                  (append (values->list
+                           (apply (qi0->racket onex) args))
+                          ...)))]
+      [(~or* (~datum -<) (~datum tee))
+       #'repeat-values]))
+
+  (define (relay-parser stx)
+    (syntax-parse stx
+      [((~or* (~datum ==) (~datum relay)) onex:clause ...)
+       #'(relay (qi0->racket onex) ...)]
+      [(~or* (~datum ==) (~datum relay))
+       ;; review this – this "map" behavior may not be natural
+       ;; for relay. And map-values should probably end up being
+       ;; used in a compiler optimization
+       #'map-values]))
+
+  (define (amp-parser stx)
+    (syntax-parse stx
+      [_:id
+       #'(qi0->racket ==)]
+      [(_ onex:clause)
+       #'(curry map-values (qi0->racket onex))]))
+
+  (define (pass-parser stx)
+    (syntax-parse stx
+      [_:id
+       #'filter-values]
+      [(_ onex:clause)
+       #'(curry filter-values (qi0->racket onex))]))
+
+  (define (fold-left-parser stx)
+    (syntax-parse stx
+      [_:id
+       #'foldl-values]
+      [(_ fn init)
+       #'(qi0->racket (~> (-< (gen (qi0->racket fn)
+                                   (qi0->racket init))
+                              _)
+                          >>))]
+      [(_ fn)
+       #'(qi0->racket (>> fn (gen ((qi0->racket fn)))))]))
+
+  (define (fold-right-parser stx)
+    (syntax-parse stx
+      [_:id
+       #'foldr-values]
+      [(_ fn init)
+       #'(qi0->racket (~> (-< (gen (qi0->racket fn)
+                                   (qi0->racket init))
+                              _)
+                          <<))]
+      [(_ fn)
+       #'(qi0->racket (<< fn (gen ((qi0->racket fn)))))]))
+
+  (define (loop-parser stx)
+    (syntax-parse stx
+      [(_ pred:clause mapex:clause combex:clause retex:clause)
+       #'(letrec ([loop (qi0->racket (if pred
+                                         (~> (group 1 mapex (esc loop))
+                                             combex)
+                                         retex))])
+           loop)]
+      [(_ pred:clause mapex:clause combex:clause)
+       #'(qi0->racket (loop pred mapex combex ⏚))]
+      [(_ pred:clause mapex:clause)
+       #'(qi0->racket (loop pred mapex _ ⏚))]
+      [(_ mapex:clause)
+       #'(qi0->racket (loop (gen #t) mapex _ ⏚))]
+      [_:id #'(λ (predf mapf combf retf . args)
+                (apply (qi0->racket (loop (esc predf)
+                                          (esc mapf)
+                                          (esc combf)
+                                          (esc retf)))
+                       args))]))
+
+  (define (clos-parser stx)
+    (syntax-parse stx
+      [_:id
+       #:do [(define chirality (syntax-property stx 'chirality))]
+       (if (and chirality (eq? chirality 'right))
+           #'(λ (f . args) (apply curryr f args))
+           #'(λ (f . args) (apply curry f args)))]
+      [(_ onex:clause)
+       #:do [(define chirality (syntax-property stx 'chirality))]
+       (if (and chirality (eq? chirality 'right))
+           #'(λ args
+               (qi0->racket (~> (-< _ (~> (gen args) △))
+                                onex)))
+           #'(λ args
+               (qi0->racket (~> (-< (~> (gen args) △) _)
+                                onex))))]))
+
+  (define (blanket-template-form-parser stx)
+    (syntax-parse stx
+      ;; "prarg" = "pre-supplied argument"
+      ;; Note: use of currying here doesn't play well with bindings
+      ;; because curry / curryr immediately evaluate their arguments
+      ;; and resolve any references to bindings at compile time.
+      ;; That's why we use a lambda which delays evaluation until runtime
+      ;; when the reference is actually resolvable. See "anaphoric references"
+      ;; in the compiler meeting notes,
+      ;; "The Artist Formerly Known as Bindingspec"
+      [((~datum #%blanket-template)
+        (natex prarg-pre ...+ (~datum __) prarg-post ...+))
+       ;; "(curry (curryr ...) ...)"
+       #'(lambda largs
+           (apply
+            (lambda rargs
+              ((kw-helper natex rargs) prarg-post ...))
+            prarg-pre ...
+            largs))]
+      [((~datum #%blanket-template) (natex prarg-pre ...+ (~datum __)))
+       ;; "curry"
+       #'(lambda args
+           (apply natex prarg-pre ... args))]
+      [((~datum #%blanket-template)
+        (natex (~datum __) prarg-post ...+))
+       ;; "curryr"
+       #'(lambda args
+           ((kw-helper natex args) prarg-post ...))])))
diff --git a/qi-lib/flow/core/compiler/2000-bindings.rkt b/qi-lib/flow/core/compiler/2000-bindings.rkt
new file mode 100644
index 00000000..7c51a53b
--- /dev/null
+++ b/qi-lib/flow/core/compiler/2000-bindings.rkt
@@ -0,0 +1,73 @@
+#lang racket/base
+
+(require (for-syntax racket/base
+                     syntax/parse
+                     "../strategy.rkt")
+         racket/undefined
+         "../passes.rkt")
+
+;; Transformation rules for the `as` binding form:
+;;
+;; 1. escape to wrap outermost ~> with let and re-enter
+;;
+;;   (~> flo ... (... (as name) ...))
+;;   ...
+;;    ↓
+;;   ...
+;;   (esc (let ([name (void)])
+;;          (☯ original-flow)))
+;;
+;; 2. as → set!
+;;
+;;   (as name)
+;;   ...
+;;    ↓
+;;   ...
+;;   (~> (esc (λ (x) (set! name x))) ⏚)
+;;
+;; 3. Overall transformation:
+;;
+;;   (~> flo ... (... (as name) ...))
+;;   ...
+;;    ↓
+;;   ...
+;;   (esc (let ([name (void)])
+;;          (☯ (~> flo ... (... (~> (esc (λ (x) (set! name x))) ⏚) ...)))))
+
+(begin-for-syntax
+
+  ;; (as name) → (~> (esc (λ (x) (set! name x))) ⏚)
+  ;; TODO: use a box instead of set!
+  (define (rewrite-all-bindings stx)
+    (find-and-map/qi (syntax-parser
+                       [((~datum as) x ...)
+                        #:with (x-val ...) (generate-temporaries (attribute x))
+                        #'(thread (esc (λ (x-val ...) (set! x x-val) ...)) ground)]
+                       [_ this-syntax])
+                     stx))
+
+  (define (bound-identifiers stx)
+    (let ([ids null])
+      (find-and-map/qi (syntax-parser
+                         [((~datum as) x ...)
+                          (begin
+                            (set! ids
+                                  (append (attribute x) ids))
+                            ;; we don't need to traverse further
+                            #f)]
+                         [_ this-syntax])
+                       stx)
+      ids))
+
+  ;; wrap stx with (let ([v undefined] ...) stx) for v ∈ ids
+  (define (wrap-with-scopes stx ids)
+    (with-syntax ([(v ...) ids])
+      #`(let ([v undefined] ...) #,stx)))
+
+  (define-and-register-pass 2000 (bindings stx)
+    ;; TODO: use syntax-parse and match ~> specifically.
+    ;; Since macros are expanded "outside in," presumably
+    ;; it will naturally wrap the outermost ~>
+    (wrap-with-scopes (rewrite-all-bindings stx)
+                      (bound-identifiers stx))))
+
diff --git a/qi-lib/flow/core/compiler/deforest/bindings.rkt b/qi-lib/flow/core/compiler/deforest/bindings.rkt
new file mode 100644
index 00000000..22eccb9a
--- /dev/null
+++ b/qi-lib/flow/core/compiler/deforest/bindings.rkt
@@ -0,0 +1,35 @@
+#lang racket/base
+
+(require (prefix-in r: racket/base)
+         (prefix-in r: racket/list)
+         syntax/parse/define
+         (for-syntax racket/syntax
+                     syntax/parse
+                     racket/base))
+
+(define-syntax-parser define-and-provide-deforestable-bindings
+  ((_ ids ...)
+   (with-syntax (((rids ...) (for/list ((s (attribute ids)))
+                               (format-id s "r:~a" s))))
+     #'(begin
+         (define ids rids) ...
+         (provide ids ...)))))
+
+(define-and-provide-deforestable-bindings
+  range
+  
+  filter
+  map
+  filter-map
+  take
+
+  foldr
+  foldl
+  car
+  cadr
+  caddr
+  cadddr
+  list-ref
+  length
+  empty?
+  null?)
diff --git a/qi-lib/flow/core/compiler/deforest/cps.rkt b/qi-lib/flow/core/compiler/deforest/cps.rkt
new file mode 100644
index 00000000..59ccc7d9
--- /dev/null
+++ b/qi-lib/flow/core/compiler/deforest/cps.rkt
@@ -0,0 +1,381 @@
+#lang racket/base
+
+(provide (for-syntax deforest-pass))
+
+(require (for-syntax racket/base
+                     syntax/parse
+                     "syntax.rkt"
+                     "../../../extended/util.rkt"
+                     syntax/srcloc
+                     racket/syntax-srcloc
+                     "fusion.rkt"
+                     "../../private/form-property.rkt")
+         "templates.rkt"
+         racket/performance-hint
+         racket/match
+         racket/contract/base)
+
+;; "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 ...) g ...] rest ...) (op f ... (inline-compose1 rest ...) g ...)]
+    ))
+
+;; Adds the initial states of all stateful transformers in the
+;; required order to the initial producer state. Uses (cons Tx S)
+;; where Tx is the transformer's initial state and S is the producer's
+;; initial state with all preceding transformer states already
+;; added. Nothing is added for stateless transformers which pass () as
+;; their initial state expression. For example: (inline-consing (T1)
+;; () (T2) P) -> (cons T2 (cons T1 P))
+(define-syntax inline-consing
+  (syntax-rules ()
+    [(_ state () rest ...) (inline-consing state rest ...)]
+    [(_ state (arg) rest ...) (inline-consing (cons arg state) rest ...)]
+    [(_ state) state]
+    ))
+
+(begin-for-syntax
+
+  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+  ;; Producers
+
+  ;; Special "curry"ing for #%fine-templates. All #%host-expressions are
+  ;; passed as they are and all (~datum _) are replaced by wrapper
+  ;; lambda arguments.
+  (define ((make-fine-curry argstx minargs maxargs form-stx) ctx name)
+    (define argstxlst (syntax->list argstx))
+    (define numargs (length argstxlst))
+    (cond
+      [(< numargs minargs)
+       (raise-syntax-error (syntax->datum name)
+                           (format "too few arguments - given ~a - accepts at least ~a"
+                                   numargs minargs)
+                           (prettify-flow-syntax ctx)
+                           (prettify-flow-syntax form-stx))]
+      [(> numargs maxargs)
+       (raise-syntax-error (syntax->datum name)
+                           (format "too many arguments - given ~a - accepts at most ~a"
+                                   numargs maxargs)
+                           (prettify-flow-syntax ctx)
+                           (prettify-flow-syntax form-stx))])
+    (define temporaries (generate-temporaries argstxlst))
+    (define-values (allargs tmpargs)
+      (for/fold ([all '()]
+                 [tmps '()]
+                 #:result (values (reverse all)
+                                  (reverse tmps)))
+                ([tmp (in-list temporaries)]
+                 [arg (in-list argstxlst)])
+        (syntax-parse arg
+          #:datum-literals (#%host-expression)
+          [(#%host-expression ex)
+           (values (cons #'ex all)
+                   tmps)]
+          [(~datum _)
+           (values (cons tmp all)
+                   (cons tmp tmps))])))
+    (with-syntax ([(carg ...) tmpargs]
+                  [(aarg ...) allargs])
+      #'(lambda (proc)
+          (lambda (carg ...)
+            (proc aarg ...)))))
+
+  ;; Special curry for #%blanket-template. Raises syntax error if there
+  ;; are too many arguments. If the number of arguments is exactly the
+  ;; maximum, wraps into lambda without any arguments. If less than
+  ;; maximum, curries it from both left and right.
+  (define ((make-blanket-curry prestx poststx maxargs form-stx) ctx name)
+    (define prelst (syntax->list prestx))
+    (define postlst (syntax->list poststx))
+    (define numargs (+ (length prelst) (length postlst)))
+    (with-syntax ([(pre-arg ...) prelst]
+                  [(post-arg ...) postlst])
+      (cond
+        [(> numargs maxargs)
+         (raise-syntax-error (syntax->datum name)
+                             (format "too many arguments - given ~a - accepts at most ~a"
+                                     numargs maxargs)
+                             (prettify-flow-syntax ctx)
+                             (prettify-flow-syntax form-stx))]
+        [(= numargs maxargs)
+         #'(lambda (v)
+             (lambda ()
+               (v pre-arg ... post-arg ...)))]
+        [else
+         #'(lambda (v)
+             (lambda rest
+               (apply v pre-arg ...
+                      (append rest
+                              (list post-arg ...)))))])))
+  ;; Unifying producer curry makers. The ellipsis escaping allows for
+  ;; simple specification of pattern variable names as bound in the
+  ;; syntax pattern.
+  (define-syntax make-producer-curry
+    (syntax-rules ()
+      [(_ min-args max-args
+          blanket? pre-arg post-arg
+          fine? arg
+          form-stx)
+       (cond
+         [(attribute blanket?)
+          (make-blanket-curry pre-arg
+                              post-arg
+                              max-args
+                              #'form-stx
+                              )]
+         [(attribute fine?)
+          (make-fine-curry arg min-args max-args #'form-stx)]
+         [else
+          (lambda (ctx name) #'(lambda (v) v))])]))
+
+  (define-syntax-class fsp
+    #:attributes (curry name contract prepare next)
+    (pattern range:fsp-range
+             #:attr name #''range
+             #:attr contract #'(->* (real?) (real? real?) any)
+             #:attr prepare #'range->cstream-prepare
+             #:attr next #'range->cstream-next
+             #:attr curry (make-producer-curry 1 3
+                                               range.blanket? #'range.pre-arg #'range.post-arg
+                                               range.fine? #'range.arg
+                                               range))
+    (pattern default:fsp-default
+             #:attr name #''list->cstream
+             #:attr contract #'(-> list? any)
+             #:attr prepare #'list->cstream-prepare
+             #:attr next #'list->cstream-next
+             #:attr curry (lambda (ctx name) #'(lambda (v) v)))
+    )
+
+  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+  ;; Transformers
+
+  (define-syntax-class fst
+    #:attributes (next f state)
+    (pattern filter:fst-filter
+             #:attr f #'(filter.f)
+             #:attr next #'filter-cstream-next
+             #:attr state #'())
+    (pattern map:fst-map
+             #:attr f #'(map.f)
+             #:attr next #'map-cstream-next
+             #:attr state #'())
+    (pattern filter-map:fst-filter-map
+             #:attr f #'(filter-map.f)
+             #:attr next #'filter-map-cstream-next
+             #:attr state #'())
+    (pattern take:fst-take
+             #:attr f #'()
+             #:attr next #'take-cstream-next
+             #:attr state #'(take.n))
+    )
+
+  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+  ;; Consumers
+
+  (define-syntax-class fsc
+    #:attributes (end)
+    (pattern foldr:fsc-foldr
+             #:attr end #'(foldr-cstream-next foldr.op foldr.init))
+    (pattern foldl:fsc-foldl
+             #:attr end #'(foldl-cstream-next foldl.op foldl.init))
+    (pattern list-ref:fsc-list-ref
+             #:attr end #'(list-ref-cstream-next list-ref.pos 'list-ref.name))
+    (pattern length:fsc-length
+             #:attr end #'(length-cstream-next))
+    (pattern empty?:fsc-empty?
+             #:attr end #'(empty?-cstream-next))
+    (pattern default:fsc-default
+             #:attr end #'(cstream-next->list))
+    )
+
+  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+  ;; The pass
+
+  ;; Performs deforestation rewrite on the whole syntax tree.
+  (define-and-register-deforest-pass (deforest-pass ops ctx)
+    (syntax-parse (reverse ops)
+      [(c:fsc
+        t:fst ...
+        p:fsp)
+       ;; A static runtime contract is placed at the beginning of the
+       ;; fused sequence. And runtime checks for consumers are in
+       ;; their respective implementation procedure.
+       (with-syntax (((rt ...) (reverse (attribute t.state))))
+         (attach-form-property
+          #`(esc
+             (#,((attribute p.curry) ctx (attribute p.name))
+              (contract p.contract
+                        (p.prepare
+                         (lambda (state)
+                           (define cstate (inline-consing state rt ...))
+                           cstate)
+                         (#,@#'c.end
+                          (inline-compose1 [t.next t.f
+                                                   '#,(prettify-flow-syntax ctx)
+                                                   '#,(build-source-location-vector
+                                                       (syntax-srcloc ctx))
+                                                   ] ...
+                                           p.next
+                                           )
+                          '#,(prettify-flow-syntax ctx)
+                          '#,(build-source-location-vector
+                              (syntax-srcloc ctx))))
+                        p.name
+                        '#,(prettify-flow-syntax ctx)
+                        #f
+                        '#,(build-source-location-vector
+                            (syntax-srcloc ctx)))))))]))
+
+  )
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Runtime
+
+(begin-encourage-inline
+
+  ;; Producers
+
+  (define-inline (list->cstream-next done skip yield)
+    (λ (state)
+      (cond [(null? state) (done)]
+            [else (yield (car state) (cdr state))])))
+
+  (define-inline (list->cstream-prepare consing next)
+    (case-lambda
+      [(lst) (next (consing lst))]
+      [rest (void)]))
+
+  (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 (range->cstream-prepare consing next)
+    (case-lambda
+      [(h) (next (consing (list 0 h 1)))]
+      [(l h) (next (consing (list l h 1)))]
+      [(l h s) (next (consing (list l h s)))]
+      [rest (void)]))
+
+  ;; Transformers
+
+  (define-inline (map-cstream-next f next ctx src)
+    (λ (done skip yield)
+      (next done
+            skip
+            (λ (value state)
+              (yield (f value) state)))))
+
+  (define-inline (filter-cstream-next f next ctx src)
+    (λ (done skip yield)
+      (next done
+            skip
+            (λ (value state)
+              (if (f value)
+                  (yield value state)
+                  (skip state))))))
+
+  (define-inline (filter-map-cstream-next f next ctx src)
+    (λ (done skip yield)
+      (next done
+            skip
+            (λ (value state)
+              (let ([fv (f value)])
+                (if fv
+                    (yield fv state)
+                    (skip state)))))))
+
+  (define-inline (take-cstream-next next ctx src)
+    (λ (done skip yield)
+      (λ (take-state)
+        (define n (car take-state))
+        (define state (cdr take-state))
+        (if (zero? n)
+            (done)
+            ((next (λ ()
+                     ((contract (-> pair? any)
+                                (λ (v) v)
+                                'take ctx
+                                #f
+                                src)
+                      '()))
+                   (λ (state)
+                     (skip (cons n state)))
+                   (λ (value state)
+                     (define new-state (cons (sub1 n) state))
+                     (yield value new-state)))
+             state)))))
+
+  ;; Consumers
+
+  (define-inline (cstream-next->list next ctx src)
+    (λ (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 ctx src)
+    (λ (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 ctx src)
+    (λ (state)
+      (let loop ([acc init] [state state])
+        ((next (λ () acc)
+               (λ (state) (loop acc state))
+               (λ (value state)
+                 (loop (op value acc) state)))
+         state))))
+
+  (define-inline (list-ref-cstream-next init-countdown name next ctx src)
+    (λ (state)
+      (let loop ([state state]
+                 [countdown init-countdown])
+        ((next (λ () ((contract (-> pair? any)
+                                (λ (v) v)
+                                name ctx #f
+                                src)
+                      '()))
+               (λ (state) (loop state countdown))
+               (λ (value state)
+                 (if (zero? countdown)
+                     value
+                     (loop state (sub1 countdown)))))
+         state))))
+
+  (define-inline (length-cstream-next next ctx src)
+    (λ (state)
+      (let loop ([state state]
+                 [the-length 0])
+        ((next (λ () the-length)
+               (λ (state) (loop state the-length))
+               (λ (value state)
+                 (loop state (add1 the-length))))
+         state))))
+
+  (define-inline (empty?-cstream-next next ctx src)
+    (λ (state)
+      (let loop ([state state])
+        ((next (λ () #t)
+               (λ (state) (loop state))
+               (λ (value state) #f))
+         state))))
+
+  )
diff --git a/qi-lib/flow/core/compiler/deforest/fusion.rkt b/qi-lib/flow/core/compiler/deforest/fusion.rkt
new file mode 100644
index 00000000..46448995
--- /dev/null
+++ b/qi-lib/flow/core/compiler/deforest/fusion.rkt
@@ -0,0 +1,80 @@
+#lang racket/base
+
+(provide define-and-register-deforest-pass)
+
+(require (for-syntax racket/base
+                     syntax/parse)
+         syntax/parse
+         "syntax.rkt"
+         "../../passes.rkt"
+         "../../strategy.rkt"
+         (for-template "../../passes.rkt")
+         "../../private/form-property.rkt")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; The actual fusion generator implementation
+
+;; Used only in deforest-rewrite to properly recognize the end of
+;; fusable sequence.
+(define-syntax-class non-fusable
+  (pattern (~not (~or _:fst-syntax
+                      _:fsp-syntax
+                      _:fsc-syntax))))
+
+(define (make-deforest-rewrite generate-fused-operation)
+  (lambda (stx)
+    (attach-form-property
+     (syntax-parse stx
+       [((~datum thread) _0:non-fusable ...
+                         p:fsp-syntax
+                         ;; There can be zero transformers here:
+                         t:fst-syntax ...
+                         c:fsc-syntax
+                         _1 ...)
+        #:with fused (generate-fused-operation
+                      (syntax->list #'(p t ... c))
+                      stx)
+        #'(thread _0 ... fused _1 ...)]
+       [((~datum thread) _0:non-fusable ...
+                         t1:fst-syntax0
+                         t:fst-syntax ...
+                         c:fsc-syntax
+                         _1 ...)
+        #:with fused (generate-fused-operation
+                      (syntax->list #'(list->cstream t1 t ... c))
+                      stx)
+        #'(thread _0 ... fused _1 ...)]
+       [((~datum thread) _0:non-fusable ...
+                         p:fsp-syntax
+                         ;; Must be 1 or more transformers here:
+                         t:fst-syntax ...+
+                         _1 ...)
+        #:with fused (generate-fused-operation
+                      (syntax->list #'(p t ... cstream->list))
+                      stx)
+        #'(thread _0 ... fused _1 ...)]
+       [((~datum thread) _0:non-fusable ...
+                         f1:fst-syntax0
+                         f:fst-syntax ...+
+                         _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]))))
+
+;; This syntax is actively used only once as it is intended to be used
+;; by alternative implementations. Currently only the CPS
+;; implementation uses it, however in the near future the named-let
+;; implementation will use it as well.
+(define-syntax (define-and-register-deforest-pass stx)
+  (syntax-parse stx
+    ((_ (deforest-pass ops ctx) expr ...)
+     #'(define-and-register-pass 100 (deforest-pass stx)
+         (find-and-map/qi
+          (make-deforest-rewrite
+           (lambda (ops ctx)
+             expr ...))
+          stx)))))
diff --git a/qi-lib/flow/core/compiler/deforest/syntax.rkt b/qi-lib/flow/core/compiler/deforest/syntax.rkt
new file mode 100644
index 00000000..ebe2f6e9
--- /dev/null
+++ b/qi-lib/flow/core/compiler/deforest/syntax.rkt
@@ -0,0 +1,256 @@
+#lang racket/base
+
+(provide fsp-syntax
+         fst-syntax0
+         fst-syntax
+         fsc-syntax
+
+         fsp-range
+         fsp-default
+
+         fst-filter
+         fst-map
+         fst-filter-map
+         fst-take
+
+         fsc-foldr
+         fsc-foldl
+         fsc-list-ref
+         fsc-length
+         fsc-empty?
+         fsc-default
+
+         )
+
+(require syntax/parse
+         "../../passes.rkt"
+         "../../strategy.rkt"
+         (for-template racket/base
+                       "../../passes.rkt"
+                       "../../strategy.rkt"
+                       "templates.rkt"
+                       (prefix-in qi: "bindings.rkt"))
+         (for-syntax racket/base
+                     syntax/parse))
+
+;; Literals set used for matching Fusable Stream Literals
+(define-literal-set fs-literals
+  #:datum-literals (esc #%host-expression #%fine-template #%blanket-template _ __)
+  ())
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Fusable Stream Producers
+;;
+;; Syntax classes used for matching functions that produce a sequence
+;; of values and they annotate the syntax with attributes that will be
+;; used in the compiler to apply optimizations.
+;;
+;; All are prefixed with fsp- for clarity.
+
+(define-syntax-class fsp-range
+  #:attributes (blanket? fine? arg pre-arg post-arg)
+  #:literal-sets (fs-literals)
+  #:literals (qi:range)
+  (pattern (esc (#%host-expression qi:range))
+           #:attr arg #f
+           #:attr pre-arg #f
+           #:attr post-arg #f
+           #:attr blanket? #f
+           #:attr fine? #f)
+  (pattern (#%fine-template
+            ((#%host-expression qi:range)
+             the-arg ...))
+           #:attr arg #'(the-arg ...)
+           #:attr pre-arg #f
+           #:attr post-arg #f
+           #:attr blanket? #f
+           #:attr fine? #t)
+  (pattern (#%blanket-template
+            ((#%host-expression qi:range)
+             (#%host-expression the-pre-arg) ...
+             __
+             (#%host-expression the-post-arg) ...))
+           #:attr arg #f
+           #:attr pre-arg #'(the-pre-arg ...)
+           #:attr post-arg #'(the-post-arg ...)
+           #:attr blanket? #t
+           #:attr fine? #f))
+
+(define-syntax-class fsp-default
+  #:datum-literals (list->cstream)
+  (pattern list->cstream
+           #:attr contract #'(-> list? any)
+           #:attr name #''list->cstream))
+
+(define-syntax-class fsp-syntax
+  (pattern (~or _:fsp-range
+                _:fsp-default)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Fusable Stream Transformers
+;;
+;; Syntax classes matching functions acting as transformers of the
+;; sequence of values passing through.
+;;
+;; All are prefixed with fst- for clarity.
+
+(define-syntax-class fst-filter
+  #:attributes (f)
+  #:literal-sets (fs-literals)
+  #:literals (qi:filter)
+  (pattern (#%blanket-template
+            ((#%host-expression qi:filter)
+             (#%host-expression f)
+             __)))
+  (pattern (#%fine-template
+            ((#%host-expression qi:filter)
+             (#%host-expression f)
+             _))))
+
+(define-syntax-class fst-map
+  #:attributes (f)
+  #:literal-sets (fs-literals)
+  #:literals (qi:map)
+  (pattern (#%blanket-template
+            ((#%host-expression qi:map)
+             (#%host-expression f)
+             __)))
+  (pattern (#%fine-template
+            ((#%host-expression qi:map)
+             (#%host-expression f)
+             _))))
+
+(define-syntax-class fst-filter-map
+  #:attributes (f)
+  #:literal-sets (fs-literals)
+  #:literals (qi:filter-map)
+  (pattern (#%blanket-template
+            ((#%host-expression qi:filter-map)
+             (#%host-expression f)
+             __)))
+  (pattern (#%fine-template
+            ((#%host-expression qi:filter-map)
+             (#%host-expression f)
+             _))))
+
+(define-syntax-class fst-take
+  #:attributes (n)
+  #:literal-sets (fs-literals)
+  #:literals (qi:take)
+  (pattern (#%blanket-template
+            ((#%host-expression qi:take)
+             __
+             (#%host-expression n))))
+  (pattern (#%fine-template
+            ((#%host-expression qi:take)
+             _
+             (#%host-expression n)))))
+
+(define-syntax-class fst-syntax0
+  (pattern (~or filter:fst-filter
+                filter-map:fst-filter-map)))
+
+(define-syntax-class fst-syntax
+  (pattern (~or _:fst-filter
+                _:fst-map
+                _:fst-filter-map
+                _:fst-take)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Fusable Stream Consumers
+;;
+;; Syntax classes used for matching functions that can consume all
+;; values from a sequence and create a single value from those.
+;;
+;; Prefixed with fsc- for clarity.
+
+(define-syntax-class fsc-foldr
+  #:attributes (op init)
+  #:literal-sets (fs-literals)
+  #:literals (qi:foldr)
+  (pattern (#%blanket-template
+            ((#%host-expression qi:foldr)
+             (#%host-expression op)
+             (#%host-expression init)
+             __)))
+  (pattern (#%fine-template
+            ((#%host-expression qi:foldr)
+             (#%host-expression op)
+             (#%host-expression init)
+             _))))
+
+(define-syntax-class fsc-foldl
+  #:attributes (op init)
+  #:literal-sets (fs-literals)
+  #:literals (qi:foldl)
+  (pattern (#%blanket-template
+            ((#%host-expression qi:foldl)
+             (#%host-expression op)
+             (#%host-expression init)
+             __)))
+  (pattern (#%fine-template
+            ((#%host-expression qi:foldl)
+             (#%host-expression op)
+             (#%host-expression init)
+             _))))
+
+(define-syntax-class cad*r-datum
+  #:attributes (countdown)
+  (pattern (~literal qi:car) #:attr countdown #'0)
+  (pattern (~literal qi:cadr) #:attr countdown #'1)
+  (pattern (~literal qi:caddr) #:attr countdown #'2)
+  (pattern (~literal qi:cadddr) #:attr countdown #'3))
+
+(define-syntax-class fsc-list-ref
+  #:attributes (pos name)
+  #:literal-sets (fs-literals)
+  #:literals (qi:list-ref)
+  (pattern (~or (#%fine-template
+                 ((#%host-expression qi:list-ref) _ idx))
+                (#%blanket-template
+                 ((#%host-expression qi:list-ref) __ idx)))
+           #:attr pos #'idx
+           #:attr name #'list-ref)
+  (pattern (~or (esc (#%host-expression cad*r:cad*r-datum))
+                (#%fine-template
+                 ((#%host-expression cad*r:cad*r-datum) _))
+                (#%blanket-template
+                 ((#%host-expression cad*r:cad*r-datum) __)))
+           #:attr pos #'cad*r.countdown
+           #:attr name #'cad*r))
+
+(define-syntax-class fsc-length
+  #:literal-sets (fs-literals)
+  #:literals (qi:length)
+  (pattern (esc
+            (#%host-expression qi:length)))
+  (pattern (#%fine-template
+            ((#%host-expression qi:length) _)))
+  (pattern (#%blanket-template
+            ((#%host-expression qi:length) __))))
+
+(define-syntax-class fsc-empty?
+  #:literal-sets (fs-literals)
+  #:literals (qi:null? qi:empty?)
+  (pattern (esc
+            (#%host-expression (~or qi:empty?
+                                    qi:null?))))
+  (pattern (#%fine-template
+            ((#%host-expression (~or qi:empty?
+                                     qi:null?)) _)))
+  (pattern (#%blanket-template
+            ((#%host-expression (~or qi:empty?
+                                     qi:null?)) __))))
+
+(define-syntax-class fsc-default
+  #:datum-literals (cstream->list)
+  (pattern cstream->list))
+
+(define-syntax-class fsc-syntax
+  (pattern (~or _:fsc-foldr
+                _:fsc-foldl
+                _:fsc-list-ref
+                _:fsc-length
+                _:fsc-empty?
+                _:fsc-default
+                )))
diff --git a/qi-lib/flow/core/compiler/deforest/templates.rkt b/qi-lib/flow/core/compiler/deforest/templates.rkt
new file mode 100644
index 00000000..9f9038bc
--- /dev/null
+++ b/qi-lib/flow/core/compiler/deforest/templates.rkt
@@ -0,0 +1,10 @@
+#lang racket/base
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Special syntax for templates
+
+;; These bindings are used for ~literal matching to introduce implicit
+;; producer/consumer when none is explicitly given in the flow.
+(provide cstream->list list->cstream)
+(define cstream->list #'-cstream->list)
+(define list->cstream #'-list->cstream)
diff --git a/qi-lib/flow/core/deforest.rkt b/qi-lib/flow/core/deforest.rkt
deleted file mode 100644
index 71e35896..00000000
--- a/qi-lib/flow/core/deforest.rkt
+++ /dev/null
@@ -1,422 +0,0 @@
-#lang racket/base
-
-;; This module implements the stream fusion optimization to "deforest"
-;; sequences of functional transformations (e.g. map, filter, fold, etc.)
-;; so that they avoid constructing intermediate representations on the
-;; way to producing the final result.
-;;
-;; See the wiki
-;;   https://github.com/drym-org/qi/wiki/The-Compiler#stream-fusion
-;; for an overview and some details of this implementation.
-
-(provide (for-syntax deforest-pass))
-
-(require (for-syntax racket/base
-                     syntax/parse
-                     racket/syntax-srcloc
-                     syntax/srcloc
-                     "../extended/util.rkt"
-                     "strategy.rkt")
-         "passes.rkt"
-         racket/performance-hint
-         racket/match
-         racket/list
-         racket/contract/base)
-
-;; These bindings are used for ~literal matching to introduce implicit
-;; producer/consumer when none is explicitly given in the flow.
-(define cstream->list #'-cstream->list)
-(define 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
-  ;; Special "curry"ing for #%fine-templates. All #%host-expressions
-  ;; are passed as they are and all (~datum _) are replaced by wrapper
-  ;; lambda arguments.
-  (define ((make-fine-curry argstx minargs maxargs form-stx) ctx name)
-    (define argstxlst (syntax->list argstx))
-    (define numargs (length argstxlst))
-    (cond
-      [(< numargs minargs)
-       (raise-syntax-error (syntax->datum name)
-                           (format "too few arguments - given ~a - accepts at least ~a"
-                                   numargs minargs)
-                           (prettify-flow-syntax ctx)
-                           (prettify-flow-syntax form-stx))]
-      [(> numargs maxargs)
-       (raise-syntax-error (syntax->datum name)
-                           (format "too many arguments - given ~a - accepts at most ~a"
-                                   numargs maxargs)
-                           (prettify-flow-syntax ctx)
-                           (prettify-flow-syntax form-stx))])
-    (define temporaries (generate-temporaries argstxlst))
-    (define-values (allargs tmpargs)
-      (for/fold ([all '()]
-                 [tmps '()]
-                 #:result (values (reverse all)
-                                  (reverse tmps)))
-                ([tmp (in-list temporaries)]
-                 [arg (in-list argstxlst)])
-        (syntax-parse arg
-          #:datum-literals (#%host-expression)
-          [(#%host-expression ex)
-           (values (cons #'ex all)
-                   tmps)]
-          [(~datum _)
-           (values (cons tmp all)
-                   (cons tmp tmps))])))
-    (with-syntax ([(carg ...) tmpargs]
-                  [(aarg ...) allargs])
-      #'(λ (proc)
-          (λ (carg ...)
-            (proc aarg ...)))))
-
-  ;; Special curry for #%blanket-template. Raises syntax error if
-  ;; there are too many arguments. If the number of arguments is
-  ;; exactly the maximum, wraps into lambda without any arguments. If
-  ;; less than maximum, curries it from both left and right.
-  (define ((make-blanket-curry prestx poststx maxargs form-stx) ctx name)
-    (define prelst (syntax->list prestx))
-    (define postlst (syntax->list poststx))
-    (define numargs (+ (length prelst) (length postlst)))
-    (with-syntax ([(pre-arg ...) prelst]
-                  [(post-arg ...) postlst])
-      (cond
-        [(> numargs maxargs)
-         (raise-syntax-error (syntax->datum name)
-                             (format "too many arguments - given ~a - accepts at most ~a"
-                                     numargs maxargs)
-                             (prettify-flow-syntax ctx)
-                             (prettify-flow-syntax form-stx))]
-        [(= numargs maxargs)
-         #'(λ (v)
-             (λ ()
-               (v pre-arg ... post-arg ...)))]
-        [else
-         #'(λ (v)
-             (λ rest
-               (apply v pre-arg ...
-                      (append rest
-                              (list post-arg ...)))))])))
-
-  ;; Unifying producer curry makers. The ellipsis escaping allows for
-  ;; simple specification of pattern variable names as bound in the
-  ;; syntax pattern.
-  (define-syntax make-producer-curry
-    (syntax-rules ()
-      [(_ min-args max-args
-          blanket? pre-arg post-arg
-          fine? arg
-          form-stx)
-       (cond
-         [(attribute blanket?)
-          (make-blanket-curry #'(pre-arg (... ...))
-                              #'(post-arg (... ...))
-                              max-args
-                              #'form-stx
-                              )]
-         [(attribute fine?)
-          (make-fine-curry #'(arg (... ...)) min-args max-args #'form-stx)]
-         [else
-          (λ (ctx name) #'(λ (v) v))])]))
-
-  ;; 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 contract name curry)
-    #:datum-literals (#%host-expression #%blanket-template #%fine-template esc __)
-    ;; Explicit range producers.
-    (pattern (~and (~or (esc (#%host-expression (~datum range)))
-                        (~and (#%fine-template
-                               ((#%host-expression (~datum range))
-                                arg ...))
-                              fine?)
-                        (~and (#%blanket-template
-                               ((#%host-expression (~datum range))
-                                (#%host-expression pre-arg) ...
-                                __
-                                (#%host-expression post-arg) ...))
-                              blanket?))
-                   form-stx)
-             #:attr next #'range->cstream-next
-             #:attr prepare #'range->cstream-prepare
-             #:attr contract #'(->* (real?) (real? real?) any)
-             #:attr name #'range
-             #:attr curry (make-producer-curry 1 3
-                                               blanket? pre-arg post-arg
-                                               fine? arg
-                                               form-stx))
-
-    ;; The implicit stream producer from plain list.
-    (pattern (~literal list->cstream)
-             #:attr next #'list->cstream-next
-             #:attr prepare #'list->cstream-prepare
-             #:attr contract #'(-> list? any)
-             #:attr name #''list->cstream
-             #:attr curry (λ (ctx name) #'(λ (v) v))))
-
-  ;; 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 #%blanket-template __ _ #%fine-template)
-    (pattern (~or (#%blanket-template
-                   ((#%host-expression (~datum filter))
-                    (#%host-expression f)
-                    __))
-                  (#%fine-template
-                   ((#%host-expression (~datum filter))
-                    (#%host-expression f)
-                    _)))
-             #: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 #%blanket-template __ _ #%fine-template)
-    (pattern (~or (#%blanket-template
-                   ((#%host-expression (~datum map))
-                    (#%host-expression f)
-                    __))
-                  (#%fine-template
-                   ((#%host-expression (~datum map))
-                    (#%host-expression f)
-                    _)))
-             #:attr next #'map-cstream-next)
-
-    (pattern (~or (#%blanket-template
-                   ((#%host-expression (~datum filter))
-                    (#%host-expression f)
-                    __))
-                  (#%fine-template
-                   ((#%host-expression (~datum filter))
-                    (#%host-expression f)
-                    _)))
-             #:attr next #'filter-cstream-next))
-
-  ;; Terminates the fused sequence (consumes the stream) and produces
-  ;; an actual result value.
-  (define-syntax-class fusable-stream-consumer
-    #:attributes (end)
-    #:datum-literals (#%host-expression #%blanket-template _ __ #%fine-template esc)
-    (pattern (~or (#%blanket-template
-                   ((#%host-expression (~datum foldr))
-                    (#%host-expression op)
-                    (#%host-expression init)
-                    __))
-                  (#%fine-template
-                   ((#%host-expression (~datum foldr))
-                    (#%host-expression op)
-                    (#%host-expression init)
-                    _)))
-             #:attr end #'(foldr-cstream-next op init))
-
-    (pattern (~or (#%blanket-template
-                   ((#%host-expression (~datum foldl))
-                    (#%host-expression op)
-                    (#%host-expression init)
-                    __))
-                  (#%fine-template
-                   ((#%host-expression (~datum foldl))
-                    (#%host-expression op)
-                    (#%host-expression init)
-                    _)))
-             #:attr end #'(foldl-cstream-next op init))
-
-    (pattern (~or (esc (#%host-expression (~datum car)))
-                  (#%fine-template
-                   ((#%host-expression (~datum car))
-                    _))
-                  (#%blanket-template
-                   ((#%host-expression (~datum car))
-                    __)))
-             #:attr end #'(car-cstream-next))
-
-    (pattern (~literal cstream->list)
-             #:attr end #'(cstream-next->list)))
-
-  ;; Used only in deforest-rewrite to properly recognize the end of
-  ;; fusable sequence.
-  (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 be in the following form:
-  ;; (producer transformer ... consumer)
-  (define (generate-fused-operation ops ctx)
-    (syntax-parse (reverse ops)
-      [(c:fusable-stream-consumer
-        t:fusable-stream-transformer ...
-        p:fusable-stream-producer)
-       ;; A static runtime contract is placed at the beginning of the
-       ;; fused sequence. And runtime checks for consumers are in
-       ;; their respective implementation procedure.
-       #`(esc
-          (#,((attribute p.curry) ctx (attribute p.name))
-           (contract p.contract
-                     (p.prepare
-                      (#,@#'c.end
-                       (inline-compose1 [t.next t.f] ...
-                                        p.next)
-                       '#,(prettify-flow-syntax ctx)
-                       '#,(build-source-location-vector
-                           (syntax-srcloc ctx))))
-                     p.name
-                     '#,(prettify-flow-syntax ctx)
-                     #f
-                     '#,(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
-     (fix deforest-rewrite)
-     stx)))
-
-(begin-encourage-inline
-
-  ;; Producers
-
-  (define-inline (list->cstream-next done skip yield)
-    (λ (state)
-      (cond [(null? state) (done)]
-            [else (yield (car state) (cdr state))])))
-
-  (define-inline (list->cstream-prepare next)
-    (case-lambda
-      [(lst) (next lst)]
-      [rest (void)]))
-
-  (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 (range->cstream-prepare next)
-    (case-lambda
-      [(h) (next (list 0 h 1))]
-      [(l h) (next (list l h 1))]
-      [(l h s) (next (list l h s))]
-      [rest (void)]))
-
-  ;; Transformers
-
-  (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))))))
-
-  ;; Consumers
-
-  (define-inline (cstream-next->list next ctx src)
-    (λ (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 ctx src)
-    (λ (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 ctx src)
-    (λ (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 ctx src)
-    (λ (state)
-      (let loop ([state state])
-        ((next (λ () ((contract (-> pair? any)
-                                (λ (v) v)
-                                'car-cstream-next ctx #f
-                                src) '()))
-               (λ (state) (loop state))
-               (λ (value state)
-                 value))
-         state))))
-
-  )
diff --git a/qi-lib/list.rkt b/qi-lib/list.rkt
index dd3e56b3..0e8ca781 100644
--- a/qi-lib/list.rkt
+++ b/qi-lib/list.rkt
@@ -2,7 +2,7 @@
 
 ;; Upon instantiation of the module it define-and-register-pass for
 ;; deforestation
-(require racket/list
-         "flow/core/deforest.rkt")
+(require "flow/core/compiler/0100-deforest.rkt"
+         "flow/core/compiler/deforest/bindings.rkt")
 
-(provide (all-from-out racket/list))
+(provide (all-from-out "flow/core/compiler/deforest/bindings.rkt"))
diff --git a/qi-test/tests/compiler/rules/deforest.rkt b/qi-test/tests/compiler/rules/deforest.rkt
index 5d2f0670..1023475d 100644
--- a/qi-test/tests/compiler/rules/deforest.rkt
+++ b/qi-test/tests/compiler/rules/deforest.rkt
@@ -9,7 +9,8 @@
          ;; necessary to correctly expand the right-threading form
          qi/flow/extended/forms
          qi/flow/core/compiler
-         qi/flow/core/deforest
+         qi/flow/core/compiler/0100-deforest
+         qi/list
          syntax/macro-testing
          (submod qi/flow/extended/expander invoke)
          rackunit
diff --git a/qi-test/tests/compiler/rules/full-cycle.rkt b/qi-test/tests/compiler/rules/full-cycle.rkt
index e7e17496..c6857b83 100644
--- a/qi-test/tests/compiler/rules/full-cycle.rkt
+++ b/qi-test/tests/compiler/rules/full-cycle.rkt
@@ -10,8 +10,8 @@
          rackunit
          rackunit/text-ui
          syntax/macro-testing
-         qi/flow/core/deforest
-         qi/flow/core/compiler
+         qi/flow/core/compiler/0100-deforest
+         qi/list
          "private/deforest-util.rkt"
          (submod qi/flow/extended/expander invoke))
 
diff --git a/qi-test/tests/compiler/rules/private/deforest-util.rkt b/qi-test/tests/compiler/rules/private/deforest-util.rkt
index 193a986d..4ab71c7d 100644
--- a/qi-test/tests/compiler/rules/private/deforest-util.rkt
+++ b/qi-test/tests/compiler/rules/private/deforest-util.rkt
@@ -20,4 +20,4 @@
   (string-contains? (format "~a" exp) "filter-cstream"))
 
 (define (car-deforested? exp)
-  (string-contains? (format "~a" exp) "car-cstream"))
+  (string-contains? (format "~a" exp) "list-ref-cstream"))
diff --git a/qi-test/tests/compiler/semantics.rkt b/qi-test/tests/compiler/semantics.rkt
index 2ffcad81..5453f38b 100644
--- a/qi-test/tests/compiler/semantics.rkt
+++ b/qi-test/tests/compiler/semantics.rkt
@@ -183,7 +183,19 @@
                   '(25))
      (test-equal? "~>> (range _ 10 3) [1] (5)"
                   (~>> (5) (range _ 10 3) (filter odd?) (map sqr))
-                  '(25))))))
+                  '(25)))
+
+    (test-suite
+     "take (stateful transformer)"
+     (test-equal? "take after filter"
+                  (~>> (20) range (filter odd?) (take _ 5) (map sqr))
+                  '(1 9 25 49 81))
+
+     (test-equal? "two takes after filter"
+                  (~>> (20) range (filter odd?) (take _ 5) (take _ 3) (map sqr))
+                  '(1 9 25))
+
+     ))))
 
 (module+ main
   (void (run-tests tests)))