Skip to content

Commit

Permalink
Merge pull request #163 from countvajhula/modular-compiler-changes
Browse files Browse the repository at this point in the history 
Modular compiler changes
  • Loading branch information
@countvajhula
countvajhula authored Mar 8, 2024
2 parents 97f55ce + 5e5e8eb commit 548bc76
Show file tree
Hide file tree
Showing 7 changed files with 124 additions and 121 deletions.
2 changes: 1 addition & 1 deletion qi-lib/flow/core/compiler.rkt
View file
Original file line number Diff line number Diff line change
Expand Up @@ -8,7 +8,7 @@
(only-in racket/list make-list)
"syntax.rkt"
"../aux-syntax.rkt"
"pass.rkt"
"strategy.rkt"
"debug.rkt"
"private/form-property.rkt")
"impl.rkt"
Expand Down
86 changes: 44 additions & 42 deletions qi-lib/flow/core/deforest.rkt
View file
Original file line number Diff line number Diff line change
Expand Up @@ -16,7 +16,7 @@
racket/syntax-srcloc
syntax/srcloc
"../extended/util.rkt"
"pass.rkt")
"strategy.rkt")
"passes.rkt"
racket/performance-hint
racket/match
Expand Down Expand Up @@ -284,50 +284,52 @@
'#,(build-source-location-vector
(syntax-srcloc ctx)))))]))

