From 2f3085b5f92732e8e50cb64ac22453cc23dd95d0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Thu, 27 Jun 2024 11:50:01 +0200 Subject: [PATCH] Update PR#175 with all the changes agreed upon at the weekly Qi compiler meeting on 2024-06-21. - add detailed explanation for inline-consing syntax - use Racket's conventions for parentheses - add description of fsp-, fst-, and fsc- prefixes - move define-and-register-deforest-pass and related to separate module, add comments --- qi-lib/flow/core/compiler/deforest/cps.rkt | 44 +++++---- qi-lib/flow/core/compiler/deforest/fusion.rkt | 76 +++++++++++++++ qi-lib/flow/core/compiler/deforest/syntax.rkt | 96 ++++++------------- 3 files changed, 129 insertions(+), 87 deletions(-) create mode 100644 qi-lib/flow/core/compiler/deforest/fusion.rkt diff --git a/qi-lib/flow/core/compiler/deforest/cps.rkt b/qi-lib/flow/core/compiler/deforest/cps.rkt index 918a684a6..65072bcd7 100644 --- a/qi-lib/flow/core/compiler/deforest/cps.rkt +++ b/qi-lib/flow/core/compiler/deforest/cps.rkt @@ -7,7 +7,8 @@ "syntax.rkt" "../../../extended/util.rkt" syntax/srcloc - racket/syntax-srcloc) + racket/syntax-srcloc + "fusion.rkt") "templates.rkt" racket/performance-hint racket/match @@ -24,6 +25,13 @@ [(_ [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 ...)] @@ -289,22 +297,21 @@ (λ (take-state) (define n (car take-state)) (define state (cdr take-state)) - (cond ((zero? n) - (done)) - (else - ((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)))))) + (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 @@ -342,7 +349,8 @@ ((next (λ () ((contract (-> pair? any) (λ (v) v) name ctx #f - src) '())) + src) + '())) (λ (state) (loop state countdown)) (λ (value state) (if (zero? countdown) 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 000000000..9049c377a --- /dev/null +++ b/qi-lib/flow/core/compiler/deforest/fusion.rkt @@ -0,0 +1,76 @@ +#lang racket/base + +(provide define-and-register-deforest-pass) + +(require (for-syntax racket/base + syntax/parse) + syntax/parse + "syntax.rkt" + "../../passes.rkt" + "../../strategy.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) + (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 index dfab0e9cc..ebe2f6e97 100644 --- a/qi-lib/flow/core/compiler/deforest/syntax.rkt +++ b/qi-lib/flow/core/compiler/deforest/syntax.rkt @@ -1,6 +1,11 @@ #lang racket/base -(provide fsp-range +(provide fsp-syntax + fst-syntax0 + fst-syntax + fsc-syntax + + fsp-range fsp-default fst-filter @@ -15,7 +20,6 @@ fsc-empty? fsc-default - define-and-register-deforest-pass ) (require syntax/parse @@ -29,12 +33,19 @@ (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 _ __) ()) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Producers +;; 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) @@ -76,7 +87,12 @@ _:fsp-default))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Transformers +;; 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) @@ -130,7 +146,7 @@ _ (#%host-expression n))))) -(define-syntax-class fst-intf0 +(define-syntax-class fst-syntax0 (pattern (~or filter:fst-filter filter-map:fst-filter-map))) @@ -141,7 +157,12 @@ _:fst-take))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Consumers +;; 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) @@ -233,66 +254,3 @@ _:fsc-empty? _:fsc-default ))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; 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) - (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-intf0 - 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-intf0 - 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]))) - -(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)))))