Skip to content

Commit

Permalink
Merge pull request #114 from dzoep/first-optimizations
Browse files Browse the repository at this point in the history 
First optimizations
  • Loading branch information
@countvajhula
countvajhula authored Nov 17, 2023
2 parents 6e3b681 + 9f0f940 commit e5feb6f
Show file tree
Hide file tree
Showing 3 changed files with 264 additions and 263 deletions.
194 changes: 2 additions & 192 deletions qi-lib/flow/core/compiler.rkt
View file
Original file line number Diff line number Diff line change
Expand Up @@ -17,17 +17,8 @@
racket/function
racket/undefined
(prefix-in fancy: fancy-app)
racket/list)

;; "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 ...))]))
racket/list
"deforest.rkt")

(begin-for-syntax

Expand All @@ -48,144 +39,6 @@
(define (compile-flow stx)
(process-bindings (optimize-flow stx)))

;; 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)
#:datum-literals (#%host-expression #%partial-application esc)
(pattern (~and (esc (#%host-expression (~literal range)))
stx)
#:attr next #'range->cstream-next
#:attr prepare #'range->cstream-prepare)
(pattern (~and (#%partial-application
((#%host-expression (~literal range))
(#%host-expression arg) ...))
stx)
#:do [(define chirality (syntax-property #'stx 'chirality))]
#:with vindaloo (if (and chirality (eq? chirality 'right))
#'curry
#'curryr)
#:attr next #'range->cstream-next
#:attr prepare #'(vindaloo range->cstream-prepare arg ...)))

;; 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 #%partial-application)
(pattern (~and (#%partial-application
((#%host-expression (~literal filter))
(#%host-expression f)))
stx)
#:do [(define chirality (syntax-property #'stx 'chirality))]
#:when (and chirality (eq? chirality 'right))
#: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 #%partial-application)
(pattern (~and (#%partial-application
((#%host-expression (~literal map))
(#%host-expression f)))
stx)
#:do [(define chirality (syntax-property #'stx 'chirality))]
#:when (and chirality (eq? chirality 'right))
#:attr next #'map-cstream-next)
(pattern (~and (#%partial-application
((#%host-expression (~literal filter))
(#%host-expression f)))
stx)
#:do [(define chirality (syntax-property #'stx 'chirality))]
#:when (and chirality (eq? chirality 'right))
#:attr next #'filter-cstream-next))

;; Terminates the fused sequence (consumes the stream) and produces
;; an actual result value. The implicit consumer is cstream->list is
;; not part of this class as it is added explicitly when generating
;; the fused operation.
(define-syntax-class fusable-stream-consumer
#:attributes (op init end)
#:datum-literals (#%host-expression #%partial-application)
(pattern (~and (#%partial-application
((#%host-expression (~literal foldr))
(#%host-expression op)
(#%host-expression init)))
stx)
#:do [(define chirality (syntax-property #'stx 'chirality))]
#:when (and chirality (eq? chirality 'right))
#:attr end #'(foldr-cstream op init))
(pattern (~and (#%partial-application
((#%host-expression (~literal foldl))
(#%host-expression op)
(#%host-expression init)))
stx)
#:do [(define chirality (syntax-property #'stx 'chirality))]
#:when (and chirality (eq? chirality 'right))
#:attr end #'(foldl-cstream op init)))

(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 conform to the rule that
;; if the first operation is a fusable-stream-transformer, it must
;; be a fusable-stream-transformer0 as well!
(define (generate-fused-operation ops)
(syntax-parse (reverse ops)
[(g:fusable-stream-consumer
op:fusable-stream-transformer ...
p:fusable-stream-producer)
;; Contract probably not needed (prepare should produce
;; meaningful error messages)
#`(esc (λ args
((#,@#'g.end
(inline-compose1 [op.next op.f] ...
p.next))
(apply p.prepare args))))]
[(g:fusable-stream-consumer
p:fusable-stream-producer)
;; dtto
#`(esc (λ args
((#,@#'g.end p.next)
(apply p.prepare args))))]
;; The list must contain fusable-stream-transformer0 as the last element!
[(g:fusable-stream-consumer
op:fusable-stream-transformer ...)
;; TODO: Add contract
#`(esc (λ (lst)
((#,@#'g.end
(inline-compose1 [op.next op.f] ...
list->cstream-next))
lst)))]
[(op:fusable-stream-transformer ...
p:fusable-stream-producer)
;; dtto
#`(esc (λ args
((cstream->list
(inline-compose1 [op.next op.f] ...
p.next))
(apply p.prepare args))))]
;; dtto
[(op:fusable-stream-transformer ...)
#'(esc (λ (lst)
;; have a contract here for the input
;; validate it's a list, and error message
;; can include the op syntax object
((cstream->list
(inline-compose1 [op.next op.f] ...
list->cstream-next))
lst)))]
))

(define-qi-expansion-step (normalize-rewrite stx)
;; TODO: the "active" components of the expansions should be
;; optimized, i.e. they should be wrapped with a recursive
Expand Down Expand Up @@ -241,49 +94,6 @@
;; return syntax unchanged if there are no known optimizations
[_ stx]))

;; 0. "Qi-normal form"
;; 1. deforestation pass
;; 2. other passes ...
;; e.g.:
;; changing internal representation to lists from values - may affect passes
;; passes as distinct stages is safe and interesting, a conservative start
;; one challenge: traversing the syntax tree
(define (deforest-rewrite stx)
(syntax-parse stx
[((~datum thread) _0:non-fusable ...
p:fusable-stream-producer
f:fusable-stream-transformer ...+
g:fusable-stream-consumer
_1 ...)
#:with fused (generate-fused-operation (syntax->list #'(p f ... g)))
#'(thread _0 ... fused _1 ...)]
[((~datum thread) _0:non-fusable ...
p:fusable-stream-producer
g:fusable-stream-consumer
_1 ...)
#:with fused (generate-fused-operation (syntax->list #'(p g)))
#'(thread _0 ... fused _1 ...)]
[((~datum thread) _0:non-fusable ...
f1:fusable-stream-transformer0
f:fusable-stream-transformer ...+
g:fusable-stream-consumer
_1 ...)
#:with fused (generate-fused-operation (syntax->list #'(f1 f ... g)))
#'(thread _0 ... fused _1 ...)]
[((~datum thread) _0:non-fusable ...
p:fusable-stream-producer
f:fusable-stream-transformer ...+
_1 ...)
#:with fused (generate-fused-operation (syntax->list #'(p f ...)))
#'(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 #'(f1 f ...)))
#'(thread _0 ... fused _1 ...)]
[_ this-syntax]))

;; Applies f repeatedly to the init-val terminating the loop if the
;; result of f is #f or the new syntax object is eq? to the previous
;; (possibly initial) one.
Expand Down
Loading

0 comments on commit e5feb6f

Please sign in to comment.