Skip to content

Commit

Permalink
Update PR#175 with all the changes agreed upon at the weekly Qi compi…
Browse files Browse the repository at this point in the history 
…ler 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
  • Loading branch information
@dzoep @countvajhula
dzoep authored and countvajhula committed Aug 3, 2024
1 parent de25f55 commit 2f3085b
Show file tree
Hide file tree
Showing 3 changed files with 129 additions and 87 deletions.
44 changes: 26 additions & 18 deletions qi-lib/flow/core/compiler/deforest/cps.rkt
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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 ...)]
Expand Down Expand Up @@ -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

Expand Down Expand Up @@ -342,7 +349,8 @@
((next (λ () ((contract (-> pair? any)
(λ (v) v)
name ctx #f
src) '()))
src)
'()))
(λ (state) (loop state countdown))
(λ (value state)
(if (zero? countdown)
Expand Down
76 changes: 76 additions & 0 deletions qi-lib/flow/core/compiler/deforest/fusion.rkt
View file
Original file line number Diff line number Diff line change
@@ -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)))))
96 changes: 27 additions & 69 deletions qi-lib/flow/core/compiler/deforest/syntax.rkt
View file
Original file line number Diff line number Diff line change
@@ -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
Expand All @@ -15,7 +20,6 @@
fsc-empty?
fsc-default

define-and-register-deforest-pass
)

(require syntax/parse
Expand All @@ -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)
Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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)))

Expand All @@ -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)
Expand Down Expand Up @@ -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)))))

0 comments on commit 2f3085b

Please sign in to comment.