(define (deforest-rewrite stx)
(syntax-parse stx
[((~datum thread) _0:non-fusable ...
p:fusable-stream-producer
;; There can be zero transformers here:
t:fusable-stream-transformer ...
c:fusable-stream-consumer
_1 ...)
#:with fused (generate-fused-operation
(syntax->list #'(p t ... c))
stx)
#'(thread _0 ... fused _1 ...)]
[((~datum thread) _0:non-fusable ...
t1:fusable-stream-transformer0
t:fusable-stream-transformer ...
c:fusable-stream-consumer
_1 ...)
#:with fused (generate-fused-operation
(syntax->list #'(list->cstream t1 t ... c))
stx)
#'(thread _0 ... fused _1 ...)]
[((~datum thread) _0:non-fusable ...
p:fusable-stream-producer
;; Must be 1 or more transformers here:
t:fusable-stream-transformer ...+
_1 ...)
#:with fused (generate-fused-operation
(syntax->list #'(p t ... cstream->list))
stx)
#'(thread _0 ... fused _1 ...)]
[((~datum thread) _0:non-fusable ...
f1:fusable-stream-transformer0
f:fusable-stream-transformer ...+
_1 ...)
#:with fused (generate-fused-operation
(syntax->list #'(list->cstream f1 f ... cstream->list))
stx)
#'(thread _0 ... fused _1 ...)]
;; return the input syntax unchanged if no rules
;; are applicable
[_ stx]))

;; Performs deforestation rewrite on the whole syntax tree.
(define-and-register-pass 100 (deforest-pass stx)
(find-and-map/qi
(lambda (stx)
(syntax-parse stx
[((~datum thread) _0:non-fusable ...
p:fusable-stream-producer
;; There can be zero transformers here:
t:fusable-stream-transformer ...
c:fusable-stream-consumer
_1 ...)
#:with fused (generate-fused-operation
(syntax->list #'(p t ... c))
stx)
#'(thread _0 ... fused _1 ...)]
[((~datum thread) _0:non-fusable ...
t1:fusable-stream-transformer0
t:fusable-stream-transformer ...
c:fusable-stream-consumer
_1 ...)
#:with fused (generate-fused-operation
(syntax->list #'(list->cstream t1 t ... c))
stx)
#'(thread _0 ... fused _1 ...)]
[((~datum thread) _0:non-fusable ...
p:fusable-stream-producer
;; Must be 1 or more transformers here:
t:fusable-stream-transformer ...+
_1 ...)
#:with fused (generate-fused-operation
(syntax->list #'(p t ... cstream->list))
stx)
#'(thread _0 ... fused _1 ...)]
[((~datum thread) _0:non-fusable ...
f1:fusable-stream-transformer0
f:fusable-stream-transformer ...+
_1 ...)
#:with fused (generate-fused-operation
(syntax->list #'(list->cstream f1 f ... cstream->list))
stx)
#'(thread _0 ... fused _1 ...)]
;; return the input syntax unchanged if no rules
;; are applicable
[_ stx]))
deforest-rewrite
stx)))

(begin-encourage-inline
Expand Down
145 changes: 73 additions & 72 deletions qi-lib/flow/core/normalize.rkt
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,84 +4,85 @@

(require (for-syntax racket/base
syntax/parse
"pass.rkt"
"strategy.rkt"
"private/form-property.rkt")
"passes.rkt")

;; 0. "Qi-normal form"
(begin-for-syntax
(define (normalize-rewrite stx)
(syntax-parse stx
#:datum-literals (#%host-expression
#%blanket-template
#%fine-template
esc
gen
thread
pass
if
amp
relay
tee
sep
collect
__)

;; "deforestation" for values
;; (~> (pass f) (>< g)) → (>< (if f g ⏚))
[(thread _0 ... (pass f) (amp g) _1 ...)
#'(thread _0 ... (amp (if f g ground)) _1 ...)]
;; merge pass filters in sequence
[(thread _0 ... (pass f) (pass g) _1 ...)
#'(thread _0 ... (pass (and f g)) _1 ...)]
;; collapse deterministic conditionals
[(if (gen (#%host-expression (~datum #t)))
f
g)
#'f]
[(if (gen (#%host-expression (~datum #f)))
f
g)
#'g]
;; trivial threading form
[(thread f)
#'f]
;; associative laws for ~>
[(thread _0 ... (thread f ...) _1 ...) ; note: greedy matching
#'(thread _0 ... f ... _1 ...)]
;; left and right identity for ~>
[(thread _0 ... (~datum _) _1 ...)
#'(thread _0 ... _1 ...)]
;; composition of identity flows is the identity flow
[(thread (~datum _) ...)
#'_]
;; amp and identity
[(amp (~datum _))
#'_]
;; trivial tee junction
[(tee f)
#'f]
;; merge adjacent gens in a tee junction
[(tee _0 ... (gen a ...) (gen b ...) _1 ...)
#'(tee _0 ... (gen a ... b ...) _1 ...)]
;; dead gen elimination
[(thread _0 ... (gen a ...) (gen b ...) _1 ...)
#'(thread _0 ... (gen b ...) _1 ...)]
;; prism identities
;; Note: (~> ... △ ▽ ...) can't be rewritten to `values` since that's
;; only valid if the input is in fact a list, and is an error otherwise,
;; and we can only know this at runtime.
[(thread _0 ... collect sep _1 ...)
#'(thread _0 ... _1 ...)]
;; collapse `values` inside a threading form
[(thread _0 ... (esc (#%host-expression (~literal values))) _1 ...)
#'(thread _0 ... _1 ...)]
[(#%blanket-template (hex __))
#'(esc hex)]
;; return syntax unchanged if there are no applicable normalizations
[_ stx]))

(define-and-register-pass 10 (normalize-pass stx)
(attach-form-property
(find-and-map/qi
(fix
(lambda (stx)
(syntax-parse stx
#:datum-literals (#%host-expression
#%blanket-template
#%fine-template
esc
gen
thread
pass
if
amp
relay
tee
sep
collect
__)

;; "deforestation" for values
;; (~> (pass f) (>< g)) → (>< (if f g ⏚))
[(thread _0 ... (pass f) (amp g) _1 ...)
#'(thread _0 ... (amp (if f g ground)) _1 ...)]
;; merge pass filters in sequence
[(thread _0 ... (pass f) (pass g) _1 ...)
#'(thread _0 ... (pass (and f g)) _1 ...)]
;; collapse deterministic conditionals
[(if (gen (#%host-expression (~datum #t)))
f
g)
#'f]
[(if (gen (#%host-expression (~datum #f)))
f
g)
#'g]
;; trivial threading form
[(thread f)
#'f]
;; associative laws for ~>
[(thread _0 ... (thread f ...) _1 ...) ; note: greedy matching
#'(thread _0 ... f ... _1 ...)]
;; left and right identity for ~>
[(thread _0 ... (~datum _) _1 ...)
#'(thread _0 ... _1 ...)]
;; composition of identity flows is the identity flow
[(thread (~datum _) ...)
#'_]
;; amp and identity
[(amp (~datum _))
#'_]
;; trivial tee junction
[(tee f)
#'f]
;; merge adjacent gens in a tee junction
[(tee _0 ... (gen a ...) (gen b ...) _1 ...)
#'(tee _0 ... (gen a ... b ...) _1 ...)]
;; dead gen elimination
[(thread _0 ... (gen a ...) (gen b ...) _1 ...)
#'(thread _0 ... (gen b ...) _1 ...)]
;; prism identities
;; Note: (~> ... △ ▽ ...) can't be rewritten to `values` since that's
;; only valid if the input is in fact a list, and is an error otherwise,
;; and we can only know this at runtime.
[(thread _0 ... collect sep _1 ...)
#'(thread _0 ... _1 ...)]
;; collapse `values` inside a threading form
[(thread _0 ... (esc (#%host-expression (~literal values))) _1 ...)
#'(thread _0 ... _1 ...)]
[(#%blanket-template (hex __))
#'(esc hex)]
;; return syntax unchanged if there are no applicable normalizations
[_ stx])))
(fix normalize-rewrite)
stx))))
6 changes: 3 additions & 3 deletions qi-lib/flow/core/passes.rkt
View file
Original file line number Diff line number Diff line change
Expand Up @@ -33,15 +33,15 @@
;; passes. Should be used by modules implementing passes.
(define-syntax-rule (define-and-register-pass prio (name stx) expr ...)
(begin
(define name (lambda (stx) expr ...))
(define (name stx) expr ...)
(register-pass #'name prio name)
))

;; Runs registered passes on given syntax object - should be used by
;; the actual compiler.
(define (run-passes stx)
(for/fold ((stx stx))
((pass (in-list (unbox registered-passes))))
(for/fold ([stx stx])
([pass (in-list (unbox registered-passes))])
(define stx1 ((passdef-parser pass) stx))
(emit-local-step stx stx1 #:id (passdef-name pass))
stx1))
Expand Down
0 qi-lib/flow/core/pass.rkt → qi-lib/flow/core/strategy.rkt
View file
File renamed without changes.
4 changes: 2 additions & 2 deletions qi-test/tests/compiler.rkt
View file
Original file line number Diff line number Diff line change
Expand Up @@ -6,7 +6,7 @@
rackunit/text-ui
(prefix-in semantics: "compiler/semantics.rkt")
(prefix-in rules: "compiler/rules.rkt")
(prefix-in pass: "compiler/pass.rkt")
(prefix-in strategy: "compiler/strategy.rkt")
(prefix-in impl: "compiler/impl.rkt"))

(define tests
Expand All @@ -15,7 +15,7 @@

semantics:tests
rules:tests
pass:tests
strategy:tests
impl:tests))

(module+ main
Expand Down
2 changes: 1 addition & 1 deletion qi-test/tests/compiler/pass.rkt → qi-test/tests/compiler/strategy.rkt
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2,7 +2,7 @@

(provide tests)

(require qi/flow/core/pass
(require qi/flow/core/strategy
rackunit
rackunit/text-ui
syntax/parse
Expand Down

0 comments on commit 548bc76

Please sign in to comment.